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