basis/bootstrap/assembler/x86.32.factor

   1 ! Copyright (C) 2007, 2011 Slava Pestov.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: bootstrap.image.private compiler.codegen.relocation
   4 compiler.constants cpu.x86.assembler cpu.x86.assembler.operands
   5 generic.single.private kernel kernel.private layouts math
   6 math.private namespaces threads.private ;
   7 IN: bootstrap.x86
   8
   9 4 \ cell set
  10
  11 : stack-frame-size ( -- n ) 8 bootstrap-cells ;
  12 : shift-arg ( -- reg ) ECX ;
  13 : div-arg ( -- reg ) EAX ;
  14 : mod-arg ( -- reg ) EDX ;
  15 : temp0 ( -- reg ) EAX ;
  16 : temp1 ( -- reg ) ECX ;
  17 : temp2 ( -- reg ) EBX ;
  18 : temp3 ( -- reg ) EDX ;
  19 : pic-tail-reg ( -- reg ) EDX ;
  20 : stack-reg ( -- reg ) ESP ;
  21 : frame-reg ( -- reg ) EBP ;
  22 : vm-reg ( -- reg ) EBX ;
  23 : ctx-reg ( -- reg ) EBP ;
  24 : nv-regs ( -- seq ) { ESI EDI EBX } ;
  25 : volatile-regs ( -- seq ) { EAX ECX EDX } ;
  26 : nv-reg ( -- reg ) ESI ;
  27 : ds-reg ( -- reg ) ESI ;
  28 : rs-reg ( -- reg ) EDI ;
  29 : link-reg ( -- reg ) EBX ;
  30 : fixnum>slot@ ( -- ) temp0 2 SAR ;
  31 : rex-length ( -- n ) 0 ;
  32 : red-zone-size ( -- n ) 0 ;
  33
  34 : jit-call ( name -- )
  35     0 CALL f rc-relative rel-dlsym ;
  36
  37 :: jit-call-1arg ( arg1s name -- )
  38     ESP [] arg1s MOV
  39     name jit-call ;
  40
  41 :: jit-call-2arg ( arg1s arg2s name -- )
  42     ESP [] arg1s MOV
  43     ESP 4 [+] arg2s MOV
  44     name jit-call ;
  45
  46 :: jit-call-3arg ( arg1s arg2s arg3s name -- )
  47     ESP [] arg1s MOV
  48     ESP 4 [+] arg2s MOV
  49     ESP 8 [+] arg3s MOV
  50     name jit-call ;
  51
  52 [
  53     pic-tail-reg 0 MOV 0 rc-absolute-cell rel-here
  54     0 JMP f rc-relative rel-word-pic-tail
  55 ] JIT-WORD-JUMP jit-define
  56
  57 : jit-load-vm ( -- )
  58     vm-reg 0 MOV 0 rc-absolute-cell rel-vm ;
  59
  60 : jit-load-context ( -- )
  61     ! VM pointer must be in vm-reg already
  62     ctx-reg vm-reg vm-context-offset [+] MOV ;
  63
  64 : jit-save-context ( -- )
  65     jit-load-context
  66     ECX ESP -4 [+] LEA
  67     ctx-reg context-callstack-top-offset [+] ECX MOV
  68     ctx-reg context-datastack-offset [+] ds-reg MOV
  69     ctx-reg context-retainstack-offset [+] rs-reg MOV ;
  70
  71 : jit-restore-context ( -- )
  72     ds-reg ctx-reg context-datastack-offset [+] MOV
  73     rs-reg ctx-reg context-retainstack-offset [+] MOV ;
  74
  75 [
  76     ! ctx-reg is preserved across the call because it is
  77     ! non-volatile in the C ABI
  78     jit-load-vm
  79     jit-save-context
  80     ! call the primitive
  81     ESP [] vm-reg MOV
  82     0 CALL f f rc-relative rel-dlsym
  83     jit-restore-context
  84 ] JIT-PRIMITIVE jit-define
  85
  86 : jit-jump-quot ( -- )
  87     EAX quot-entry-point-offset [+] JMP ;
  88
  89 : jit-call-quot ( -- )
  90     EAX quot-entry-point-offset [+] CALL ;
  91
  92 : signal-handler-save-regs ( -- regs )
  93     { EAX EBX ECX EDX EBP EDI ESI } ;
  94
  95 [
  96     EAX ds-reg [] MOV
  97     ds-reg bootstrap-cell SUB
  98 ]
  99 [ jit-call-quot ]
 100 [ jit-jump-quot ]
 101 \ (call) define-combinator-primitive
 102
 103 [
 104     jit-load-vm
 105     jit-save-context
 106
 107     ! Call VM, quotation reference is in EAX
 108     EAX vm-reg "lazy_jit_compile" jit-call-2arg
 109 ]
 110 [ jit-call-quot ]
 111 [ jit-jump-quot ]
 112 \ lazy-jit-compile define-combinator-primitive
 113
 114 [
 115     temp1 0xffffffff CMP f rc-absolute-cell rel-literal
 116 ] PIC-CHECK-TUPLE jit-define
 117
 118 ! Inline cache miss entry points
 119 : jit-load-return-address ( -- )
 120     pic-tail-reg ESP stack-frame-size bootstrap-cell - [+] MOV ;
 121
 122 ! These are always in tail position with an existing stack
 123 ! frame, and the stack. The frame setup takes this into account.
 124 : jit-inline-cache-miss ( -- )
 125     jit-load-vm
 126     jit-save-context
 127     ESP 4 [+] vm-reg MOV
 128     ESP [] pic-tail-reg MOV
 129     0 CALL rc-relative rel-inline-cache-miss
 130     jit-restore-context ;
 131
 132 [ jit-load-return-address jit-inline-cache-miss ]
 133 [ EAX CALL ]
 134 [ EAX JMP ]
 135 \ inline-cache-miss define-combinator-primitive
 136
 137 [ jit-inline-cache-miss ]
 138 [ EAX CALL ]
 139 [ EAX JMP ]
 140 \ inline-cache-miss-tail define-combinator-primitive
 141
 142 ! Overflowing fixnum arithmetic
 143 : jit-overflow ( insn func -- )
 144     ds-reg 4 SUB
 145     jit-load-vm
 146     jit-save-context
 147     EAX ds-reg [] MOV
 148     EDX ds-reg 4 [+] MOV
 149     EBX EAX MOV
 150     [ [ EBX EDX ] dip call( dst src -- ) ] dip
 151     ds-reg [] EBX MOV
 152     [ JNO ]
 153     [
 154         ESP [] EAX MOV
 155         ESP 4 [+] EDX MOV
 156         jit-load-vm
 157         ESP 8 [+] vm-reg MOV
 158         jit-call
 159     ]
 160     jit-conditional ;
 161
 162 ! Contexts
 163 : jit-switch-context ( reg -- )
 164     ! Push a bogus return address so the GC can track this frame back
 165     ! to the owner
 166     0 CALL
 167
 168     ! Make the new context the current one
 169     ctx-reg swap MOV
 170     vm-reg vm-context-offset [+] ctx-reg MOV
 171
 172     ! Load new stack pointer
 173     ESP ctx-reg context-callstack-top-offset [+] MOV
 174
 175     ! Windows-specific setup
 176     ctx-reg jit-update-tib
 177
 178     ! Load new ds, rs registers
 179     jit-restore-context ;
 180
 181 : jit-set-context ( -- )
 182     ! Load context and parameter from datastack
 183     EAX ds-reg [] MOV
 184     EAX EAX alien-offset [+] MOV
 185     EDX ds-reg -4 [+] MOV
 186     ds-reg 8 SUB
 187
 188     ! Save ds, rs registers
 189     jit-load-vm
 190     jit-save-context
 191
 192     ! Make the new context active
 193     EAX jit-switch-context
 194
 195     ! Windows-specific setup
 196     ctx-reg jit-update-seh
 197
 198     ! Twiddle stack for return
 199     ESP 4 ADD
 200
 201     ! Store parameter to datastack
 202     ds-reg 4 ADD
 203     ds-reg [] EDX MOV ;
 204
 205 : jit-save-quot-and-param ( -- )
 206     EDX ds-reg MOV
 207     ds-reg 8 SUB ;
 208
 209 : jit-push-param ( -- )
 210     EAX EDX -4 [+] MOV
 211     ds-reg 4 ADD
 212     ds-reg [] EAX MOV ;
 213
 214 : jit-start-context ( -- )
 215     ! Create the new context in return-reg
 216     jit-load-vm
 217     jit-save-context
 218     vm-reg "new_context" jit-call-1arg
 219
 220     jit-save-quot-and-param
 221
 222     ! Make the new context active
 223     jit-load-vm
 224     jit-save-context
 225     EAX jit-switch-context
 226
 227     jit-push-param
 228
 229     ! Windows-specific setup
 230     jit-install-seh
 231
 232     ! Push a fake return address
 233     0 PUSH
 234
 235     ! Jump to initial quotation
 236     EAX EDX [] MOV
 237     jit-jump-quot ;
 238
 239 : jit-delete-current-context ( -- )
 240     jit-load-vm
 241     jit-load-context
 242     vm-reg "delete_context" jit-call-1arg ;
 243
 244 : jit-start-context-and-delete ( -- )
 245     jit-load-vm
 246
 247     ! Updates the context to match the values in the data and retain
 248     ! stack registers. reset_context can GC.
 249     jit-save-context
 250
 251     ! Resets the context. The top two ds item are preserved.
 252     vm-reg "reset_context" jit-call-1arg
 253
 254     ! Switches to the same context I think, uses ctx-reg
 255     ctx-reg jit-switch-context
 256
 257     ! Pops the quotation from the stack and puts it in EAX.
 258     EAX ds-reg [] MOV
 259     ds-reg 4 SUB
 260
 261     ! Jump to the quotation in EAX.
 262     jit-jump-quot ;
 263
 264 [
 265     0 EAX MOVABS rc-absolute rel-safepoint
 266 ] JIT-SAFEPOINT jit-define
 267
 268 ! # All x86.32 subprimitives
 269 {
 270     ! ## Contexts
 271     { (set-context) [ jit-set-context ] }
 272     { (set-context-and-delete) [
 273         jit-delete-current-context
 274         jit-set-context
 275     ] }
 276     { (start-context) [ jit-start-context ] }
 277     { (start-context-and-delete) [ jit-start-context-and-delete ] }
 278
 279     ! ## Entry points
 280     { c-to-factor [
 281         jit-load-vm
 282         EAX EBP 8 [+] MOV
 283         vm-reg EAX "begin_callback" jit-call-2arg
 284
 285         jit-call-quot
 286
 287         jit-load-vm
 288         vm-reg "end_callback" jit-call-1arg
 289     ] }
 290     { unwind-native-frames [
 291         ! unwind-native-frames is marked as "special" in
 292         ! vm/quotations.cpp so it does not have a standard prolog Load
 293         ! ds and rs registers
 294         jit-load-vm
 295         jit-load-context
 296         jit-restore-context
 297
 298         ! clear the fault flag
 299         vm-reg vm-fault-flag-offset [+] 0 MOV
 300
 301         ! Windows-specific setup
 302         ctx-reg jit-update-seh
 303
 304         ! Load arguments
 305         EAX ESP bootstrap-cell [+] MOV
 306         EDX ESP 2 bootstrap-cells [+] MOV
 307
 308         ! Unwind stack frames
 309         ESP EDX MOV
 310
 311         jit-jump-quot
 312     ] }
 313
 314     ! ## Math
 315     { fixnum+ [ [ ADD ] "overflow_fixnum_add" jit-overflow ] }
 316     { fixnum- [ [ SUB ] "overflow_fixnum_subtract" jit-overflow ] }
 317     { fixnum* [
 318         ds-reg 4 SUB
 319         jit-load-vm
 320         jit-save-context
 321         ECX ds-reg [] MOV
 322         EAX ECX MOV
 323         EBP ds-reg 4 [+] MOV
 324         EBP tag-bits get SAR
 325         ! clobbers EDX
 326         EBP IMUL
 327         ds-reg [] EAX MOV
 328         [ JNO ]
 329         [
 330             ECX tag-bits get SAR
 331             ECX EBP vm-reg "overflow_fixnum_multiply" jit-call-3arg
 332         ]
 333         jit-conditional
 334     ] }
 335
 336     ! ## Misc
 337     { fpu-state [
 338         ESP 2 SUB
 339         ESP [] FNSTCW
 340         FNINIT
 341         AX ESP [] MOV
 342         ESP 2 ADD
 343     ] }
 344     { set-fpu-state [
 345         ESP stack-frame-size [+] FLDCW
 346     ] }
 347     { set-callstack [
 348         ! Load callstack object
 349         temp3 ds-reg [] MOV
 350         ds-reg bootstrap-cell SUB
 351         ! Get ctx->callstack_bottom
 352         jit-load-vm
 353         jit-load-context
 354         temp0 ctx-reg context-callstack-bottom-offset [+] MOV
 355         ! Get top of callstack object -- 'src' for memcpy
 356         temp1 temp3 callstack-top-offset [+] LEA
 357         ! Get callstack length, in bytes --- 'len' for memcpy
 358         temp2 temp3 callstack-length-offset [+] MOV
 359         temp2 tag-bits get SHR
 360         ! Compute new stack pointer -- 'dst' for memcpy
 361         temp0 temp2 SUB
 362         ! Install new stack pointer
 363         ESP temp0 MOV
 364         ! Call memcpy
 365         temp2 PUSH
 366         temp1 PUSH
 367         temp0 PUSH
 368         "factor_memcpy" jit-call
 369         ESP 12 ADD
 370         ! Return with new callstack
 371         0 RET
 372     ] }
 373 } define-sub-primitives