basis/cpu/x86/32/bootstrap.factor

   1 ! Copyright (C) 2007, 2011 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 compiler.codegen.relocation
   6 sequences math math.private generic.single.private
   7 threads.private locals ;
   8 IN: bootstrap.x86
   9
  10 4 \ cell set
  11
  12 : stack-frame-size ( -- n ) 8 bootstrap-cells ;
  13 : shift-arg ( -- reg ) ECX ;
  14 : div-arg ( -- reg ) EAX ;
  15 : mod-arg ( -- reg ) EDX ;
  16 : temp0 ( -- reg ) EAX ;
  17 : temp1 ( -- reg ) ECX ;
  18 : temp2 ( -- reg ) EBX ;
  19 : temp3 ( -- reg ) EDX ;
  20 : pic-tail-reg ( -- reg ) EDX ;
  21 : stack-reg ( -- reg ) ESP ;
  22 : frame-reg ( -- reg ) EBP ;
  23 : vm-reg ( -- reg ) EBX ;
  24 : ctx-reg ( -- reg ) EBP ;
  25 : nv-regs ( -- seq ) { ESI EDI EBX } ;
  26 : volatile-regs ( -- seq ) { EAX ECX EDX } ;
  27 : nv-reg ( -- reg ) ESI ;
  28 : ds-reg ( -- reg ) ESI ;
  29 : rs-reg ( -- reg ) EDI ;
  30 : link-reg ( -- reg ) EBX ;
  31 : fixnum>slot@ ( -- ) temp0 2 SAR ;
  32 : rex-length ( -- n ) 0 ;
  33
  34 : jit-call ( name -- )
  35     0 CALL f rc-relative rel-dlsym ;
  36
  37 [
  38     ! alignment
  39     ESP stack-frame-size bootstrap-cell - SUB
  40     ! store entry point
  41     ESP stack-frame-size 3 bootstrap-cells - [+] 0 MOV rc-absolute-cell rel-this
  42     ! store stack frame size
  43     ESP stack-frame-size 2 bootstrap-cells - [+] stack-frame-size MOV
  44 ] jit-prolog jit-define
  45
  46 [
  47     pic-tail-reg 0 MOV 0 rc-absolute-cell rel-here
  48     0 JMP f rc-relative rel-word-pic-tail
  49 ] jit-word-jump jit-define
  50
  51 : jit-load-vm ( -- )
  52     vm-reg 0 MOV 0 rc-absolute-cell rel-vm ;
  53
  54 : jit-load-context ( -- )
  55     ! VM pointer must be in vm-reg already
  56     ctx-reg vm-reg vm-context-offset [+] MOV ;
  57
  58 : jit-save-context ( -- )
  59     jit-load-context
  60     ECX ESP -4 [+] LEA
  61     ctx-reg context-callstack-top-offset [+] ECX MOV
  62     ctx-reg context-datastack-offset [+] ds-reg MOV
  63     ctx-reg context-retainstack-offset [+] rs-reg MOV ;
  64
  65 : jit-restore-context ( -- )
  66     ds-reg ctx-reg context-datastack-offset [+] MOV
  67     rs-reg ctx-reg context-retainstack-offset [+] MOV ;
  68
  69 [
  70     ! ctx-reg is preserved across the call because it is
  71     ! non-volatile in the C ABI
  72     jit-load-vm
  73     jit-save-context
  74     ! call the primitive
  75     ESP [] vm-reg MOV
  76     0 CALL f f rc-relative rel-dlsym
  77     jit-restore-context
  78 ] jit-primitive jit-define
  79
  80 : jit-jump-quot ( -- )
  81     EAX quot-entry-point-offset [+] JMP ;
  82
  83 : jit-call-quot ( -- )
  84     EAX quot-entry-point-offset [+] CALL ;
  85
  86 [
  87     jit-load-vm
  88     ESP [] vm-reg MOV
  89     EAX EBP 8 [+] MOV
  90     ESP 4 [+] EAX MOV
  91     "begin_callback" jit-call
  92
  93     jit-call-quot
  94
  95     jit-load-vm
  96     ESP [] vm-reg MOV
  97     "end_callback" jit-call
  98 ] \ c-to-factor define-sub-primitive
  99
 100 ! The signal-handler and leaf-signal-handler subprimitives are special-cased
 101 ! in vm/quotations.cpp not to trigger generation of a stack frame, so they can
 102 ! peform their own prolog/epilog preserving registers.
 103
 104 :: jit-signal-handler-prolog ( -- frame-size )
 105     stack-frame-size 8 bootstrap-cells + :> frame-size
 106     ESP frame-size bootstrap-cell - SUB ! minus a cell for return address
 107     ESP []                    EAX MOV
 108     ESP 1 bootstrap-cells [+] ECX MOV
 109     ESP 2 bootstrap-cells [+] EDX MOV
 110     ESP 3 bootstrap-cells [+] EBX MOV
 111     ESP 4 bootstrap-cells [+] EBP MOV
 112     ESP 5 bootstrap-cells [+] ESI MOV
 113     ESP 6 bootstrap-cells [+] EDI MOV
 114     ESP frame-size 3 bootstrap-cells - [+] 0 MOV rc-absolute-cell rel-this
 115     ESP frame-size 2 bootstrap-cells - [+] frame-size MOV
 116     ! subprimitive definition assumes vm's been loaded
 117     jit-load-vm
 118     frame-size ;
 119
 120 :: jit-signal-handler-epilog ( frame-size -- )
 121     EAX ESP []                    MOV
 122     ECX ESP 1 bootstrap-cells [+] MOV
 123     EDX ESP 2 bootstrap-cells [+] MOV
 124     EBX ESP 3 bootstrap-cells [+] MOV
 125     EBP ESP 4 bootstrap-cells [+] MOV
 126     ESI ESP 5 bootstrap-cells [+] MOV
 127     EDI ESP 6 bootstrap-cells [+] MOV
 128     ESP frame-size bootstrap-cell - ADD ;
 129
 130 [
 131     EAX ds-reg [] MOV
 132     ds-reg bootstrap-cell SUB
 133 ]
 134 [ jit-call-quot ]
 135 [ jit-jump-quot ]
 136 \ (call) define-combinator-primitive
 137
 138 [
 139     ! Load ds and rs registers
 140     jit-load-vm
 141     jit-load-context
 142     jit-restore-context
 143
 144     ! Windows-specific setup
 145     ctx-reg jit-update-seh
 146
 147     ! Load arguments
 148     EAX ESP stack-frame-size [+] MOV
 149     EDX ESP stack-frame-size 4 + [+] MOV
 150
 151     ! Unwind stack frames
 152     ESP EDX MOV
 153
 154     jit-jump-quot
 155 ] \ unwind-native-frames define-sub-primitive
 156
 157 [
 158     ESP 2 SUB
 159     ESP [] FNSTCW
 160     FNINIT
 161     AX ESP [] MOV
 162     ESP 2 ADD
 163 ] \ fpu-state define-sub-primitive
 164
 165 [
 166     ESP stack-frame-size [+] FLDCW
 167 ] \ set-fpu-state define-sub-primitive
 168
 169 [
 170     ! Load callstack object
 171     temp3 ds-reg [] MOV
 172     ds-reg bootstrap-cell SUB
 173     ! Get ctx->callstack_bottom
 174     jit-load-vm
 175     jit-load-context
 176     temp0 ctx-reg context-callstack-bottom-offset [+] MOV
 177     ! Get top of callstack object -- 'src' for memcpy
 178     temp1 temp3 callstack-top-offset [+] LEA
 179     ! Get callstack length, in bytes --- 'len' for memcpy
 180     temp2 temp3 callstack-length-offset [+] MOV
 181     temp2 tag-bits get SHR
 182     ! Compute new stack pointer -- 'dst' for memcpy
 183     temp0 temp2 SUB
 184     ! Install new stack pointer
 185     ESP temp0 MOV
 186     ! Call memcpy
 187     temp2 PUSH
 188     temp1 PUSH
 189     temp0 PUSH
 190     "factor_memcpy" jit-call
 191     ESP 12 ADD
 192     ! Return with new callstack
 193     0 RET
 194 ] \ set-callstack define-sub-primitive
 195
 196 [
 197     jit-load-vm
 198     jit-save-context
 199
 200     ! Store arguments
 201     ESP [] EAX MOV
 202     ESP 4 [+] vm-reg MOV
 203
 204     ! Call VM
 205     "lazy_jit_compile" jit-call
 206 ]
 207 [ jit-call-quot ]
 208 [ jit-jump-quot ]
 209 \ lazy-jit-compile define-combinator-primitive
 210
 211 [
 212     temp1 HEX: ffffffff CMP f rc-absolute-cell rel-literal
 213 ] pic-check-tuple jit-define
 214
 215 ! Inline cache miss entry points
 216 : jit-load-return-address ( -- )
 217     pic-tail-reg ESP stack-frame-size bootstrap-cell - [+] MOV ;
 218
 219 ! These are always in tail position with an existing stack
 220 ! frame, and the stack. The frame setup takes this into account.
 221 : jit-inline-cache-miss ( -- )
 222     jit-load-vm
 223     jit-save-context
 224     ESP 4 [+] vm-reg MOV
 225     ESP [] pic-tail-reg MOV
 226     0 CALL rc-relative rel-inline-cache-miss
 227     jit-restore-context ;
 228
 229 [ jit-load-return-address jit-inline-cache-miss ]
 230 [ EAX CALL ]
 231 [ EAX JMP ]
 232 \ inline-cache-miss define-combinator-primitive
 233
 234 [ jit-inline-cache-miss ]
 235 [ EAX CALL ]
 236 [ EAX JMP ]
 237 \ inline-cache-miss-tail define-combinator-primitive
 238
 239 ! Overflowing fixnum arithmetic
 240 : jit-overflow ( insn func -- )
 241     ds-reg 4 SUB
 242     jit-load-vm
 243     jit-save-context
 244     EAX ds-reg [] MOV
 245     EDX ds-reg 4 [+] MOV
 246     EBX EAX MOV
 247     [ [ EBX EDX ] dip call( dst src -- ) ] dip
 248     ds-reg [] EBX MOV
 249     [ JNO ]
 250     [
 251         ESP [] EAX MOV
 252         ESP 4 [+] EDX MOV
 253         jit-load-vm
 254         ESP 8 [+] vm-reg MOV
 255         jit-call
 256     ]
 257     jit-conditional ;
 258
 259 [ [ ADD ] "overflow_fixnum_add" jit-overflow ] \ fixnum+ define-sub-primitive
 260
 261 [ [ SUB ] "overflow_fixnum_subtract" jit-overflow ] \ fixnum- define-sub-primitive
 262
 263 [
 264     ds-reg 4 SUB
 265     jit-load-vm
 266     jit-save-context
 267     EBX ds-reg [] MOV
 268     EAX EBX MOV
 269     EBP ds-reg 4 [+] MOV
 270     EBP tag-bits get SAR
 271     EBP IMUL
 272     ds-reg [] EAX MOV
 273     [ JNO ]
 274     [
 275         EBX tag-bits get SAR
 276         ESP [] EBX MOV
 277         ESP 4 [+] EBP MOV
 278         jit-load-vm
 279         ESP 8 [+] vm-reg MOV
 280         "overflow_fixnum_multiply" jit-call
 281     ]
 282     jit-conditional
 283 ] \ fixnum* define-sub-primitive
 284
 285 ! Contexts
 286 : jit-switch-context ( reg -- )
 287     ! Reset return value since its bogus right now, to avoid
 288     ! confusing the GC
 289     ESP -4 [+] 0 MOV
 290
 291     ! Make the new context the current one
 292     ctx-reg swap MOV
 293     vm-reg vm-context-offset [+] ctx-reg MOV
 294
 295     ! Load new stack pointer
 296     ESP ctx-reg context-callstack-top-offset [+] MOV
 297
 298     ! Windows-specific setup
 299     ctx-reg jit-update-tib
 300
 301     ! Load new ds, rs registers
 302     jit-restore-context ;
 303
 304 : jit-set-context ( -- )
 305     ! Load context and parameter from datastack
 306     EAX ds-reg [] MOV
 307     EAX EAX alien-offset [+] MOV
 308     EDX ds-reg -4 [+] MOV
 309     ds-reg 8 SUB
 310
 311     ! Save ds, rs registers
 312     jit-load-vm
 313     jit-save-context
 314
 315     ! Make the new context active
 316     EAX jit-switch-context
 317
 318     ! Windows-specific setup
 319     ctx-reg jit-update-seh
 320
 321     ! Twiddle stack for return
 322     ESP 4 ADD
 323
 324     ! Store parameter to datastack
 325     ds-reg 4 ADD
 326     ds-reg [] EDX MOV ;
 327
 328 [ jit-set-context ] \ (set-context) define-sub-primitive
 329
 330 : jit-save-quot-and-param ( -- )
 331     EDX ds-reg MOV
 332     ds-reg 8 SUB ;
 333
 334 : jit-push-param ( -- )
 335     EAX EDX -4 [+] MOV
 336     ds-reg 4 ADD
 337     ds-reg [] EAX MOV ;
 338
 339 : jit-start-context ( -- )
 340     ! Create the new context in return-reg
 341     jit-load-vm
 342     jit-save-context
 343     ESP [] vm-reg MOV
 344     "new_context" jit-call
 345
 346     jit-save-quot-and-param
 347
 348     ! Make the new context active
 349     jit-load-vm
 350     jit-save-context
 351     EAX jit-switch-context
 352
 353     jit-push-param
 354
 355     ! Windows-specific setup
 356     jit-install-seh
 357
 358     ! Push a fake return address
 359     0 PUSH
 360
 361     ! Jump to initial quotation
 362     EAX EDX [] MOV
 363     jit-jump-quot ;
 364
 365 [ jit-start-context ] \ (start-context) define-sub-primitive
 366
 367 : jit-delete-current-context ( -- )
 368     jit-load-vm
 369     jit-load-context
 370     ESP [] vm-reg MOV
 371     ESP 4 [+] ctx-reg MOV
 372     "delete_context" jit-call ;
 373
 374 [
 375     jit-delete-current-context
 376     jit-set-context
 377 ] \ (set-context-and-delete) define-sub-primitive
 378
 379 : jit-start-context-and-delete ( -- )
 380     jit-load-vm
 381     jit-load-context
 382     ESP [] vm-reg MOV
 383     ESP 4 [+] ctx-reg MOV
 384     "reset_context" jit-call
 385
 386     jit-save-quot-and-param
 387     ctx-reg jit-switch-context
 388     jit-push-param
 389
 390     EAX EDX [] MOV
 391     jit-jump-quot ;
 392
 393 : jit-safepoint ( -- )
 394     0 EAX MOVABS rc-absolute rel-safepoint ;
 395
 396 [
 397     jit-start-context-and-delete
 398 ] \ (start-context-and-delete) define-sub-primitive