basis/cpu/x86/32/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 cpu.x86.assembler cpu.x86.assembler.operands layouts
   5 vocabs parser compiler.constants sequences math math.private
   6 generic.single.private ;
   7 IN: bootstrap.x86
   8
   9 4 \ cell set
  10
  11 : stack-frame-size ( -- n ) 8 bootstrap-cells ;
  12 : shift-arg ( -- reg ) ECX ;
  13 : div-arg ( -- reg ) EAX ;
  14 : mod-arg ( -- reg ) EDX ;
  15 : temp0 ( -- reg ) EAX ;
  16 : temp1 ( -- reg ) EDX ;
  17 : temp2 ( -- reg ) ECX ;
  18 : temp3 ( -- reg ) EBX ;
  19 : safe-reg ( -- reg ) EAX ;
  20 : stack-reg ( -- reg ) ESP ;
  21 : frame-reg ( -- reg ) EBP ;
  22 : vm-reg ( -- reg ) ECX ;
  23 : ctx-reg ( -- reg ) EBP ;
  24 : nv-regs ( -- seq ) { ESI EDI EBX } ;
  25 : ds-reg ( -- reg ) ESI ;
  26 : rs-reg ( -- reg ) EDI ;
  27 : fixnum>slot@ ( -- ) temp0 2 SAR ;
  28 : rex-length ( -- n ) 0 ;
  29
  30 [
  31     ! save stack frame size
  32     stack-frame-size PUSH
  33     ! push entry point
  34     0 PUSH rc-absolute-cell rt-this jit-rel
  35     ! alignment
  36     ESP stack-frame-size 3 bootstrap-cells - SUB
  37 ] jit-prolog jit-define
  38
  39 [
  40     temp3 0 MOV rc-absolute-cell rt-here jit-rel
  41     0 JMP rc-relative rt-entry-point-pic-tail jit-rel
  42 ] jit-word-jump jit-define
  43
  44 : jit-load-vm ( -- )
  45     vm-reg 0 MOV 0 rc-absolute-cell jit-vm ;
  46
  47 : jit-load-context ( -- )
  48     ! VM pointer must be in vm-reg already
  49     ctx-reg vm-reg vm-context-offset [+] MOV ;
  50
  51 : jit-save-context ( -- )
  52     EDX RSP -4 [+] LEA
  53     ctx-reg context-callstack-top-offset [+] EDX MOV
  54     ctx-reg context-datastack-offset [+] ds-reg MOV
  55     ctx-reg context-retainstack-offset [+] rs-reg MOV ;
  56
  57 : jit-restore-context ( -- )
  58     ds-reg ctx-reg context-datastack-offset [+] MOV
  59     rs-reg ctx-reg context-retainstack-offset [+] MOV ;
  60
  61 [
  62     jit-load-vm
  63     jit-load-context
  64     jit-save-context
  65     ! call the primitive
  66     ESP [] vm-reg MOV
  67     0 CALL rc-relative rt-dlsym jit-rel
  68     ! restore ds, rs registers
  69     jit-restore-context
  70 ] jit-primitive jit-define
  71
  72 [
  73     ! Load quotation
  74     EAX EBP 8 [+] MOV
  75     ! save ctx->callstack_bottom, load ds, rs registers
  76     jit-load-vm
  77     jit-load-context
  78     jit-restore-context
  79     EDX stack-reg stack-frame-size 4 - [+] LEA
  80     ctx-reg context-callstack-bottom-offset [+] EDX MOV
  81     ! call the quotation
  82     EAX quot-entry-point-offset [+] CALL
  83     ! save ds, rs registers
  84     jit-save-context
  85 ] \ c-to-factor define-sub-primitive
  86
  87 [
  88     EAX ds-reg [] MOV
  89     ds-reg bootstrap-cell SUB
  90 ]
  91 [ EAX quot-entry-point-offset [+] CALL ]
  92 [ EAX quot-entry-point-offset [+] JMP ]
  93 \ (call) define-combinator-primitive
  94
  95 [
  96     ! Clear x87 stack, but preserve rounding mode and exception flags
  97     ESP 2 SUB
  98     ESP [] FNSTCW
  99     FNINIT
 100     ESP [] FLDCW
 101     ESP 2 ADD
 102
 103     ! Load arguments
 104     EAX ESP stack-frame-size [+] MOV
 105     EDX ESP stack-frame-size 4 + [+] MOV
 106
 107     ! Unwind stack frames
 108     ESP EDX MOV
 109
 110     ! Load ds and rs registers
 111     jit-load-vm
 112     jit-load-context
 113     jit-restore-context
 114
 115     ! Call quotation
 116     EAX quot-entry-point-offset [+] JMP
 117 ] \ unwind-native-frames define-sub-primitive
 118
 119 [
 120     ! Load callstack object
 121     EBX ds-reg [] MOV
 122     ds-reg bootstrap-cell SUB
 123     ! Get ctx->callstack_bottom
 124     jit-load-vm
 125     jit-load-context
 126     EAX ctx-reg context-callstack-bottom-offset [+] MOV
 127     ! Get top of callstack object -- 'src' for memcpy
 128     EBP EBX callstack-top-offset [+] LEA
 129     ! Get callstack length, in bytes --- 'len' for memcpy
 130     EDX EBX callstack-length-offset [+] MOV
 131     EDX tag-bits get SHR
 132     ! Compute new stack pointer -- 'dst' for memcpy
 133     EAX EDX SUB
 134     ! Install new stack pointer
 135     ESP EAX MOV
 136     ! Call memcpy
 137     EDX PUSH
 138     EBP PUSH
 139     EAX PUSH
 140     0 CALL "factor_memcpy" f rc-relative jit-dlsym
 141     ESP 12 ADD
 142     ! Return with new callstack
 143     0 RET
 144 ] \ set-callstack define-sub-primitive
 145
 146 [
 147     jit-load-vm
 148     jit-load-context
 149     jit-save-context
 150
 151     ! Store arguments
 152     ESP [] EAX MOV
 153     ESP 4 [+] vm-reg MOV
 154
 155     ! Call VM
 156     0 CALL "lazy_jit_compile" f rc-relative jit-dlsym
 157 ]
 158 [ EAX quot-entry-point-offset [+] CALL ]
 159 [ EAX quot-entry-point-offset [+] JMP ]
 160 \ lazy-jit-compile define-combinator-primitive
 161
 162 ! Inline cache miss entry points
 163 : jit-load-return-address ( -- )
 164     EBX ESP stack-frame-size bootstrap-cell - [+] MOV ;
 165
 166 ! These are always in tail position with an existing stack
 167 ! frame, and the stack. The frame setup takes this into account.
 168 : jit-inline-cache-miss ( -- )
 169     jit-load-vm
 170     jit-load-context
 171     jit-save-context
 172     ESP 4 [+] vm-reg MOV
 173     ESP [] EBX MOV
 174     0 CALL "inline_cache_miss" f rc-relative jit-dlsym
 175     jit-restore-context ;
 176
 177 [ jit-load-return-address jit-inline-cache-miss ]
 178 [ EAX CALL ]
 179 [ EAX JMP ]
 180 \ inline-cache-miss define-combinator-primitive
 181
 182 [ jit-inline-cache-miss ]
 183 [ EAX CALL ]
 184 [ EAX JMP ]
 185 \ inline-cache-miss-tail define-combinator-primitive
 186
 187 ! Overflowing fixnum arithmetic
 188 : jit-overflow ( insn func -- )
 189     ds-reg 4 SUB
 190     jit-load-vm
 191     jit-load-context
 192     jit-save-context
 193     EAX ds-reg [] MOV
 194     EDX ds-reg 4 [+] MOV
 195     EBX EAX MOV
 196     [ [ EBX EDX ] dip call( dst src -- ) ] dip
 197     ds-reg [] EBX MOV
 198     [ JNO ]
 199     [
 200         ESP [] EAX MOV
 201         ESP 4 [+] EDX MOV
 202         ESP 8 [+] vm-reg MOV
 203         [ 0 CALL ] dip f rc-relative jit-dlsym
 204     ]
 205     jit-conditional ;
 206
 207 [ [ ADD ] "overflow_fixnum_add" jit-overflow ] \ fixnum+ define-sub-primitive
 208
 209 [ [ SUB ] "overflow_fixnum_subtract" jit-overflow ] \ fixnum- define-sub-primitive
 210
 211 [
 212     ds-reg 4 SUB
 213     jit-load-vm
 214     jit-load-context
 215     jit-save-context
 216     EBX ds-reg [] MOV
 217     EAX EBX MOV
 218     EBP ds-reg 4 [+] MOV
 219     EBP tag-bits get SAR
 220     EBP IMUL
 221     ds-reg [] EAX MOV
 222     [ JNO ]
 223     [
 224         EBX tag-bits get SAR
 225         ESP [] EBX MOV
 226         ESP 4 [+] EBP MOV
 227         ESP 8 [+] vm-reg MOV
 228         0 CALL "overflow_fixnum_multiply" f rc-relative jit-dlsym
 229     ]
 230     jit-conditional
 231 ] \ fixnum* define-sub-primitive
 232
 233 << "vocab:cpu/x86/bootstrap.factor" parse-file suffix! >>
 234 call