freepascal.compiler/rtl/i386/i386.inc

{
    $Id$
    This file is part of the Free Pascal run time library.
    Copyright (c) 1993,97 by the Free Pascal development team.

    Processor dependent implementation for the system unit for
    intel i386+
    
    See the file COPYING.FPC, included in this distribution,
    for details about the copyright.

    This program is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.

 **********************************************************************}

{****************************************************************************
                                Move / Fill
****************************************************************************}

procedure Move(var source;var dest;count:longint);
begin
        asm
        movl    dest,%edi
        movl    source,%esi
        movl    %edi,%eax
        movl    count,%ebx
{ Check for back or forward }
        sub     %esi,%eax
        jz      .LMoveEnd               { Do nothing when source=dest }
        jc      .LFMove                 { Do forward, dest<source }
        cmp     %ebx,%eax
        jb      .LBMove                 { Dest is in range of move, do backward }
{ Forward Copy }
.LFMove:
        cld
        cmpl    $15,%ebx
        jl      .LFMove1
        movl    %edi,%ecx       { Align on 32bits }
        negl    %ecx
        andl    $3,%ecx
        subl    %ecx,%ebx
        rep
        movsb
        movl    %ebx,%ecx
        andl    $3,%ebx
        shrl    $2,%ecx
        rep
        movsl
.LFMove1:
        movl    %ebx,%ecx
        rep
        movsb
        jmp .LMoveEnd
{ Backward Copy }
.LBMove:
        std
        addl    %ebx,%esi
        addl    %ebx,%edi
        movl    %edi,%ecx
        decl    %esi
        decl    %edi
        cmpl    $15,%ebx
        jl      .LBMove1
        negl    %ecx            { Align on 32bits }
        andl    $3,%ecx
        subl    %ecx,%ebx
        rep
        movsb
        movl    %ebx,%ecx
        andl    $3,%ebx
        shrl    $2,%ecx
        subl    $3,%esi
        subl    $3,%edi
        rep
        movsl
        addl    $3,%esi
        addl    $3,%edi
.LBMove1:
        movl    %ebx,%ecx
        rep
        movsb
        cld
.LMoveEnd:
        end;
end;


Procedure FillChar(var x;count:longint;value:byte);[alias: 'FILL_OBJECT'];
begin
        asm
        cld
        movl    x,%edi
        movl    value,%eax      { Only lower 8 bits will be used }
        movl    count,%ecx
        cmpl    $7,%ecx
        jl      .LFill1
        movb    %al,%ah
        movl    %eax,%ebx
        shll    $16,%eax
        movl    %ecx,%edx
        movw    %bx,%ax
        movl    %edi,%ecx       { Align on 32bits }
        negl    %ecx
        andl    $3,%ecx
        subl    %ecx,%edx
        rep
        stosb
        movl    %edx,%ecx
        andl    $3,%edx
        shrl    $2,%ecx
        rep
        stosl
        movl    %edx,%ecx
.LFill1:
        rep
        stosb
        end;
end;


procedure fillword(var x;count : longint;value : word);
begin
  asm
        movl 8(%ebp),%edi
        movl 12(%ebp),%ecx
        movl 16(%ebp),%eax
        movl %eax,%edx
        shll $16,%eax
        movw %dx,%ax
        movl %ecx,%edx
        shrl $1,%ecx
        cld
        rep
        stosl
        movl %edx,%ecx
        andl $1,%ecx
        rep
        stosw
  end ['EAX','ECX','EDX','EDI'];
end;



{****************************************************************************
                              Object Helpers
****************************************************************************}

{$I386_DIRECT}

