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 ;
   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 ) nv-regs first ;
  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 [] 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     RAX RSP -8 [+] LEA
  55     ctx-reg context-callstack-top-offset [+] RAX 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     jit-load-context
  61     ds-reg ctx-reg context-datastack-offset [+] MOV
  62     rs-reg ctx-reg context-retainstack-offset [+] MOV ;
  63
  64 [
  65     jit-save-context
  66     ! call the primitive
  67     arg1 vm-reg MOV
  68     RAX 0 MOV rc-absolute-cell rt-dlsym jit-rel
  69     RAX CALL
  70     jit-restore-context
  71 ] jit-primitive jit-define
  72
  73 [
  74     nv-reg arg1 MOV
  75
  76     arg1 vm-reg MOV
  77     "begin_callback" jit-call
  78
  79     jit-restore-context
  80
  81     ! save C callstack pointer
  82     ctx-reg context-callstack-save-offset [+] stack-reg MOV
  83
  84     ! load Factor callstack pointer
  85     stack-reg ctx-reg context-callstack-bottom-offset [+] MOV
  86     stack-reg 8 ADD
  87
  88     ! call the quotation
  89     arg1 nv-reg MOV
  90     arg1 quot-entry-point-offset [+] CALL
  91
  92     jit-save-context
  93
  94     ! load C callstack pointer
  95     stack-reg ctx-reg context-callstack-save-offset [+] MOV
  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 [ arg1 quot-entry-point-offset [+] CALL ]
 106 [ arg1 quot-entry-point-offset [+] JMP ]
 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-restore-context
 125
 126     ! Call quotation
 127     arg1 quot-entry-point-offset [+] JMP
 128 ] \ unwind-native-frames define-sub-primitive
 129
 130 [
 131     ! Load callstack object
 132     arg4 ds-reg [] MOV
 133     ds-reg bootstrap-cell SUB
 134     ! Get ctx->callstack_bottom
 135     jit-load-context
 136     arg1 ctx-reg context-callstack-bottom-offset [+] MOV
 137     ! Get top of callstack object -- 'src' for memcpy
 138     arg2 arg4 callstack-top-offset [+] LEA
 139     ! Get callstack length, in bytes --- 'len' for memcpy
 140     arg3 arg4 callstack-length-offset [+] MOV
 141     arg3 tag-bits get SHR
 142     ! Compute new stack pointer -- 'dst' for memcpy
 143     arg1 arg3 SUB
 144     ! Install new stack pointer
 145     RSP arg1 MOV
 146     ! Call memcpy; arguments are now in the correct registers
 147     ! Create register shadow area for Win64
 148     RSP 32 SUB
 149     "factor_memcpy" jit-call
 150     ! Tear down register shadow area
 151     RSP 32 ADD
 152     ! Return with new callstack
 153     0 RET
 154 ] \ set-callstack define-sub-primitive
 155
 156 [
 157     jit-save-context
 158     arg2 vm-reg MOV
 159     "lazy_jit_compile" jit-call
 160 ]
 161 [ return-reg quot-entry-point-offset [+] CALL ]
 162 [ return-reg quot-entry-point-offset [+] JMP ]
 163 \ lazy-jit-compile define-combinator-primitive
 164
 165 ! Inline cache miss entry points
 166 : jit-load-return-address ( -- )
 167     RBX RSP stack-frame-size bootstrap-cell - [+] MOV ;
 168
 169 ! These are always in tail position with an existing stack
 170 ! frame, and the stack. The frame setup takes this into account.
 171 : jit-inline-cache-miss ( -- )
 172     jit-save-context
 173     arg1 RBX MOV
 174     arg2 vm-reg MOV
 175     "inline_cache_miss" jit-call
 176     jit-restore-context ;
 177
 178 [ jit-load-return-address jit-inline-cache-miss ]
 179 [ RAX CALL ]
 180 [ RAX JMP ]
 181 \ inline-cache-miss define-combinator-primitive
 182
 183 [ jit-inline-cache-miss ]
 184 [ RAX CALL ]
 185 [ RAX JMP ]
 186 \ inline-cache-miss-tail define-combinator-primitive
 187
 188 ! Overflowing fixnum arithmetic
 189 : jit-overflow ( insn func -- )
 190     ds-reg 8 SUB
 191     jit-save-context
 192     arg1 ds-reg [] MOV
 193     arg2 ds-reg 8 [+] MOV
 194     arg3 arg1 MOV
 195     [ [ arg3 arg2 ] dip call ] dip
 196     ds-reg [] arg3 MOV
 197     [ JNO ]
 198     [ arg3 vm-reg MOV jit-call ]
 199     jit-conditional ; inline
 200
 201 [ [ ADD ] "overflow_fixnum_add" jit-overflow ] \ fixnum+ define-sub-primitive
 202
 203 [ [ SUB ] "overflow_fixnum_subtract" jit-overflow ] \ fixnum- define-sub-primitive
 204
 205 [
 206     ds-reg 8 SUB
 207     jit-save-context
 208     RCX ds-reg [] MOV
 209     RBX ds-reg 8 [+] MOV
 210     RBX tag-bits get SAR
 211     RAX RCX MOV
 212     RBX IMUL
 213     ds-reg [] RAX MOV
 214     [ JNO ]
 215     [
 216         arg1 RCX MOV
 217         arg1 tag-bits get SAR
 218         arg2 RBX MOV
 219         arg3 vm-reg MOV
 220         "overflow_fixnum_multiply" jit-call
 221     ]
 222     jit-conditional
 223 ] \ fixnum* define-sub-primitive
 224
 225 << "vocab:cpu/x86/bootstrap.factor" parse-file suffix! >>
 226 call