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