1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351135213531354135513561357135813591360136113621363136413651366136713681369137013711372137313741375137613771378137913801381138213831384138513861387138813891390139113921393139413951396139713981399140014011402140314041405140614071408140914101411141214131414141514161417141814191420142114221423142414251426142714281429143014311432143314341435143614371438143914401441144214431444144514461447144814491450145114521453145414551456145714581459146014611462146314641465146614671468146914701471147214731474147514761477147814791480148114821483148414851486148714881489149014911492149314941495149614971498149915001501150215031504150515061507150815091510151115121513151415151516151715181519152015211522152315241525152615271528152915301531153215331534153515361537153815391540154115421543154415451546154715481549155015511552155315541555155615571558155915601561156215631564156515661567156815691570157115721573157415751576157715781579158015811582158315841585158615871588158915901591159215931594159515961597159815991600160116021603160416051606160716081609161016111612161316141615161616171618161916201621162216231624162516261627162816291630163116321633163416351636163716381639164016411642164316441645164616471648164916501651165216531654165516561657165816591660166116621663166416651666166716681669167016711672167316741675167616771678167916801681168216831684168516861687168816891690169116921693169416951696169716981699170017011702170317041705170617071708170917101711171217131714171517161717171817191720172117221723172417251726172717281729173017311732173317341735173617371738173917401741174217431744174517461747174817491750175117521753 |
- {
- $Id$
- 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}
- {****************************************************************************
- Object Helpers
- ****************************************************************************}
- {$ifndef HAS_GENERICCONSTRUCTOR}
- {$define FPC_SYSTEM_HAS_FPC_HELP_CONSTRUCTOR}
- procedure fpc_help_constructor; assembler; [public,alias:'FPC_HELP_CONSTRUCTOR']; {$ifdef hascompilerproc} compilerproc; {$endif}
- 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
- {$ifdef valuegetmem}
- { esi can be destroyed in fpc_getmem!!! (JM) }
- pushl %esi
- {$endif valuegetmem}
- { Memory size }
- pushl (%eax)
- {$ifdef valuegetmem}
- call fpc_getmem
- popl %esi
- movl %eax,(%esi)
- {$else valuegetmem}
- pushl %esi
- call AsmGetMem
- {$endif valuegetmem}
- movl $-1,8(%ebp)
- popal
- { Avoid 80386DX bug }
- nop
- { 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)
- { jmp not necessary anymore because next instruction is disabled (JM)
- jmp .LHC_6 }
- { Why was the VMT reset to zero here ????
- I need it fail to know if I should
- zero the VMT field in static objects PM }
- .LHC_4:
- { movl $0,8(%ebp) }
- .LHC_6:
- { 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
- movl %ecx,%ebx
- xorl %eax,%eax
- shrl $2,%ecx
- andl $3,%ebx
- rep
- stosl
- movl %ebx,%ecx
- rep
- stosb
- popal
- { avoid the 80386DX bug }
- nop
- { 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)
- testl %eax,%eax
- .LHC_5:
- end;
- {$define FPC_SYSTEM_HAS_FPC_HELP_FAIL}
- procedure fpc_help_fail;assembler;[public,alias:'FPC_HELP_FAIL']; {$ifdef hascompilerproc} compilerproc; {$endif}
- { should be called with a object that needs to be
- freed if VMT field is at -1
- %edi contains VMT offset in object again }
- asm
- testl %esi,%esi
- je .LHF_1
- cmpl $-1,8(%ebp)
- je .LHF_2
- { reset vmt field to zero for static instances }
- cmpl $0,8(%ebp)
- je .LHF_3
- { main constructor, we can zero the VMT field now }
- movl $0,(%esi,%edi,1)
- .LHF_3:
- { we zero esi to indicate failure }
- xorl %esi,%esi
- jmp .LHF_1
- .LHF_2:
- { get vmt address in eax }
- movl (%esi,%edi,1),%eax
- movl %esi,12(%ebp)
- { push object position }
- {$ifdef valuefreemem}
- pushl %esi
- call fpc_freemem
- {$else valuefreemem}
- leal 12(%ebp),%eax
- pushl %eax
- call AsmFreeMem
- {$endif valuefreemem}
- { set both object places to zero }
- xorl %esi,%esi
- movl %esi,12(%ebp)
- .LHF_1:
- end;
- {$define FPC_SYSTEM_HAS_FPC_HELP_DESTRUCTOR}
- procedure fpc_help_destructor;assembler;[public,alias:'FPC_HELP_DESTRUCTOR']; {$ifdef hascompilerproc} compilerproc; {$endif}
- 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)
- {$ifdef valuefreemem}
- { Freemem }
- pushl %eax
- call fpc_freemem
- {$else valuefreemem}
- { temporary Variable }
- subl $4,%esp
- movl %esp,%edi
- { SELF }
- movl %eax,(%edi)
- pushl %edi
- call AsmFreeMem
- addl $4,%esp
- {$endif valuefreemem}
- .LHD_3:
- popal
- { avoid the 80386DX bug }
- nop
- end;
- {$define FPC_SYSTEM_HAS_FPC_NEW_CLASS}
- procedure fpc_new_class;assembler;[public,alias:'FPC_NEW_CLASS']; {$ifdef hascompilerproc} compilerproc; {$endif}
- asm
- { to be sure in the future, we save also edit }
- pushl %edi
- { create class ? }
- movl 8(%ebp),%edi
- { if we test eax later without calling newinstance }
- { it must have a value <>0 }
- movl $1,%eax
- testl %edi,%edi
- jz .LNEW_CLASS1
- { save registers !! }
- pushl %ebx
- pushl %ecx
- pushl %edx
- { esi contains the vmt }
- pushl %esi
- { call newinstance (class method!) }
- call *52{vmtNewInstance}(%esi)
- popl %edx
- popl %ecx
- popl %ebx
- { 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)
- testl %eax,%eax
- popl %edi
- end;
- { Internal alias that can be reference from asm code }
- procedure int_dispose_class;external name 'FPC_DISPOSE_CLASS';
- {$define FPC_SYSTEM_HAS_FPC_DISPOSE_CLASS}
- procedure fpc_dispose_class;assembler;[public,alias:'FPC_DISPOSE_CLASS']; {$ifdef hascompilerproc} compilerproc; {$endif}
- asm
- { to be sure in the future, we save also edit }
- pushl %edi
- { destroy class ? }
- movl 12(%ebp),%edi
- testl %edi,%edi
- jz .LDISPOSE_CLASS1
- { no inherited call }
- movl (%esi),%edi
- { save registers !! }
- pushl %eax
- pushl %ebx
- pushl %ecx
- pushl %edx
- { push self }
- pushl %esi
- { call freeinstance }
- call *56{vmtFreeInstance}(%edi)
- popl %edx
- popl %ecx
- popl %ebx
- popl %eax
- .LDISPOSE_CLASS1:
- popl %edi
- end;
- {$define FPC_SYSTEM_HAS_FPC_HELP_FAIL_CLASS}
- procedure fpc_help_fail_class;assembler;[public,alias:'FPC_HELP_FAIL_CLASS']; {$ifdef hascompilerproc} compilerproc; {$endif}
- { a non zero class must allways be disposed
- VMT is allways at pos 0 }
- asm
- testl %esi,%esi
- je .LHFC_1
- { can't use the compilerproc version as that will generate a
- reference instead of a symbol }
- call int_dispose_class
- { set both object places to zero }
- xorl %esi,%esi
- movl %esi,8(%ebp)
- .LHFC_1:
- end;
- {$define FPC_SYSTEM_HAS_FPC_CHECK_OBJECT}
- { we want the stack for debugging !! PM }
- procedure fpc_check_object(obj : pointer);[public,alias:'FPC_CHECK_OBJECT']; {$ifdef hascompilerproc} compilerproc; {$endif}
- begin
- asm
- pushl %edi
- movl obj,%edi
- pushl %eax
- { Here we must check if the VMT pointer is nil before }
- { accessing it... }
- testl %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 }
- end;{ of asm }
- end;
- {$define FPC_SYSTEM_HAS_FPC_CHECK_OBJECT_EXT}
- procedure fpc_check_object_ext;assembler;[public,alias:'FPC_CHECK_OBJECT_EXT']; {$ifdef hascompilerproc} compilerproc; {$endif}
- { checks for a correct vmt pointer }
- { deeper check to see if the current object is }
- { really related to the true }
- 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:
- testl %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 $219
- 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 HAS_GENERICCONSTRUCTOR}
- {****************************************************************************
- 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']; {$ifdef hascompilerproc} compilerproc; {$endif}
- 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;
- {$ifdef interncopy}
- procedure fpc_shortstr_assign(len:longint;sstr,dstr:pointer);[public,alias:'FPC_SHORTSTR_ASSIGN'];
- {$else}
- procedure fpc_shortstr_copy(len:longint;sstr,dstr:pointer);[public,alias:'FPC_SHORTSTR_COPY'];
- {$endif}
- 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;{$ifdef hascompilerproc}compilerproc;{$endif}
- 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}
- {$ifdef hascompilerproc}
- 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;
- {$else hascompilerproc}
- procedure fpc_shortstr_concat_int(const s1,s2:shortstring);[public,alias:'FPC_SHORTSTR_CONCAT'];
- begin
- asm
- movl s1,%esi
- movl s2,%edi
- movl %edi,%ebx
- movzbl (%edi),%ecx
- xor %eax,%eax
- lea 1(%edi,%ecx),%edi
- negl %ecx
- addl $0x0ff,%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;
- {$endif hascompilerproc}
- {$endif FPC_SYSTEM_HAS_FPC_SHORTSTR_APPEND_SHORTSTR}
- {$ifndef FPC_SYSTEM_HAS_FPC_SHORTSTR_COMPARE}
- {$define FPC_SYSTEM_HAS_FPC_SHORTSTR_COMPARE}
- {$ifdef SHORTSTRCOMPAREINREG}
- 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;
- {$else SHORTSTRCOMPAREINREG}
- function fpc_shortstr_compare(const left,right:shortstring): longint; [public,alias:'FPC_SHORTSTR_COMPARE']; {$ifdef hascompilerproc} compilerproc; {$endif}
- begin
- asm
- cld
- xorl %ebx,%ebx
- xorl %eax,%eax
- movl right,%esi
- movl left,%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;
- {$endif SHORTSTRCOMPAREINREG}
- {$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']; {$ifdef hascompilerproc} compilerproc; {$endif}
- {$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']; {$ifdef hascompilerproc} compilerproc; {$endif}
- {$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}{$ifndef INTERNCONSTINTF}[internconst:fpc_in_const_abs];{$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}{$ifndef INTERNCONSTINTF}[internconst:fpc_in_const_odd];{$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}{$ifndef INTERNCONSTINTF}[internconst:fpc_in_const_sqr];{$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
- ****************************************************************************}
- {$ifndef NOBOUNDCHECK}
- procedure int_boundcheck;assembler;[public,alias: 'FPC_BOUNDCHECK'];
- var dummy_to_force_stackframe_generation_for_trace: Longint;
- {
- 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 %ebp
- pushl $201
- call HandleErrorFrame
- .Lbc_ok:
- end;
- {$endif NOBOUNDCHECK}
- { do a thread save inc/dec }
- {$define FPC_SYSTEM_HAS_DECLOCKED_LONGINT}
- function declocked(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! }
- cmpb $0,IsMultithread
- jz .Ldeclockednolock
- lock
- decl (%eax)
- jmp .Ldeclockedend
- .Ldeclockednolock:
- decl (%eax);
- .Ldeclockedend:
- setzb %al
- end;
- {$define FPC_SYSTEM_HAS_INCLOCKED_LONGINT}
- procedure inclocked(var l : longint);assembler;
- asm
- {$ifndef REGCALL}
- movl l,%eax
- {$endif}
- { this check should be done because a lock takes a lot }
- { of time! }
- cmpb $0,IsMultithread
- jz .Linclockednolock
- lock
- incl (%eax)
- jmp .Linclockedend
- .Linclockednolock:
- incl (%eax)
- .Linclockedend:
- 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
- end;
- {
- $Log$
- Revision 1.67 2005-01-23 20:03:23 florian
- + fastmove from John O'Harrow integrated
- Revision 1.66 2004/11/17 22:19:04 peter
- internconst, internproc and some external declarations moved to interface
- Revision 1.65 2004/11/01 12:43:29 peter
- * shortstr compare with empty string fixed
- * removed special i386 code
- Revision 1.64 2004/07/18 20:21:44 florian
- + several unicode (to/from utf-8 conversion) stuff added
- * some longint -> SizeInt changes
- Revision 1.63 2004/07/18 16:40:08 jonas
- * fixed indexbyte/word/dword when length is 0 (return -1 instead of 0)
- Revision 1.62 2004/07/07 17:38:58 daniel
- * Aligment code in fillchar proved to slow down stuff seriously instead of
- speeding it up. This is logical, the compiler aligns everything very well,
- it is possible that fillchar gets called on misaligned data, but it seems
- this never happens.
- Revision 1.61 2004/04/29 20:00:47 peter
- * inclocked_longint ifdef fixed
- Revision 1.60 2004/04/26 15:55:01 peter
- * FPC_MOVE alias
- Revision 1.59 2004/02/05 01:16:12 florian
- + completed x86-64/linux system unit
- Revision 1.58 2004/01/11 11:10:07 jonas
- + cgeneric.inc: implementations of rtl routines based on libc
- * system.inc: include cgeneric.inc before powerpc.inc/i386.inc/... if
- FPC_USE_LIBC is defined
- * powerpc.inc, i386.inc: check whether the routines they implement aren't
- implemented yet in another include file (cgeneric.inc)
- Revision 1.57 2004/01/02 17:22:14 jonas
- + fpc_cpuinit procedure to allow cpu/fpu initialisation before any unit
- initialises
- + fpu exceptions for invalid operations and division by zero enabled for
- ppc
- Revision 1.56 2003/12/24 23:07:28 peter
- * fixed indexbyte for regcall
- Revision 1.55 2003/12/04 21:44:39 peter
- * fix warning in gas
- Revision 1.54 2003/11/19 16:58:44 peter
- * make strpas assembler function
- Revision 1.53 2003/11/11 21:08:17 peter
- * REGCALL define added
- Revision 1.52 2003/11/03 09:42:27 marco
- * Peter's Cardinal<->Longint fixes patch
- Revision 1.51 2003/10/27 09:16:57 marco
- * fix from peter i386.inc to circumvent ebx destroying
- Revision 1.50 2003/10/23 17:01:27 peter
- * save edi,ebx,esi in int_str
- Revision 1.49 2003/10/16 21:28:40 peter
- * use __HIGH()
- Revision 1.48 2003/10/14 00:57:48 florian
- + some code for PIC support added
- Revision 1.47 2003/09/14 11:34:13 peter
- * moved int64 asm code to int64p.inc
- * save ebx,esi
- Revision 1.46 2003/09/08 18:21:37 peter
- * save edi,esi,ebx
- Revision 1.45 2003/06/01 14:50:17 jonas
- * fpc_shortstr_append_shortstr has to use high(s1) instead of 255 as
- maxlen
- + ppc version of fpc_shortstr_append_shortstr
- Revision 1.44 2003/05/26 21:18:13 peter
- * FPC_SHORTSTR_APPEND_SHORTSTR public added
- Revision 1.43 2003/05/26 19:36:46 peter
- * fpc_shortstr_concat is now the same for all targets
- * fpc_shortstr_append_shortstr added for optimized code generation
- Revision 1.42 2003/05/16 22:40:11 florian
- * fixed generic shortstr_compare
- Revision 1.41 2003/03/26 00:19:10 peter
- * ifdef HAS_GENERICCONSTRUCTOR
- Revision 1.40 2003/03/17 14:30:11 peter
- * changed address parameter/return values to pointer instead
- of longint
- Revision 1.39 2003/02/18 17:56:06 jonas
- - removed buggy i386-specific FPC_CHARARRAY_TO_SHORTSTR
- * fixed generic FPC_CHARARRAY_TO_SHORTSTR (web bug 2382)
- * fixed some potential range errors in indexchar/word/dword
- Revision 1.38 2003/01/06 23:03:13 mazen
- + defining FPC_SYSTEM_HAS_DECLOCKED and FPC_SYSTEM_HAS_INCLOCKED to avoid
- compilation error on generic.inc
- Revision 1.37 2003/01/03 17:14:54 peter
- * fix possible overflow when array len > 255 when converting to
- shortstring
- Revision 1.36 2002/12/15 22:32:25 peter
- * fixed return value when len=0 for indexchar,indexword
- Revision 1.35 2002/10/20 11:50:57 carl
- * avoid crashes with negative len counts on fills/moves
- Revision 1.34 2002/10/15 19:24:47 carl
- * Replace 220 -> 219
- Revision 1.33 2002/10/14 19:39:16 peter
- * threads unit added for thread support
- Revision 1.32 2002/10/05 14:20:16 peter
- * fpc_pchar_length compilerproc and strlen alias
- Revision 1.31 2002/10/02 18:21:51 peter
- * Copy() changed to internal function calling compilerprocs
- * FPC_SHORTSTR_COPY renamed to FPC_SHORTSTR_ASSIGN because of the
- new copy functions
- Revision 1.30 2002/09/07 21:33:35 carl
- - removed unused defines
- Revision 1.29 2002/09/07 16:01:19 peter
- * old logs removed and tabs fixed
- Revision 1.28 2002/09/03 15:43:36 peter
- * add alias for fpc_dispose_class so it can be called from
- fpc_help_fail_class
- Revision 1.27 2002/08/19 19:34:02 peter
- * SYSTEMINLINE define that will add inline directives for small
- functions and wrappers. This will be defined automaticly when
- the compiler defines the HASINLINE directive
- Revision 1.26 2002/07/26 15:45:33 florian
- * changed multi threading define: it's MT instead of MTRTL
- Revision 1.25 2002/07/06 20:31:59 carl
- + added TEST_GENERIC to test generic version
- Revision 1.24 2002/06/16 08:21:26 carl
- + TEST_GENERIC to test generic versions of code
- Revision 1.23 2002/06/09 12:54:37 jonas
- * fixed memory corruption bug in fpc_help_constructor
- Revision 1.22 2002/04/21 18:56:59 peter
- * fpc_freemem and fpc_getmem compilerproc
- Revision 1.21 2002/04/01 14:23:17 carl
- - no need for runerror 203, already fixed!
- Revision 1.20 2002/03/30 14:52:04 carl
- * cause runtime error 203 on failed class creation
- }
|