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 : safe-reg ( -- reg ) RAX ;
  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 [
  30     ! load XT
  31     safe-reg 0 MOV rc-absolute-cell rt-this jit-rel
  32     ! save stack frame size
  33     stack-frame-size PUSH
  34     ! push XT
  35     safe-reg PUSH
  36     ! alignment
  37     RSP stack-frame-size 3 bootstrap-cells - SUB
  38 ] jit-prolog jit-define
  39
  40 : jit-load-context ( -- )
  41     ctx-reg vm-reg vm-context-offset [+] MOV ;
  42
  43 : jit-save-context ( -- )
  44     jit-load-context
  45     safe-reg RSP -8 [+] LEA
  46     ctx-reg context-callstack-top-offset [+] safe-reg MOV
  47     ctx-reg context-datastack-offset [+] ds-reg MOV
  48     ctx-reg context-retainstack-offset [+] rs-reg MOV ;
  49
  50 : jit-restore-context ( -- )
  51     jit-load-context
  52     ds-reg ctx-reg context-datastack-offset [+] MOV
  53     rs-reg ctx-reg context-retainstack-offset [+] MOV ;
  54
  55 [
  56     jit-save-context
  57     ! call the primitive
  58     arg1 vm-reg MOV
  59     RAX 0 MOV rc-absolute-cell rt-primitive jit-rel
  60     RAX CALL
  61     jit-restore-context
  62 ] jit-primitive jit-define
  63
  64 [
  65     jit-restore-context
  66     ! save ctx->callstack_bottom
  67     safe-reg stack-reg stack-frame-size 8 - [+] LEA
  68     ctx-reg context-callstack-bottom-offset [+] safe-reg MOV
  69     ! call the quotation
  70     arg1 quot-xt-offset [+] CALL
  71     jit-save-context
  72 ] \ c-to-factor define-sub-primitive
  73
  74 [
  75     arg1 ds-reg [] MOV
  76     ds-reg bootstrap-cell SUB
  77 ]
  78 [ arg1 quot-xt-offset [+] CALL ]
  79 [ arg1 quot-xt-offset [+] JMP ]
  80 \ (call) define-combinator-primitive
  81
  82 [
  83     ! Clear x87 stack, but preserve rounding mode and exception flags
  84     RSP 2 SUB
  85     RSP [] FNSTCW
  86     FNINIT
  87     RSP [] FLDCW
  88
  89     ! Unwind stack frames
  90     RSP arg2 MOV
  91
  92     ! Load ds and rs registers
  93     jit-restore-context
  94
  95     ! Call quotation
  96     arg1 quot-xt-offset [+] JMP
  97 ] \ unwind-native-frames define-sub-primitive
  98
  99 [
 100     ! Load callstack object
 101     arg4 ds-reg [] MOV
 102     ds-reg bootstrap-cell SUB
 103     ! Get ctx->callstack_bottom
 104     jit-load-context
 105     arg1 ctx-reg context-callstack-bottom-offset [+] MOV
 106     ! Get top of callstack object -- 'src' for memcpy
 107     arg2 arg4 callstack-top-offset [+] LEA
 108     ! Get callstack length, in bytes --- 'len' for memcpy
 109     arg3 arg4 callstack-length-offset [+] MOV
 110     arg3 tag-bits get SHR
 111     ! Compute new stack pointer -- 'dst' for memcpy
 112     arg1 arg3 SUB
 113     ! Install new stack pointer
 114     RSP arg1 MOV
 115     ! Call memcpy; arguments are now in the correct registers
 116     ! Create register shadow area for Win64
 117     RSP 32 SUB
 118     safe-reg 0 MOV "factor_memcpy" f rc-absolute-cell jit-dlsym
 119     safe-reg CALL
 120     ! Tear down register shadow area
 121     RSP 32 ADD
 122     ! Return with new callstack
 123     0 RET
 124 ] \ set-callstack define-sub-primitive
 125
 126 [
 127     jit-save-context
 128     arg2 vm-reg MOV
 129     safe-reg 0 MOV "lazy_jit_compile" f rc-absolute-cell jit-dlsym
 130     safe-reg CALL
 131 ]
 132 [ return-reg quot-xt-offset [+] CALL ]
 133 [ return-reg quot-xt-offset [+] JMP ]
 134 \ lazy-jit-compile define-combinator-primitive
 135
 136 ! Inline cache miss entry points
 137 : jit-load-return-address ( -- )
 138     RBX RSP stack-frame-size bootstrap-cell - [+] MOV ;
 139
 140 ! These are always in tail position with an existing stack
 141 ! frame, and the stack. The frame setup takes this into account.
 142 : jit-inline-cache-miss ( -- )
 143     jit-save-context
 144     arg1 RBX MOV
 145     arg2 vm-reg MOV
 146     RAX 0 MOV "inline_cache_miss" f rc-absolute-cell jit-dlsym
 147     RAX CALL
 148     jit-restore-context ;
 149
 150 [ jit-load-return-address jit-inline-cache-miss ]
 151 [ RAX CALL ]
 152 [ RAX JMP ]
 153 \ inline-cache-miss define-combinator-primitive
 154
 155 [ jit-inline-cache-miss ]
 156 [ RAX CALL ]
 157 [ RAX JMP ]
 158 \ inline-cache-miss-tail define-combinator-primitive
 159
 160 ! Overflowing fixnum arithmetic
 161 : jit-overflow ( insn func -- )
 162     ds-reg 8 SUB
 163     jit-save-context
 164     arg1 ds-reg [] MOV
 165     arg2 ds-reg 8 [+] MOV
 166     arg3 arg1 MOV
 167     [ [ arg3 arg2 ] dip call ] dip
 168     ds-reg [] arg3 MOV
 169     [ JNO ]
 170     [
 171         arg3 vm-reg MOV
 172         RAX 0 MOV f rc-absolute-cell jit-dlsym
 173         RAX CALL
 174     ]
 175     jit-conditional ; inline
 176
 177 [ [ ADD ] "overflow_fixnum_add" jit-overflow ] \ fixnum+ define-sub-primitive
 178
 179 [ [ SUB ] "overflow_fixnum_subtract" jit-overflow ] \ fixnum- define-sub-primitive
 180
 181 [
 182     ds-reg 8 SUB
 183     jit-save-context
 184     RCX ds-reg [] MOV
 185     RBX ds-reg 8 [+] MOV
 186     RBX tag-bits get SAR
 187     RAX RCX MOV
 188     RBX IMUL
 189     ds-reg [] RAX MOV
 190     [ JNO ]
 191     [
 192         arg1 RCX MOV
 193         arg1 tag-bits get SAR
 194         arg2 RBX MOV
 195         arg3 vm-reg MOV
 196         RAX 0 MOV "overflow_fixnum_multiply" f rc-absolute-cell jit-dlsym
 197         RAX CALL
 198     ]
 199     jit-conditional
 200 ] \ fixnum* define-sub-primitive
 201
 202 << "vocab:cpu/x86/bootstrap.factor" parse-file suffix! >>
 203 call