* some cleanup and i386_att usage

This commit is contained in:
peter 1998-04-29 13:28:19 +00:00
parent 5cdd60cac8
commit f11a6ba390

View File

@ -3,6 +3,9 @@
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.
@ -11,31 +14,145 @@
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
**********************************************************************}
{****************************************************************************
i386.inc : Processor dependent implementation of the system unit
for the Intel Ix86, x>=3
Move / Fill
****************************************************************************}
procedure int_help_constructor;
procedure Move(var source;var dest;count:longint);
begin
asm
.globl HELP_CONSTRUCTOR_NE
{$IFDEF LINUX}
.type HELP_CONSTRUCTOR_NE,@function
{$ENDIF}
HELP_CONSTRUCTOR_NE:
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;
.globl HELP_CONSTRUCTOR
{$IFDEF LINUX}
.type HELP_CONSTRUCTOR,@function
{$ENDIF}
HELP_CONSTRUCTOR:
{ Entry without preamble, since we need the ESP of the
constructor }
{ Stack (relative to %ebp):
Procedure FillChar(var x;count:longint;value:byte);[alias: '.L_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
@ -46,8 +163,7 @@ HELP_CONSTRUCTOR:
{ initialise self ? }
orl %esi,%esi
jne .LHC_4
{ get memory, but save register first }
{ temporary variable }
{ get memory, but save register first temporary variable }
subl $4,%esp
movl %esp,%esi
{ Save Register}
@ -79,32 +195,22 @@ HELP_CONSTRUCTOR:
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:
ret
end;
end;
procedure help_fail;
begin
procedure help_fail;assembler;
asm
end;
end;
procedure int_new_class;assembler;
procedure int_new_class;assembler;[public,alias:'NEW_CLASS'];
asm
.global NEW_CLASS
{$IFDEF LINUX}
.type NEW_CLASS,@function
{$ENDIF}
NEW_CLASS:
{ create class ? }
movl 8(%ebp),%edi
orl %edi,%edi
@ -121,17 +227,11 @@ procedure int_new_class;assembler;
ret
.LNEW_CLASS1:
movl %esi,8(%ebp)
ret
end;
procedure int_dispose_class;assembler;
procedure int_dispose_class;assembler;[public,alias:'DISPOSE_CLASS'];
asm
.global DISPOSE_CLASS
{$IFDEF LINUX}
.type DISPOSE_CLASS,@function
{$ENDIF}
DISPOSE_CLASS:
{ destroy class ? }
movl 8(%ebp),%edi
{ save self }
@ -147,18 +247,12 @@ procedure int_dispose_class;assembler;
.LDISPOSE_CLASS1:
{ load self }
movl 8(%ebp),%esi
ret
end;
{ checks for a correct vmt pointer }
procedure co;assembler;
{ checks for a correct vmt pointer }
procedure int_check_obhject;assembler;[public,alias:'CHECK_OBJECT'];
asm
.globl CHECK_OBJECT
{$IFDEF LINUX}
.type CHECK_OBJECT,@function
{$ENDIF}
CHECK_OBJECT:
pushl %edi
movl 8(%esp),%edi
pushl %eax
@ -180,9 +274,8 @@ procedure co;assembler;
call runerror
end;
procedure int_help_destructor;
begin
procedure int_help_destructor;assembler;[public,alias:'HELP_DESTRUCTOR'];
asm
{ Stack (relative to %ebp):
12 Self
@ -190,16 +283,6 @@ procedure int_help_destructor;
4 Main program-Addr
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 }
subl $4,%esp
movl %esp,%edi
@ -224,105 +307,17 @@ HELP_DESTRUCTOR:
.LHD_3:
popal
addl $4,%esp
ret
end;
end;
function get_addr(BP : longint) : longint;
begin
asm
movl BP,%eax
cmpl $0,%eax
je .Lnul_address
movl 4(%eax),%eax
.Lnul_address:
movl %eax,__RESULT
end ['EAX'];
end;
{****************************************************************************
String
****************************************************************************}
function get_next_frame(bp : longint) : longint;
begin
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'];
{
this procedure must save all modified registers except EDI and ESI !!!
}
begin
asm
pushl %eax
@ -340,7 +335,7 @@ begin
stosb
cmpl $7,%eax
jl .LStrCopy2
movl %edi,%ecx # Align on 32bits
movl %edi,%ecx { Align on 32bits }
negl %ecx
andl $3,%ecx
subl %ecx,%eax
@ -381,7 +376,7 @@ begin
addb %al,(%ebx)
cmpl $7,%eax
jl .LStrConcat2
movl %edi,%ecx # Align on 32bits
movl %edi,%ecx { Align on 32bits }
negl %ecx
andl $3,%ecx
subl %ecx,%eax
@ -419,7 +414,7 @@ begin
.LStrCmp1:
cmpl $7,%eax
jl .LStrCmp2
movl %edi,%ecx # Align on 32bits
movl %edi,%ecx { Align on 32bits }
negl %ecx
andl $3,%ecx
subl %ecx,%eax
@ -467,7 +462,7 @@ begin
stosb
cmpl $7,%eax
jl .LStrPas2
movl %edi,%ecx # Align on 32bits
movl %edi,%ecx { Align on 32bits }
negl %ecx
andl $3,%ecx
subl %ecx,%eax
@ -485,198 +480,131 @@ begin
end ['ECX','EAX','ESI','EDI'];
end;
function strlen(p : pchar) : longint;
begin
function strlen(p:pchar):longint;assembler;
asm
cld
movl 8(%ebp),%edi
movl p,%edi
movl $0xffffffff,%ecx
xorl %eax,%eax
cld
repne
scasb
movl $0xfffffffe,%eax
subl %ecx,%eax
leave
ret $4
end ['EDI','ECX','EAX'];
end;
{****************************************************************************
Other
****************************************************************************}
procedure Move(var source;var dest;count:longint);
begin
function get_addr(addrbp:longint):longint;assembler;
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 $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;
movl addrbp,%eax
orl %eax,%eax
jz .Lg_a_null
movl 4(%eax),%eax
.Lg_a_null:
end ['EAX'];
Procedure FillChar(var x;count:longint;value:byte);[alias: '.L_FILL_OBJECT'];
begin
function get_next_frame(framebp:longint):longint;assembler;
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;
movl framebp,%eax
orl %eax,%eax
jz .Lgnf_null
movl (%eax),%eax
.Lgnf_null:
end ['EAX'];
procedure fillword(var x;count : longint;value : word);
procedure runerror(w : word);[alias: 'runerror'];
function get_addr : longint;
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'];
movl (%ebp),%eax
movl 4(%eax),%eax
movl %eax,__RESULT
end ['EAX'];
end;
{$ifndef ordintern}
{!!!!!! not very fast, but easy. }
function ord(b : boolean) : byte;
function get_error_bp : longint;
begin
asm
movb 8(%ebp),%al
leave
ret $2
movl (%ebp),%eax {%ebp of run_error}
movl %eax,__RESULT
end ['EAX'];
end;
end;
{$endif}
function abs(l : longint) : longint;
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
movl 8(%ebp),%eax
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;
function abs(l:longint):longint;assembler;
asm
movl l,%eax
orl %eax,%eax
jns .LMABS1
negl %eax
.LMABS1:
leave
ret $4
end ['EAX'];
end;
function odd(l : longint) : boolean;
begin
function odd(l:longint):boolean;assembler;
asm
movl 8(%ebp),%eax
movl l,%eax
andl $1,%eax
setnz %al
leave
ret $4
end ['EAX'];
end;
function sqr(l : longint) : longint;
begin
function sqr(l:longint):longint;assembler;
asm
movl 8(%ebp),%eax
mov l,%eax
imull %eax,%eax
leave
ret $4
end ['EAX'];
end;
{$ifndef str_intern }
procedure str(l : longint;var s : string);
@ -773,6 +701,7 @@ function sqr(l : longint) : longint;
end;
end;
Function Sptr : Longint;
begin
asm
@ -782,24 +711,33 @@ begin
end ['EAX'];
end;
Function Random(L: LongInt): LongInt;{assembler;
{$I386_ATT}
Function Random(L: LongInt): LongInt;assembler;
asm
movl $134775813,%eax
mull U_SYSTEM_RANDSEED
mull RandSeed
incl %eax
movl %eax,U_SYSTEM_RANDSEED
movl %eax,RandSeed
mull 4(%esp)
movl %edx,%eax
end;}
end;
{
begin
Randseed:=Randseed*134775813+1;
Random:=abs(Randseed mod l);
end;
}
{$I386_DIRECT}
{
$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
Revision 1.3 1998/04/10 15:25:23 michael