paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-15 21:09:27 +02:00
Code Issues Packages Projects Releases Wiki Activity

* some cleanup and i386_att usage

Browse Source
This commit is contained in:
peter 1998-04-29 13:28:19 +00:00
parent 5cdd60cac8
commit f11a6ba390
1 changed files with 360 additions and 422 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

782
rtl/i386/i386.inc
View File

@ -3,6 +3,9 @@
This file is part of the Free Pascal run time library. This file is part of the Free Pascal run time library.
Copyright (c) 1993,97 by the Free Pascal development team. 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, See the file COPYING.FPC, included in this distribution,
for details about the copyright. for details about the copyright.
@ -11,100 +14,203 @@
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
**********************************************************************} **********************************************************************}
{**************************************************************************** {****************************************************************************
Move / Fill
****************************************************************************}
i386.inc : Processor dependent implementation of the system unit procedure Move(var source;var dest;count:longint);
for the Intel Ix86, x>=3 begin
asm
****************************************************************************} movl dest,%edi
movl source,%esi
procedure int_help_constructor; movl %edi,%eax
movl count,%ebx
begin { Check for back or forward }
asm sub %esi,%eax
.globl HELP_CONSTRUCTOR_NE jz .LMoveEnd { Do nothing when source=dest }
{$IFDEF LINUX} jc .LFMove { Do forward, dest<source }
.type HELP_CONSTRUCTOR_NE,@function cmp %ebx,%eax
{$ENDIF} jb .LBMove { Dest is in range of move, do backward }
HELP_CONSTRUCTOR_NE: { Forward Copy }
.LFMove:
.globl HELP_CONSTRUCTOR cld
{$IFDEF LINUX} cmpl $15,%ebx
.type HELP_CONSTRUCTOR,@function jl .LFMove1
{$ENDIF} movl %edi,%ecx { Align on 32bits }
HELP_CONSTRUCTOR: negl %ecx
{ Entry without preamble, since we need the ESP of the andl $3,%ecx
constructor } subl %ecx,%ebx
{ Stack (relative to %ebp): rep
12 Self movsb
8 VMT-Address movl %ebx,%ecx
4 main programm-Addr andl $3,%ebx
0 %ebp shrl $2,%ecx
} rep
{eax isn't touched anywhere, so it doesn't have to reloaded} movsl
movl 8(%ebp),%eax .LFMove1:
{ initialise self ? } movl %ebx,%ecx
orl %esi,%esi rep
jne .LHC_4 movsb
{ get memory, but save register first } jmp .LMoveEnd
{ temporary variable } { Backward Copy }
subl $4,%esp .LBMove:
movl %esp,%esi std
{ Save Register} addl %ebx,%esi
pushal addl %ebx,%edi
{ Memory size } movl %edi,%ecx
pushl (%eax) decl %esi
pushl %esi decl %edi
call GETMEM cmpl $15,%ebx
popal jl .LBMove1
{ Memory size to %esi } negl %ecx { Align on 32bits }
movl (%esi),%esi andl $3,%ecx
addl $4,%esp subl %ecx,%ebx
{ If no memory available : fail() } rep
orl %esi,%esi movsb
jz .LHC_5 movl %ebx,%ecx
{ init self for the constructor } andl $3,%ebx
movl %esi,12(%ebp) shrl $2,%ecx
.LHC_4: subl $3,%esi
{ is there a VMT address ? } subl $3,%edi
orl %eax,%eax rep
jnz .LHC_7 movsl
{ In case the constructor doesn't do anything, the Zero-Flag } addl $3,%esi
{ can't be put, because this calls Fail() } addl $3,%edi
incl %eax .LBMove1:
ret movl %ebx,%ecx
.LHC_7: rep
{ set zero inside the object } movsb
pushal cld
pushw $0 .LMoveEnd:
pushl (%eax) end;
pushl %esi
{ }
call .L_FILL_OBJECT
popal
{ set the VMT address for the new created object }
movl %eax,(%esi)
orl %eax,%eax
.LHC_5:
ret
end;
end; end;
procedure help_fail;
begin Procedure FillChar(var x;count:longint;value:byte);[alias: '.L_FILL_OBJECT'];
asm begin
end; asm
end; 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 int_new_class;assembler;
procedure fillword(var x;count : longint;value : word);
begin
asm asm
.global NEW_CLASS movl 8(%ebp),%edi
{$IFDEF LINUX} movl 12(%ebp),%ecx
.type NEW_CLASS,@function movl 16(%ebp),%eax
{$ENDIF} movl %eax,%edx
NEW_CLASS: 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 .L_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 ? } { create class ? }
movl 8(%ebp),%edi movl 8(%ebp),%edi
orl %edi,%edi orl %edi,%edi
@ -121,17 +227,11 @@ procedure int_new_class;assembler;
ret ret
.LNEW_CLASS1: .LNEW_CLASS1:
movl %esi,8(%ebp) movl %esi,8(%ebp)
ret end;
end;
procedure int_dispose_class;assembler;
asm procedure int_dispose_class;assembler;[public,alias:'DISPOSE_CLASS'];
.global DISPOSE_CLASS asm
{$IFDEF LINUX}
.type DISPOSE_CLASS,@function
{$ENDIF}
DISPOSE_CLASS:
{ destroy class ? } { destroy class ? }
movl 8(%ebp),%edi movl 8(%ebp),%edi
{ save self } { save self }
@ -147,18 +247,12 @@ procedure int_dispose_class;assembler;
.LDISPOSE_CLASS1: .LDISPOSE_CLASS1:
{ load self } { load self }
movl 8(%ebp),%esi movl 8(%ebp),%esi
ret end;
end;
{ checks for a correct vmt pointer } { checks for a correct vmt pointer }
procedure co;assembler; procedure int_check_obhject;assembler;[public,alias:'CHECK_OBJECT'];
asm
asm
.globl CHECK_OBJECT
{$IFDEF LINUX}
.type CHECK_OBJECT,@function
{$ENDIF}
CHECK_OBJECT:
pushl %edi pushl %edi
movl 8(%esp),%edi movl 8(%esp),%edi
pushl %eax pushl %eax
@ -178,151 +272,52 @@ procedure co;assembler;
.Lco_re: .Lco_re:
pushw $210 pushw $210
call runerror call runerror
end; end;
procedure int_help_destructor;
begin procedure int_help_destructor;assembler;[public,alias:'HELP_DESTRUCTOR'];
asm asm
{ Stack (relative to %ebp): { Stack (relative to %ebp):
12 Self 12 Self
8 VMT-Address 8 VMT-Address
4 Main program-Addr 4 Main program-Addr
0 %ebp 0 %ebp
} }
.globl HELP_DESTRUCTOR_NE
{$IFDEF LINUX}
.type HELP_DESTRUCTOR_NE,@function
{$ENDIF}
HELP_DESTRUCTOR_NE:
.globl HELP_DESTRUCTOR
{$IFDEF LINUX}
.type HELP_DESTRUCTOR,@function
{$ENDIF}
HELP_DESTRUCTOR:
{ temporary Variable } { temporary Variable }
subl $4,%esp subl $4,%esp
movl %esp,%edi movl %esp,%edi
pushal pushal
{ Should the object be resolved ? } { Should the object be resolved ? }
movl 8(%ebp),%eax movl 8(%ebp),%eax
orl %eax,%eax orl %eax,%eax
jz .LHD_3 jz .LHD_3
{ Yes, get size from SELF! } { Yes, get size from SELF! }
movl 12(%ebp),%eax movl 12(%ebp),%eax
{ get VMT-pointer (from Self) to %ebx } { get VMT-pointer (from Self) to %ebx }
movl (%eax),%ebx movl (%eax),%ebx
{ And put size on the Stack } { And put size on the Stack }
pushl (%ebx) pushl (%ebx)
{ SELF } { SELF }
{ I think for precaution } { I think for precaution }
{ that we should clear the VMT here } { that we should clear the VMT here }
movl $0,(%eax) movl $0,(%eax)
movl %eax,(%edi) movl %eax,(%edi)
pushl %edi pushl %edi
call FREEMEM call FREEMEM
.LHD_3: .LHD_3:
popal popal
addl $4,%esp addl $4,%esp
ret
end;
end; end;
function get_addr(BP : longint) : longint;
begin {****************************************************************************
asm String
movl BP,%eax ****************************************************************************}
cmpl $0,%eax
je .Lnul_address
movl 4(%eax),%eax
.Lnul_address:
movl %eax,__RESULT
end ['EAX'];
end;
function get_next_frame(bp : longint) : longint; procedure strcopy(dstr,sstr:pointer;len:longint);[public,alias:'STRCOPY'];
{
begin this procedure must save all modified registers except EDI and ESI !!!
asm }
movl bp,%eax
cmpl $0,%eax
je .Lnul_frame
movl (%eax),%eax
.Lnul_frame:
movl %eax,__RESULT
end ['EAX'];
end;
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 io1(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 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;
{ this procedure must save all modified registers except EDI and ESI !!! }
procedure strcopy(dstr,sstr : pointer;len : longint);[public,alias: 'STRCOPY'];
begin begin
asm asm
pushl %eax pushl %eax
@ -340,7 +335,7 @@ begin
stosb stosb
cmpl $7,%eax cmpl $7,%eax
jl .LStrCopy2 jl .LStrCopy2
movl %edi,%ecx # Align on 32bits movl %edi,%ecx { Align on 32bits }
negl %ecx negl %ecx
andl $3,%ecx andl $3,%ecx
subl %ecx,%eax subl %ecx,%eax
@ -381,7 +376,7 @@ begin
addb %al,(%ebx) addb %al,(%ebx)
cmpl $7,%eax cmpl $7,%eax
jl .LStrConcat2 jl .LStrConcat2
movl %edi,%ecx # Align on 32bits movl %edi,%ecx { Align on 32bits }
negl %ecx negl %ecx
andl $3,%ecx andl $3,%ecx
subl %ecx,%eax subl %ecx,%eax
@ -419,7 +414,7 @@ begin
.LStrCmp1: .LStrCmp1:
cmpl $7,%eax cmpl $7,%eax
jl .LStrCmp2 jl .LStrCmp2
movl %edi,%ecx # Align on 32bits movl %edi,%ecx { Align on 32bits }
negl %ecx negl %ecx
andl $3,%ecx andl $3,%ecx
subl %ecx,%eax subl %ecx,%eax
@ -449,7 +444,7 @@ begin
end; end;
function strpas(p : pchar) : string; function strpas(p:pchar):string;
begin begin
asm asm
cld cld
@ -467,7 +462,7 @@ begin
stosb stosb
cmpl $7,%eax cmpl $7,%eax
jl .LStrPas2 jl .LStrPas2
movl %edi,%ecx # Align on 32bits movl %edi,%ecx { Align on 32bits }
negl %ecx negl %ecx
andl $3,%ecx andl $3,%ecx
subl %ecx,%eax subl %ecx,%eax
@ -485,198 +480,131 @@ begin
end ['ECX','EAX','ESI','EDI']; end ['ECX','EAX','ESI','EDI'];
end; end;
function strlen(p:pchar):longint;assembler;
function strlen(p : pchar) : longint; asm
begin movl p,%edi
asm
cld
movl 8(%ebp),%edi
movl $0xffffffff,%ecx movl $0xffffffff,%ecx
xorl %eax,%eax xorl %eax,%eax
cld
repne repne
scasb scasb
movl $0xfffffffe,%eax movl $0xfffffffe,%eax
subl %ecx,%eax subl %ecx,%eax
leave end ['EDI','ECX','EAX'];
ret $4
end ['EDI','ECX','EAX']; {****************************************************************************
end; 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'];
procedure Move(var source;var dest;count:longint); 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 io1(addr : longint);[public,alias: 'IOCHECK'];
var
l : longint;
begin begin
asm { Since IOCHECK is called directly and only later the optimiser }
movl dest,%edi { Maybe also save global registers }
movl source,%esi asm
movl %edi,%eax pushal
movl count,%ebx end;
## Check for back or forward l:=ioresult;
sub %esi,%eax if l<>0 then
jz .LMoveEnd # Do nothing when source=dest begin
jc .LFMove # Do forward, dest<source writeln('IO-Error ',l,' at ',addr);
cmp %ebx,%eax halt(l);
jb .LBMove # Dest is in range of move, do backward end;
## Forward Copy asm
.LFMove: popal
cld end;
cmpl $7,%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 $7,%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; end;
Procedure FillChar(var x;count:longint;value:byte);[alias: '.L_FILL_OBJECT']; procedure re_overflow;[public,alias: 'RE_OVERFLOW'];
var
addr : longint;
begin begin
asm { Overflow was shortly before the return address }
cld asm
movl x,%edi movl 4(%ebp),%edi
movl value,%eax # Only lower 8 bits will be used movl %edi,addr
movl count,%ecx end;
cmpl $7,%ecx writeln('Overflow at ',addr);
jl .LFill1 RunError(215);
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; end;
procedure fillword(var x;count : longint;value : word); function abs(l:longint):longint;assembler;
asm
begin movl l,%eax
asm orl %eax,%eax
movl 8(%ebp),%edi jns .LMABS1
movl 12(%ebp),%ecx negl %eax
movl 16(%ebp),%eax .LMABS1:
movl %eax,%edx end ['EAX'];
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;
{$ifndef ordintern} function odd(l:longint):boolean;assembler;
{!!!!!! not very fast, but easy. } asm
function ord(b : boolean) : byte; movl l,%eax
andl $1,%eax
begin setnz %al
asm end ['EAX'];
movb 8(%ebp),%al
leave
ret $2
end;
end;
{$endif}
function abs(l : longint) : longint;
begin
asm
movl 8(%ebp),%eax
orl %eax,%eax
jns .LMABS1
negl %eax
.LMABS1:
leave
ret $4
end ['EAX'];
end;
function odd(l : longint) : boolean; function sqr(l:longint):longint;assembler;
asm
mov l,%eax
imull %eax,%eax
end ['EAX'];
begin
asm
movl 8(%ebp),%eax
andl $1,%eax
setnz %al
leave
ret $4
end ['EAX'];
end;
function sqr(l : longint) : longint;
begin
asm
movl 8(%ebp),%eax
imull %eax,%eax
leave
ret $4
end ['EAX'];
end;
{$ifndef str_intern } {$ifndef str_intern }
procedure str(l : longint;var s : string); procedure str(l : longint;var s : string);
@ -773,6 +701,7 @@ function sqr(l : longint) : longint;
end; end;
end; end;
Function Sptr : Longint; Function Sptr : Longint;
begin begin
asm asm
@ -782,24 +711,33 @@ begin
end ['EAX']; end ['EAX'];
end; end;
Function Random(L: LongInt): LongInt;{assembler;
asm
movl $134775813,%eax
mull U_SYSTEM_RANDSEED
incl %eax
movl %eax,U_SYSTEM_RANDSEED
mull 4(%esp)
movl %edx,%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;
{
begin begin
Randseed:=Randseed*134775813+1; Randseed:=Randseed*134775813+1;
Random:=abs(Randseed mod l); Random:=abs(Randseed mod l);
end; end;
}
{$I386_DIRECT}
{ {
$Log$ $Log$
Revision 1.4 1998-04-10 15:41:54 florian 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 + some small comments added
Revision 1.3 1998/04/10 15:25:23 michael Revision 1.3 1998/04/10 15:25:23 michael