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