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