basis/cpu/x86/32/32.factor

   1 ! Copyright (C) 2005, 2011 Slava Pestov.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: accessors alien alien.c-types arrays classes.struct
   4 combinators compiler.cfg.builder.alien.boxing
   5 compiler.codegen.gc-maps compiler.codegen.labels
   6 compiler.codegen.relocation compiler.constants cpu.architecture
   7 cpu.x86 cpu.x86.assembler cpu.x86.assembler.operands
   8 cpu.x86.features kernel locals make math namespaces sequences
   9 specialized-arrays system vocabs ;
  10 SPECIALIZED-ARRAY: uint
  11 FROM: layouts => cell ;
  12 IN: cpu.x86.32
  13
  14 : x86-float-regs ( -- seq )
  15     "cpu.x86.sse" lookup-vocab
  16     { XMM0 XMM1 XMM2 XMM3 XMM4 XMM5 XMM6 XMM7 }
  17     { ST0 ST1 ST2 ST3 ST4 ST5 ST6 }
  18     ? ;
  19
  20 M: x86.32 machine-registers
  21     { int-regs { EAX ECX EDX EBP EBX } }
  22     float-regs x86-float-regs 2array
  23     2array ;
  24
  25 M: x86.32 ds-reg ESI ;
  26 M: x86.32 rs-reg EDI ;
  27 M: x86.32 stack-reg ESP ;
  28 M: x86.32 frame-reg EBP ;
  29
  30 M: x86.32 immediate-comparand? ( obj -- ? ) drop t ;
  31
  32 M:: x86.32 %load-vector ( dst val rep -- )
  33     dst 0 [] rep copy-memory* val rc-absolute rel-binary-literal ;
  34
  35 M: x86.32 %mov-vm-ptr ( reg -- )
  36     0 MOV 0 rc-absolute-cell rel-vm ;
  37
  38 M: x86.32 %vm-field ( dst field -- )
  39     [ 0 [] MOV ] dip rc-absolute-cell rel-vm ;
  40
  41 M: x86.32 %set-vm-field ( dst field -- )
  42     [ 0 [] swap MOV ] dip rc-absolute-cell rel-vm ;
  43
  44 M: x86.32 %vm-field-ptr ( dst field -- )
  45     [ 0 MOV ] dip rc-absolute-cell rel-vm ;
  46
  47 M: x86.32 %mark-card
  48     drop 0xffffffff [+] card-mark <byte> MOV
  49     building get pop
  50     rc-absolute-cell rel-cards-offset
  51     building get push ;
  52
  53 M: x86.32 %mark-deck
  54     drop 0xffffffff [+] card-mark <byte> MOV
  55     building get pop
  56     rc-absolute-cell rel-decks-offset
  57     building get push ;
  58
  59 M: x86.32 pic-tail-reg EDX ;
  60
  61 M: x86.32 reserved-stack-space 0 ;
  62
  63 M: x86.32 vm-stack-space 16 ;
  64
  65 : save-vm-ptr ( n -- )
  66     stack@ 0 MOV 0 rc-absolute-cell rel-vm ;
  67
  68 M: x86.32 return-struct-in-registers? ( c-type -- ? )
  69     lookup-c-type
  70     [ return-in-registers?>> ]
  71     [ heap-size { 1 2 4 8 } member? ] bi
  72     os linux? not
  73     and or ;
  74
  75 ! On x86, parameters are usually never passed in registers,
  76 ! except with Microsoft's "thiscall" and "fastcall" abis
  77 M: x86.32 param-regs
  78     {
  79         { thiscall [ { { int-regs { ECX } } { float-regs { } } } ] }
  80         { fastcall [ { { int-regs { ECX EDX } } { float-regs { } } } ] }
  81         [ drop { { int-regs { } } { float-regs { } } } ]
  82     } case ;
  83
  84 ! Need a fake return-reg for floats
  85 M: x86.32 return-regs
  86     {
  87         { int-regs { EAX EDX } }
  88         { float-regs { ST0 } }
  89     } ;
  90
  91 M: x86.32 %prepare-jump
  92     pic-tail-reg 0 MOV xt-tail-pic-offset rc-absolute-cell rel-here ;
  93
  94 M: x86.32 %load-stack-param ( dst rep n -- )
  95     next-stack@ swap pick register? [ %copy ] [
  96         {
  97             { int-rep [ [ EAX ] dip MOV ?spill-slot EAX MOV ] }
  98             { float-rep [ FLDS ?spill-slot FSTPS ] }
  99             { double-rep [ FLDL ?spill-slot FSTPL ] }
 100         } case
 101     ] if ;
 102
 103 M: x86.32 %store-stack-param ( src rep n -- )
 104     stack@ swap pick register? [ swapd %copy ] [
 105         {
 106             { int-rep [ [ [ EAX ] dip ?spill-slot MOV ] [ EAX MOV ] bi* ] }
 107             { float-rep [ [ ?spill-slot FLDS ] [ FSTPS ] bi* ] }
 108             { double-rep [ [ ?spill-slot FLDL ] [ FSTPL ] bi* ] }
 109         } case
 110     ] if ;
 111
 112 :: load-float-return ( dst x87-insn rep -- )
 113     dst register? [
 114         ESP 4 SUB
 115         ESP [] x87-insn execute
 116         dst ESP [] rep %copy
 117         ESP 4 ADD
 118     ] [
 119         dst ?spill-slot x87-insn execute
 120     ] if ; inline
 121
 122 M: x86.32 %load-reg-param ( vreg rep reg -- )
 123     swap {
 124         { int-rep [ int-rep %copy ] }
 125         { float-rep [ drop \ FSTPS float-rep load-float-return ] }
 126         { double-rep [ drop \ FSTPL double-rep load-float-return ] }
 127     } case ;
 128
 129 :: store-float-return ( src x87-insn rep -- )
 130     src register? [
 131         ESP 4 SUB
 132         ESP [] src rep %copy
 133         ESP [] x87-insn execute
 134         ESP 4 ADD
 135     ] [
 136         src ?spill-slot x87-insn execute
 137     ] if ; inline
 138
 139 M: x86.32 %store-reg-param ( vreg rep reg -- )
 140     swap {
 141         { int-rep [ swap int-rep %copy ] }
 142         { float-rep [ drop \ FLDS float-rep store-float-return ] }
 143         { double-rep [ drop \ FLDL double-rep store-float-return ] }
 144     } case ;
 145
 146 M: x86.32 %discard-reg-param ( rep reg -- )
 147     drop {
 148         { int-rep [ ] }
 149         { float-rep [ ST0 FSTP ] }
 150         { double-rep [ ST0 FSTP ] }
 151     } case ;
 152
 153 :: call-unbox-func ( src func -- )
 154     EAX src tagged-rep %copy
 155     4 save-vm-ptr
 156     0 stack@ EAX MOV
 157     func f f %c-invoke ;
 158
 159 M:: x86.32 %unbox ( dst src func rep -- )
 160     src func call-unbox-func
 161     dst rep %load-return ;
 162
 163 M:: x86.32 %unbox-long-long ( dst1 dst2 src func -- )
 164     src int-rep 0 %store-stack-param
 165     4 save-vm-ptr
 166     func f f %c-invoke
 167     dst1 EAX int-rep %copy
 168     dst2 EDX int-rep %copy ;
 169
 170 M:: x86.32 %box ( dst src func rep gc-map -- )
 171     src rep 0 %store-stack-param
 172     rep rep-size save-vm-ptr
 173     func f gc-map %c-invoke
 174     dst EAX tagged-rep %copy ;
 175
 176 M:: x86.32 %box-long-long ( dst src1 src2 func gc-map -- )
 177     src1 int-rep 0 %store-stack-param
 178     src2 int-rep 4 %store-stack-param
 179     8 save-vm-ptr
 180     func f gc-map %c-invoke
 181     dst EAX tagged-rep %copy ;
 182
 183 M: x86.32 %c-invoke
 184     [ 0 CALL rc-relative rel-dlsym ] dip gc-map-here ;
 185
 186 M: x86.32 %begin-callback ( -- )
 187     0 save-vm-ptr
 188     4 stack@ 0 MOV
 189     "begin_callback" f f %c-invoke ;
 190
 191 M: x86.32 %end-callback ( -- )
 192     0 save-vm-ptr
 193     "end_callback" f f %c-invoke ;
 194
 195 : funny-large-struct-return? ( return abi -- ? )
 196     #! MINGW ABI incompatibility disaster
 197     [ large-struct? ] [ mingw eq? os windows? not or ] bi* and ;
 198
 199 M: x86.32 %prepare-var-args ( -- ) ;
 200
 201 M:: x86.32 stack-cleanup ( stack-size return abi -- n )
 202     #! a) Functions which are stdcall/fastcall/thiscall have to
 203     #! clean up the caller's stack frame.
 204     #! b) Functions returning large structs on MINGW have to
 205     #! fix ESP.
 206     {
 207         { [ abi callee-cleanup? ] [ stack-size ] }
 208         { [ return abi funny-large-struct-return? ] [ 4 ] }
 209         [ 0 ]
 210     } cond ;
 211
 212 M: x86.32 %cleanup ( n -- )
 213     [ ESP swap SUB ] unless-zero ;
 214
 215 M: x86.32 %safepoint
 216     0 EAX MOVABS rc-absolute rel-safepoint ;
 217
 218 M: x86.32 dummy-stack-params? f ;
 219
 220 M: x86.32 dummy-int-params? f ;
 221
 222 M: x86.32 dummy-fp-params? f ;
 223
 224 M: x86.32 long-long-on-stack? t ;
 225
 226 M: x86.32 float-on-stack? t ;
 227
 228 M: x86.32 flatten-struct-type
 229     call-next-method [ first t f 3array ] map ;
 230
 231 M: x86.32 struct-return-on-stack? os linux? not ;
 232
 233 M: x86.32 (cpuid) ( eax ecx regs -- )
 234     void { uint uint void* } cdecl [
 235         ! Save ds-reg, rs-reg
 236         EDI PUSH
 237         EAX ESP 4 [+] MOV
 238         ECX ESP 8 [+] MOV
 239         CPUID
 240         EDI ESP 12 [+] MOV
 241         EDI [] EAX MOV
 242         EDI 4 [+] EBX MOV
 243         EDI 8 [+] ECX MOV
 244         EDI 12 [+] EDX MOV
 245         EDI POP
 246     ] alien-assembly ;
 247
 248 check-cpu-features