procedure int_help_constructor;assembler; [public,alias:'HELP_CONSTRUCTOR'];
asm
{ Entry without preamble, since we need the ESP of the constructor
  Stack (relative to %ebp):
    12 Self
     8 VMT-Address
     4 main programm-Addr
     0 %ebp
}
      { eax isn't touched anywhere, so it doesn't have to reloaded }
	movl	8(%ebp),%eax
      { initialise self ? }
	orl	%esi,%esi
	jne	.LHC_4
      { get memory, but save register first temporary variable }
        subl	$4,%esp
        movl	%esp,%esi
      { Save Register}
        pushal
      { Memory size }
        pushl	(%eax)
        pushl	%esi
        call	GETMEM
        popal
      { Memory size to %esi }
        movl	(%esi),%esi
        addl	$4,%esp
      { If no memory available : fail() }
        orl	%esi,%esi
        jz	.LHC_5
      { init self for the constructor }
        movl	%esi,12(%ebp)
.LHC_4:
      { is there a VMT address ? }
        orl	%eax,%eax
        jnz	.LHC_7
      { In case the constructor doesn't do anything, the Zero-Flag }
      { can't be put, because this calls Fail() }
        incl	%eax
        ret
.LHC_7:
      { set zero inside the object }
        pushal
        pushw	$0
        pushl	(%eax)
        pushl	%esi
        call	FILL_OBJECT
        popal
      { set the VMT address for the new created object }
        movl	%eax,(%esi)
        orl	%eax,%eax
.LHC_5:
end;


procedure help_fail;assembler;
asm
end;


procedure int_new_class;assembler;[public,alias:'NEW_CLASS'];
asm
     { create class ? }
     movl 8(%ebp),%edi
     orl %edi,%edi
     jz .LNEW_CLASS1
     { esi contains the vmt }
     pushl %esi
     { call newinstance (class method!) }
     call 16(%esi)
     { newinstance returns a pointer to the new created }
     { instance in eax                                  }
     { load esi and insert self                         }
     movl %eax,8(%ebp)
     movl %eax,%esi
     ret
.LNEW_CLASS1:
     movl %esi,8(%ebp)
end;


procedure int_dispose_class;assembler;[public,alias:'DISPOSE_CLASS'];
asm
     { destroy class ? }
     movl 8(%ebp),%edi
     { save self }
     movl %esi,8(%ebp)
     orl %edi,%edi
     jz .LDISPOSE_CLASS1
     { no inherited call }
     movl (%esi),%edi
     { push self }
     pushl %esi
     { call freeinstance }
     call 20(%edi)
.LDISPOSE_CLASS1:
     { load self }
     movl 8(%ebp),%esi
end;


{ checks for a correct vmt pointer }
procedure int_check_object;assembler;[public,alias:'CHECK_OBJECT'];
asm
     pushl %edi
     movl 8(%esp),%edi
     pushl %eax
     { Here we must check if the VMT pointer is nil before  }
     { accessing it...                                      }
     { WARNING: Will only probably work with GAS, as fields }
     { are ZEROED automatically in BSS, which might not be  }
     { the case with other linkers/assemblers...            }
     orl   %edi,%edi
     jz    .Lco_re
     movl (%edi),%eax
     addl 4(%edi),%eax
     jnz .Lco_re
     popl %eax
     popl %edi
     ret $4
.Lco_re:
     pushw $210
     call runerror
end;


procedure int_help_destructor;assembler;[public,alias:'HELP_DESTRUCTOR'];
asm
{ Stack (relative to %ebp):
    12 Self
     8 VMT-Address
     4 Main program-Addr
     0 %ebp
}
      { temporary Variable }
	subl 	$4,%esp
        movl 	%esp,%edi
        pushal
      { Should the object be resolved ? }
        movl 	8(%ebp),%eax
        orl 	%eax,%eax
        jz 	.LHD_3
      { Yes, get size from SELF! }
        movl 	12(%ebp),%eax
      { get VMT-pointer (from Self) to %ebx }
        movl 	(%eax),%ebx
      { And put size on the Stack }
        pushl 	(%ebx)
      { SELF }
      { I think for precaution }
      { that we should clear the VMT here }
        movl 	$0,(%eax)
        movl 	%eax,(%edi)
        pushl 	%edi
        call 	FREEMEM
.LHD_3:
        popal
        addl	$4,%esp
end;


{****************************************************************************
                                 String 
****************************************************************************}

procedure strcopy(dstr,sstr:pointer;len:longint);[public,alias:'STRCOPY'];
{
  this procedure must save all modified registers except EDI and ESI !!!
}
begin
  asm
        pushl %eax
        pushl %ecx
        cld
        movl    16(%ebp),%edi
        movl    12(%ebp),%esi
        xorl    %eax,%eax
        movl    8(%ebp),%ecx
        lodsb
        cmpl    %ecx,%eax
        jbe     .LStrCopy1
        movl    %ecx,%eax
.LStrCopy1:
        stosb
        cmpl    $7,%eax
        jl      .LStrCopy2
        movl    %edi,%ecx       { Align on 32bits }
        negl    %ecx
        andl    $3,%ecx
        subl    %ecx,%eax
        rep
        movsb
        movl    %eax,%ecx
        andl    $3,%eax
        shrl    $2,%ecx
        rep
        movsl
.LStrCopy2:
        movl    %eax,%ecx
        rep
        movsb
        popl %ecx
        popl %eax
  end ['ECX','EAX','ESI','EDI'];
end;


procedure strconcat(s1,s2 : pointer);[public,alias: 'STRCONCAT'];
begin
  asm
        xorl    %ecx,%ecx
        movl    12(%ebp),%edi
        movl    8(%ebp),%esi
        movl    %edi,%ebx
        movb    (%edi),%cl
        lea     1(%edi,%ecx),%edi
        negl    %ecx
        xor     %eax,%eax
        addl    $0xff,%ecx
        lodsb
        cmpl    %ecx,%eax
        jbe     .LStrConcat1
        movl    %ecx,%eax
.LStrConcat1:
        addb    %al,(%ebx)
        cmpl    $7,%eax
        jl      .LStrConcat2
        movl    %edi,%ecx       { Align on 32bits }
        negl    %ecx
        andl    $3,%ecx
        subl    %ecx,%eax
        rep
        movsb
        movl    %eax,%ecx
        andl    $3,%eax
        shrl    $2,%ecx
        rep
        movsl
.LStrConcat2:
        movl    %eax,%ecx
        rep
        movsb
  end ['EBX','ECX','EAX','ESI','EDI'];
end;


procedure strcmp(dstr,sstr : pointer);[public,alias: 'STRCMP'];
begin
  asm
        cld
        xorl    %ebx,%ebx
        xorl    %eax,%eax
        movl    12(%ebp),%esi
        movl    8(%ebp),%edi
        movb    (%esi),%al
        movb    (%edi),%bl
        movl    %eax,%edx
        incl    %esi
        incl    %edi
        cmpl    %ebx,%eax
        jbe     .LStrCmp1
        movl    %ebx,%eax
.LStrCmp1:
        cmpl    $7,%eax
        jl      .LStrCmp2
        movl    %edi,%ecx       { Align on 32bits }
        negl    %ecx
        andl    $3,%ecx
        subl    %ecx,%eax
        orl     %ecx,%ecx
        rep
        cmpsb
        jne     .LStrCmp3
        movl    %eax,%ecx
        andl    $3,%eax
        shrl    $2,%ecx
        orl     %ecx,%ecx
        rep
        cmpsl
        je      .LStrCmp2
        movl    $4,%eax
        sub     %eax,%esi
        sub     %eax,%edi
.LStrCmp2:
        movl    %eax,%ecx
        orl     %eax,%eax
        rep
        cmpsb
        jne     .LStrCmp3
        cmp     %ebx,%edx
.LStrCmp3:
  end ['EDX','ECX','EBX','EAX','ESI','EDI'];
end;


function strpas(p:pchar):string;
begin
  asm
        cld
        movl    12(%ebp),%edi
        movl    $0xff,%ecx
        xorl    %eax,%eax
        movl    %edi,%esi
        repne
        scasb
        movl    %ecx,%eax

        movl    8(%ebp),%edi
        notb    %al
        decl    %eax
        stosb
        cmpl    $7,%eax
        jl      .LStrPas2
        movl    %edi,%ecx       { Align on 32bits }
        negl    %ecx
        andl    $3,%ecx
        subl    %ecx,%eax
        rep
        movsb
        movl    %eax,%ecx
        andl    $3,%eax
        shrl    $2,%ecx
        rep
        movsl
.LStrPas2:
        movl    %eax,%ecx
        rep
        movsb
  end ['ECX','EAX','ESI','EDI'];
end;

function strlen(p:pchar):longint;assembler;
asm
        movl    p,%edi
        movl    $0xffffffff,%ecx
        xorl    %eax,%eax
        cld
        repne
        scasb
        movl    $0xfffffffe,%eax
        subl    %ecx,%eax
end ['EDI','ECX','EAX'];

{****************************************************************************
                                 Other 
****************************************************************************}

function get_addr(addrbp:longint):longint;assembler;
asm
	movl	addrbp,%eax
	orl	%eax,%eax
	jz	.Lg_a_null
        movl	4(%eax),%eax
.Lg_a_null:
end ['EAX'];


function get_next_frame(framebp:longint):longint;assembler;
asm
	movl	framebp,%eax
	orl	%eax,%eax
	jz	.Lgnf_null
        movl	(%eax),%eax
.Lgnf_null:
end ['EAX'];


procedure runerror(w : word);[alias: 'runerror'];

  function get_addr : longint;

    begin
       asm
          movl (%ebp),%eax
          movl 4(%eax),%eax
          movl %eax,__RESULT
       end ['EAX'];
    end;

  function get_error_bp : longint;

    begin
       asm
          movl (%ebp),%eax {%ebp of run_error}
          movl %eax,__RESULT
       end ['EAX'];
    end;

  begin
     errorcode:=w;
     exitcode:=w;
     erroraddr:=pointer(get_addr);
     errorbase:=get_error_bp;
     doError:=True;
     halt(errorcode);
  end;

procedure int_iocheck(addr : longint);[public,alias: 'IOCHECK'];
var
  l : longint;
begin
{ Since IOCHECK is called directly and only later the optimiser }
{ Maybe also save global registers  }
  asm
	pushal
  end;
  l:=ioresult;
  if l<>0 then
   begin
     writeln('IO-Error ',l,' at ',addr);
     halt(l);
   end;
  asm
	popal
   end;
end;


procedure int_re_overflow;[public,alias: 'RE_OVERFLOW'];
var
  addr : longint;
begin
{ Overflow was shortly before the return address }
   asm
	movl	4(%ebp),%edi
        movl	%edi,addr
   end;
   writeln('Overflow at ',addr);
   RunError(215);
end;


function abs(l:longint):longint;assembler;
asm
	movl	l,%eax
        orl	%eax,%eax
        jns	.LMABS1
        negl	%eax
.LMABS1:
end ['EAX'];


function odd(l:longint):boolean;assembler;
asm
       movl	l,%eax
       andl	$1,%eax
       setnz	%al
end ['EAX'];


function sqr(l:longint):longint;assembler;
asm
        mov	l,%eax
        imull	%eax,%eax
end ['EAX'];


    procedure int_str(l : longint;var s : string);

      var
         buffer : array[0..11] of byte;

      begin
         { Workaround: }
         if l=$80000000 then
           begin
              s:='-2147483648';
              exit;
           end;
         asm
            movl 8(%ebp),%eax    // load Integer
            movl 12(%ebp),%edi      // Load String address
            xorl %ecx,%ecx    // String length=0
            xorl %ebx,%ebx    // Buffer length=0
            movl $0x0a,%esi      // load 10 as dividing constant.
            or %eax,%eax        // Sign ?
            jns .LM2
            neg %eax
            movb $0x2d,1(%edi)   // put '-' in String
            incl %ecx
         .LM2:
            cdq
            idivl %esi,%eax
            addb $0x30,%dl    // convert Rest to ASCII.
            movb %dl,-12(%ebp,%ebx)
            incl %ebx
            cmpl $0,%eax
            jnz .LM2
                        // copy String
         .LM3:
            movb -13(%ebp,%ebx),%al    // -13 because EBX is decreased only
                                       // later.
            movb %al,1(%edi,%ecx)
            incl %ecx
            decl %ebx
            jnz .LM3
            movb %cl,(%edi)      // Copy String length
         end;
      end;

    procedure int_str(c : cardinal;var s : string);

      var
         buffer : array[0..14] of byte;

      begin
         asm
            movl 8(%ebp),%eax       // load CARDINAL
            movl 12(%ebp),%edi      // Load String address
            xorl %ecx,%ecx          // String length=0
            xorl %ebx,%ebx          // Buffer length=0
            movl $0x0a,%esi         // load 10 as dividing constant.
         .LM4:
            xorl %edx,%edx
            divl %esi,%eax
            addb $0x30,%dl          // convert Rest to ASCII.
            movb %dl,-12(%ebp,%ebx)
            incl %ebx
            cmpl $0,%eax
            jnz .LM4
            { now copy the string }
         .LM5:
            movb -13(%ebp,%ebx),%al    // -13 because EBX is decreased only
                                       // later.
            movb %al,1(%edi,%ecx)
            incl %ecx
            decl %ebx
            jnz .LM5
            movb %cl,(%edi)            // Copy String length
         end;
      end;

    procedure f1;[public,alias: 'FLUSH_STDOUT'];

      begin
         asm
            pushal
         end;
         FileFunc(textrec(output).flushfunc)(textrec(output));
         asm
            popal
         end;
      end;

      
Function Sptr : Longint;
begin
  asm
    movl %esp,%eax
    addl $8,%eax
    movl %eax,-4(%ebp)
  end ['EAX'];
end;


{$I386_ATT}

Function Random(L: LongInt): LongInt;assembler;
asm
	  movl	$134775813,%eax
          mull	RandSeed
          incl	%eax
          movl	%eax,RandSeed
          mull	4(%esp)
          movl	%edx,%eax
end;

{$I386_DIRECT}

{
  $Log$
  Revision 1.10  1998-05-25 10:40:49  peter
    * remake3 works again on tflily

  Revision 1.5  1998/04/29 13:28:19  peter
    * some cleanup and i386_att usage

  Revision 1.4  1998/04/10 15:41:54  florian
    + some small comments added

  Revision 1.3  1998/04/10 15:25:23  michael
  - Removed so-called better random function

  Revision 1.2  1998/04/08 07:53:31  michael
  + Changed Random() function. Moved from system to processor dependent files (from Pedro Gimeno)

  Revision 1.1.1.1  1998/03/25 11:18:43  root
  * Restored version

  Revision 1.30  1998/03/20 05:11:17  carl
    * bugfix of register usage list for strcmp and strconcat

  Revision 1.29  1998/03/15 19:38:41  peter
    * fixed a bug in Move()

  Revision 1.28  1998/03/10 23:50:39  florian
    * strcopy saves now the used registers except ESI and EDI, solves
      a problem with the optimizer

  Revision 1.27  1998/03/10 16:25:52  jonas
    * removed reloading of eax with 8(ebp), in int_help_constructor, as eax is nowhere modified

  Revision 1.25  1998/03/02 11:44:43  florian
    * writing of large cardinals fixed

  Revision 1.24  1998/03/02 04:14:02  carl
    * page fault bug fix with CHECK_OBJECT
       warning: Will only work with GAS as VMT pointer field is an
       .lcomm and will be ZEROED by linker (might not be true for TASM)

  Revision 1.23  1998/02/24 17:50:46  peter
    * upto 100% (255's char is different ;) faster STRCMP
    * faster StrPas from i386.inc also strings.pp

  Revision 1.22  1998/02/22 22:01:26  carl
  + IOCHECK halts with the correct errorcode now

  Revision 1.21  1998/02/11 16:55:14  michael
  fixed cardinal printing. Large cardinals (>0fffffff) not yet working

  Revision 1.20  1998/02/06 09:12:39  florian
    * bug in CHECK_OBJECT fixed

  Revision 1.19  1998/02/05 22:30:25  florian
    + CHECK_OBJECT to check for an valid VMT (before calling a virtual method)

  Revision 1.18  1998/02/04 14:46:36  daniel
  * Some small tweaks

  Revision 1.17  1998/01/27 22:05:07  florian
    * again small fixes to DOM (Delphi Object Model)

  Revision 1.16  1998/01/26 11:59:01  michael
  + Added log at the end

  revision 1.15
  date: 1998/01/25 22:52:52;  author: peter;  state: Exp;  lines: +140 -122
    * Faster string functions by using aligning
  ----------------------------
  revision 1.14
  date: 1998/01/25 22:30:48;  author: florian;  state: Exp;  lines: +14 -2
    * DOM: some fixes to tobject and the con-/destructor help routines
  ----------------------------
  revision 1.13
  date: 1998/01/23 18:08:29;  author: florian;  state: Exp;  lines: +10 -4
    * more bugs in FCL object model removed
  ----------------------------
  revision 1.12
  date: 1998/01/23 15:54:47;  author: florian;  state: Exp;  lines: +5 -5
    + small extensions to FCL object model
  ----------------------------
  revision 1.11
  date: 1998/01/20 00:14:24;  author: peter;  state: Exp;  lines: +18 -5
    * .type is linux only, go32v2 doesn't like it
  ----------------------------
  revision 1.10
  date: 1998/01/19 16:19:53;  author: peter;  state: Exp;  lines: +7 -1
  * Works now correct with shared libs, .globl always needs a .type
  ----------------------------
  revision 1.9
  date: 1998/01/19 10:21:35;  author: michael;  state: Exp;  lines: +1 -6
  * moved Fillchar t(..,char) to system.inc
  ----------------------------
  revision 1.8
  date: 1998/01/19 09:15:05;  author: michael;  state: Exp;  lines: +40 -132
  * Bugfixes in Move and FillChar
  ----------------------------
  revision 1.7
  date: 1998/01/16 23:10:52;  author: florian;  state: Exp;  lines: +23 -1
    + some tobject stuff
  ----------------------------
  revision 1.6
  date: 1998/01/16 22:21:35;  author: michael;  state: Exp;  lines: +601 -493
  + Installed pentium-optimized move (optional)
  ----------------------------
  revision 1.5
  date: 1998/01/12 03:39:17;  author: carl;  state: Exp;  lines: +2 -2
    * bugfix of RE_OVERFLOW, gives out now a Runerror(215)
  ----------------------------
  revision 1.4
  date: 1998/01/01 16:57:36;  author: michael;  state: Exp;  lines: +1 -21
  Moved DO_EXIT to system.inc. Now processor independent
  ----------------------------
  revision 1.3
  date: 1997/12/10 12:12:31;  author: michael;  state: Exp;  lines: +2 -2
  * changed dateifunc to FileFunc
  ----------------------------
  revision 1.2
  date: 1997/12/01 12:34:36;  author: michael;  state: Exp;  lines: +13 -0
  + added copyright reference in header.
  ----------------------------
  revision 1.1
  date: 1997/11/27 08:33:48;  author: michael;  state: Exp;
  Initial revision
  ----------------------------
  revision 1.1.1.1
  date: 1997/11/27 08:33:48;  author: michael;  state: Exp;  lines: +0 -0
  FPC RTL CVS start
  =============================================================================
}