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