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