basis/cpu/x86/64/bootstrap.factor

   1 ! Copyright (C) 2007, 2011 Slava Pestov.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: bootstrap.image.private kernel kernel.private namespaces
   4 system layouts vocabs parser compiler.constants
   5 compiler.codegen.relocation math math.private cpu.x86.assembler
   6 cpu.x86.assembler.operands sequences generic.single.private
   7 threads.private locals ;
   8 IN: bootstrap.x86
   9
  10 8 \ cell set
  11
  12 : shift-arg ( -- reg ) RCX ;
  13 : div-arg ( -- reg ) RAX ;
  14 : mod-arg ( -- reg ) RDX ;
  15 : temp0 ( -- reg ) RAX ;
  16 : temp1 ( -- reg ) RCX ;
  17 : temp2 ( -- reg ) RDX ;
  18 : temp3 ( -- reg ) RBX ;
  19 : pic-tail-reg ( -- reg ) RBX ;
  20 : return-reg ( -- reg ) RAX ;
  21 : nv-reg ( -- reg ) RBX ;
  22 : stack-reg ( -- reg ) RSP ;
  23 : frame-reg ( -- reg ) RBP ;
  24 : link-reg ( -- reg ) R11 ;
  25 : ctx-reg ( -- reg ) R12 ;
  26 : vm-reg ( -- reg ) R13 ;
  27 : ds-reg ( -- reg ) R14 ;
  28 : rs-reg ( -- reg ) R15 ;
  29 : fixnum>slot@ ( -- ) temp0 1 SAR ;
  30 : rex-length ( -- n ) 1 ;
  31
  32 : jit-call ( name -- )
  33     RAX 0 MOV f rc-absolute-cell rel-dlsym
  34     RAX CALL ;
  35
  36 [
  37     ! load entry point
  38     RAX 0 MOV rc-absolute-cell rel-this
  39     ! alignment
  40     RSP stack-frame-size bootstrap-cell - SUB
  41     ! store entry point
  42     RSP stack-frame-size 3 bootstrap-cells - [+] RAX MOV
  43     ! store stack frame size
  44     RSP stack-frame-size 2 bootstrap-cells - [+] stack-frame-size MOV
  45 ] jit-prolog jit-define
  46
  47 [
  48     pic-tail-reg 5 [RIP+] LEA
  49     0 JMP f rc-relative rel-word-pic-tail
  50 ] jit-word-jump jit-define
  51
  52 : jit-load-context ( -- )
  53     ctx-reg vm-reg vm-context-offset [+] MOV ;
  54
  55 : jit-save-context ( -- )
  56     jit-load-context
  57     R11 RSP -8 [+] LEA
  58     ctx-reg context-callstack-top-offset [+] R11 MOV
  59     ctx-reg context-datastack-offset [+] ds-reg MOV
  60     ctx-reg context-retainstack-offset [+] rs-reg MOV ;
  61
  62 : jit-restore-context ( -- )
  63     ds-reg ctx-reg context-datastack-offset [+] MOV
  64     rs-reg ctx-reg context-retainstack-offset [+] MOV ;
  65
  66 [
  67     ! ctx-reg is preserved across the call because it is non-volatile
  68     ! in the C ABI
  69     jit-save-context
  70     ! call the primitive
  71     arg1 vm-reg MOV
  72     RAX 0 MOV f f rc-absolute-cell rel-dlsym
  73     RAX CALL
  74     jit-restore-context
  75 ] jit-primitive jit-define
  76
  77 : jit-jump-quot ( -- ) arg1 quot-entry-point-offset [+] JMP ;
  78
  79 : jit-call-quot ( -- ) arg1 quot-entry-point-offset [+] CALL ;
  80
  81 [
  82     arg2 arg1 MOV
  83     arg1 vm-reg MOV
  84     "begin_callback" jit-call
  85
  86     ! call the quotation
  87     arg1 return-reg MOV
  88     jit-call-quot
  89
  90     arg1 vm-reg MOV
  91     "end_callback" jit-call
  92 ] \ c-to-factor define-sub-primitive
  93
  94 : signal-handler-save-regs ( -- regs )
  95     { RAX RCX RDX RBX RBP RSI RDI R8 R9 R10 R11 R12 R13 R14 R15 } ;
  96
  97 :: jit-signal-handler-prolog ( -- frame-size )
  98     signal-handler-save-regs :> save-regs
  99     save-regs length bootstrap-cells 16 align stack-frame-size + :> frame-size
 100     RSP frame-size bootstrap-cell - SUB ! minus a cell for return address
 101     save-regs
 102     [| r i | RSP i bootstrap-cells [+] r MOV ] each-index
 103     ! Now that the registers are saved, we can make the stack frame
 104     RAX 0 MOV rc-absolute-cell rel-this
 105     RSP frame-size 3 bootstrap-cells - [+] RAX MOV
 106     RSP frame-size 2 bootstrap-cells - [+] frame-size MOV
 107     frame-size ;
 108
 109 :: jit-signal-handler-epilog ( frame-size -- )
 110     signal-handler-save-regs
 111     [| r i | r RSP i bootstrap-cells [+] MOV ] each-index
 112     RSP frame-size bootstrap-cell - ADD ;
 113
 114 [
 115     arg1 ds-reg [] MOV
 116     ds-reg bootstrap-cell SUB
 117 ]
 118 [ jit-call-quot ]
 119 [ jit-jump-quot ]
 120 \ (call) define-combinator-primitive
 121
 122 [
 123     ! Unwind stack frames
 124     RSP arg2 MOV
 125
 126     ! Load VM pointer into vm-reg, since we're entering from
 127     ! C code
 128     vm-reg 0 MOV 0 rc-absolute-cell rel-vm
 129
 130     ! Load ds and rs registers
 131     jit-load-context
 132     jit-restore-context
 133
 134     ! Call quotation
 135     jit-jump-quot
 136 ] \ unwind-native-frames define-sub-primitive
 137
 138 [
 139     RSP 2 SUB
 140     RSP [] FNSTCW
 141     FNINIT
 142     AX RSP [] MOV
 143     RSP 2 ADD
 144 ] \ fpu-state define-sub-primitive
 145
 146 [
 147     RSP 2 SUB
 148     RSP [] arg1 16-bit-version-of MOV
 149     RSP [] FLDCW
 150     RSP 2 ADD
 151 ] \ set-fpu-state define-sub-primitive
 152
 153 [
 154     ! Load callstack object
 155     arg4 ds-reg [] MOV
 156     ds-reg bootstrap-cell SUB
 157     ! Get ctx->callstack_bottom
 158     jit-load-context
 159     arg1 ctx-reg context-callstack-bottom-offset [+] MOV
 160     ! Get top of callstack object -- 'src' for memcpy
 161     arg2 arg4 callstack-top-offset [+] LEA
 162     ! Get callstack length, in bytes --- 'len' for memcpy
 163     arg3 arg4 callstack-length-offset [+] MOV
 164     arg3 tag-bits get SHR
 165     ! Compute new stack pointer -- 'dst' for memcpy
 166     arg1 arg3 SUB
 167     ! Install new stack pointer
 168     RSP arg1 MOV
 169     ! Call memcpy; arguments are now in the correct registers
 170     ! Create register shadow area for Win64
 171     RSP 32 SUB
 172     "factor_memcpy" jit-call
 173     ! Tear down register shadow area
 174     RSP 32 ADD
 175     ! Return with new callstack
 176     0 RET
 177 ] \ set-callstack define-sub-primitive
 178
 179 [
 180     jit-save-context
 181     arg2 vm-reg MOV
 182     "lazy_jit_compile" jit-call
 183     arg1 return-reg MOV
 184 ]
 185 [ return-reg quot-entry-point-offset [+] CALL ]
 186 [ jit-jump-quot ]
 187 \ lazy-jit-compile define-combinator-primitive
 188
 189 [
 190     temp2 HEX: ffffffff MOV f rc-absolute-cell rel-literal
 191     temp1 temp2 CMP
 192 ] pic-check-tuple jit-define
 193
 194 ! Inline cache miss entry points
 195 : jit-load-return-address ( -- )
 196     RBX RSP stack-frame-size bootstrap-cell - [+] MOV ;
 197
 198 ! These are always in tail position with an existing stack
 199 ! frame, and the stack. The frame setup takes this into account.
 200 : jit-inline-cache-miss ( -- )
 201     jit-save-context
 202     arg1 RBX MOV
 203     arg2 vm-reg MOV
 204     RAX 0 MOV rc-absolute-cell rel-inline-cache-miss
 205     RAX CALL
 206     jit-load-context
 207     jit-restore-context ;
 208
 209 [ jit-load-return-address jit-inline-cache-miss ]
 210 [ RAX CALL ]
 211 [ RAX JMP ]
 212 \ inline-cache-miss define-combinator-primitive
 213
 214 [ jit-inline-cache-miss ]
 215 [ RAX CALL ]
 216 [ RAX JMP ]
 217 \ inline-cache-miss-tail define-combinator-primitive
 218
 219 ! Overflowing fixnum arithmetic
 220 : jit-overflow ( insn func -- )
 221     ds-reg 8 SUB
 222     jit-save-context
 223     arg1 ds-reg [] MOV
 224     arg2 ds-reg 8 [+] MOV
 225     arg3 arg1 MOV
 226     [ [ arg3 arg2 ] dip call ] dip
 227     ds-reg [] arg3 MOV
 228     [ JNO ]
 229     [ arg3 vm-reg MOV jit-call ]
 230     jit-conditional ; inline
 231
 232 [ [ ADD ] "overflow_fixnum_add" jit-overflow ] \ fixnum+ define-sub-primitive
 233
 234 [ [ SUB ] "overflow_fixnum_subtract" jit-overflow ] \ fixnum- define-sub-primitive
 235
 236 [
 237     ds-reg 8 SUB
 238     jit-save-context
 239     RCX ds-reg [] MOV
 240     RBX ds-reg 8 [+] MOV
 241     RBX tag-bits get SAR
 242     RAX RCX MOV
 243     RBX IMUL
 244     ds-reg [] RAX MOV
 245     [ JNO ]
 246     [
 247         arg1 RCX MOV
 248         arg1 tag-bits get SAR
 249         arg2 RBX MOV
 250         arg3 vm-reg MOV
 251         "overflow_fixnum_multiply" jit-call
 252     ]
 253     jit-conditional
 254 ] \ fixnum* define-sub-primitive
 255
 256 ! Contexts
 257 : jit-switch-context ( reg -- )
 258     ! Reset return value since its bogus right now, to avoid
 259     ! confusing the GC
 260     RSP -8 [+] 0 MOV
 261
 262     ! Make the new context the current one
 263     ctx-reg swap MOV
 264     vm-reg vm-context-offset [+] ctx-reg MOV
 265
 266     ! Load new stack pointer
 267     RSP ctx-reg context-callstack-top-offset [+] MOV
 268
 269     ! Load new ds, rs registers
 270     jit-restore-context
 271
 272     ctx-reg jit-update-tib ;
 273
 274 : jit-pop-context-and-param ( -- )
 275     arg1 ds-reg [] MOV
 276     arg1 arg1 alien-offset [+] MOV
 277     arg2 ds-reg -8 [+] MOV
 278     ds-reg 16 SUB ;
 279
 280 : jit-push-param ( -- )
 281     ds-reg 8 ADD
 282     ds-reg [] arg2 MOV ;
 283
 284 : jit-set-context ( -- )
 285     jit-pop-context-and-param
 286     jit-save-context
 287     arg1 jit-switch-context
 288     RSP 8 ADD
 289     jit-push-param ;
 290
 291 [ jit-set-context ] \ (set-context) define-sub-primitive
 292
 293 : jit-pop-quot-and-param ( -- )
 294     arg1 ds-reg [] MOV
 295     arg2 ds-reg -8 [+] MOV
 296     ds-reg 16 SUB ;
 297
 298 : jit-start-context ( -- )
 299     ! Create the new context in return-reg. Have to save context
 300     ! twice, first before calling new_context() which may GC,
 301     ! and again after popping the two parameters from the stack.
 302     jit-save-context
 303     arg1 vm-reg MOV
 304     "new_context" jit-call
 305
 306     jit-pop-quot-and-param
 307     jit-save-context
 308     return-reg jit-switch-context
 309     jit-push-param
 310     jit-jump-quot ;
 311
 312 [ jit-start-context ] \ (start-context) define-sub-primitive
 313
 314 : jit-delete-current-context ( -- )
 315     jit-load-context
 316     arg1 vm-reg MOV
 317     arg2 ctx-reg MOV
 318     "delete_context" jit-call ;
 319
 320 [
 321     jit-delete-current-context
 322     jit-set-context
 323 ] \ (set-context-and-delete) define-sub-primitive
 324
 325 : jit-start-context-and-delete ( -- )
 326     jit-load-context
 327     arg1 vm-reg MOV
 328     arg2 ctx-reg MOV
 329     "reset_context" jit-call
 330
 331     jit-pop-quot-and-param
 332     ctx-reg jit-switch-context
 333     jit-push-param
 334     jit-jump-quot ;
 335
 336 [
 337     0 [RIP+] EAX MOV rc-relative rel-safepoint
 338 ] \ jit-safepoint jit-define
 339
 340 [
 341     jit-start-context-and-delete
 342 ] \ (start-context-and-delete) define-sub-primitive