basis/cpu/x86/64/bootstrap.factor

   1 ! Copyright (C) 2007, 2010 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 math
   5 math.private cpu.x86.assembler cpu.x86.assembler.operands
   6 sequences generic.single.private threads.private ;
   7 IN: bootstrap.x86
   8
   9 8 \ cell set
  10
  11 : shift-arg ( -- reg ) RCX ;
  12 : div-arg ( -- reg ) RAX ;
  13 : mod-arg ( -- reg ) RDX ;
  14 : temp0 ( -- reg ) RDI ;
  15 : temp1 ( -- reg ) RSI ;
  16 : temp2 ( -- reg ) RDX ;
  17 : temp3 ( -- reg ) RBX ;
  18 : return-reg ( -- reg ) RAX ;
  19 : nv-reg ( -- reg ) RBX ;
  20 : stack-reg ( -- reg ) RSP ;
  21 : frame-reg ( -- reg ) RBP ;
  22 : ctx-reg ( -- reg ) R12 ;
  23 : vm-reg ( -- reg ) R13 ;
  24 : ds-reg ( -- reg ) R14 ;
  25 : rs-reg ( -- reg ) R15 ;
  26 : fixnum>slot@ ( -- ) temp0 1 SAR ;
  27 : rex-length ( -- n ) 1 ;
  28
  29 : jit-call ( name -- )
  30     RAX 0 MOV rc-absolute-cell jit-dlsym
  31     RAX CALL ;
  32
  33 [
  34     ! load entry point
  35     RAX 0 MOV rc-absolute-cell rt-this jit-rel
  36     ! save stack frame size
  37     stack-frame-size PUSH
  38     ! push entry point
  39     RAX PUSH
  40     ! alignment
  41     RSP stack-frame-size 3 bootstrap-cells - SUB
  42 ] jit-prolog jit-define
  43
  44 [
  45     temp3 5 [RIP+] LEA
  46     0 JMP rc-relative rt-entry-point-pic-tail jit-rel
  47 ] jit-word-jump jit-define
  48
  49 : jit-load-context ( -- )
  50     ctx-reg vm-reg vm-context-offset [+] MOV ;
  51
  52 : jit-save-context ( -- )
  53     jit-load-context
  54     R11 RSP -8 [+] LEA
  55     ctx-reg context-callstack-top-offset [+] R11 MOV
  56     ctx-reg context-datastack-offset [+] ds-reg MOV
  57     ctx-reg context-retainstack-offset [+] rs-reg MOV ;
  58
  59 : jit-restore-context ( -- )
  60     ds-reg ctx-reg context-datastack-offset [+] MOV
  61     rs-reg ctx-reg context-retainstack-offset [+] MOV ;
  62
  63 [
  64     ! ctx-reg is preserved across the call because it is non-volatile
  65     ! in the C ABI
  66     jit-save-context
  67     ! call the primitive
  68     arg1 vm-reg MOV
  69     RAX 0 MOV rc-absolute-cell rt-dlsym jit-rel
  70     RAX CALL
  71     jit-restore-context
  72 ] jit-primitive jit-define
  73
  74 : jit-jump-quot ( -- ) arg1 quot-entry-point-offset [+] JMP ;
  75
  76 : jit-call-quot ( -- ) arg1 quot-entry-point-offset [+] CALL ;
  77
  78 [
  79     arg2 arg1 MOV
  80     arg1 vm-reg MOV
  81     "begin_callback" jit-call
  82
  83     jit-load-context
  84     jit-restore-context
  85
  86     ! call the quotation
  87     arg1 return-reg MOV
  88     jit-call-quot
  89
  90     jit-save-context
  91
  92     arg1 vm-reg MOV
  93     "end_callback" jit-call
  94 ] \ c-to-factor define-sub-primitive
  95
  96 [
  97     arg1 ds-reg [] MOV
  98     ds-reg bootstrap-cell SUB
  99 ]
 100 [ jit-call-quot ]
 101 [ jit-jump-quot ]
 102 \ (call) define-combinator-primitive
 103
 104 [
 105     ! Clear x87 stack, but preserve rounding mode and exception flags
 106     RSP 2 SUB
 107     RSP [] FNSTCW
 108     FNINIT
 109     RSP [] FLDCW
 110
 111     ! Unwind stack frames
 112     RSP arg2 MOV
 113
 114     ! Load VM pointer into vm-reg, since we're entering from
 115     ! C code
 116     vm-reg 0 MOV 0 rc-absolute-cell jit-vm
 117
 118     ! Load ds and rs registers
 119     jit-load-context
 120     jit-restore-context
 121
 122     ! Call quotation
 123     jit-jump-quot
 124 ] \ unwind-native-frames define-sub-primitive
 125
 126 [
 127     ! Load callstack object
 128     arg4 ds-reg [] MOV
 129     ds-reg bootstrap-cell SUB
 130     ! Get ctx->callstack_bottom
 131     jit-load-context
 132     arg1 ctx-reg context-callstack-bottom-offset [+] MOV
 133     ! Get top of callstack object -- 'src' for memcpy
 134     arg2 arg4 callstack-top-offset [+] LEA
 135     ! Get callstack length, in bytes --- 'len' for memcpy
 136     arg3 arg4 callstack-length-offset [+] MOV
 137     arg3 tag-bits get SHR
 138     ! Compute new stack pointer -- 'dst' for memcpy
 139     arg1 arg3 SUB
 140     ! Install new stack pointer
 141     RSP arg1 MOV
 142     ! Call memcpy; arguments are now in the correct registers
 143     ! Create register shadow area for Win64
 144     RSP 32 SUB
 145     "factor_memcpy" jit-call
 146     ! Tear down register shadow area
 147     RSP 32 ADD
 148     ! Return with new callstack
 149     0 RET
 150 ] \ set-callstack define-sub-primitive
 151
 152 [
 153     jit-save-context
 154     arg2 vm-reg MOV
 155     "lazy_jit_compile" jit-call
 156     arg1 return-reg MOV
 157 ]
 158 [ return-reg quot-entry-point-offset [+] CALL ]
 159 [ jit-jump-quot ]
 160 \ lazy-jit-compile define-combinator-primitive
 161
 162 ! Inline cache miss entry points
 163 : jit-load-return-address ( -- )
 164     RBX RSP stack-frame-size bootstrap-cell - [+] MOV ;
 165
 166 ! These are always in tail position with an existing stack
 167 ! frame, and the stack. The frame setup takes this into account.
 168 : jit-inline-cache-miss ( -- )
 169     jit-save-context
 170     arg1 RBX MOV
 171     arg2 vm-reg MOV
 172     "inline_cache_miss" jit-call
 173     jit-load-context
 174     jit-restore-context ;
 175
 176 [ jit-load-return-address jit-inline-cache-miss ]
 177 [ RAX CALL ]
 178 [ RAX JMP ]
 179 \ inline-cache-miss define-combinator-primitive
 180
 181 [ jit-inline-cache-miss ]
 182 [ RAX CALL ]
 183 [ RAX JMP ]
 184 \ inline-cache-miss-tail define-combinator-primitive
 185
 186 ! Overflowing fixnum arithmetic
 187 : jit-overflow ( insn func -- )
 188     ds-reg 8 SUB
 189     jit-save-context
 190     arg1 ds-reg [] MOV
 191     arg2 ds-reg 8 [+] MOV
 192     arg3 arg1 MOV
 193     [ [ arg3 arg2 ] dip call ] dip
 194     ds-reg [] arg3 MOV
 195     [ JNO ]
 196     [ arg3 vm-reg MOV jit-call ]
 197     jit-conditional ; inline
 198
 199 [ [ ADD ] "overflow_fixnum_add" jit-overflow ] \ fixnum+ define-sub-primitive
 200
 201 [ [ SUB ] "overflow_fixnum_subtract" jit-overflow ] \ fixnum- define-sub-primitive
 202
 203 [
 204     ds-reg 8 SUB
 205     jit-save-context
 206     RCX ds-reg [] MOV
 207     RBX ds-reg 8 [+] MOV
 208     RBX tag-bits get SAR
 209     RAX RCX MOV
 210     RBX IMUL
 211     ds-reg [] RAX MOV
 212     [ JNO ]
 213     [
 214         arg1 RCX MOV
 215         arg1 tag-bits get SAR
 216         arg2 RBX MOV
 217         arg3 vm-reg MOV
 218         "overflow_fixnum_multiply" jit-call
 219     ]
 220     jit-conditional
 221 ] \ fixnum* define-sub-primitive
 222
 223 ! Contexts
 224 : jit-switch-context ( reg -- )
 225     ! Save ds, rs registers
 226     jit-save-context
 227
 228     ! Make the new context the current one
 229     ctx-reg swap MOV
 230     vm-reg vm-context-offset [+] ctx-reg MOV
 231
 232     ! Load new stack pointer
 233     RSP ctx-reg context-callstack-top-offset [+] MOV
 234
 235     ! Load new ds, rs registers
 236     jit-restore-context
 237
 238     ctx-reg jit-update-tib ;
 239
 240 : jit-pop-context-and-param ( -- )
 241     arg1 ds-reg [] MOV
 242     arg1 arg1 alien-offset [+] MOV
 243     arg2 ds-reg -8 [+] MOV
 244     ds-reg 16 SUB ;
 245
 246 : jit-push-param ( -- )
 247     ds-reg 8 ADD
 248     ds-reg [] arg2 MOV ;
 249
 250 : jit-set-context ( -- )
 251     jit-pop-context-and-param
 252     arg1 jit-switch-context
 253     RSP 8 ADD
 254     jit-push-param ;
 255
 256 [ jit-set-context ] \ (set-context) define-sub-primitive
 257
 258 : jit-pop-quot-and-param ( -- )
 259     arg1 ds-reg [] MOV
 260     arg2 ds-reg -8 [+] MOV
 261     ds-reg 16 SUB ;
 262
 263 : jit-start-context ( -- )
 264     ! Create the new context in return-reg
 265     arg1 vm-reg MOV
 266     "new_context" jit-call
 267
 268     jit-pop-quot-and-param
 269
 270     return-reg jit-switch-context
 271
 272     jit-push-param
 273
 274     jit-jump-quot ;
 275
 276 [ jit-start-context ] \ (start-context) define-sub-primitive
 277
 278 : jit-delete-current-context ( -- )
 279     jit-load-context
 280     arg1 vm-reg MOV
 281     arg2 ctx-reg MOV
 282     "delete_context" jit-call ;
 283
 284 [
 285     jit-delete-current-context
 286     jit-set-context
 287 ] \ (set-context-and-delete) define-sub-primitive
 288
 289 [
 290     jit-delete-current-context
 291     jit-start-context
 292 ] \ (start-context-and-delete) define-sub-primitive