basis/cpu/x86/bootstrap.factor

   1 ! Copyright (C) 2007, 2011 Slava Pestov.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: bootstrap.image.private compiler.constants
   4 compiler.codegen.relocation compiler.units cpu.x86.assembler
   5 cpu.x86.assembler.operands kernel kernel.private layouts
   6 locals locals.backend make math math.private namespaces sequences
   7 slots.private strings.private vocabs ;
   8 IN: bootstrap.x86
   9
  10 big-endian off
  11
  12 ! C to Factor entry point
  13 [
  14     ! Optimizing compiler's side of callback accesses
  15     ! arguments that are on the stack via the frame pointer.
  16     ! On x86-32 fastcall, and x86-64, some arguments are passed
  17     ! in registers, and so the only registers that are safe for
  18     ! use here are frame-reg, nv-reg and vm-reg.
  19     frame-reg PUSH
  20     frame-reg stack-reg MOV
  21
  22     ! Save all non-volatile registers
  23     nv-regs [ PUSH ] each
  24
  25     jit-save-tib
  26
  27     ! Load VM into vm-reg
  28     vm-reg 0 MOV 0 rc-absolute-cell rel-vm
  29
  30     ! Save old context
  31     nv-reg vm-reg vm-context-offset [+] MOV
  32     nv-reg PUSH
  33
  34     ! Switch over to the spare context
  35     nv-reg vm-reg vm-spare-context-offset [+] MOV
  36     vm-reg vm-context-offset [+] nv-reg MOV
  37
  38     ! Save C callstack pointer
  39     nv-reg context-callstack-save-offset [+] stack-reg MOV
  40
  41     ! Load Factor stack pointers
  42     stack-reg nv-reg context-callstack-bottom-offset [+] MOV
  43     nv-reg jit-update-tib
  44     jit-install-seh
  45
  46     rs-reg nv-reg context-retainstack-offset [+] MOV
  47     ds-reg nv-reg context-datastack-offset [+] MOV
  48
  49     ! Call into Factor code
  50     link-reg 0 MOV f rc-absolute-cell rel-word
  51     link-reg CALL
  52
  53     ! Load VM into vm-reg; only needed on x86-32, but doesn't
  54     ! hurt on x86-64
  55     vm-reg 0 MOV 0 rc-absolute-cell rel-vm
  56
  57     ! Load C callstack pointer
  58     nv-reg vm-reg vm-context-offset [+] MOV
  59     stack-reg nv-reg context-callstack-save-offset [+] MOV
  60
  61     ! Load old context
  62     nv-reg POP
  63     vm-reg vm-context-offset [+] nv-reg MOV
  64
  65     ! Restore non-volatile registers
  66     jit-restore-tib
  67
  68     nv-regs <reversed> [ POP ] each
  69
  70     frame-reg POP
  71
  72     ! Callbacks which return structs, or use stdcall/fastcall/thiscall,
  73     ! need a parameter here.
  74
  75     ! See the comment for M\ x86.32 stack-cleanup in cpu.x86.32
  76     HEX: ffff RET f rc-absolute-2 rel-untagged
  77 ] callback-stub jit-define
  78
  79 [
  80     ! load literal
  81     temp0 0 MOV f rc-absolute-cell rel-literal
  82     ! increment datastack pointer
  83     ds-reg bootstrap-cell ADD
  84     ! store literal on datastack
  85     ds-reg [] temp0 MOV
  86 ] jit-push jit-define
  87
  88 [
  89     0 CALL f rc-relative rel-word-pic
  90 ] jit-word-call jit-define
  91
  92 ! The *-signal-handler subprimitives are special-cased in vm/quotations.cpp
  93 ! not to trigger generation of a stack frame, so they can
  94 ! peform their own prolog/epilog preserving registers.
  95
  96 [| |
  97     jit-signal-handler-prolog :> frame-size
  98     jit-save-context
  99     temp0 vm-reg vm-signal-handler-addr-offset [+] MOV
 100     temp0 CALL
 101     frame-size jit-signal-handler-epilog
 102     0 RET
 103 ] \ signal-handler define-sub-primitive
 104
 105 : leaf-frame-size ( -- n ) 4 bootstrap-cells ;
 106
 107 [| |
 108     jit-signal-handler-prolog :> frame-size
 109     jit-save-context
 110     temp0 vm-reg vm-signal-handler-addr-offset [+] MOV
 111     temp0 CALL
 112     frame-size jit-signal-handler-epilog
 113     ! Pop the fake leaf frame along with our return address
 114     leaf-frame-size bootstrap-cell - RET
 115 ] \ leaf-signal-handler define-sub-primitive
 116
 117 [| |
 118     jit-signal-handler-prolog :> frame-size
 119     temp0 vm-reg vm-signal-handler-addr-offset [+] MOV
 120     temp0 CALL
 121     frame-size jit-signal-handler-epilog
 122     red-zone-size RET
 123 ] \ ffi-signal-handler define-sub-primitive
 124
 125 [| |
 126     jit-signal-handler-prolog :> frame-size
 127     temp0 vm-reg vm-signal-handler-addr-offset [+] MOV
 128     temp0 CALL
 129     frame-size jit-signal-handler-epilog
 130     red-zone-size 16 bootstrap-cell - + RET
 131 ] \ ffi-leaf-signal-handler define-sub-primitive
 132
 133 [
 134     ! load boolean
 135     temp0 ds-reg [] MOV
 136     ! pop boolean
 137     ds-reg bootstrap-cell SUB
 138     ! compare boolean with f
 139     temp0 \ f type-number CMP
 140     ! jump to true branch if not equal
 141     0 JNE f rc-relative rel-word
 142     ! jump to false branch if equal
 143     0 JMP f rc-relative rel-word
 144 ] jit-if jit-define
 145
 146 : jit->r ( -- )
 147     rs-reg bootstrap-cell ADD
 148     temp0 ds-reg [] MOV
 149     ds-reg bootstrap-cell SUB
 150     rs-reg [] temp0 MOV ;
 151
 152 : jit-2>r ( -- )
 153     rs-reg 2 bootstrap-cells ADD
 154     temp0 ds-reg [] MOV
 155     temp1 ds-reg -1 bootstrap-cells [+] MOV
 156     ds-reg 2 bootstrap-cells SUB
 157     rs-reg [] temp0 MOV
 158     rs-reg -1 bootstrap-cells [+] temp1 MOV ;
 159
 160 : jit-3>r ( -- )
 161     rs-reg 3 bootstrap-cells ADD
 162     temp0 ds-reg [] MOV
 163     temp1 ds-reg -1 bootstrap-cells [+] MOV
 164     temp2 ds-reg -2 bootstrap-cells [+] MOV
 165     ds-reg 3 bootstrap-cells SUB
 166     rs-reg [] temp0 MOV
 167     rs-reg -1 bootstrap-cells [+] temp1 MOV
 168     rs-reg -2 bootstrap-cells [+] temp2 MOV ;
 169
 170 : jit-r> ( -- )
 171     ds-reg bootstrap-cell ADD
 172     temp0 rs-reg [] MOV
 173     rs-reg bootstrap-cell SUB
 174     ds-reg [] temp0 MOV ;
 175
 176 : jit-2r> ( -- )
 177     ds-reg 2 bootstrap-cells ADD
 178     temp0 rs-reg [] MOV
 179     temp1 rs-reg -1 bootstrap-cells [+] MOV
 180     rs-reg 2 bootstrap-cells SUB
 181     ds-reg [] temp0 MOV
 182     ds-reg -1 bootstrap-cells [+] temp1 MOV ;
 183
 184 : jit-3r> ( -- )
 185     ds-reg 3 bootstrap-cells ADD
 186     temp0 rs-reg [] MOV
 187     temp1 rs-reg -1 bootstrap-cells [+] MOV
 188     temp2 rs-reg -2 bootstrap-cells [+] MOV
 189     rs-reg 3 bootstrap-cells SUB
 190     ds-reg [] temp0 MOV
 191     ds-reg -1 bootstrap-cells [+] temp1 MOV
 192     ds-reg -2 bootstrap-cells [+] temp2 MOV ;
 193
 194 [
 195     jit->r
 196     0 CALL f rc-relative rel-word
 197     jit-r>
 198 ] jit-dip jit-define
 199
 200 [
 201     jit-2>r
 202     0 CALL f rc-relative rel-word
 203     jit-2r>
 204 ] jit-2dip jit-define
 205
 206 [
 207     jit-3>r
 208     0 CALL f rc-relative rel-word
 209     jit-3r>
 210 ] jit-3dip jit-define
 211
 212 [
 213     ! load from stack
 214     temp0 ds-reg [] MOV
 215     ! pop stack
 216     ds-reg bootstrap-cell SUB
 217 ]
 218 [ temp0 word-entry-point-offset [+] CALL ]
 219 [ temp0 word-entry-point-offset [+] JMP ]
 220 \ (execute) define-combinator-primitive
 221
 222 [
 223     temp0 ds-reg [] MOV
 224     ds-reg bootstrap-cell SUB
 225     temp0 word-entry-point-offset [+] JMP
 226 ] jit-execute jit-define
 227
 228 [
 229     stack-reg stack-frame-size bootstrap-cell - ADD
 230 ] jit-epilog jit-define
 231
 232 [ 0 RET ] jit-return jit-define
 233
 234 ! ! ! Polymorphic inline caches
 235
 236 ! The PIC stubs are not permitted to touch pic-tail-reg.
 237
 238 ! Load a value from a stack position
 239 [
 240     temp1 ds-reg HEX: 7f [+] MOV f rc-absolute-1 rel-untagged
 241 ] pic-load jit-define
 242
 243 [ temp1 tag-mask get AND ] pic-tag jit-define
 244
 245 [
 246     temp0 temp1 MOV
 247     temp1 tag-mask get AND
 248     temp1 tuple type-number CMP
 249     [ JNE ]
 250     [ temp1 temp0 tuple-class-offset [+] MOV ]
 251     jit-conditional
 252 ] pic-tuple jit-define
 253
 254 [
 255     temp1 HEX: 7f CMP f rc-absolute-1 rel-untagged
 256 ] pic-check-tag jit-define
 257
 258 [ 0 JE f rc-relative rel-word ] pic-hit jit-define
 259
 260 ! ! ! Megamorphic caches
 261
 262 [
 263     ! class = ...
 264     temp0 temp1 MOV
 265     temp1 tag-mask get AND
 266     temp1 tag-bits get SHL
 267     temp1 tuple type-number tag-fixnum CMP
 268     [ JNE ]
 269     [ temp1 temp0 tuple-class-offset [+] MOV ]
 270     jit-conditional
 271     ! cache = ...
 272     temp0 0 MOV f rc-absolute-cell rel-literal
 273     ! key = hashcode(class)
 274     temp2 temp1 MOV
 275     bootstrap-cell 4 = [ temp2 1 SHR ] when
 276     ! key &= cache.length - 1
 277     temp2 mega-cache-size get 1 - bootstrap-cell * AND
 278     ! cache += array-start-offset
 279     temp0 array-start-offset ADD
 280     ! cache += key
 281     temp0 temp2 ADD
 282     ! if(get(cache) == class)
 283     temp0 [] temp1 CMP
 284     [ JNE ]
 285     [
 286         ! megamorphic_cache_hits++
 287         temp1 0 MOV rc-absolute-cell rel-megamorphic-cache-hits
 288         temp1 [] 1 ADD
 289         ! goto get(cache + bootstrap-cell)
 290         temp0 temp0 bootstrap-cell [+] MOV
 291         temp0 word-entry-point-offset [+] JMP
 292         ! fall-through on miss
 293     ] jit-conditional
 294 ] mega-lookup jit-define
 295
 296 ! ! ! Sub-primitives
 297
 298 ! Objects
 299 [
 300     ! load from stack
 301     temp0 ds-reg [] MOV
 302     ! compute tag
 303     temp0 tag-mask get AND
 304     ! tag the tag
 305     temp0 tag-bits get SHL
 306     ! push to stack
 307     ds-reg [] temp0 MOV
 308 ] \ tag define-sub-primitive
 309
 310 [
 311     ! load slot number
 312     temp0 ds-reg [] MOV
 313     ! adjust stack pointer
 314     ds-reg bootstrap-cell SUB
 315     ! load object
 316     temp1 ds-reg [] MOV
 317     ! turn slot number into offset
 318     fixnum>slot@
 319     ! mask off tag
 320     temp1 tag-bits get SHR
 321     temp1 tag-bits get SHL
 322     ! load slot value
 323     temp0 temp1 temp0 [+] MOV
 324     ! push to stack
 325     ds-reg [] temp0 MOV
 326 ] \ slot define-sub-primitive
 327
 328 [
 329     ! load string index from stack
 330     temp0 ds-reg bootstrap-cell neg [+] MOV
 331     temp0 tag-bits get SHR
 332     ! load string from stack
 333     temp1 ds-reg [] MOV
 334     ! load character
 335     temp0 8-bit-version-of temp0 temp1 string-offset [++] MOV
 336     temp0 temp0 8-bit-version-of MOVZX
 337     temp0 tag-bits get SHL
 338     ! store character to stack
 339     ds-reg bootstrap-cell SUB
 340     ds-reg [] temp0 MOV
 341 ] \ string-nth-fast define-sub-primitive
 342
 343 ! Shufflers
 344 [
 345     ds-reg bootstrap-cell SUB
 346 ] \ drop define-sub-primitive
 347
 348 [
 349     ds-reg 2 bootstrap-cells SUB
 350 ] \ 2drop define-sub-primitive
 351
 352 [
 353     ds-reg 3 bootstrap-cells SUB
 354 ] \ 3drop define-sub-primitive
 355
 356 [
 357     temp0 ds-reg [] MOV
 358     ds-reg bootstrap-cell ADD
 359     ds-reg [] temp0 MOV
 360 ] \ dup define-sub-primitive
 361
 362 [
 363     temp0 ds-reg [] MOV
 364     temp1 ds-reg bootstrap-cell neg [+] MOV
 365     ds-reg 2 bootstrap-cells ADD
 366     ds-reg [] temp0 MOV
 367     ds-reg bootstrap-cell neg [+] temp1 MOV
 368 ] \ 2dup define-sub-primitive
 369
 370 [
 371     temp0 ds-reg [] MOV
 372     temp1 ds-reg -1 bootstrap-cells [+] MOV
 373     temp3 ds-reg -2 bootstrap-cells [+] MOV
 374     ds-reg 3 bootstrap-cells ADD
 375     ds-reg [] temp0 MOV
 376     ds-reg -1 bootstrap-cells [+] temp1 MOV
 377     ds-reg -2 bootstrap-cells [+] temp3 MOV
 378 ] \ 3dup define-sub-primitive
 379
 380 [
 381     temp0 ds-reg [] MOV
 382     ds-reg bootstrap-cell SUB
 383     ds-reg [] temp0 MOV
 384 ] \ nip define-sub-primitive
 385
 386 [
 387     temp0 ds-reg [] MOV
 388     ds-reg 2 bootstrap-cells SUB
 389     ds-reg [] temp0 MOV
 390 ] \ 2nip define-sub-primitive
 391
 392 [
 393     temp0 ds-reg -1 bootstrap-cells [+] MOV
 394     ds-reg bootstrap-cell ADD
 395     ds-reg [] temp0 MOV
 396 ] \ over define-sub-primitive
 397
 398 [
 399     temp0 ds-reg -2 bootstrap-cells [+] MOV
 400     ds-reg bootstrap-cell ADD
 401     ds-reg [] temp0 MOV
 402 ] \ pick define-sub-primitive
 403
 404 [
 405     temp0 ds-reg [] MOV
 406     temp1 ds-reg -1 bootstrap-cells [+] MOV
 407     ds-reg [] temp1 MOV
 408     ds-reg bootstrap-cell ADD
 409     ds-reg [] temp0 MOV
 410 ] \ dupd define-sub-primitive
 411
 412 [
 413     temp0 ds-reg [] MOV
 414     temp1 ds-reg bootstrap-cell neg [+] MOV
 415     ds-reg bootstrap-cell neg [+] temp0 MOV
 416     ds-reg [] temp1 MOV
 417 ] \ swap define-sub-primitive
 418
 419 [
 420     temp0 ds-reg -1 bootstrap-cells [+] MOV
 421     temp1 ds-reg -2 bootstrap-cells [+] MOV
 422     ds-reg -2 bootstrap-cells [+] temp0 MOV
 423     ds-reg -1 bootstrap-cells [+] temp1 MOV
 424 ] \ swapd define-sub-primitive
 425
 426 [
 427     temp0 ds-reg [] MOV
 428     temp1 ds-reg -1 bootstrap-cells [+] MOV
 429     temp3 ds-reg -2 bootstrap-cells [+] MOV
 430     ds-reg -2 bootstrap-cells [+] temp1 MOV
 431     ds-reg -1 bootstrap-cells [+] temp0 MOV
 432     ds-reg [] temp3 MOV
 433 ] \ rot define-sub-primitive
 434
 435 [
 436     temp0 ds-reg [] MOV
 437     temp1 ds-reg -1 bootstrap-cells [+] MOV
 438     temp3 ds-reg -2 bootstrap-cells [+] MOV
 439     ds-reg -2 bootstrap-cells [+] temp0 MOV
 440     ds-reg -1 bootstrap-cells [+] temp3 MOV
 441     ds-reg [] temp1 MOV
 442 ] \ -rot define-sub-primitive
 443
 444 [ jit->r ] \ load-local define-sub-primitive
 445
 446 ! Comparisons
 447 : jit-compare ( insn -- )
 448     ! load t
 449     temp3 0 MOV t rc-absolute-cell rel-literal
 450     ! load f
 451     temp1 \ f type-number MOV
 452     ! load first value
 453     temp0 ds-reg [] MOV
 454     ! adjust stack pointer
 455     ds-reg bootstrap-cell SUB
 456     ! compare with second value
 457     ds-reg [] temp0 CMP
 458     ! move t if true
 459     [ temp1 temp3 ] dip execute( dst src -- )
 460     ! store
 461     ds-reg [] temp1 MOV ;
 462
 463 : define-jit-compare ( insn word -- )
 464     [ [ jit-compare ] curry ] dip define-sub-primitive ;
 465
 466 \ CMOVE \ eq? define-jit-compare
 467 \ CMOVGE \ fixnum>= define-jit-compare
 468 \ CMOVLE \ fixnum<= define-jit-compare
 469 \ CMOVG \ fixnum> define-jit-compare
 470 \ CMOVL \ fixnum< define-jit-compare
 471
 472 ! Math
 473 : jit-math ( insn -- )
 474     ! load second input
 475     temp0 ds-reg [] MOV
 476     ! pop stack
 477     ds-reg bootstrap-cell SUB
 478     ! compute result
 479     [ ds-reg [] temp0 ] dip execute( dst src -- ) ;
 480
 481 [ \ ADD jit-math ] \ fixnum+fast define-sub-primitive
 482
 483 [ \ SUB jit-math ] \ fixnum-fast define-sub-primitive
 484
 485 [
 486     ! load second input
 487     temp0 ds-reg [] MOV
 488     ! pop stack
 489     ds-reg bootstrap-cell SUB
 490     ! load first input
 491     temp1 ds-reg [] MOV
 492     ! untag second input
 493     temp0 tag-bits get SAR
 494     ! multiply
 495     temp0 temp1 IMUL2
 496     ! push result
 497     ds-reg [] temp0 MOV
 498 ] \ fixnum*fast define-sub-primitive
 499
 500 [ \ AND jit-math ] \ fixnum-bitand define-sub-primitive
 501
 502 [ \ OR jit-math ] \ fixnum-bitor define-sub-primitive
 503
 504 [ \ XOR jit-math ] \ fixnum-bitxor define-sub-primitive
 505
 506 [
 507     ! complement
 508     ds-reg [] NOT
 509     ! clear tag bits
 510     ds-reg [] tag-mask get XOR
 511 ] \ fixnum-bitnot define-sub-primitive
 512
 513 [
 514     ! load shift count
 515     shift-arg ds-reg [] MOV
 516     ! untag shift count
 517     shift-arg tag-bits get SAR
 518     ! adjust stack pointer
 519     ds-reg bootstrap-cell SUB
 520     ! load value
 521     temp3 ds-reg [] MOV
 522     ! make a copy
 523     temp2 temp3 MOV
 524     ! compute positive shift value in temp2
 525     temp2 CL SHL
 526     shift-arg NEG
 527     ! compute negative shift value in temp3
 528     temp3 CL SAR
 529     temp3 tag-mask get bitnot AND
 530     shift-arg 0 CMP
 531     ! if shift count was negative, move temp0 to temp2
 532     temp2 temp3 CMOVGE
 533     ! push to stack
 534     ds-reg [] temp2 MOV
 535 ] \ fixnum-shift-fast define-sub-primitive
 536
 537 : jit-fixnum-/mod ( -- )
 538     ! load second parameter
 539     temp1 ds-reg [] MOV
 540     ! load first parameter
 541     div-arg ds-reg bootstrap-cell neg [+] MOV
 542     ! make a copy
 543     mod-arg div-arg MOV
 544     ! sign-extend
 545     mod-arg bootstrap-cell-bits 1 - SAR
 546     ! divide
 547     temp1 IDIV ;
 548
 549 [
 550     jit-fixnum-/mod
 551     ! adjust stack pointer
 552     ds-reg bootstrap-cell SUB
 553     ! push to stack
 554     ds-reg [] mod-arg MOV
 555 ] \ fixnum-mod define-sub-primitive
 556
 557 [
 558     jit-fixnum-/mod
 559     ! adjust stack pointer
 560     ds-reg bootstrap-cell SUB
 561     ! tag it
 562     div-arg tag-bits get SHL
 563     ! push to stack
 564     ds-reg [] div-arg MOV
 565 ] \ fixnum/i-fast define-sub-primitive
 566
 567 [
 568     jit-fixnum-/mod
 569     ! tag it
 570     div-arg tag-bits get SHL
 571     ! push to stack
 572     ds-reg [] mod-arg MOV
 573     ds-reg bootstrap-cell neg [+] div-arg MOV
 574 ] \ fixnum/mod-fast define-sub-primitive
 575
 576 [
 577     temp0 ds-reg [] MOV
 578     ds-reg bootstrap-cell SUB
 579     temp0 ds-reg [] OR
 580     temp0 tag-mask get TEST
 581     temp0 \ f type-number MOV
 582     temp1 1 tag-fixnum MOV
 583     temp0 temp1 CMOVE
 584     ds-reg [] temp0 MOV
 585 ] \ both-fixnums? define-sub-primitive
 586
 587 [
 588     ! load local number
 589     temp0 ds-reg [] MOV
 590     ! turn local number into offset
 591     fixnum>slot@
 592     ! load local value
 593     temp0 rs-reg temp0 [+] MOV
 594     ! push to stack
 595     ds-reg [] temp0 MOV
 596 ] \ get-local define-sub-primitive
 597
 598 [
 599     ! load local count
 600     temp0 ds-reg [] MOV
 601     ! adjust stack pointer
 602     ds-reg bootstrap-cell SUB
 603     ! turn local number into offset
 604     fixnum>slot@
 605     ! decrement retain stack pointer
 606     rs-reg temp0 SUB
 607 ] \ drop-locals define-sub-primitive
 608
 609 [ "bootstrap.x86" forget-vocab ] with-compilation-unit