{ 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. **********************************************************************} {$if not(defined(VER3_0)) and defined(linux)} {$define FPC_SYSTEM_STACKALIGNMENT16} {$endif not(defined(VER3_0)) and defined(linux)} {**************************************************************************** Primitives ****************************************************************************} var os_supports_sse : boolean; { this variable is set to true, if currently an sse check is executed and no sig ill should be generated } sse_check : boolean; {$asmmode ATT} function cpuid_support : boolean;assembler;nostackframe; { 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 pushfl movl (%esp),%eax xorl $0x200000,%eax pushl %eax popfl pushfl popl %eax xorl (%esp),%eax popfl testl $0x200000,%eax setnz %al end; {$ifndef FPC_PIC} {$ifndef FPC_SYSTEM_HAS_MOVE} {$ifndef OLD_ASSEMBLER} {$define USE_FASTMOVE} {$i fastmove.inc} {$endif not OLD_ASSEMBLER} {$endif FPC_SYSTEM_HAS_MOVE} {$endif FPC_PIC} {$define FPC_SYSTEM_HAS_FPC_CPUINIT} procedure fpc_cpuinit; begin { because of the brain dead sse detection on x86, this test is post poned to fpc_cpucodeinit which must be implemented OS dependend (FK) has_sse_support:=sse_support; has_mmx_support:=mmx_support; setup_fastmove; } end; {$ifndef darwin} procedure fpc_geteipasebx; [public, alias: 'fpc_geteipasebx'];assembler; nostackframe; asm movl (%esp),%ebx end; procedure fpc_geteipasecx; [public, alias: 'fpc_geteipasecx'];assembler; nostackframe; asm movl (%esp),%ecx end; {$endif} {$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 movl %eax,%esi movl %edx,%edi movl %ecx,%edx 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=Sptr) then Result:=PPointer(framebp+4)^ else Result:=nil; end; {$else defined(win32)} nostackframe;assembler; asm orl %eax,%eax jz .Lg_a_null movl 4(%eax),%eax .Lg_a_null: end; {$endif defined(win32)} {$define FPC_SYSTEM_HAS_GET_CALLER_FRAME} function get_caller_frame(framebp:pointer;addr:pointer=nil):pointer; {$if defined(win32)} { Windows has StackTop always properly set } begin if assigned(framebp) and (framebp<=StackTop) and (framebp>=Sptr) then Result:=PPointer(framebp)^ else Result:=nil; end; {$else defined(win32)} nostackframe;assembler; asm orl %eax,%eax jz .Lgnf_null movl (%eax),%eax .Lgnf_null: end; {$endif defined(win32)} {$define FPC_SYSTEM_HAS_SPTR} Function Sptr : Pointer;assembler;nostackframe; asm movl %esp,%eax end; {**************************************************************************** Str() ****************************************************************************} {$if defined(disabled) and defined(regcall) } {$define FPC_SYSTEM_HAS_INT_STR_LONGWORD} {$define FPC_SYSTEM_HAS_INT_STR_LONGINT} label str_int_shortcut; procedure int_str(l:longword;out s:shortstring);assembler;nostackframe; asm pushl %esi pushl %edi pushl %ebx mov %edx,%edi xor %edx,%edx jmp str_int_shortcut end; procedure int_str(l:longint;out s:shortstring);assembler;nostackframe; {Optimized for speed, but balanced with size.} const digits:array[0..9] of cardinal=(0,10,100,1000,10000, 100000,1000000,10000000, 100000000,1000000000); asm {$ifdef FPC_PROFILE} push %eax push %edx push %ecx call mcount pop %ecx pop %edx pop %eax {$endif FPC_PROFILE} push %esi push %edi push %ebx movl %edx,%edi { Calculate absolute value and put sign in edx} cltd xorl %edx,%eax subl %edx,%eax negl %edx str_int_shortcut: movl %ecx,%esi {Calculate amount of digits in ecx.} xorl %ecx,%ecx bsrl %eax,%ecx incl %ecx imul $1233,%ecx shr $12,%ecx {$ifdef FPC_PIC} call fpc_geteipasebx {$ifdef darwin} movl digits-.Lpic(%ebx),%ebx {$else} addl $_GLOBAL_OFFSET_TABLE_,%ebx movl digits@GOT(%ebx),%ebx {$endif} cmpl (%ebx,%ecx,4),%eax {$else} cmpl digits(,%ecx,4),%eax {$endif} cmc adcl $0,%ecx {Nr. digits ready in ecx.} {Write length & sign.} lea (%edx,%ecx),%ebx movb $45,%bh {movb $'-,%bh Not supported by our ATT reader.} movw %bx,(%edi) addl %edx,%edi subl %edx,%esi {Skip digits beyond string length.} movl %eax,%edx subl %ecx,%esi jae .Lloop_write .balign 4 .Lloop_skip: movl $0xcccccccd,%eax {Divide by 10 using mul+shr} mull %edx shrl $3,%edx decl %ecx jz .Ldone {If (l<0) and (high(s)=1) this jump is taken.} incl %esi jnz .Lloop_skip {Write out digits.} .balign 4 .Lloop_write: movl $0xcccccccd,%eax {Divide by 10 using mul+shr} {Pre-add '0'} leal 48(%edx),%ebx {leal $'0(,%edx),%ebx Not supported by our ATT reader.} mull %edx shrl $3,%edx leal (%edx,%edx,8),%eax {x mod 10 = x-10*(x div 10)} subl %edx,%ebx subl %eax,%ebx movb %bl,(%edi,%ecx) decl %ecx jnz .Lloop_write .Ldone: popl %ebx popl %edi popl %esi end; {$endif} {**************************************************************************** Bounds Check ****************************************************************************} { do a thread-safe inc/dec } {$define FPC_SYSTEM_HAS_DECLOCKED_LONGINT} function cpudeclocked(var l : longint) : boolean;assembler;nostackframe; asm lock decl (%eax) setzb %al end; {$define FPC_SYSTEM_HAS_INCLOCKED_LONGINT} procedure cpuinclocked(var l : longint);assembler;nostackframe; asm 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; function InterLockedDecrement (var Target: longint) : longint; assembler; asm movl $-1,%edx xchgl %edx,%eax lock xaddl %eax, (%edx) decl %eax end; function InterLockedIncrement (var Target: longint) : longint; assembler; asm movl $1,%edx xchgl %edx,%eax lock xaddl %eax, (%edx) incl %eax end; function InterLockedExchange (var Target: longint;Source : longint) : longint; assembler; asm xchgl (%eax),%edx movl %edx,%eax end; function InterLockedExchangeAdd (var Target: longint;Source : longint) : longint; assembler; asm xchgl %eax,%edx lock xaddl %eax, (%edx) end; function InterlockedCompareExchange(var Target: longint; NewValue: longint; Comperand: longint): longint; assembler; asm xchgl %eax,%ecx lock cmpxchgl %edx, (%ecx) end; function InterlockedCompareExchange64(var Target: int64; NewValue: int64; Comperand: int64): int64; assembler; asm pushl %ebx pushl %edi movl %eax,%edi movl Comperand+4,%edx movl Comperand+0,%eax movl NewValue+4,%ecx movl NewValue+0,%ebx lock cmpxchg8b (%edi) pop %edi pop %ebx end; {**************************************************************************** FPU ****************************************************************************} const { Internal constants for use in system unit } FPU_Invalid = 1; FPU_Denormal = 2; FPU_DivisionByZero = 4; FPU_Overflow = 8; FPU_Underflow = $10; FPU_StackUnderflow = $20; FPU_StackOverflow = $40; FPU_ExceptionMask = $ff; MM_Invalid = 1; MM_Denormal = 2; MM_DivisionByZero = 4; MM_Overflow = 8; MM_Underflow = $10; MM_Precicion = $20; MM_ExceptionMask = $3f; MM_MaskInvalidOp = %0000000010000000; MM_MaskDenorm = %0000000100000000; MM_MaskDivZero = %0000001000000000; MM_MaskOverflow = %0000010000000000; MM_MaskUnderflow = %0000100000000000; MM_MaskPrecision = %0001000000000000; {$define FPC_SYSTEM_HAS_SYSINITFPU} Procedure SysInitFPU; begin end; {$define FPC_SYSTEM_HAS_SYSRESETFPU} Procedure SysResetFPU; var { these locals are so we don't have to hack pic code in the assembler } localmxcsr: dword; localfpucw: word; begin localfpucw:=Default8087CW; asm fninit fwait fldcw localfpucw end; if has_sse_support then begin localmxcsr:=DefaultMXCSR; asm { setup sse exceptions } {$ifndef OLD_ASSEMBLER} ldmxcsr localmxcsr {$else OLD_ASSEMBLER} mov localmxcsr,%eax subl $4,%esp mov %eax,(%esp) //ldmxcsr (%esp) .byte 0x0f,0xae,0x14,0x24 addl $4,%esp {$endif OLD_ASSEMBLER} end; end; end; { because of the brain dead sse detection on x86, this test is post poned } procedure fpc_cpucodeinit; var _ecx,_edx : longint; begin if cpuid_support then begin asm movl $1,%eax cpuid movl %edx,_edx movl %ecx,_ecx end ['ebx']; has_mmx_support:=(_edx and $800000)<>0; if ((_edx and $2000000)<>0) then begin os_supports_sse:=true; sse_check:=true; asm { force an sse exception if no sse is supported, the exception handler sets os_supports_sse to false then } { don't change this instruction, the code above depends on its size } {$ifdef OLD_ASSEMBLER} .byte 0x0f,0x28,0xf7 {$else} movaps %xmm7, %xmm6 {$endif not EMX} end; sse_check:=false; has_sse_support:=os_supports_sse; end; if has_sse_support then begin has_sse2_support:=((_edx and $4000000)<>0); has_sse3_support:=((_ecx and $200)<>0); end; end; { don't let libraries influence the FPU cw set by the host program } if IsLibrary then begin Default8087CW:=Get8087CW; if has_sse_support then DefaultMXCSR:=GetMXCSR; end; SysResetFPU; {$ifdef USE_FASTMOVE} setup_fastmove; {$endif} end; {$if not defined(darwin) and defined(regcall) } { darwin requires that the stack is aligned to 16 bytes when calling another function } {$ifdef FPC_HAS_FEATURE_ANSISTRINGS} {$define FPC_SYSTEM_HAS_ANSISTR_DECR_REF} Procedure fpc_AnsiStr_Decr_Ref (Var S : Pointer); [Public,Alias:'FPC_ANSISTR_DECR_REF']; compilerproc; nostackframe; assembler; asm movl (%eax),%edx testl %edx,%edx jz .Lquit movl $0,(%eax) // s:=nil cmpl $0,-8(%edx) // exit if refcount<0 jl .Lquit {$ifdef FPC_PIC} call fpc_geteipasecx addl $_GLOBAL_OFFSET_TABLE_,%ecx movl ismultithread@GOT(%ecx),%ecx cmpl $0,(%ecx) {$else FPC_PIC} cmpl $0,ismultithread {$endif FPC_PIC} je .Lskiplock .byte 0xF0 // LOCK prefix, jumped over if IsMultiThread = false. FPC assembler does not accept disjoint LOCK mnemonic. .Lskiplock: decl -8(%edx) jz .Lfree .Lquit: ret .Lfree: leal -12(%edx),%eax // points to start of allocation { freemem is not an assembler leaf function like fpc_geteipasecx, so it needs to be called with proper stack alignment } {$ifdef FPC_SYSTEM_STACKALIGNMENT16} leal -12(%esp),%esp call FPC_FREEMEM leal 12(%esp),%esp {$else FPC_SYSTEM_STACKALIGNMENT16} jmp FPC_FREEMEM // can perform a tail call {$endif FPC_SYSTEM_STACKALIGNMENT16} 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 {$ifdef FPC_SYSTEM_STACKALIGNMENT16} leal -12(%esp),%esp {$endif FPC_SYSTEM_STACKALIGNMENT16} call fpc_truely_ansistr_unique {$ifdef FPC_SYSTEM_STACKALIGNMENT16} leal 12(%esp),%esp {$endif FPC_SYSTEM_STACKALIGNMENT16} .Lj4038: .Lj4031: // [442] end; end; {$endif FPC_HAS_FEATURE_ANSISTRINGS} {$endif ndef darwin and defined(regcall) } {$ifndef FPC_SYSTEM_HAS_MEM_BARRIER} {$define FPC_SYSTEM_HAS_MEM_BARRIER} procedure ReadBarrier;assembler;nostackframe; asm {$ifdef CPUX86_HAS_SSE2} lfence {$else CPUX86_HAS_SSE2} lock addl $0,0(%esp) {$endif CPUX86_HAS_SSE2} end; procedure ReadDependencyBarrier;{$ifdef SYSTEMINLINE}inline;{$endif} begin { reads imply barrier on earlier reads depended on } end; procedure ReadWriteBarrier;assembler;nostackframe; asm {$ifdef CPUX86_HAS_SSE2} mfence {$else CPUX86_HAS_SSE2} lock addl $0,0(%esp) {$endif CPUX86_HAS_SSE2} end; procedure WriteBarrier;assembler;nostackframe; asm {$ifdef CPUX86_HAS_SSEUNIT} sfence {$endif CPUX86_HAS_SSEUNIT} end; {$endif} {$ifndef FPC_SYSTEM_HAS_BSF_QWORD} {$define FPC_SYSTEM_HAS_BSF_QWORD} function BsfQWord(Const AValue : QWord): cardinal; assembler; nostackframe; asm bsfl 4(%esp),%eax jnz .L2 .L1: bsfl 8(%esp),%eax jnz .L3 movl $223,%eax .L3: addl $32,%eax .L2: end; {$endif FPC_SYSTEM_HAS_BSF_QWORD} {$ifndef FPC_SYSTEM_HAS_BSR_QWORD} {$define FPC_SYSTEM_HAS_BSR_QWORD} function BsrQWord(Const AValue : QWord): cardinal; assembler; nostackframe; asm bsrl 8(%esp),%eax jz .L1 add $32,%eax jmp .L2 .L1: bsrl 4(%esp),%eax jnz .L2 movl $255,%eax .L2: end; {$endif FPC_SYSTEM_HAS_BSR_QWORD} {$ifndef FPC_SYSTEM_HAS_SAR_QWORD} {$define FPC_SYSTEM_HAS_SAR_QWORD} function fpc_SarInt64(Const AValue : Int64;const Shift : Byte): Int64; [Public,Alias:'FPC_SARINT64']; compilerproc; assembler; nostackframe; asm movb %al,%cl movl 8(%esp),%edx movl 4(%esp),%eax andb $63,%cl cmpb $32,%cl jnb .L1 shrdl %cl,%edx,%eax sarl %cl,%edx jmp .Lexit .L1: movl %edx,%eax sarl $31,%edx andb $31,%cl sarl %cl,%eax .Lexit: end; {$endif FPC_SYSTEM_HAS_SAR_QWORD}