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 ;
   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 bootstrap-cell 3 * - [+] RAX MOV
  43     ! store stack frame size
  44     RSP stack-frame-size bootstrap-cell 2 * - [+] 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 USE: locals
  95
  96 : jit-save-volatile-regs ( -- )
  97     ! do we also need to save XMM?
  98     RSP volatile-regs length bootstrap-cell * SUB
  99     volatile-regs
 100     [| r i | RSP i bootstrap-cell * [+] r MOV ] each-index ;
 101
 102 :: jit-restore-volatile-regs ( additional-pop -- )
 103     volatile-regs
 104     [| r i | r RSP i bootstrap-cell * [+] MOV ] each-index
 105     RSP volatile-regs length bootstrap-cell * additional-pop + ADD ;
 106
 107 [
 108     ! Stack at this point has the signal handler pointer followed by
 109     ! the return address back into normal execution, then the 24 bytes
 110     ! of stack frame + alignment inserted by the prolog.
 111     ! After registers are saved, the stack looks like:
 112     ! RSP  saved volatile regs (`volatile-regs length` cells)
 113     !  +   subprimitive stack frame alignment (3 cells)
 114     !  .   signal handler address (1 cell)
 115     !  .   resume address (1 cell)
 116     jit-save-volatile-regs
 117     jit-save-context
 118     RAX RSP volatile-regs length 3 + bootstrap-cell * [+] MOV
 119     RAX CALL
 120     bootstrap-cell jit-restore-volatile-regs
 121 ] \ signal-handler define-sub-primitive
 122
 123 ! :: jit-push-leaf-stack-frame ( -- )
 124 !     ;
 125 !
 126 ! :: jit-pop-leaf-stack-frame ( -- )
 127 !     ;
 128 !
 129 ! [
 130 !     ! Stack at this point has the signal handler pointer followed by
 131 !     ! the word pointer and the return address back into normal execution,
 132 !     ! then the 24 bytes of stack frame + alignment inserted by the prolog
 133 !     ! After registers are saved and the leaf stack frame is constructed,
 134 !     ! the stack looks like:
 135 !     ! RSP  fake leaf stack frame (4 cells)
 136 !     !  +   saved volatile regs (`volatile-regs length` cells)
 137 !     !  .   subprimitive stack frame alignment (3 cells)
 138 !     !  .   leaf word (1 cell)
 139 !     !  .   signal handler address (1 cell)
 140 !     !      resume address (1 cell)
 141 !     jit-save-volatile-regs
 142 !     jit-push-leaf-stack-frame
 143 !     jit-save-context
 144 !     "memory_signal_handler_impl" jit-call
 145 !     jit-pop-leaf-stack-frame
 146 !     bootstrap-cell jit-restore-volatile-regs
 147 ! ] \ leaf-signal-handler define-sub-primitive
 148
 149 [
 150     arg1 ds-reg [] MOV
 151     ds-reg bootstrap-cell SUB
 152 ]
 153 [ jit-call-quot ]
 154 [ jit-jump-quot ]
 155 \ (call) define-combinator-primitive
 156
 157 [
 158     ! Unwind stack frames
 159     RSP arg2 MOV
 160
 161     ! Load VM pointer into vm-reg, since we're entering from
 162     ! C code
 163     vm-reg 0 MOV 0 rc-absolute-cell rel-vm
 164
 165     ! Load ds and rs registers
 166     jit-load-context
 167     jit-restore-context
 168
 169     ! Call quotation
 170     jit-jump-quot
 171 ] \ unwind-native-frames define-sub-primitive
 172
 173 [
 174     RSP 2 SUB
 175     RSP [] FNSTCW
 176     FNINIT
 177     AX RSP [] MOV
 178     RSP 2 ADD
 179 ] \ fpu-state define-sub-primitive
 180
 181 [
 182     RSP 2 SUB
 183     RSP [] arg1 16-bit-version-of MOV
 184     RSP [] FLDCW
 185     RSP 2 ADD
 186 ] \ set-fpu-state define-sub-primitive
 187
 188 [
 189     ! Load callstack object
 190     arg4 ds-reg [] MOV
 191     ds-reg bootstrap-cell SUB
 192     ! Get ctx->callstack_bottom
 193     jit-load-context
 194     arg1 ctx-reg context-callstack-bottom-offset [+] MOV
 195     ! Get top of callstack object -- 'src' for memcpy
 196     arg2 arg4 callstack-top-offset [+] LEA
 197     ! Get callstack length, in bytes --- 'len' for memcpy
 198     arg3 arg4 callstack-length-offset [+] MOV
 199     arg3 tag-bits get SHR
 200     ! Compute new stack pointer -- 'dst' for memcpy
 201     arg1 arg3 SUB
 202     ! Install new stack pointer
 203     RSP arg1 MOV
 204     ! Call memcpy; arguments are now in the correct registers
 205     ! Create register shadow area for Win64
 206     RSP 32 SUB
 207     "factor_memcpy" jit-call
 208     ! Tear down register shadow area
 209     RSP 32 ADD
 210     ! Return with new callstack
 211     0 RET
 212 ] \ set-callstack define-sub-primitive
 213
 214 [
 215     jit-save-context
 216     arg2 vm-reg MOV
 217     "lazy_jit_compile" jit-call
 218     arg1 return-reg MOV
 219 ]
 220 [ return-reg quot-entry-point-offset [+] CALL ]
 221 [ jit-jump-quot ]
 222 \ lazy-jit-compile define-combinator-primitive
 223
 224 [
 225     temp2 HEX: ffffffff MOV f rc-absolute-cell rel-literal
 226     temp1 temp2 CMP
 227 ] pic-check-tuple jit-define
 228
 229 ! Inline cache miss entry points
 230 : jit-load-return-address ( -- )
 231     RBX RSP stack-frame-size bootstrap-cell - [+] MOV ;
 232
 233 ! These are always in tail position with an existing stack
 234 ! frame, and the stack. The frame setup takes this into account.
 235 : jit-inline-cache-miss ( -- )
 236     jit-save-context
 237     arg1 RBX MOV
 238     arg2 vm-reg MOV
 239     RAX 0 MOV rc-absolute-cell rel-inline-cache-miss
 240     RAX CALL
 241     jit-load-context
 242     jit-restore-context ;
 243
 244 [ jit-load-return-address jit-inline-cache-miss ]
 245 [ RAX CALL ]
 246 [ RAX JMP ]
 247 \ inline-cache-miss define-combinator-primitive
 248
 249 [ jit-inline-cache-miss ]
 250 [ RAX CALL ]
 251 [ RAX JMP ]
 252 \ inline-cache-miss-tail define-combinator-primitive
 253
 254 ! Overflowing fixnum arithmetic
 255 : jit-overflow ( insn func -- )
 256     ds-reg 8 SUB
 257     jit-save-context
 258     arg1 ds-reg [] MOV
 259     arg2 ds-reg 8 [+] MOV
 260     arg3 arg1 MOV
 261     [ [ arg3 arg2 ] dip call ] dip
 262     ds-reg [] arg3 MOV
 263     [ JNO ]
 264     [ arg3 vm-reg MOV jit-call ]
 265     jit-conditional ; inline
 266
 267 [ [ ADD ] "overflow_fixnum_add" jit-overflow ] \ fixnum+ define-sub-primitive
 268
 269 [ [ SUB ] "overflow_fixnum_subtract" jit-overflow ] \ fixnum- define-sub-primitive
 270
 271 [
 272     ds-reg 8 SUB
 273     jit-save-context
 274     RCX ds-reg [] MOV
 275     RBX ds-reg 8 [+] MOV
 276     RBX tag-bits get SAR
 277     RAX RCX MOV
 278     RBX IMUL
 279     ds-reg [] RAX MOV
 280     [ JNO ]
 281     [
 282         arg1 RCX MOV
 283         arg1 tag-bits get SAR
 284         arg2 RBX MOV
 285         arg3 vm-reg MOV
 286         "overflow_fixnum_multiply" jit-call
 287     ]
 288     jit-conditional
 289 ] \ fixnum* define-sub-primitive
 290
 291 ! Contexts
 292 : jit-switch-context ( reg -- )
 293     ! Reset return value since its bogus right now, to avoid
 294     ! confusing the GC
 295     RSP -8 [+] 0 MOV
 296
 297     ! Make the new context the current one
 298     ctx-reg swap MOV
 299     vm-reg vm-context-offset [+] ctx-reg MOV
 300
 301     ! Load new stack pointer
 302     RSP ctx-reg context-callstack-top-offset [+] MOV
 303
 304     ! Load new ds, rs registers
 305     jit-restore-context
 306
 307     ctx-reg jit-update-tib ;
 308
 309 : jit-pop-context-and-param ( -- )
 310     arg1 ds-reg [] MOV
 311     arg1 arg1 alien-offset [+] MOV
 312     arg2 ds-reg -8 [+] MOV
 313     ds-reg 16 SUB ;
 314
 315 : jit-push-param ( -- )
 316     ds-reg 8 ADD
 317     ds-reg [] arg2 MOV ;
 318
 319 : jit-set-context ( -- )
 320     jit-pop-context-and-param
 321     jit-save-context
 322     arg1 jit-switch-context
 323     RSP 8 ADD
 324     jit-push-param ;
 325
 326 [ jit-set-context ] \ (set-context) define-sub-primitive
 327
 328 : jit-pop-quot-and-param ( -- )
 329     arg1 ds-reg [] MOV
 330     arg2 ds-reg -8 [+] MOV
 331     ds-reg 16 SUB ;
 332
 333 : jit-start-context ( -- )
 334     ! Create the new context in return-reg. Have to save context
 335     ! twice, first before calling new_context() which may GC,
 336     ! and again after popping the two parameters from the stack.
 337     jit-save-context
 338     arg1 vm-reg MOV
 339     "new_context" jit-call
 340
 341     jit-pop-quot-and-param
 342     jit-save-context
 343     return-reg jit-switch-context
 344     jit-push-param
 345     jit-jump-quot ;
 346
 347 [ jit-start-context ] \ (start-context) define-sub-primitive
 348
 349 : jit-delete-current-context ( -- )
 350     jit-load-context
 351     arg1 vm-reg MOV
 352     arg2 ctx-reg MOV
 353     "delete_context" jit-call ;
 354
 355 [
 356     jit-delete-current-context
 357     jit-set-context
 358 ] \ (set-context-and-delete) define-sub-primitive
 359
 360 : jit-start-context-and-delete ( -- )
 361     jit-load-context
 362     arg1 vm-reg MOV
 363     arg2 ctx-reg MOV
 364     "reset_context" jit-call
 365
 366     jit-pop-quot-and-param
 367     ctx-reg jit-switch-context
 368     jit-push-param
 369     jit-jump-quot ;
 370
 371 : jit-safepoint ( -- )
 372     0 [RIP+] EAX MOV rc-relative rel-safepoint ;
 373
 374 [
 375     jit-start-context-and-delete
 376 ] \ (start-context-and-delete) define-sub-primitive