mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-26 18:43:42 +02:00
895 lines
22 KiB
PHP
895 lines
22 KiB
PHP
{
|
|
$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.
|
|
|
|
**********************************************************************}
|
|
|
|
{$asmmode ATT}
|
|
|
|
|
|
{****************************************************************************
|
|
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);
|
|
begin
|
|
asm
|
|
cld
|
|
movl x,%edi
|
|
{ movl value,%eax Only lower 8 bits will be used }
|
|
movb value,%al
|
|
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
|
|
****************************************************************************}
|
|
|
|
procedure int_help_constructor;assembler; [public,alias:'FPC_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
|
|
edi contains the vmt position
|
|
}
|
|
{ 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 position 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
|
|
cld
|
|
movl (%eax),%ecx
|
|
movl %esi,%edi
|
|
xorl %eax,%eax
|
|
shrl $1,%ecx
|
|
jnc .LHCFill1
|
|
stosb
|
|
.LHCFill1:
|
|
shrl $1,%ecx
|
|
jnc .LHCFill2
|
|
stosw
|
|
.LHCFill2:
|
|
rep
|
|
stosl
|
|
popal
|
|
{ set the VMT address for the new created object }
|
|
{ the offset is in %edi since the calling and has not been changed !! }
|
|
movl %eax,(%esi,%edi,1)
|
|
orl %eax,%eax
|
|
.LHC_5:
|
|
end;
|
|
|
|
|
|
procedure int_help_destructor;assembler;[public,alias:'FPC_HELP_DESTRUCTOR'];
|
|
asm
|
|
{ Stack (relative to %ebp):
|
|
12 Self
|
|
8 VMT-Address
|
|
4 Main program-Addr
|
|
0 %ebp
|
|
edi contains the vmt position
|
|
}
|
|
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 }
|
|
{ the offset is in %edi since the calling and has not been changed !! }
|
|
movl (%eax,%edi,1),%ebx
|
|
{ I think for precaution }
|
|
{ that we should clear the VMT here }
|
|
movl $0,(%eax,%edi,1)
|
|
{ temporary Variable }
|
|
subl $4,%esp
|
|
movl %esp,%edi
|
|
{ And put size on the Stack }
|
|
pushl (%ebx)
|
|
{ SELF }
|
|
movl %eax,(%edi)
|
|
pushl %edi
|
|
call FreeMem
|
|
addl $4,%esp
|
|
.LHD_3:
|
|
popal
|
|
end;
|
|
|
|
{$ifndef NEWATT}
|
|
{$asmmode DIRECT}
|
|
{$endif}
|
|
|
|
procedure int_new_class;assembler;[public,alias:'FPC_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,%esi
|
|
.LNEW_CLASS1:
|
|
movl %esi,8(%ebp)
|
|
orl %eax,%eax
|
|
end;
|
|
|
|
|
|
procedure int_dispose_class;assembler;[public,alias:'FPC_DISPOSE_CLASS'];
|
|
asm
|
|
{ destroy class ? }
|
|
movl 12(%ebp),%edi
|
|
orl %edi,%edi
|
|
jz .LDISPOSE_CLASS1
|
|
{ no inherited call }
|
|
movl (%esi),%edi
|
|
{ push self }
|
|
pushl %esi
|
|
{ call freeinstance }
|
|
call *20(%edi)
|
|
.LDISPOSE_CLASS1:
|
|
end;
|
|
|
|
{$ifndef NEWATT}
|
|
{$asmmode att}
|
|
{$endif}
|
|
|
|
|
|
{ checks for a correct vmt pointer }
|
|
{$ifdef SYSTEMDEBUG}
|
|
{ we want the stack for debugging !! PM }
|
|
procedure int_check_object(obj : pointer);[public,alias:'FPC_CHECK_OBJECT'];
|
|
begin
|
|
{$else not SYSTEMDEBUG}
|
|
procedure int_check_object;assembler;[public,alias:'FPC_CHECK_OBJECT'];
|
|
{$endif not SYSTEMDEBUG}
|
|
asm
|
|
pushl %edi
|
|
{$ifdef SYSTEMDEBUG}
|
|
movl obj,%edi
|
|
{$else not SYSTEMDEBUG}
|
|
movl 8(%esp),%edi
|
|
{$endif not SYSTEMDEBUG}
|
|
pushl %eax
|
|
{ Here we must check if the VMT pointer is nil before }
|
|
{ accessing it... }
|
|
orl %edi,%edi
|
|
jz .Lco_re
|
|
movl (%edi),%eax
|
|
addl 4(%edi),%eax
|
|
jz .Lco_ok
|
|
.Lco_re:
|
|
pushl $210
|
|
call HandleError
|
|
.Lco_ok:
|
|
popl %eax
|
|
popl %edi
|
|
{ the adress is pushed : it needs to be removed from stack !! PM }
|
|
{$ifdef SYSTEMDEBUG}
|
|
end;{ of asm }
|
|
end;
|
|
{$else SYSTEMDEBUG}
|
|
ret $4
|
|
end;
|
|
{$endif not SYSTEMDEBUG}
|
|
|
|
{$ifdef FPC_TESTOBJEXT}
|
|
{ checks for a correct vmt pointer }
|
|
{ deeper check to see if the current object is }
|
|
{ really related to the true }
|
|
|
|
procedure int_check_object_ext;assembler;[public,alias:'FPC_CHECK_OBJECT_EXT'];
|
|
asm
|
|
pushl %ebp
|
|
movl %esp,%ebp
|
|
pushl %edi
|
|
movl 8(%ebp),%edi
|
|
pushl %ebx
|
|
movl 12(%ebp),%ebx
|
|
pushl %eax
|
|
{ Here we must check if the VMT pointer is nil before }
|
|
{ accessing it... }
|
|
.Lcoext_obj:
|
|
orl %edi,%edi
|
|
jz .Lcoext_re
|
|
movl (%edi),%eax
|
|
addl 4(%edi),%eax
|
|
jnz .Lcoext_re
|
|
cmpl %edi,%ebx
|
|
je .Lcoext_ok
|
|
.Lcoext_vmt:
|
|
movl 8(%edi),%eax
|
|
cmpl %ebx,%eax
|
|
je .Lcoext_ok
|
|
movl %eax,%edi
|
|
jmp .Lcoext_obj
|
|
.Lcoext_re:
|
|
pushl $220
|
|
call HandleError
|
|
.Lcoext_ok:
|
|
popl %eax
|
|
popl %ebx
|
|
popl %edi
|
|
{ the adress and vmt were pushed : it needs to be removed from stack !! PM }
|
|
popl %ebp
|
|
ret $8
|
|
end;
|
|
{$endif FPC_TESTOBJEXT}
|
|
|
|
|
|
{****************************************************************************
|
|
String
|
|
****************************************************************************}
|
|
|
|
procedure int_strcopy(len:longint;sstr,dstr:pointer);[public,alias:'FPC_SHORTSTR_COPY'];
|
|
{
|
|
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 ['ESI','EDI'];
|
|
end;
|
|
|
|
|
|
procedure int_strconcat(s1,s2:pointer);[public,alias:'FPC_SHORTSTR_CONCAT'];
|
|
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 int_strcmp(dstr,sstr:pointer);[public,alias:'FPC_SHORTSTR_COMPARE'];
|
|
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;[public,alias:'FPC_PCHAR_TO_SHORTSTR'];
|
|
begin
|
|
asm
|
|
cld
|
|
movl p,%edi
|
|
movl $0xff,%ecx
|
|
xorl %eax,%eax
|
|
movl %edi,%esi
|
|
repne
|
|
scasb
|
|
movl %ecx,%eax
|
|
|
|
{$ifdef NEWATT1}
|
|
movl __RESULT,%edi
|
|
{$else}
|
|
movl 8(%ebp),%edi
|
|
{$endif}
|
|
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'];
|
|
|
|
|
|
{****************************************************************************
|
|
Caller/StackFrame Helpers
|
|
****************************************************************************}
|
|
|
|
function get_frame:longint;assembler;
|
|
asm
|
|
movl %ebp,%eax
|
|
end ['EAX'];
|
|
|
|
|
|
function get_caller_addr(framebp:longint):longint;assembler;
|
|
asm
|
|
movl framebp,%eax
|
|
orl %eax,%eax
|
|
jz .Lg_a_null
|
|
movl 4(%eax),%eax
|
|
.Lg_a_null:
|
|
end ['EAX'];
|
|
|
|
|
|
function get_caller_frame(framebp:longint):longint;assembler;
|
|
asm
|
|
movl framebp,%eax
|
|
orl %eax,%eax
|
|
jz .Lgnf_null
|
|
movl (%eax),%eax
|
|
.Lgnf_null:
|
|
end ['EAX'];
|
|
|
|
|
|
{****************************************************************************
|
|
Math
|
|
****************************************************************************}
|
|
|
|
function abs(l:longint):longint;assembler;[internconst:in_const_abs];
|
|
asm
|
|
movl l,%eax
|
|
orl %eax,%eax
|
|
jns .LMABS1
|
|
negl %eax
|
|
.LMABS1:
|
|
end ['EAX'];
|
|
|
|
|
|
function odd(l:longint):boolean;assembler;[internconst:in_const_odd];
|
|
asm
|
|
movl l,%eax
|
|
andl $1,%eax
|
|
setnz %al
|
|
end ['EAX'];
|
|
|
|
|
|
function sqr(l:longint):longint;assembler;[internconst:in_const_sqr];
|
|
asm
|
|
mov l,%eax
|
|
imull %eax,%eax
|
|
end ['EAX'];
|
|
|
|
|
|
Function Sptr : Longint;
|
|
begin
|
|
asm
|
|
movl %esp,%eax
|
|
addl $8,%eax
|
|
movl %eax,-4(%ebp)
|
|
end ['EAX'];
|
|
end;
|
|
|
|
|
|
{****************************************************************************
|
|
Str()
|
|
****************************************************************************}
|
|
|
|
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 l,%eax // load Integer
|
|
movl s,%edi // Load String address
|
|
xorl %ecx,%ecx // String length=0
|
|
xorl %ebx,%ebx // Buffer length=0
|
|
movl $0x0a,%esi // load 10 as dividing constant.
|
|
orl %eax,%eax // Sign ?
|
|
jns .LM2
|
|
neg %eax
|
|
movb $0x2d,1(%edi) // put '-' in String
|
|
incl %ecx
|
|
.LM2:
|
|
cltd
|
|
idivl %esi
|
|
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 c,%eax // load CARDINAL
|
|
movl s,%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
|
|
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;
|
|
|
|
|
|
{****************************************************************************
|
|
Bounds Check
|
|
****************************************************************************}
|
|
|
|
{$ifdef SYSTEMDEBUG}
|
|
{ we want the stack for debugging !! PM }
|
|
procedure int_boundcheck;[public,alias: 'FPC_BOUNDCHECK'];
|
|
begin
|
|
{$else not SYSTEMDEBUG}
|
|
procedure int_boundcheck;assembler;[public,alias: 'FPC_BOUNDCHECK'];
|
|
{$endif not SYSTEMDEBUG}
|
|
{
|
|
called with:
|
|
%ecx - value
|
|
%edi - pointer to the ranges
|
|
}
|
|
asm
|
|
cmpl (%edi),%ecx
|
|
jl .Lbc_err
|
|
cmpl 4(%edi),%ecx
|
|
jle .Lbc_ok
|
|
.Lbc_err:
|
|
pushl $201
|
|
call HandleError
|
|
.Lbc_ok:
|
|
end;
|
|
{$ifdef SYSTEMDEBUG}
|
|
end;
|
|
{$endif def SYSTEMDEBUG}
|
|
|
|
|
|
{****************************************************************************
|
|
IoCheck
|
|
****************************************************************************}
|
|
|
|
procedure int_iocheck(addr : longint);[public,alias:'FPC_IOCHECK'];
|
|
var
|
|
l : longint;
|
|
begin
|
|
asm
|
|
pushal
|
|
end;
|
|
if InOutRes<>0 then
|
|
begin
|
|
l:=InOutRes;
|
|
InOutRes:=0;
|
|
HandleErrorFrame(l,get_frame);
|
|
end;
|
|
asm
|
|
popal
|
|
end;
|
|
end;
|
|
|
|
|
|
|
|
{
|
|
$Log$
|
|
Revision 1.42 1999-04-07 16:21:10 pierre
|
|
+ no assembler if systemdebug defined
|
|
|
|
Revision 1.41 1999/03/01 15:40:55 peter
|
|
* use external names
|
|
* removed all direct assembler modes
|
|
|
|
Revision 1.40 1999/02/22 13:23:22 pierre
|
|
* VMT field zeroed at destructor forgot offset !!
|
|
|
|
Revision 1.39 1999/02/05 12:26:25 pierre
|
|
+ code for FPC_TESTOBJEXT conditionnal
|
|
|
|
Revision 1.38 1999/02/02 11:04:27 florian
|
|
* class destructor helper routine for the new calling copnventions fixed
|
|
|
|
Revision 1.37 1998/12/21 14:28:20 pierre
|
|
* HandleError -> HandleErrorFrame to avoid problem in
|
|
assembler code in i386.inc
|
|
(call to overloaded function in assembler block !)
|
|
|
|
Revision 1.36 1998/12/18 17:21:32 peter
|
|
* fixed io-error handling
|
|
|
|
Revision 1.35 1998/12/15 22:42:53 peter
|
|
* removed temp symbols
|
|
|
|
Revision 1.34 1998/11/30 15:27:28 pierre
|
|
* vmt address pushed for CHECK_OBJECT was not removed from stack
|
|
|
|
Revision 1.33 1998/11/28 14:09:49 peter
|
|
* NOATTCDQ define
|
|
|
|
Revision 1.32 1998/11/26 23:15:08 jonas
|
|
* changed cdq to cltd in AT&T assembler block
|
|
|
|
Revision 1.31 1998/11/26 21:33:58 peter
|
|
+ FPC_BOUNDCHECK
|
|
|
|
Revision 1.30 1998/11/17 00:41:08 peter
|
|
* renamed string functions
|
|
|
|
Revision 1.29 1998/10/19 08:49:16 pierre
|
|
* removed old code forgotten about vmtoffset
|
|
|
|
Revision 1.28 1998/10/16 13:37:46 pierre
|
|
* added code for vmt_offset in destructors
|
|
|
|
Revision 1.27 1998/10/16 08:53:50 peter
|
|
* fill_object in constructor changed to 'inline' code to overcome
|
|
pushw/pushl problem
|
|
|
|
Revision 1.26 1998/10/15 11:35:02 pierre
|
|
+ first step of variable vmt offset
|
|
offset is stored in R_EDI (R_D0)
|
|
if objectvmtoffset is defined
|
|
|
|
Revision 1.25 1998/09/28 11:02:34 peter
|
|
* added some more $ifdef FPCNAMES
|
|
|
|
Revision 1.24 1998/09/28 10:23:43 florian
|
|
* FPC_NEW_CLASS optimized: addl $0,%eax => orl %eax,%eax
|
|
|
|
Revision 1.23 1998/09/28 08:40:47 michael
|
|
+ Bugreport from Gertjan Schouten
|
|
|
|
Revision 1.22 1998/09/22 15:32:00 peter
|
|
+ fpc_pchar_to_str alias for strpas
|
|
|
|
Revision 1.21 1998/09/14 10:48:08 peter
|
|
* FPC_ names
|
|
* Heap manager is now system independent
|
|
|
|
Revision 1.20 1998/09/11 17:38:48 pierre
|
|
merge for fixes branch
|
|
|
|
Revision 1.19.2.1 1998/09/11 17:37:24 pierre
|
|
* correction respective to stricter as v2.9.1 syntax
|
|
|
|
Revision 1.19 1998/09/01 17:36:17 peter
|
|
+ internconst
|
|
|
|
Revision 1.18 1998/08/11 00:04:47 peter
|
|
* $ifdef ver0_99_5 updates
|
|
|
|
Revision 1.17 1998/07/30 13:26:20 michael
|
|
+ Added support for ErrorProc variable. All internal functions are required
|
|
to call HandleError instead of runerror from now on.
|
|
This is necessary for exception support.
|
|
|
|
Revision 1.16 1998/07/02 12:55:04 carl
|
|
* Put back DoError, DO NOT TOUCH!
|
|
|
|
Revision 1.15 1998/07/02 12:19:32 carl
|
|
+ IO-Error and Overflow now print address in hex
|
|
|
|
Revision 1.14 1998/07/01 15:29:58 peter
|
|
* better readln/writeln
|
|
|
|
Revision 1.13 1998/06/26 08:20:57 daniel
|
|
- Doerror removed.
|
|
|
|
Revision 1.12 1998/05/31 14:15:47 peter
|
|
* force to use ATT or direct parsing
|
|
|
|
Revision 1.11 1998/05/30 14:30:21 peter
|
|
* force att reading
|
|
|
|
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)
|
|
}
|