core/cpu/x86/32/32.factor

   1 ! Copyright (C) 2005, 2008 Slava Pestov.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: alien.c-types arrays cpu.x86.assembler
   4 cpu.x86.architecture cpu.x86.intrinsics cpu.x86.allot
   5 cpu.architecture kernel kernel.private math namespaces sequences
   6 generator.registers generator.fixup generator system layouts
   7 alien.compiler combinators command-line
   8 compiler compiler.units io vocabs.loader accessors init ;
   9 IN: cpu.x86.32
  10
  11 ! We implement the FFI for Linux, OS X and Windows all at once.
  12 ! OS X requires that the stack be 16-byte aligned, and we do
  13 ! this on all platforms, sacrificing some stack space for
  14 ! code simplicity.
  15
  16 M: x86.32 ds-reg ESI ;
  17 M: x86.32 rs-reg EDI ;
  18 M: x86.32 stack-reg ESP ;
  19 M: x86.32 stack-save-reg EDX ;
  20 M: x86.32 temp-reg-1 EAX ;
  21 M: x86.32 temp-reg-2 ECX ;
  22
  23 M: temp-reg v>operand drop EBX ;
  24
  25 M: x86.32 %alien-global 0 [] MOV rc-absolute-cell rel-dlsym ;
  26
  27 M: x86.32 %alien-invoke (CALL) rel-dlsym ;
  28
  29 ! On x86, parameters are never passed in registers.
  30 M: int-regs return-reg drop EAX ;
  31 M: int-regs param-regs drop { } ;
  32 M: int-regs vregs drop { EAX ECX EDX EBP } ;
  33 M: int-regs push-return-reg return-reg PUSH ;
  34 : load/store-int-return ( n reg-class -- src dst )
  35     return-reg stack-reg rot [+] ;
  36 M: int-regs load-return-reg load/store-int-return MOV ;
  37 M: int-regs store-return-reg load/store-int-return swap MOV ;
  38
  39 M: float-regs param-regs drop { } ;
  40 M: float-regs vregs drop { XMM0 XMM1 XMM2 XMM3 XMM4 XMM5 XMM6 XMM7 } ;
  41
  42 : FSTP ( operand size -- ) 4 = [ FSTPS ] [ FSTPL ] if ;
  43
  44 M: float-regs push-return-reg
  45     stack-reg swap reg-size [ SUB  stack-reg [] ] keep FSTP ;
  46
  47 : FLD ( operand size -- ) 4 = [ FLDS ] [ FLDL ] if ;
  48
  49 : load/store-float-return ( n reg-class -- op size )
  50     [ stack@ ] [ reg-size ] bi* ;
  51 M: float-regs load-return-reg load/store-float-return FLD ;
  52 M: float-regs store-return-reg load/store-float-return FSTP ;
  53
  54 : align-sub ( n -- )
  55     dup 16 align swap - ESP swap SUB ;
  56
  57 : align-add ( n -- )
  58     16 align ESP swap ADD ;
  59
  60 : with-aligned-stack ( n quot -- )
  61     swap dup align-sub slip align-add ; inline
  62
  63 ! On x86, we can always use an address as an operand
  64 ! directly.
  65 M: x86.32 address-operand ;
  66
  67 M: x86.32 fixnum>slot@ 1 SHR ;
  68
  69 M: x86.32 prepare-division CDQ ;
  70
  71 M: x86.32 load-indirect
  72     0 [] MOV rc-absolute-cell rel-literal ;
  73
  74 M: object %load-param-reg 3drop ;
  75
  76 M: object %save-param-reg 3drop ;
  77
  78 M: x86.32 %prepare-unbox ( -- )
  79     #! Move top of data stack to EAX.
  80     EAX ESI [] MOV
  81     ESI 4 SUB ;
  82
  83 : (%unbox) ( func -- )
  84     4 [
  85         ! Push parameter
  86         EAX PUSH
  87         ! Call the unboxer
  88         f %alien-invoke
  89     ] with-aligned-stack ;
  90
  91 M: x86.32 %unbox ( n reg-class func -- )
  92     #! The value being unboxed must already be in EAX.
  93     #! If n is f, we're unboxing a return value about to be
  94     #! returned by the callback. Otherwise, we're unboxing
  95     #! a parameter to a C function about to be called.
  96     (%unbox)
  97     ! Store the return value on the C stack
  98     over [ store-return-reg ] [ 2drop ] if ;
  99
 100 M: x86.32 %unbox-long-long ( n func -- )
 101     (%unbox)
 102     ! Store the return value on the C stack
 103     [
 104         dup stack@ EAX MOV
 105         cell + stack@ EDX MOV
 106     ] when* ;
 107
 108 M: x86.32 %unbox-struct-2
 109     #! Alien must be in EAX.
 110     4 [
 111         EAX PUSH
 112         "alien_offset" f %alien-invoke
 113         ! Load second cell
 114         EDX EAX 4 [+] MOV
 115         ! Load first cell
 116         EAX EAX [] MOV
 117     ] with-aligned-stack ;
 118
 119 M: x86.32 %unbox-large-struct ( n size -- )
 120     #! Alien must be in EAX.
 121     ! Compute destination address
 122     ECX ESP roll [+] LEA
 123     12 [
 124         ! Push struct size
 125         PUSH
 126         ! Push destination address
 127         ECX PUSH
 128         ! Push source address
 129         EAX PUSH
 130         ! Copy the struct to the stack
 131         "to_value_struct" f %alien-invoke
 132     ] with-aligned-stack ;
 133
 134 : box@ ( n reg-class -- stack@ )
 135     #! Used for callbacks; we want to box the values given to
 136     #! us by the C function caller. Computes stack location of
 137     #! nth parameter; note that we must go back one more stack
 138     #! frame, since %box sets one up to call the one-arg boxer
 139     #! function. The size of this stack frame so far depends on
 140     #! the reg-class of the boxer's arg.
 141     reg-size neg + stack-frame* + 20 + ;
 142
 143 : (%box) ( n reg-class -- )
 144     #! If n is f, push the return register onto the stack; we
 145     #! are boxing a return value of a C function. If n is an
 146     #! integer, push [ESP+n] on the stack; we are boxing a
 147     #! parameter being passed to a callback from C.
 148     over [ [ box@ ] keep [ load-return-reg ] keep ] [ nip ] if
 149     push-return-reg ;
 150
 151 M: x86.32 %box ( n reg-class func -- )
 152     over reg-size [
 153         >r (%box) r> f %alien-invoke
 154     ] with-aligned-stack ;
 155
 156 : (%box-long-long) ( n -- )
 157     #! If n is f, push the return registers onto the stack; we
 158     #! are boxing a return value of a C function. If n is an
 159     #! integer, push [ESP+n]:[ESP+n+4] on the stack; we are
 160     #! boxing a parameter being passed to a callback from C.
 161     [
 162         int-regs box@
 163         EDX over stack@ MOV
 164         EAX swap cell - stack@ MOV
 165     ] when*
 166     EDX PUSH
 167     EAX PUSH ;
 168
 169 M: x86.32 %box-long-long ( n func -- )
 170     8 [
 171         [ (%box-long-long) ] [ f %alien-invoke ] bi*
 172     ] with-aligned-stack ;
 173
 174 M: x86.32 %box-large-struct ( n size -- )
 175     ! Compute destination address
 176     [ swap struct-return@ ] keep
 177     ECX ESP roll [+] LEA
 178     8 [
 179         ! Push struct size
 180         PUSH
 181         ! Push destination address
 182         ECX PUSH
 183         ! Copy the struct from the C stack
 184         "box_value_struct" f %alien-invoke
 185     ] with-aligned-stack ;
 186
 187 M: x86.32 %prepare-box-struct ( size -- )
 188     ! Compute target address for value struct return
 189     EAX ESP rot f struct-return@ [+] LEA
 190     ! Store it as the first parameter
 191     ESP [] EAX MOV ;
 192
 193 M: x86.32 %unbox-struct-1
 194     #! Alien must be in EAX.
 195     4 [
 196         EAX PUSH
 197         "alien_offset" f %alien-invoke
 198         ! Load first cell
 199         EAX EAX [] MOV
 200     ] with-aligned-stack ;
 201
 202 M: x86.32 %box-small-struct ( size -- )
 203     #! Box a <= 8-byte struct returned in EAX:DX. OS X only.
 204     12 [
 205         PUSH
 206         EDX PUSH
 207         EAX PUSH
 208         "box_small_struct" f %alien-invoke
 209     ] with-aligned-stack ;
 210
 211 M: x86.32 %prepare-alien-indirect ( -- )
 212     "unbox_alien" f %alien-invoke
 213     cell temp@ EAX MOV ;
 214
 215 M: x86.32 %alien-indirect ( -- )
 216     cell temp@ CALL ;
 217
 218 M: x86.32 %alien-callback ( quot -- )
 219     4 [
 220         EAX load-indirect
 221         EAX PUSH
 222         "c_to_factor" f %alien-invoke
 223     ] with-aligned-stack ;
 224
 225 M: x86.32 %callback-value ( ctype -- )
 226     ! Align C stack
 227     ESP 12 SUB
 228     ! Save top of data stack
 229     %prepare-unbox
 230     EAX PUSH
 231     ! Restore data/call/retain stacks
 232     "unnest_stacks" f %alien-invoke
 233     ! Place top of data stack in EAX
 234     EAX POP
 235     ! Restore C stack
 236     ESP 12 ADD
 237     ! Unbox EAX
 238     unbox-return ;
 239
 240 M: x86.32 %cleanup ( alien-node -- )
 241     #! a) If we just called an stdcall function in Windows, it
 242     #! cleaned up the stack frame for us. But we don't want that
 243     #! so we 'undo' the cleanup since we do that in %epilogue.
 244     #! b) If we just called a function returning a struct, we
 245     #! have to fix ESP.
 246     {
 247         {
 248             [ dup abi>> "stdcall" = ]
 249             [ alien-stack-frame ESP swap SUB ]
 250         } {
 251             [ dup return>> large-struct? ]
 252             [ drop EAX PUSH ]
 253         }
 254         [ drop ]
 255     } cond ;
 256
 257 M: x86.32 %unwind ( n -- ) %epilogue-later RET ;
 258
 259 os windows? [
 260     cell "longlong" c-type set-c-type-align
 261     cell "ulonglong" c-type set-c-type-align
 262     4 "double" c-type set-c-type-align
 263 ] unless
 264
 265 : (sse2?) ( -- ? ) "Intrinsic" throw ;
 266
 267 <<
 268
 269 \ (sse2?) [
 270     { EAX EBX ECX EDX } [ PUSH ] each
 271     EAX 1 MOV
 272     CPUID
 273     EDX 26 SHR
 274     EDX 1 AND
 275     { EAX EBX ECX EDX } [ POP ] each
 276     JE
 277 ] { } define-if-intrinsic
 278
 279 >>
 280
 281 : sse2? ( -- ? ) (sse2?) ;
 282
 283 "-no-sse2" cli-args member? [
 284     "Checking if your CPU supports SSE2..." print flush
 285     [ optimized-recompile-hook ] recompile-hook [
 286         [ sse2? ] compile-call
 287     ] with-variable
 288     [
 289         " - yes" print
 290         "cpu.x86.sse2" require
 291         [
 292             sse2? [
 293                 "This image was built to use SSE2, which your CPU does not support." print
 294                 "You will need to bootstrap Factor again." print
 295                 flush
 296                 1 exit
 297             ] unless
 298         ] "cpu.x86" add-init-hook
 299     ] [
 300         " - no" print
 301     ] if
 302 ] unless