fpc/rtl/i8086/i8086.inc
nickysn a8f466c400 * updated the CSeg, DSeg and SSeg rtl functions on i8086 to use the new x86
intrinsics for reading the segment registers

git-svn-id: trunk@39434 -
2018-07-11 14:34:05 +00:00

1232 lines
28 KiB
PHP

{
This file is part of the Free Pascal run time library.
Copyright (c) 2013 by the Free Pascal development team.
Processor dependent implementation for the system unit for
intel i8086+
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.
**********************************************************************}
procedure fpc_cpuinit;
begin
end;
{$ifndef FPC_SYSTEM_HAS_FILLCHAR}
{$define FPC_SYSTEM_HAS_FILLCHAR}
procedure FillChar(var x;count:SizeUInt;value:byte);assembler;nostackframe;
asm
mov bx, sp
mov cx, ss:[bx + 4 + extra_param_offset] // count
jcxz @@Done
{$ifdef FPC_X86_DATA_NEAR}
mov di, ss:[bx + 6 + extra_param_offset] // @x
mov ax, ds
mov es, ax
{$else FPC_X86_DATA_NEAR}
les di, ss:[bx + 6 + extra_param_offset] // @x
{$endif FPC_X86_DATA_NEAR}
mov al, ss:[bx + 2 + extra_param_offset] // value
mov ah, al
shr cx, 1
{$ifdef FPC_ENABLED_CLD}
cld
{$endif FPC_ENABLED_CLD}
rep stosw
adc cx, cx
rep stosb
@@Done:
end;
{$endif FPC_SYSTEM_HAS_FILLCHAR}
{$ifndef FPC_SYSTEM_HAS_FILLWORD}
{$define FPC_SYSTEM_HAS_FILLWORD}
procedure FillWord(var x;count : SizeInt;value : word);assembler;nostackframe;
asm
mov bx, sp
mov cx, ss:[bx + 4 + extra_param_offset] // count
or cx, cx
jle @@Done
{$ifdef FPC_X86_DATA_NEAR}
mov di, ss:[bx + 6 + extra_param_offset] // @x
mov ax, ds
mov es, ax
{$else FPC_X86_DATA_NEAR}
les di, ss:[bx + 6 + extra_param_offset] // @x
{$endif FPC_X86_DATA_NEAR}
mov ax, ss:[bx + 2 + extra_param_offset] // value
{$ifdef FPC_ENABLED_CLD}
cld
{$endif FPC_ENABLED_CLD}
rep stosw
@@Done:
end;
{$endif FPC_SYSTEM_HAS_FILLWORD}
{$ifndef FPC_SYSTEM_HAS_FILLDWORD}
{$define FPC_SYSTEM_HAS_FILLDWORD}
procedure FillDWord(var x;count : SizeInt;value : dword);assembler;nostackframe;
asm
mov bx, sp
mov cx, ss:[bx + 6 + extra_param_offset] // count
or cx, cx
jle @@Done
{$ifdef FPC_X86_DATA_NEAR}
mov di, ss:[bx + 8 + extra_param_offset] // @x
mov ax, ds
mov es, ax
{$else FPC_X86_DATA_NEAR}
les di, ss:[bx + 8 + extra_param_offset] // @x
{$endif FPC_X86_DATA_NEAR}
mov ax, ss:[bx + 2 + extra_param_offset] // lo(value)
mov bx, ss:[bx + 4 + extra_param_offset] // hi(value)
{$ifdef FPC_ENABLED_CLD}
cld
{$endif FPC_ENABLED_CLD}
cmp ax, bx
jne @@lo_hi_different
shl cx, 1
rep stosw
jmp @@Done
@@lo_hi_different:
stosw
xchg ax, bx
stosw
xchg ax, bx
loop @@lo_hi_different
@@Done:
end;
{$endif FPC_SYSTEM_HAS_FILLDWORD}
procedure MoveData(srcseg,srcoff,destseg,destoff:Word;n:Word);assembler;nostackframe;
asm
mov bx, sp
mov cx, ss:[bx + 2 + extra_param_offset] // count
jcxz @@Done
mov ax, ds // backup ds
lds si, ss:[bx + 8 + extra_param_offset] // @source
les di, ss:[bx + 4 + extra_param_offset] // @dest
cmp si, di
jb @@BackwardsMove
{$ifdef FPC_ENABLED_CLD}
cld
{$endif FPC_ENABLED_CLD}
shr cx, 1
rep movsw
adc cx, cx
rep movsb
jmp @@AfterMove // todo, add mov ds,ax & ret here for performance reasons
@@BackwardsMove:
std
add si, cx
add di, cx
dec si
dec di
rep movsb // todo: movsw
cld
@@AfterMove:
mov ds, ax
@@Done:
end;
{$ifndef FPC_SYSTEM_HAS_MOVE}
{$define FPC_SYSTEM_HAS_MOVE}
procedure Move(const source;var dest;count:SizeUInt);[public, alias: 'FPC_MOVE'];assembler;nostackframe;
asm
mov bx, sp
mov cx, ss:[bx + 2 + extra_param_offset] // count
jcxz @@Done
mov ax, ds // for far data models, backup ds; for near data models, use to initialize es
{$ifdef FPC_X86_DATA_NEAR}
mov es, ax
mov si, ss:[bx + 6 + extra_param_offset] // @source
mov di, ss:[bx + 4 + extra_param_offset] // @dest
{$else FPC_X86_DATA_NEAR}
lds si, ss:[bx + 8 + extra_param_offset] // @source
les di, ss:[bx + 4 + extra_param_offset] // @dest
{$endif FPC_X86_DATA_NEAR}
cmp si, di
jb @@BackwardsMove
{$ifdef FPC_ENABLED_CLD}
cld
{$endif FPC_ENABLED_CLD}
shr cx, 1
rep movsw
adc cx, cx
rep movsb
jmp @@AfterMove // todo, add mov ds,ax & ret here for performance reasons
@@BackwardsMove:
std
add si, cx
add di, cx
dec si
dec di
rep movsb // todo: movsw
cld
@@AfterMove:
{$if defined(FPC_X86_DATA_FAR) or defined(FPC_X86_DATA_HUGE)}
mov ds, ax
{$endif}
@@Done:
end;
{$endif FPC_SYSTEM_HAS_MOVE}
{$ifndef FPC_SYSTEM_HAS_INDEXBYTE}
{$define FPC_SYSTEM_HAS_INDEXBYTE}
function IndexByte(Const buf;len:SizeInt;b:byte):SizeInt; assembler; nostackframe;
asm
mov bx, sp
mov cx, ss:[bx + 4 + extra_param_offset] // len
jcxz @@NotFound
{$ifdef FPC_X86_DATA_NEAR}
mov di, ss:[bx + 6 + extra_param_offset] // @buf
mov ax, ds
mov es, ax
{$else FPC_X86_DATA_NEAR}
les di, ss:[bx + 6 + extra_param_offset] // @buf
{$endif FPC_X86_DATA_NEAR}
mov si, di // save the start of the buffer in si
mov al, ss:[bx + 2 + extra_param_offset] // b
{$ifdef FPC_ENABLED_CLD}
cld
{$endif FPC_ENABLED_CLD}
repne scasb
je @@Found
@@NotFound:
mov ax, 0FFFFh // return -1
jmp @@Done
@@Found:
sub di, si
xchg ax, di
dec ax
@@Done:
end;
{$endif FPC_SYSTEM_HAS_INDEXBYTE}
{$ifndef FPC_SYSTEM_HAS_INDEXWORD}
{$define FPC_SYSTEM_HAS_INDEXWORD}
function IndexWord(Const buf;len:SizeInt;b:word):SizeInt; assembler; nostackframe;
asm
mov bx, sp
mov cx, ss:[bx + 4 + extra_param_offset] // len
jcxz @@NotFound
{$ifdef FPC_X86_DATA_NEAR}
mov di, ss:[bx + 6 + extra_param_offset] // @buf
mov ax, ds
mov es, ax
{$else FPC_X86_DATA_NEAR}
les di, ss:[bx + 6 + extra_param_offset] // @buf
{$endif FPC_X86_DATA_NEAR}
mov si, cx // save the length of the buffer in si
mov ax, ss:[bx + 2 + extra_param_offset] // b
{$ifdef FPC_ENABLED_CLD}
cld
{$endif FPC_ENABLED_CLD}
repne scasw
je @@Found
@@NotFound:
mov ax, 0FFFFh // return -1
jmp @@Done
@@Found:
sub si, cx
xchg ax, si
dec ax
@@Done:
end;
{$endif FPC_SYSTEM_HAS_INDEXWORD}
{$ifndef FPC_SYSTEM_HAS_INDEXDWORD}
{$define FPC_SYSTEM_HAS_INDEXDWORD}
function IndexDWord(Const buf;len:SizeInt;b:DWord):SizeInt; assembler; nostackframe;
asm
mov bx, sp
mov cx, ss:[bx + 6 + extra_param_offset] // len
jcxz @@NotFound
{$ifdef FPC_X86_DATA_NEAR}
mov di, ss:[bx + 8 + extra_param_offset] // @buf
mov ax, ds
mov es, ax
{$else FPC_X86_DATA_NEAR}
les di, ss:[bx + 8 + extra_param_offset] // @buf
{$endif FPC_X86_DATA_NEAR}
mov si, cx // save the length of the buffer in si
mov ax, ss:[bx + 2 + extra_param_offset] // b
mov bx, ss:[bx + 4 + extra_param_offset]
{$ifdef FPC_ENABLED_CLD}
cld
{$endif FPC_ENABLED_CLD}
jmp @@LoopStart
@@SkipWord:
scasw
@@LoopStart:
scasw
loopne @@SkipWord
jne @@NotFound
xchg ax, bx
scasw
je @@Found
jcxz @@NotFound
xchg ax, bx
jmp @@LoopStart
@@Found:
sub si, cx
xchg ax, si
dec ax
jmp @@Done
@@NotFound:
mov ax, 0FFFFh // return -1
@@Done:
end;
{$endif FPC_SYSTEM_HAS_INDEXDWORD}
{$ifndef FPC_SYSTEM_HAS_COMPAREBYTE}
{$define FPC_SYSTEM_HAS_COMPAREBYTE}
function CompareByte(Const buf1,buf2;len:SizeInt):SizeInt; assembler; nostackframe;
asm
xor ax, ax // initialize ax=0 (it's the result register, we never use it for anything else in this function)
mov bx, sp
mov cx, ss:[bx + 2 + extra_param_offset] // len
jcxz @@Done
mov dx, ds // for far data models, backup ds; for near data models, use to initialize es
{$ifdef FPC_X86_DATA_NEAR}
mov es, dx
mov si, ss:[bx + 6 + extra_param_offset] // @buf1
mov di, ss:[bx + 4 + extra_param_offset] // @buf2
{$else FPC_X86_DATA_NEAR}
lds si, ss:[bx + 8 + extra_param_offset] // @buf1
les di, ss:[bx + 4 + extra_param_offset] // @buf2
{$endif FPC_X86_DATA_NEAR}
{$ifdef FPC_ENABLED_CLD}
cld
{$endif FPC_ENABLED_CLD}
xor bx, bx
shr cx, 1
adc bx, bx // remainder goes to bx
jcxz @@BytewiseComparison
repe cmpsw
je @@BytewiseComparison
// we found an unequal word
// let's go back and compare it bytewise
mov bl, 2
dec si
dec si
dec di
dec di
@@BytewiseComparison:
mov cx, bx
jcxz @@Equal
repe cmpsb
je @@Equal
// ax is 0
sbb ax, ax
shl ax, 1
inc ax
@@Equal:
// ax is 0
{$if defined(FPC_X86_DATA_FAR) or defined(FPC_X86_DATA_HUGE)}
mov ds, dx
{$endif}
@@Done:
end;
{$endif FPC_SYSTEM_HAS_COMPAREBYTE}
{$ifndef FPC_SYSTEM_HAS_COMPAREWORD}
{$define FPC_SYSTEM_HAS_COMPAREWORD}
function CompareWord(Const buf1,buf2;len:SizeInt):SizeInt; assembler; nostackframe;
asm
xor ax, ax // initialize ax=0 (it's the result register, we never use it for anything else in this function)
mov bx, sp
mov cx, ss:[bx + 2 + extra_param_offset] // len
jcxz @@Done
mov dx, ds // for far data models, backup ds; for near data models, use to initialize es
{$ifdef FPC_X86_DATA_NEAR}
mov es, dx
mov si, ss:[bx + 6 + extra_param_offset] // @buf1
mov di, ss:[bx + 4 + extra_param_offset] // @buf2
{$else FPC_X86_DATA_NEAR}
lds si, ss:[bx + 8 + extra_param_offset] // @buf1
les di, ss:[bx + 4 + extra_param_offset] // @buf2
{$endif FPC_X86_DATA_NEAR}
{$ifdef FPC_ENABLED_CLD}
cld
{$endif FPC_ENABLED_CLD}
repe cmpsw
je @@Equal
// ax is 0
sbb ax, ax
shl ax, 1
inc ax
@@Equal:
// ax is 0
{$if defined(FPC_X86_DATA_FAR) or defined(FPC_X86_DATA_HUGE)}
mov ds, dx
{$endif}
@@Done:
end;
{$endif FPC_SYSTEM_HAS_COMPAREWORD}
{$ifndef FPC_SYSTEM_HAS_COMPAREDWORD}
{$define FPC_SYSTEM_HAS_COMPAREDWORD}
function CompareDWord(Const buf1,buf2;len:SizeInt):SizeInt; assembler; nostackframe;
asm
xor ax, ax // initialize ax=0 (it's the result register, we never use it for anything else in this function)
mov bx, sp
mov cx, ss:[bx + 2 + extra_param_offset] // len
jcxz @@Done
cmp cx, 4000h
jb @@NotTooBig
mov cx, 4000h
@@NotTooBig:
shl cx, 1
mov dx, ds // for far data models, backup ds; for near data models, use to initialize es
{$ifdef FPC_X86_DATA_NEAR}
mov es, dx
mov si, ss:[bx + 6 + extra_param_offset] // @buf1
mov di, ss:[bx + 4 + extra_param_offset] // @buf2
{$else FPC_X86_DATA_NEAR}
lds si, ss:[bx + 8 + extra_param_offset] // @buf1
les di, ss:[bx + 4 + extra_param_offset] // @buf2
{$endif FPC_X86_DATA_NEAR}
{$ifdef FPC_ENABLED_CLD}
cld
{$endif FPC_ENABLED_CLD}
repe cmpsw
je @@Equal
// ax is 0
sbb ax, ax
shl ax, 1
inc ax
shr cx, 1
jnc @@Skip
xchg ax, bx
xor ax, ax
cmpsw
je @@hi_equal
// ax is 0
sbb ax, ax
shl ax, 1
inc ax
jmp @@Skip
@@hi_equal:
xchg ax, bx
@@Equal:
// ax is 0
@@Skip:
{$if defined(FPC_X86_DATA_FAR) or defined(FPC_X86_DATA_HUGE)}
mov ds, dx
{$endif}
@@Done:
end;
{$endif FPC_SYSTEM_HAS_COMPAREDWORD}
{$ifndef FPC_SYSTEM_HAS_FPC_PCHAR_LENGTH}
{$define FPC_SYSTEM_HAS_FPC_PCHAR_LENGTH}
function fpc_pchar_length(p:pchar):sizeint;assembler;nostackframe;[public,alias:'FPC_PCHAR_LENGTH']; compilerproc;
asm
mov bx, sp
{$ifdef FPC_X86_DATA_NEAR}
mov ax, ss:[bx + 2 + extra_param_offset] // p
test ax, ax
jz @@Done
xchg ax, di
mov ax, ds
mov es, ax
{$else FPC_X86_DATA_NEAR}
les di, ss:[bx + 2 + extra_param_offset] // p
mov ax, es
or ax, di
jz @@Done
{$endif FPC_X86_DATA_NEAR}
mov cx, 0FFFFh
xor ax, ax
{$ifdef FPC_ENABLED_CLD}
cld
{$endif FPC_ENABLED_CLD}
repne scasb
dec ax
dec ax
sub ax, cx
@@Done:
end;
{$endif FPC_SYSTEM_HAS_FPC_PCHAR_LENGTH}
{$define FPC_SYSTEM_HAS_SPTR}
Function Sptr : Pointer;assembler;nostackframe;
asm
mov ax, sp
{$if defined(FPC_X86_DATA_FAR) or defined(FPC_X86_DATA_HUGE)}
mov dx, ss
{$endif}
end;
{$define FPC_SYSTEM_HAS_PTR}
function Ptr(sel,off: Word):farpointer;{$ifdef SYSTEMINLINE}inline;{$endif}assembler;nostackframe;
asm
mov si, sp
mov ax, ss:[si + 2 + extra_param_offset] // off
mov dx, ss:[si + 4 + extra_param_offset] // sel
end;
{$define FPC_SYSTEM_HAS_CSEG}
function CSeg: Word;{$ifdef SYSTEMINLINE}inline;{$endif}
begin
CSeg:=fpc_x86_get_cs;
end;
{$define FPC_SYSTEM_HAS_DSEG}
function DSeg: Word;{$ifdef SYSTEMINLINE}inline;{$endif}
begin
DSeg:=fpc_x86_get_ds;
end;
{$define FPC_SYSTEM_HAS_SSEG}
function SSeg: Word;{$ifdef SYSTEMINLINE}inline;{$endif}
begin
SSeg:=fpc_x86_get_ss;
end;
{$IFNDEF INTERNAL_BACKTRACE}
{$define FPC_SYSTEM_HAS_GET_FRAME}
function get_frame:pointer;assembler;nostackframe;{$ifdef SYSTEMINLINE}inline;{$endif}
asm
mov ax, bp
{$if defined(FPC_X86_DATA_FAR) or defined(FPC_X86_DATA_HUGE)}
mov dx, ss
{$endif}
end;
{$ENDIF not INTERNAL_BACKTRACE}
{$define FPC_SYSTEM_HAS_GET_PC_ADDR}
Function Get_pc_addr : CodePointer;assembler;nostackframe;
asm
mov bx, sp
mov ax, ss:[bx]
{$ifdef FPC_X86_CODE_FAR}
mov dx, ss:[bx+2]
{$endif FPC_X86_CODE_FAR}
end;
{$define FPC_SYSTEM_HAS_GET_CALLER_ADDR}
function get_caller_addr(framebp:pointer;addr:codepointer=nil):codepointer;nostackframe;assembler;
asm
mov si, sp
{$ifdef FPC_X86_CODE_FAR}
xor dx, dx
{$endif FPC_X86_CODE_FAR}
{$ifdef FPC_X86_DATA_NEAR}
mov ax, ss:[si + 4 + extra_param_offset + extra_param_offset] // framebp
{$ifdef WIN16}
mov cx, ax
and al, $FE
{$endif WIN16}
or ax, ax
jz @@Lg_a_null
xchg ax, bx // 1 byte shorter than a mov
mov ax, [bx+2]
{$ifdef FPC_X86_CODE_FAR}
{$ifdef WIN16}
test cl, 1
jnz @@farretaddr
mov dx, ss:[si + 2 + extra_param_offset + extra_param_offset] // Seg(addr^)
jmp @@retsegdone
@@farretaddr:
mov dx, [bx+4]
@@retsegdone:
{$else WIN16}
mov dx, [bx+4]
{$endif WIN16}
{$endif FPC_X86_CODE_FAR}
{$else FPC_X86_DATA_NEAR}
les ax, ss:[si + 4 + extra_param_offset + extra_param_offset] // framebp
{$ifdef WIN16}
mov cx, ax
and al, $FE
{$endif WIN16}
mov dx, es
or dx, ax
jz @@Lg_a_null
xchg ax, bx // 1 byte shorter than a mov
mov ax, es:[bx+2]
{$ifdef FPC_X86_CODE_FAR}
{$ifdef WIN16}
test cl, 1
jnz @@farretaddr
mov dx, ss:[si + 2 + extra_param_offset + extra_param_offset] // Seg(addr^)
jmp @@retsegdone
@@farretaddr:
mov dx, es:[bx+4]
@@retsegdone:
{$else WIN16}
mov dx, es:[bx+4]
{$endif WIN16}
{$endif FPC_X86_CODE_FAR}
{$endif FPC_X86_DATA_NEAR}
@@Lg_a_null:
end;
{$define FPC_SYSTEM_HAS_GET_CALLER_FRAME}
function get_caller_frame(framebp:pointer;addr:codepointer=nil):pointer;nostackframe;assembler;
asm
{$ifdef FPC_X86_DATA_NEAR}
mov si, sp
mov ax, ss:[si + 4 + extra_param_offset + extra_param_offset] // framebp
{$ifdef WIN16}
and al, $FE
{$endif WIN16}
or ax, ax
jz @@Lgnf_null
xchg ax, si // 1 byte shorter than a mov
lodsw
@@Lgnf_null:
{$else FPC_X86_DATA_NEAR}
mov si, sp
les ax, ss:[si + 4 + extra_param_offset + extra_param_offset] // framebp
{$ifdef WIN16}
and al, $FE
{$endif WIN16}
mov dx, es
or dx, ax
jz @@Lgnf_null
xchg ax, si // 1 byte shorter than a mov
seges lodsw
{$ifdef WIN16}
and al, $FE
{$endif WIN16}
mov dx, es
@@Lgnf_null:
{$endif FPC_X86_DATA_NEAR}
end;
function InterLockedDecrement (var Target: smallint) : smallint;nostackframe;assembler;
asm
mov si, sp
{$ifdef FPC_X86_DATA_NEAR}
mov bx, ss:[si + 2 + extra_param_offset] // Target
{$else FPC_X86_DATA_NEAR}
mov cx, ds
lds bx, ss:[si + 2 + extra_param_offset] // Target
{$endif FPC_X86_DATA_NEAR}
pushf
cli
sub word [bx], 1
mov ax, [bx]
popf
{$if defined(FPC_X86_DATA_FAR) or defined(FPC_X86_DATA_HUGE)}
mov ds, cx
{$endif}
end;
function InterLockedDecrement (var Target: longint) : longint;nostackframe;assembler;
asm
mov si, sp
{$ifdef FPC_X86_DATA_NEAR}
mov bx, ss:[si + 2 + extra_param_offset] // Target
{$else FPC_X86_DATA_NEAR}
mov cx, ds
lds bx, ss:[si + 2 + extra_param_offset] // Target
{$endif FPC_X86_DATA_NEAR}
pushf
cli
sub word [bx], 1
sbb word [bx+2], 0
mov ax, [bx]
mov dx, [bx+2]
popf
{$if defined(FPC_X86_DATA_FAR) or defined(FPC_X86_DATA_HUGE)}
mov ds, cx
{$endif}
end;
function InterLockedIncrement (var Target: smallint) : smallint;nostackframe;assembler;
asm
mov si, sp
{$ifdef FPC_X86_DATA_NEAR}
mov bx, ss:[si + 2 + extra_param_offset] // Target
{$else FPC_X86_DATA_NEAR}
mov cx, ds
lds bx, ss:[si + 2 + extra_param_offset] // Target
{$endif FPC_X86_DATA_NEAR}
pushf
cli
add word [bx], 1
mov ax, [bx]
popf
{$if defined(FPC_X86_DATA_FAR) or defined(FPC_X86_DATA_HUGE)}
mov ds, cx
{$endif}
end;
function InterLockedIncrement (var Target: longint) : longint;nostackframe;assembler;
asm
mov si, sp
{$ifdef FPC_X86_DATA_NEAR}
mov bx, ss:[si + 2 + extra_param_offset] // Target
{$else FPC_X86_DATA_NEAR}
mov cx, ds
lds bx, ss:[si + 2 + extra_param_offset] // Target
{$endif FPC_X86_DATA_NEAR}
pushf
cli
add word [bx], 1
adc word [bx+2], 0
mov ax, [bx]
mov dx, [bx+2]
popf
{$if defined(FPC_X86_DATA_FAR) or defined(FPC_X86_DATA_HUGE)}
mov ds, cx
{$endif}
end;
function InterLockedExchange (var Target: smallint;Source : smallint) : smallint;nostackframe;assembler;
asm
mov si, sp
{$ifdef FPC_X86_DATA_NEAR}
mov bx, ss:[si + 4 + extra_param_offset] // Target
{$else FPC_X86_DATA_NEAR}
mov cx, ds
lds bx, ss:[si + 4 + extra_param_offset] // Target
{$endif FPC_X86_DATA_NEAR}
mov ax, ss:[si + 2 + extra_param_offset] // Source
xchg word [bx], ax
{$if defined(FPC_X86_DATA_FAR) or defined(FPC_X86_DATA_HUGE)}
mov ds, cx
{$endif}
end;
function InterLockedExchange (var Target: longint;Source : longint) : longint;nostackframe;assembler;
asm
mov si, sp
{$ifdef FPC_X86_DATA_NEAR}
mov bx, ss:[si + 6 + extra_param_offset] // Target
{$else FPC_X86_DATA_NEAR}
mov cx, ds
lds bx, ss:[si + 6 + extra_param_offset] // Target
{$endif FPC_X86_DATA_NEAR}
mov ax, ss:[si + 2 + extra_param_offset] // Lo(Source)
mov dx, ss:[si + 4 + extra_param_offset] // Hi(Source)
pushf
cli
xchg word [bx], ax
xchg word [bx+2], dx
popf
{$if defined(FPC_X86_DATA_FAR) or defined(FPC_X86_DATA_HUGE)}
mov ds, cx
{$endif}
end;
function InterLockedExchangeAdd (var Target: smallint;Source : smallint) : smallint;nostackframe;assembler;
asm
mov si, sp
{$ifdef FPC_X86_DATA_NEAR}
mov bx, ss:[si + 4 + extra_param_offset] // Target
{$else FPC_X86_DATA_NEAR}
mov cx, ds
lds bx, ss:[si + 4 + extra_param_offset] // Target
{$endif FPC_X86_DATA_NEAR}
mov di, ss:[si + 2 + extra_param_offset] // Source
pushf
cli
mov ax, [bx]
add word [bx], di
popf
{$if defined(FPC_X86_DATA_FAR) or defined(FPC_X86_DATA_HUGE)}
mov ds, cx
{$endif}
end;
function InterLockedExchangeAdd (var Target: longint;Source : longint) : longint;nostackframe;assembler;
asm
mov si, sp
{$ifdef FPC_X86_DATA_NEAR}
mov bx, ss:[si + 6 + extra_param_offset] // Target
{$else FPC_X86_DATA_NEAR}
mov cx, ds
lds bx, ss:[si + 6 + extra_param_offset] // Target
{$endif FPC_X86_DATA_NEAR}
mov di, ss:[si + 2 + extra_param_offset] // Lo(Source)
mov si, ss:[si + 4 + extra_param_offset] // Hi(Source)
pushf
cli
mov ax, [bx]
mov dx, [bx+2]
add word [bx], di
adc word [bx+2], si
popf
{$if defined(FPC_X86_DATA_FAR) or defined(FPC_X86_DATA_HUGE)}
mov ds, cx
{$endif}
end;
function InterlockedCompareExchange(var Target: smallint; NewValue: smallint; Comperand: smallint): smallint;assembler;
asm
{$ifdef FPC_X86_DATA_NEAR}
mov bx, [Target] // Target
{$else FPC_X86_DATA_NEAR}
mov cx, ds
lds bx, [Target] // Target
{$endif FPC_X86_DATA_NEAR}
mov di, [Comperand]
pushf
cli
mov ax, [bx]
cmp ax, di
jne @@not_equal
mov di, [NewValue]
mov [bx], di
@@not_equal:
popf
{$if defined(FPC_X86_DATA_FAR) or defined(FPC_X86_DATA_HUGE)}
mov ds, cx
{$endif}
end;
function InterlockedCompareExchange(var Target: longint; NewValue: longint; Comperand: longint): longint;assembler;
asm
{$ifdef FPC_X86_DATA_NEAR}
mov bx, [Target] // Target
{$else FPC_X86_DATA_NEAR}
mov cx, ds
lds bx, [Target] // Target
{$endif FPC_X86_DATA_NEAR}
mov di, word [Comperand]
mov si, word [Comperand+2]
pushf
cli
mov ax, [bx]
mov dx, [bx+2]
cmp ax, di
jne @@not_equal
cmp dx, si
jne @@not_equal
mov di, word [NewValue]
mov si, word [NewValue+2]
mov [bx], di
mov [bx+2], si
@@not_equal:
popf
{$if defined(FPC_X86_DATA_FAR) or defined(FPC_X86_DATA_HUGE)}
mov ds, cx
{$endif}
end;
{****************************************************************************
Stack checking
****************************************************************************}
procedure fpc_stackcheck_i8086;[public,alias:'FPC_STACKCHECK_I8086'];compilerproc;assembler;nostackframe;
const
STACK_MARGIN=512;
asm
{ on entry: AX = required stack size to check if available
(function is called before stack allocation) }
{$ifdef FPC_MM_HUGE}
push ds
push ax
mov ax, SEG @DATA
mov ds, ax
pop ax
{$endif FPC_MM_HUGE}
add ax, STACK_MARGIN
jc @@stack_overflow
add ax, word ptr [__stkbottom]
jc @@stack_overflow
cmp ax, sp
ja @@stack_overflow
@@no_overflow:
{$ifdef FPC_MM_HUGE}
pop ds
{$endif FPC_MM_HUGE}
ret
@@stack_overflow:
{ check StackError flag, to avoid recursive calls from the exit routines }
cmp byte ptr [StackError], 1
je @@no_overflow
mov byte ptr [StackError], 1
{ cleanup return address (and maybe saved ds) from call to this function }
{$if defined(FPC_MM_HUGE)}
add sp, 6
{$elseif defined(FPC_X86_CODE_FAR)}
pop ax
pop ax
{$else}
pop ax
{$endif}
{ call HandleError(202) }
{$ifdef CPU8086}
xor ax, ax
push ax
mov al, 202
push ax
{$else}
push 0
push 202
{$endif}
call HandleError
end;
{****************************************************************************
BSR/BSF
****************************************************************************}
const
bsr8bit: array [Byte] of Byte = (
$ff,0,1,1,2,2,2,2,3,3,3,3,3,3,3,3,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,
5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,
6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,
6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,
7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,
7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,
7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,
7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7
);
bsf8bit: array [Byte] of Byte = (
$ff,0,1,0,2,0,1,0,3,0,1,0,2,0,1,0,4,0,1,0,2,0,1,0,3,0,1,0,2,0,1,0,
5,0,1,0,2,0,1,0,3,0,1,0,2,0,1,0,4,0,1,0,2,0,1,0,3,0,1,0,2,0,1,0,
6,0,1,0,2,0,1,0,3,0,1,0,2,0,1,0,4,0,1,0,2,0,1,0,3,0,1,0,2,0,1,0,
5,0,1,0,2,0,1,0,3,0,1,0,2,0,1,0,4,0,1,0,2,0,1,0,3,0,1,0,2,0,1,0,
7,0,1,0,2,0,1,0,3,0,1,0,2,0,1,0,4,0,1,0,2,0,1,0,3,0,1,0,2,0,1,0,
5,0,1,0,2,0,1,0,3,0,1,0,2,0,1,0,4,0,1,0,2,0,1,0,3,0,1,0,2,0,1,0,
6,0,1,0,2,0,1,0,3,0,1,0,2,0,1,0,4,0,1,0,2,0,1,0,3,0,1,0,2,0,1,0,
5,0,1,0,2,0,1,0,3,0,1,0,2,0,1,0,4,0,1,0,2,0,1,0,3,0,1,0,2,0,1,0
);
{$define FPC_SYSTEM_HAS_BSR_BYTE}
function BsrByte(const AValue: Byte): Byte;
begin
BsrByte := bsr8bit[AValue];
end;
{$define FPC_SYSTEM_HAS_BSF_BYTE}
function BsfByte(const AValue: Byte): Byte;
begin
BsfByte := bsf8bit[AValue];
end;
{$define FPC_SYSTEM_HAS_BSR_WORD}
function BsrWord(const AValue: Word): Byte; assembler;
asm
lea bx, bsr8bit
xor cl, cl
mov ax, word [AValue]
test ah, ah
jz @@0
mov cl, 8
mov al, ah
@@0: xlatb
add al, cl
end;
{$define FPC_SYSTEM_HAS_BSF_WORD}
function BsfWord(const AValue: Word): Byte; assembler;
asm
lea bx, bsf8bit
xor cl, cl
mov ax, word [AValue]
test al, al
jnz @@0
or al, ah
jz @@0
add cl, 8
@@0: xlatb
add al, cl
end;
{$define FPC_SYSTEM_HAS_BSR_DWORD}
function BsrDword(const AValue: DWord): Byte; assembler;
asm
lea bx, bsr8bit
mov cl, 16
mov ax, word [AValue+2]
test ax, ax
jnz @@0
xor cl, cl
mov ax, word [AValue]
@@0: test ah, ah
jz @@1
add cl, 8
mov al, ah
@@1: xlatb
add al, cl
end;
{$define FPC_SYSTEM_HAS_BSF_DWORD}
function BsfDword(const AValue: DWord): Byte; assembler;
asm
lea bx, bsf8bit
xor cl, cl
mov ax, word [AValue]
test ax, ax
jnz @@0
or ax, word [AValue+2]
jz @@1
mov cl, 16
@@0: test al, al
jnz @@1
add cl, 8
mov al, ah
@@1: xlatb
add al, cl
end;
{$define FPC_SYSTEM_HAS_BSR_QWORD}
function BsrQword(const AValue: QWord): Byte; assembler;
asm
lea bx, bsr8bit
mov cl, 48
mov ax, word [AValue+6]
test ax, ax
jnz @@0
mov cl, 32
or ax, word [AValue+4]
jnz @@0
mov cl, 16
or ax, word [AValue+2]
jnz @@0
xor cl, cl
mov ax, word [AValue]
@@0: test ah, ah
jz @@1
add cl, 8
mov al, ah
@@1: xlatb
add al, cl
end;
{$define FPC_SYSTEM_HAS_BSF_QWORD}
function BsfQword(const AValue: QWord): Byte; assembler;
asm
lea bx, bsf8bit
xor cl, cl
mov ax, word [AValue]
test ax, ax
jnz @@0
mov cl, 16
or ax, word [AValue+2]
jnz @@0
mov cl, 32
or ax, word [AValue+4]
jnz @@0
xor cl, cl
or ax, word [AValue+6]
jz @@1
mov cl, 48
@@0: test al, al
jnz @@1
add cl, 8
mov al, ah
@@1: xlatb
add al, cl
end;
{****************************************************************************
HexStr
****************************************************************************}
{$define FPC_HAS_HEXSTR_POINTER_SHORTSTR}
function HexStr(Val: NearPointer): ShortString;
begin
HexStr:=HexStr(Word(Val),4);
end;
function HexStr(Val: NearCsPointer): ShortString;
begin
HexStr:='CS:'+HexStr(Word(Val),4);
end;
function HexStr(Val: NearDsPointer): ShortString;
begin
HexStr:='DS:'+HexStr(Word(Val),4);
end;
function HexStr(Val: NearEsPointer): ShortString;
begin
HexStr:='ES:'+HexStr(Word(Val),4);
end;
function HexStr(Val: NearSsPointer): ShortString;
begin
HexStr:='SS:'+HexStr(Word(Val),4);
end;
function HexStr(Val: NearFsPointer): ShortString;
begin
HexStr:='FS:'+HexStr(Word(Val),4);
end;
function HexStr(Val: NearGsPointer): ShortString;
begin
HexStr:='GS:'+HexStr(Word(Val),4);
end;
function HexStr(Val: FarPointer): ShortString;
type
TFarPointerRec = record
Offset, Segment: Word;
end;
begin
HexStr:=HexStr(TFarPointerRec(Val).Segment,4)+':'+HexStr(TFarPointerRec(Val).Offset,4);
end;
function HexStr(Val: HugePointer): ShortString;{$ifdef SYSTEMINLINE}inline;{$endif}
begin
HexStr:=HexStr(FarPointer(Val));
end;
{****************************************************************************
FPU
****************************************************************************}
const
{ Internal constants for use in system unit }
FPU_Invalid = 1;
FPU_Denormal = 2;
FPU_DivisionByZero = 4;
FPU_Overflow = 8;
FPU_Underflow = $10;
FPU_StackUnderflow = $20;
FPU_StackOverflow = $40;
FPU_ExceptionMask = $ff;
{ Detects the FPU and initializes the Test8087 variable (and Default8087CW):
0 = NO FPU
1 = 8087
2 = 80287
3 = 80387+ }
procedure DetectFPU;
var
localfpucw: word;
begin
asm
xor bx, bx { initialization, 0=NO FPU }
{ FPU presence detection }
fninit
mov byte [localfpucw + 1], 0
nop
fnstcw localfpucw
cmp byte [localfpucw + 1], 3
jne @@Done { No FPU? }
inc bx
{ FPU found; now test if it's a 8087 }
and byte [localfpucw], $7F { clear the interrupt enable mask (IEM) }
fldcw localfpucw
fdisi { try to set the interrupt enable mask }
fstcw localfpucw
test byte [localfpucw], $80 { IEM set? }
jnz @@Done { if yes, we have an 8087 }
inc bx
{ we have a 287+; now test if it's a 80287 }
finit
fld1
fldz
fdiv { calculate 1/0 }
fld st { copy the value }
fchs { change the sign }
fcompp { compare. if the FPU distinguishes +inf from -inf, it's a 387+ }
fstsw localfpucw
mov ah, byte [localfpucw + 1]
sahf
je @@Done
inc bx { 387+ }
@@Done:
mov Test8087, bl
end ['AX','BX'];
if Test8087<=2 then
Default8087CW:=$1330
else
Default8087CW:=$1332;
end;
{$ifndef FPC_SYSTEM_HAS_SYSINITFPU}
{$define FPC_SYSTEM_HAS_SYSINITFPU}
Procedure SysInitFPU;
var
{ these locals are so we don't have to hack pic code in the assembler }
localfpucw: word;
begin
localfpucw:=Default8087CW;
asm
fninit
fldcw localfpucw
fwait
end;
end;
{$endif ndef FPC_SYSTEM_HAS_SYSINITFPU}
{$define FPC_SYSTEM_HAS_SYSRESETFPU}
Procedure SysResetFPU;
var
{ these locals are so we don't have to hack pic code in the assembler }
localfpucw: word;
begin
localfpucw:=Default8087CW;
asm
fninit
fwait
fldcw localfpucw
end;
end;
{$I int32p.inc}
{$I hugeptr.inc}