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