123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149 |
- {
- This file is part of the Free Pascal run time library.
- Copyright (c) 1999-2000 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.
- **********************************************************************}
- {****************************************************************************
- Primitives
- ****************************************************************************}
- var
- has_sse_support,has_mmx_support : boolean;
- {$asmmode intel}
- function cpuid_support : boolean;assembler;
- {
- Check if the ID-flag can be changed, if changed then CpuID is supported.
- Tested under go32v1 and Linux on c6x86 with CpuID enabled and disabled (PFV)
- }
- asm
- pushf
- pushf
- pop eax
- mov ebx,eax
- xor eax,200000h
- push eax
- popf
- pushf
- pop eax
- popf
- and eax,200000h
- and ebx,200000h
- cmp eax,ebx
- setnz al
- end;
- {$asmmode ATT}
- function sse_support : boolean;
- var
- _edx : longint;
- begin
- if cpuid_support then
- begin
- asm
- movl $1,%eax
- cpuid
- movl %edx,_edx
- end;
- sse_support:=(_edx and $2000000)<>0;
- end
- else
- { a cpu with without cpuid instruction supports never sse }
- sse_support:=false;
- end;
- { returns true, if the processor supports the mmx instructions }
- function mmx_support : boolean;
- var
- _edx : longint;
- begin
- if cpuid_support then
- begin
- asm
- movl $1,%eax
- cpuid
- movl %edx,_edx
- end;
- mmx_support:=(_edx and $800000)<>0;
- end
- else
- { a cpu with without cpuid instruction supports never mmx }
- mmx_support:=false;
- end;
- {$i fastmove.inc}
- procedure fpc_cpuinit;
- begin
- has_sse_support:=sse_support;
- has_mmx_support:=mmx_support;
- setup_fastmove;
- end;
- function geteipasebx : pointer;assembler;[public,alias:'FPC_GETEIPINEBX'];
- asm
- movl (%esp),%ebx
- ret
- end;
- {$ifndef FPC_SYSTEM_HAS_MOVE}
- {$define FPC_SYSTEM_HAS_MOVE}
- procedure Move(const source;var dest;count:SizeInt);[public, alias: 'FPC_MOVE'];assembler;
- var
- saveesi,saveedi : longint;
- asm
- movl %edi,saveedi
- movl %esi,saveesi
- {$ifdef REGCALL}
- movl %eax,%esi
- movl %edx,%edi
- movl %ecx,%edx
- {$else}
- movl dest,%edi
- movl source,%esi
- movl count,%edx
- {$endif}
- movl %edi,%eax
- { check for zero or negative count }
- cmpl $0,%edx
- jle .LMoveEnd
- { Check for back or forward }
- sub %esi,%eax
- jz .LMoveEnd { Do nothing when source=dest }
- jc .LFMove { Do forward, dest<source }
- cmp %edx,%eax
- jb .LBMove { Dest is in range of move, do backward }
- { Forward Copy }
- .LFMove:
- cld
- cmpl $15,%edx
- jl .LFMove1
- movl %edi,%ecx { Align on 32bits }
- negl %ecx
- andl $3,%ecx
- subl %ecx,%edx
- rep
- movsb
- movl %edx,%ecx
- andl $3,%edx
- shrl $2,%ecx
- rep
- movsl
- .LFMove1:
- movl %edx,%ecx
- rep
- movsb
- jmp .LMoveEnd
- { Backward Copy }
- .LBMove:
- std
- addl %edx,%esi
- addl %edx,%edi
- movl %edi,%ecx
- decl %esi
- decl %edi
- cmpl $15,%edx
- jl .LBMove1
- negl %ecx { Align on 32bits }
- andl $3,%ecx
- subl %ecx,%edx
- rep
- movsb
- movl %edx,%ecx
- andl $3,%edx
- shrl $2,%ecx
- subl $3,%esi
- subl $3,%edi
- rep
- movsl
- addl $3,%esi
- addl $3,%edi
- .LBMove1:
- movl %edx,%ecx
- rep
- movsb
- cld
- .LMoveEnd:
- movl saveedi,%edi
- movl saveesi,%esi
- end;
- {$endif FPC_SYSTEM_HAS_MOVE}
- {$ifndef FPC_SYSTEM_HAS_FILLCHAR}
- {$define FPC_SYSTEM_HAS_FILLCHAR}
- Procedure FillChar(var x;count:SizeInt;value:byte);assembler;
- asm
- {A push is prefered over a local variable because a local
- variable causes the compiler to generate a stackframe.}
- cld
- {$ifdef REGCALL}
- push %edi
- movl %eax,%edi
- movzbl %cl,%eax
- movl %edx,%ecx
- {$else}
- movl x,%edi
- movl count,%ecx
- movzbl value,%eax
- movl %ecx,%edx
- {$endif}
- { check for zero or negative count }
- or %ecx,%ecx
- jle .LFillEnd
- cmpl $7,%ecx
- jl .LFill1
- imul $0x01010101,%eax { Expand al into a 4 subbytes of eax}
- shrl $2,%ecx
- andl $3,%edx
- rep
- stosl
- movl %edx,%ecx
- .LFill1:
- rep
- stosb
- .LFillEnd:
- {$ifdef REGCALL}
- pop %edi
- {$endif}
- 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;
- var
- saveedi : longint;
- asm
- movl %edi,saveedi
- {$ifdef REGCALL}
- movl %eax,%edi
- movzwl %cx,%eax
- movl %edx,%ecx
- {$else}
- movl x,%edi
- movl count,%ecx
- movzwl value,%eax
- {$endif}
- { check for zero or negative count }
- cmpl $0,%ecx
- jle .LFillWordEnd
- movl %eax,%edx
- shll $16,%eax
- orl %edx,%eax
- movl %ecx,%edx
- shrl $1,%ecx
- cld
- rep
- stosl
- movl %edx,%ecx
- andl $1,%ecx
- rep
- stosw
- .LFillWordEnd:
- movl saveedi,%edi
- 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;
- var
- saveedi : longint;
- asm
- movl %edi,saveedi
- {$ifdef REGCALL}
- movl %eax,%edi
- movl %ecx,%eax
- movl %edx,%ecx
- {$else}
- movl x,%edi
- movl count,%ecx
- movl value,%eax
- {$endif}
- { check for zero or negative count }
- cmpl $0,%ecx
- jle .LFillDWordEnd
- cld
- rep
- stosl
- .LFillDWordEnd:
- movl saveedi,%edi
- end;
- {$endif FPC_SYSTEM_HAS_FILLDWORD}
- {$ifndef FPC_SYSTEM_HAS_INDEXBYTE}
- {$define FPC_SYSTEM_HAS_INDEXBYTE}
- function IndexByte(Const buf;len:SizeInt;b:byte):SizeInt; assembler;
- var
- saveedi,saveebx : longint;
- asm
- movl %edi,saveedi
- movl %ebx,saveebx
- movl buf,%edi // Load String
- movb b,%bl
- movl len,%ecx // Load len
- xorl %eax,%eax
- testl %ecx,%ecx
- jz .Lcharposnotfound
- cld
- movl %ecx,%edx // Copy for easy manipulation
- movb %bl,%al
- repne
- scasb
- jne .Lcharposnotfound
- incl %ecx
- subl %ecx,%edx
- movl %edx,%eax
- jmp .Lready
- .Lcharposnotfound:
- movl $-1,%eax
- .Lready:
- movl saveedi,%edi
- movl saveebx,%ebx
- end;
- {$endif FPC_SYSTEM_HAS_FILLDWORD}
- {$ifndef FPC_SYSTEM_HAS_INDEXWORD}
- {$define FPC_SYSTEM_HAS_INDEXWORD}
- function Indexword(Const buf;len:SizeInt;b:word):SizeInt; assembler;
- var
- saveedi,saveebx : longint;
- asm
- movl %edi,saveedi
- movl %ebx,saveebx
- movl Buf,%edi // Load String
- movw b,%bx
- movl Len,%ecx // Load len
- xorl %eax,%eax
- testl %ecx,%ecx
- jz .Lcharposnotfound
- cld
- movl %ecx,%edx // Copy for easy manipulation
- movw %bx,%ax
- repne
- scasw
- jne .Lcharposnotfound
- incl %ecx
- subl %ecx,%edx
- movl %edx,%eax
- jmp .Lready
- .Lcharposnotfound:
- movl $-1,%eax
- .Lready:
- movl saveedi,%edi
- movl saveebx,%ebx
- 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;
- var
- saveedi,saveebx : longint;
- asm
- movl %edi,saveedi
- movl %ebx,saveebx
- {$ifdef REGCALL}
- movl %eax,%edi
- movl %ecx,%ebx
- movl %edx,%ecx
- {$else}
- movl Len,%ecx // Load len
- movl Buf,%edi // Load String
- movl b,%ebx
- {$endif}
- xorl %eax,%eax
- testl %ecx,%ecx
- jz .Lcharposnotfound
- cld
- movl %ecx,%edx // Copy for easy manipulation
- movl %ebx,%eax
- repne
- scasl
- jne .Lcharposnotfound
- incl %ecx
- subl %ecx,%edx
- movl %edx,%eax
- jmp .Lready
- .Lcharposnotfound:
- movl $-1,%eax
- .Lready:
- movl saveedi,%edi
- movl saveebx,%ebx
- 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;
- var
- saveesi,saveedi : longint;
- asm
- movl %edi,saveedi
- movl %esi,saveesi
- cld
- {$ifdef REGCALL}
- movl %eax,%edi
- movl %edx,%esi
- movl %ecx,%eax
- {$else}
- movl len,%eax
- movl buf2,%esi { Load params}
- movl buf1,%edi
- {$endif}
- testl %eax,%eax {We address -1(%esi), so we have to deal with len=0}
- je .LCmpbyteExit
- cmpl $7,%eax {<7 not worth aligning and go through all trouble}
- jl .LCmpbyte2
- movl %edi,%ecx { Align on 32bits }
- negl %ecx { calc bytes to align (%edi and 3) xor 3= -%edi and 3}
- andl $3,%ecx
- subl %ecx,%eax { Subtract from number of bytes to go}
- orl %ecx,%ecx
- rep
- cmpsb {The actual 32-bit Aligning}
- jne .LCmpbyte3
- movl %eax,%ecx {bytes to do, divide by 4}
- andl $3,%eax {remainder}
- shrl $2,%ecx {The actual division}
- orl %ecx,%ecx {Sets zero flag if ecx=0 -> no cmp}
- rep
- cmpsl
- je .LCmpbyte2 { All equal? then to the left over bytes}
- movl $4,%eax { Not equal. Rescan the last 4 bytes bytewise}
- subl %eax,%esi
- subl %eax,%edi
- .LCmpbyte2:
- movl %eax,%ecx {bytes still to (re)scan}
- orl %eax,%eax {prevent disaster in case %eax=0}
- rep
- cmpsb
- .LCmpbyte3:
- movzbl -1(%esi),%ecx
- movzbl -1(%edi),%eax // Compare failing (or equal) position
- subl %ecx,%eax
- .LCmpbyteExit:
- movl saveedi,%edi
- movl saveesi,%esi
- 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;
- var
- saveesi,saveedi,saveebx : longint;
- asm
- movl %edi,saveedi
- movl %esi,saveesi
- movl %ebx,saveebx
- cld
- {$ifdef REGCALL}
- movl %eax,%edi
- movl %edx,%esi
- movl %ecx,%eax
- {$else}
- movl len,%eax
- movl buf2,%esi { Load params}
- movl buf1,%edi
- {$endif}
- testl %eax,%eax {We address -2(%esi), so we have to deal with len=0}
- je .LCmpwordExit
- cmpl $5,%eax {<5 (3 bytes align + 4 bytes cmpsl = 4 words}
- jl .LCmpword2 { not worth aligning and go through all trouble}
- movl (%edi),%ebx // Compare alignment bytes.
- cmpl (%esi),%ebx
- jne .LCmpword2 // Aligning will go wrong already. Max 2 words will be scanned Branch NOW
- shll $1,%eax {Convert word count to bytes}
- movl %edi,%edx { Align comparing is already done, so simply add}
- negl %edx { calc bytes to align -%edi and 3}
- andl $3,%edx
- addl %edx,%esi { Skip max 3 bytes alignment}
- addl %edx,%edi
- subl %edx,%eax { Subtract from number of bytes to go}
- movl %eax,%ecx { Make copy of bytes to go}
- andl $3,%eax { Calc remainder (mod 4) }
- andl $1,%edx { %edx is 1 if array not 2-aligned, 0 otherwise}
- shrl $2,%ecx { divide bytes to go by 4, DWords to go}
- orl %ecx,%ecx { Sets zero flag if ecx=0 -> no cmp}
- rep { Compare entire DWords}
- cmpsl
- je .LCmpword2a { All equal? then to the left over bytes}
- movl $4,%eax { Not equal. Rescan the last 4 bytes bytewise}
- subl %eax,%esi { Go back one DWord}
- subl %eax,%edi
- incl %eax {if not odd then this does nothing, else it makes
- sure that adding %edx increases from 2 to 3 words}
- .LCmpword2a:
- subl %edx,%esi { Subtract alignment}
- subl %edx,%edi
- addl %edx,%eax
- shrl $1,%eax
- .LCmpword2:
- movl %eax,%ecx {words still to (re)scan}
- orl %eax,%eax {prevent disaster in case %eax=0}
- rep
- cmpsw
- .LCmpword3:
- movzwl -2(%esi),%ecx
- movzwl -2(%edi),%eax // Compare failing (or equal) position
- subl %ecx,%eax // calculate end result.
- .LCmpwordExit:
- movl saveedi,%edi
- movl saveesi,%esi
- movl saveebx,%ebx
- 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;
- var
- saveesi,saveedi,saveebx : longint;
- asm
- movl %edi,saveedi
- movl %esi,saveesi
- movl %ebx,saveebx
- cld
- {$ifdef REGCALL}
- movl %eax,%edi
- movl %edx,%esi
- movl %ecx,%eax
- {$else}
- movl len,%eax
- movl buf2,%esi { Load params}
- movl buf1,%edi
- {$endif}
- testl %eax,%eax {We address -2(%esi), so we have to deal with len=0}
- je .LCmpDwordExit
- cmpl $3,%eax {<3 (3 bytes align + 4 bytes cmpsl) = 2 DWords}
- jl .LCmpDword2 { not worth aligning and go through all trouble}
- movl (%edi),%ebx // Compare alignment bytes.
- cmpl (%esi),%ebx
- jne .LCmpDword2 // Aligning will go wrong already. Max 2 words will be scanned Branch NOW
- shll $2,%eax {Convert word count to bytes}
- movl %edi,%edx { Align comparing is already done, so simply add}
- negl %edx { calc bytes to align -%edi and 3}
- andl $3,%edx
- addl %edx,%esi { Skip max 3 bytes alignment}
- addl %edx,%edi
- subl %edx,%eax { Subtract from number of bytes to go}
- movl %eax,%ecx { Make copy of bytes to go}
- andl $3,%eax { Calc remainder (mod 4) }
- shrl $2,%ecx { divide bytes to go by 4, DWords to go}
- orl %ecx,%ecx { Sets zero flag if ecx=0 -> no cmp}
- rep { Compare entire DWords}
- cmpsl
- je .LCmpDword2a { All equal? then to the left over bytes}
- movl $4,%eax { Not equal. Rescan the last 4 bytes bytewise}
- subl %eax,%esi { Go back one DWord}
- subl %eax,%edi
- addl $3,%eax {if align<>0 this causes repcount to be 2}
- .LCmpDword2a:
- subl %edx,%esi { Subtract alignment}
- subl %edx,%edi
- addl %edx,%eax
- shrl $2,%eax
- .LCmpDword2:
- movl %eax,%ecx {words still to (re)scan}
- orl %eax,%eax {prevent disaster in case %eax=0}
- rep
- cmpsl
- .LCmpDword3:
- movzwl -4(%esi),%ecx
- movzwl -4(%edi),%eax // Compare failing (or equal) position
- subl %ecx,%eax // calculate end result.
- .LCmpDwordExit:
- movl saveedi,%edi
- movl saveesi,%esi
- movl saveebx,%ebx
- end;
- {$endif FPC_SYSTEM_HAS_COMPAREDWORD}
- {$ifndef FPC_SYSTEM_HAS_INDEXCHAR0}
- {$define FPC_SYSTEM_HAS_INDEXCHAR0}
- function IndexChar0(Const buf;len:SizeInt;b:Char):SizeInt; assembler;
- var
- saveesi,saveebx : longint;
- asm
- movl %esi,saveesi
- movl %ebx,saveebx
- // Can't use scasb, or will have to do it twice, think this
- // is faster for small "len"
- {$ifdef REGCALL}
- movl %eax,%esi // Load address
- movzbl %cl,%ebx // Load searchpattern
- {$else}
- movl Buf,%esi // Load address
- movl len,%edx // load maximal searchdistance
- movzbl b,%ebx // Load searchpattern
- {$endif}
- testl %edx,%edx
- je .LFound
- xorl %ecx,%ecx // zero index in Buf
- xorl %eax,%eax // To make DWord compares possible
- .LLoop:
- movb (%esi),%al // Load byte
- cmpb %al,%bl
- je .LFound // byte the same?
- incl %ecx
- incl %esi
- cmpl %edx,%ecx // Maximal distance reached?
- je .LNotFound
- testl %eax,%eax // Nullchar = end of search?
- jne .LLoop
- .LNotFound:
- movl $-1,%ecx // Not found return -1
- .LFound:
- movl %ecx,%eax
- movl saveesi,%esi
- movl saveebx,%ebx
- end;
- {$endif FPC_SYSTEM_HAS_INDEXCHAR0}
- {****************************************************************************
- String
- ****************************************************************************}
- {$ifndef FPC_SYSTEM_HAS_FPC_SHORTSTR_ASSIGN}
- {$define FPC_SYSTEM_HAS_FPC_SHORTSTR_ASSIGN}
- function fpc_shortstr_to_shortstr(len:longint; const sstr: shortstring): shortstring; [public,alias: 'FPC_SHORTSTR_TO_SHORTSTR']; compilerproc;
- begin
- asm
- cld
- movl __RESULT,%edi
- movl sstr,%esi
- xorl %eax,%eax
- movl len,%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
- end ['ESI','EDI','EAX','ECX'];
- end;
- procedure fpc_shortstr_assign(len:longint;sstr,dstr:pointer);[public,alias:'FPC_SHORTSTR_ASSIGN'];
- begin
- asm
- pushl %eax
- pushl %ecx
- cld
- movl dstr,%edi
- movl sstr,%esi
- xorl %eax,%eax
- movl len,%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;
- {$endif FPC_SYSTEM_HAS_FPC_SHORTSTR_ASSIGN}
- {$ifndef FPC_SYSTEM_HAS_FPC_SHORTSTR_CONCAT}
- {$define FPC_SYSTEM_HAS_FPC_SHORTSTR_CONCAT}
- function fpc_shortstr_concat(const s1,s2:shortstring):shortstring;compilerproc;
- begin
- asm
- movl __RESULT,%edi
- movl %edi,%ebx
- movl s1,%esi { first string }
- lodsb
- andl $0x0ff,%eax
- stosb
- cmpl $7,%eax
- jl .LStrConcat1
- 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
- .LStrConcat1:
- movl %eax,%ecx
- rep
- movsb
- movl s2,%esi { second string }
- movzbl (%ebx),%ecx
- negl %ecx
- addl $0x0ff,%ecx
- lodsb
- cmpl %ecx,%eax
- jbe .LStrConcat2
- movl %ecx,%eax
- .LStrConcat2:
- addb %al,(%ebx)
- cmpl $7,%eax
- jl .LStrConcat3
- 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
- .LStrConcat3:
- movl %eax,%ecx
- rep
- movsb
- end ['EBX','ECX','EAX','ESI','EDI'];
- end;
- {$endif FPC_SYSTEM_HAS_FPC_SHORTSTR_CONCAT}
- {$ifndef FPC_SYSTEM_HAS_FPC_SHORTSTR_APPEND_SHORTSTR}
- {$define FPC_SYSTEM_HAS_FPC_SHORTSTR_APPEND_SHORTSTR}
- procedure fpc_shortstr_append_shortstr(var s1:shortstring;const s2:shortstring);compilerproc;
- [public,alias:'FPC_SHORTSTR_APPEND_SHORTSTR'];
- begin
- asm
- movl s1,%edi
- movl s2,%esi
- movl %edi,%ebx
- movzbl (%edi),%ecx
- movl __HIGH(s1),%eax
- lea 1(%edi,%ecx),%edi
- negl %ecx
- addl %eax,%ecx
- // no need to zero eax, high(s1) <= 255
- 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;
- {$endif FPC_SYSTEM_HAS_FPC_SHORTSTR_APPEND_SHORTSTR}
- {$ifndef FPC_SYSTEM_HAS_FPC_SHORTSTR_COMPARE}
- {$define FPC_SYSTEM_HAS_FPC_SHORTSTR_COMPARE}
- function fpc_shortstr_compare(const left,right:shortstring): longint;assembler; [public,alias:'FPC_SHORTSTR_COMPARE']; compilerproc;
- var
- saveesi,saveedi,saveebx : longint;
- asm
- movl %edi,saveedi
- movl %esi,saveesi
- movl %ebx,saveebx
- cld
- movl right,%esi
- movl left,%edi
- movzbl (%esi),%eax
- movzbl (%edi),%ebx
- 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
- subl %eax,%esi
- subl %eax,%edi
- .LStrCmp2:
- movl %eax,%ecx
- orl %eax,%eax
- rep
- cmpsb
- je .LStrCmp4
- .LStrCmp3:
- movzbl -1(%esi),%edx // Compare failing (or equal) position
- movzbl -1(%edi),%ebx
- .LStrCmp4:
- movl %ebx,%eax // Compare length or position
- subl %edx,%eax
- movl saveedi,%edi
- movl saveesi,%esi
- movl saveebx,%ebx
- end;
- {$endif FPC_SYSTEM_HAS_FPC_SHORTSTR_COMPARE}
- {$ifndef FPC_SYSTEM_HAS_FPC_PCHAR_TO_SHORTSTR}
- {$define FPC_SYSTEM_HAS_FPC_PCHAR_TO_SHORTSTR}
- function fpc_pchar_to_shortstr(p:pchar):shortstring;assembler;[public,alias:'FPC_PCHAR_TO_SHORTSTR']; compilerproc;
- {$include strpas.inc}
- {$endif FPC_SYSTEM_HAS_FPC_PCHAR_TO_SHORTSTR}
- {$ifndef FPC_SYSTEM_HAS_FPC_PCHAR_LENGTH}
- {$define FPC_SYSTEM_HAS_FPC_PCHAR_LENGTH}
- function fpc_pchar_length(p:pchar):longint;assembler;[public,alias:'FPC_PCHAR_LENGTH']; compilerproc;
- {$include strlen.inc}
- {$endif FPC_SYSTEM_HAS_FPC_PCHAR_LENGTH}
- {$define FPC_SYSTEM_HAS_GET_FRAME}
- function get_frame:pointer;assembler;{$ifdef SYSTEMINLINE}inline;{$endif}
- asm
- movl %ebp,%eax
- end ['EAX'];
- {$define FPC_SYSTEM_HAS_GET_CALLER_ADDR}
- function get_caller_addr(framebp:pointer):pointer;assembler;{$ifdef SYSTEMINLINE}inline;{$endif}
- asm
- {$ifndef REGCALL}
- movl framebp,%eax
- {$endif}
- orl %eax,%eax
- jz .Lg_a_null
- movl 4(%eax),%eax
- .Lg_a_null:
- end ['EAX'];
- {$define FPC_SYSTEM_HAS_GET_CALLER_FRAME}
- function get_caller_frame(framebp:pointer):pointer;assembler;{$ifdef SYSTEMINLINE}inline;{$endif}
- asm
- {$ifndef REGCALL}
- movl framebp,%eax
- {$endif}
- orl %eax,%eax
- jz .Lgnf_null
- movl (%eax),%eax
- .Lgnf_null:
- end ['EAX'];
- {****************************************************************************
- Math
- ****************************************************************************}
- {$define FPC_SYSTEM_HAS_ABS_LONGINT}
- function abs(l:longint):longint; assembler;{$ifdef SYSTEMINLINE}inline;{$endif}
- asm
- {$ifndef REGCALL}
- movl l,%eax
- {$endif}
- cltd
- xorl %edx,%eax
- subl %edx,%eax
- end ['EAX','EDX'];
- {$define FPC_SYSTEM_HAS_ODD_LONGINT}
- function odd(l:longint):boolean;assembler;{$ifdef SYSTEMINLINE}inline;{$endif}
- asm
- {$ifdef SYSTEMINLINE}
- movl l,%eax
- {$else}
- {$ifndef REGCALL}
- movl l,%eax
- {$endif}
- {$endif}
- andl $1,%eax
- setnz %al
- end ['EAX'];
- {$define FPC_SYSTEM_HAS_SQR_LONGINT}
- function sqr(l:longint):longint;assembler;{$ifdef SYSTEMINLINE}inline;{$endif}
- asm
- {$ifdef SYSTEMINLINE}
- movl l,%eax
- {$else}
- {$ifndef REGCALL}
- movl l,%eax
- {$endif}
- {$endif}
- imull %eax,%eax
- end ['EAX'];
- {$define FPC_SYSTEM_HAS_SPTR}
- Function Sptr : Pointer;assembler;{$ifdef SYSTEMINLINE}inline;{$endif}
- asm
- movl %esp,%eax
- end;
- {****************************************************************************
- Str()
- ****************************************************************************}
- {$define FPC_SYSTEM_HAS_INT_STR_LONGINT}
- procedure int_str(l : longint;var s : string);
- var
- buffer : array[0..15] of byte;
- isneg : byte;
- begin
- { Workaround: }
- if l=longint($80000000) then
- begin
- s:='-2147483648';
- exit;
- end;
- asm
- movl l,%eax // load Integer
- xorl %ecx,%ecx // String length=0
- leal buffer,%ebx
- movl $0x0a,%esi // load 10 as dividing constant.
- movb $0,isneg
- orl %eax,%eax // Sign ?
- jns .LM2
- movb $1,isneg
- negl %eax
- .LM2:
- cltd
- idivl %esi
- addb $0x30,%dl // convert Rest to ASCII.
- movb %dl,(%ebx)
- incl %ecx
- incl %ebx
- cmpl $0,%eax
- jnz .LM2
- { now copy the string }
- movl s,%edi // Load String address
- cmpb $0,isneg
- je .LM3
- movb $0x2d,(%ebx)
- incl %ecx
- incl %ebx
- .LM3:
- movb %cl,(%edi) // Copy String length
- incl %edi
- .LM4:
- decl %ebx
- movb (%ebx),%al
- stosb
- decl %ecx
- jnz .LM4
- end ['eax','ecx','edx','ebx','esi','edi'];
- end;
- {$define FPC_SYSTEM_HAS_INT_STR_LONGWORD}
- procedure int_str(c : longword;var s : string);
- var
- buffer : array[0..15] of byte;
- begin
- asm
- movl c,%eax // load CARDINAL
- xorl %ecx,%ecx // String length=0
- leal buffer,%ebx
- movl $0x0a,%esi // load 10 as dividing constant.
- .LM4:
- xorl %edx,%edx
- divl %esi
- addb $0x30,%dl // convert Rest to ASCII.
- movb %dl,(%ebx)
- incl %ecx
- incl %ebx
- cmpl $0,%eax
- jnz .LM4
- { now copy the string }
- movl s,%edi // Load String address
- movb %cl,(%edi) // Copy String length
- incl %edi
- .LM5:
- decl %ebx
- movb (%ebx),%al
- stosb
- decl %ecx
- jnz .LM5
- end ['eax','ecx','edx','ebx','esi','edi'];
- end;
- {****************************************************************************
- Bounds Check
- ****************************************************************************}
- { do a thread save inc/dec }
- {$define FPC_SYSTEM_HAS_DECLOCKED_LONGINT}
- function cpudeclocked(var l : longint) : boolean;assembler;
- asm
- {$ifndef REGCALL}
- movl l,%eax
- {$endif}
- { this check should be done because a lock takes a lot }
- { of time! }
- lock
- decl (%eax)
- setzb %al
- end;
- {$define FPC_SYSTEM_HAS_INCLOCKED_LONGINT}
- procedure cpuinclocked(var l : longint);assembler;
- asm
- {$ifndef REGCALL}
- movl l,%eax
- {$endif}
- lock
- incl (%eax)
- end;
- // inline SMP check and normal lock.
- // the locked one is so slow, inlining doesn't matter.
- function declocked(var l : longint) : boolean; inline;
- begin
- if not ismultithread then
- begin
- dec(l);
- declocked:=l=0;
- end
- else
- declocked:=cpudeclocked(l);
- end;
- procedure inclocked(var l : longint); inline;
- begin
- if not ismultithread then
- inc(l)
- else
- cpuinclocked(l);
- end;
- {****************************************************************************
- FPU
- ****************************************************************************}
- const
- fpucw : word = $1332;
- { 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;
- {$define FPC_SYSTEM_HAS_SYSRESETFPU}
- Procedure SysResetFPU;assembler;{$ifdef SYSTEMINLINE}inline;{$endif}
- asm
- fninit
- fldcw fpucw
- fwait
- end;
|