12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226 |
- {
- 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;
- {$define FPC_SYSTEM_HAS_ANSISTR_DECR_REF}
- function fpc_freemem_x(p:pointer):ptrint; [external name 'FPC_FREEMEM_X'];
- Procedure fpc_AnsiStr_Decr_Ref (Var S : Pointer); [Public,Alias:'FPC_ANSISTR_DECR_REF']; compilerproc; nostackframe; assembler;
- asm
- cmpl $0,(%eax)
- jne .Ldecr_ref_continue
- ret
- .Ldecr_ref_continue:
- // Temps allocated between ebp-24 and ebp+0
- subl $4,%esp
- // Var S located in register
- // Var l located in register
- movl %eax,(%esp)
- .Lj3599:
- // [101] l:=@PAnsiRec(S-FirstOff)^.Ref;
- movl (%esp),%edx
- movl (%edx),%edx
- subl $8,%edx
- // [102] If l^<0 then exit;
- movl (%edx),%eax
- testl %eax,%eax
- jl .Lj3596
- .Lj3603:
- // [104] If declocked(l^) then
- movb ismultithread,%al
- testb %al,%al
- jne .Lj3610
- decl (%edx)
- je .Lj3620
- addl $4,%esp
- ret
- .Lj3610:
- movl %edx,%eax
- call cpudeclocked
- movb %al,%cl
- .Lj3613:
- testb %cl,%cl
- je .Lj3605
- .Lj3620:
- movl (%esp),%eax
- movl (%eax),%eax
- subl $8,%eax
- call FPC_FREEMEM_X
- movl (%esp),%eax
- movl $0,(%eax)
- .Lj3618:
- .Lj3605:
- .Lj3596:
- // [107] end;
- addl $4,%esp
- end;
- function fpc_truely_ansistr_unique(Var S : Pointer): Pointer; forward;
- {$define FPC_SYSTEM_HAS_ANSISTR_UNIQUE}
- Function fpc_ansistr_Unique(Var S : Pointer): Pointer; [Public,Alias : 'FPC_ANSISTR_UNIQUE']; compilerproc; nostackframe;assembler;
- asm
- // Var S located in register
- // Var $result located in register
- movl %eax,%edx
- // [437] pointer(result) := pointer(s);
- movl (%eax),%eax
- // [438] If Pointer(S)=Nil then
- testl %eax,%eax
- je .Lj4031
- .Lj4036:
- // [440] if PAnsiRec(Pointer(S)-Firstoff)^.Ref<>1 then
- movl -8(%eax),%ecx
- cmpl $1,%ecx
- je .Lj4038
- // [441] result:=fpc_truely_ansistr_unique(s);
- movl %edx,%eax
- call fpc_truely_ansistr_unique
- .Lj4038:
- .Lj4031:
- // [442] end;
- end;
|