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     0xffff 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 : jit-signal-handler-prolog ( -- )
  97     ! minus a cell each for flags, return address
  98     ! use LEA so we don't dirty flags
  99     stack-reg stack-reg signal-handler-stack-frame-size
 100     2 bootstrap-cells - neg [+] LEA
 101
 102     signal-handler-save-regs
 103     [| r i | stack-reg i bootstrap-cells [+] r MOV ] each-index
 104
 105     PUSHF
 106
 107     jit-load-vm ;
 108
 109 : jit-signal-handler-epilog ( -- )
 110     POPF
 111
 112     signal-handler-save-regs
 113     [| r i | r stack-reg i bootstrap-cells [+] MOV ] each-index
 114
 115     stack-reg stack-reg signal-handler-stack-frame-size
 116     2 bootstrap-cells - [+] LEA ;
 117
 118 [| |
 119     jit-signal-handler-prolog
 120     jit-save-context
 121     temp0 vm-reg vm-signal-handler-addr-offset [+] MOV
 122     temp0 CALL
 123     jit-signal-handler-epilog
 124     0 RET
 125 ] \ signal-handler define-sub-primitive
 126
 127 [| |
 128     jit-signal-handler-prolog
 129     jit-save-context
 130     temp0 vm-reg vm-signal-handler-addr-offset [+] MOV
 131     temp0 CALL
 132     jit-signal-handler-epilog
 133     ! Pop the fake leaf frame along with our return address
 134     leaf-stack-frame-size bootstrap-cell - RET
 135 ] \ leaf-signal-handler define-sub-primitive
 136
 137 [| |
 138     jit-signal-handler-prolog
 139     temp0 vm-reg vm-signal-handler-addr-offset [+] MOV
 140     temp0 CALL
 141     jit-signal-handler-epilog
 142     red-zone-size RET
 143 ] \ ffi-signal-handler define-sub-primitive
 144
 145 [| |
 146     jit-signal-handler-prolog
 147     temp0 vm-reg vm-signal-handler-addr-offset [+] MOV
 148     temp0 CALL
 149     jit-signal-handler-epilog
 150     red-zone-size 16 bootstrap-cell - + RET
 151 ] \ ffi-leaf-signal-handler define-sub-primitive
 152
 153 [
 154     ! load boolean
 155     temp0 ds-reg [] MOV
 156     ! pop boolean
 157     ds-reg bootstrap-cell SUB
 158     ! compare boolean with f
 159     temp0 \ f type-number CMP
 160     ! jump to true branch if not equal
 161     0 JNE f rc-relative rel-word
 162     ! jump to false branch if equal
 163     0 JMP f rc-relative rel-word
 164 ] jit-if jit-define
 165
 166 : jit->r ( -- )
 167     rs-reg bootstrap-cell ADD
 168     temp0 ds-reg [] MOV
 169     ds-reg bootstrap-cell SUB
 170     rs-reg [] temp0 MOV ;
 171
 172 : jit-2>r ( -- )
 173     rs-reg 2 bootstrap-cells ADD
 174     temp0 ds-reg [] MOV
 175     temp1 ds-reg -1 bootstrap-cells [+] MOV
 176     ds-reg 2 bootstrap-cells SUB
 177     rs-reg [] temp0 MOV
 178     rs-reg -1 bootstrap-cells [+] temp1 MOV ;
 179
 180 : jit-3>r ( -- )
 181     rs-reg 3 bootstrap-cells ADD
 182     temp0 ds-reg [] MOV
 183     temp1 ds-reg -1 bootstrap-cells [+] MOV
 184     temp2 ds-reg -2 bootstrap-cells [+] MOV
 185     ds-reg 3 bootstrap-cells SUB
 186     rs-reg [] temp0 MOV
 187     rs-reg -1 bootstrap-cells [+] temp1 MOV
 188     rs-reg -2 bootstrap-cells [+] temp2 MOV ;
 189
 190 : jit-r> ( -- )
 191     ds-reg bootstrap-cell ADD
 192     temp0 rs-reg [] MOV
 193     rs-reg bootstrap-cell SUB
 194     ds-reg [] temp0 MOV ;
 195
 196 : jit-2r> ( -- )
 197     ds-reg 2 bootstrap-cells ADD
 198     temp0 rs-reg [] MOV
 199     temp1 rs-reg -1 bootstrap-cells [+] MOV
 200     rs-reg 2 bootstrap-cells SUB
 201     ds-reg [] temp0 MOV
 202     ds-reg -1 bootstrap-cells [+] temp1 MOV ;
 203
 204 : jit-3r> ( -- )
 205     ds-reg 3 bootstrap-cells ADD
 206     temp0 rs-reg [] MOV
 207     temp1 rs-reg -1 bootstrap-cells [+] MOV
 208     temp2 rs-reg -2 bootstrap-cells [+] MOV
 209     rs-reg 3 bootstrap-cells SUB
 210     ds-reg [] temp0 MOV
 211     ds-reg -1 bootstrap-cells [+] temp1 MOV
 212     ds-reg -2 bootstrap-cells [+] temp2 MOV ;
 213
 214 [
 215     jit->r
 216     0 CALL f rc-relative rel-word
 217     jit-r>
 218 ] jit-dip jit-define
 219
 220 [
 221     jit-2>r
 222     0 CALL f rc-relative rel-word
 223     jit-2r>
 224 ] jit-2dip jit-define
 225
 226 [
 227     jit-3>r
 228     0 CALL f rc-relative rel-word
 229     jit-3r>
 230 ] jit-3dip jit-define
 231
 232 [
 233     ! load from stack
 234     temp0 ds-reg [] MOV
 235     ! pop stack
 236     ds-reg bootstrap-cell SUB
 237 ]
 238 [ temp0 word-entry-point-offset [+] CALL ]
 239 [ temp0 word-entry-point-offset [+] JMP ]
 240 \ (execute) define-combinator-primitive
 241
 242 [
 243     temp0 ds-reg [] MOV
 244     ds-reg bootstrap-cell SUB
 245     temp0 word-entry-point-offset [+] JMP
 246 ] jit-execute jit-define
 247
 248 [
 249     stack-reg stack-frame-size bootstrap-cell - SUB
 250 ] jit-prolog jit-define
 251
 252 [
 253     stack-reg stack-frame-size bootstrap-cell - ADD
 254 ] jit-epilog jit-define
 255
 256 [ 0 RET ] jit-return jit-define
 257
 258 ! ! ! Polymorphic inline caches
 259
 260 ! The PIC stubs are not permitted to touch pic-tail-reg.
 261
 262 ! Load a value from a stack position
 263 [
 264     temp1 ds-reg 0x7f [+] MOV f rc-absolute-1 rel-untagged
 265 ] pic-load jit-define
 266
 267 [ temp1 tag-mask get AND ] pic-tag jit-define
 268
 269 [
 270     temp0 temp1 MOV
 271     temp1 tag-mask get AND
 272     temp1 tuple type-number CMP
 273     [ JNE ]
 274     [ temp1 temp0 tuple-class-offset [+] MOV ]
 275     jit-conditional
 276 ] pic-tuple jit-define
 277
 278 [
 279     temp1 0x7f CMP f rc-absolute-1 rel-untagged
 280 ] pic-check-tag jit-define
 281
 282 [ 0 JE f rc-relative rel-word ] pic-hit jit-define
 283
 284 ! ! ! Megamorphic caches
 285
 286 [
 287     ! class = ...
 288     temp0 temp1 MOV
 289     temp1 tag-mask get AND
 290     temp1 tag-bits get SHL
 291     temp1 tuple type-number tag-fixnum CMP
 292     [ JNE ]
 293     [ temp1 temp0 tuple-class-offset [+] MOV ]
 294     jit-conditional
 295     ! cache = ...
 296     temp0 0 MOV f rc-absolute-cell rel-literal
 297     ! key = hashcode(class)
 298     temp2 temp1 MOV
 299     bootstrap-cell 4 = [ temp2 1 SHR ] when
 300     ! key &= cache.length - 1
 301     temp2 mega-cache-size get 1 - bootstrap-cell * AND
 302     ! cache += array-start-offset
 303     temp0 array-start-offset ADD
 304     ! cache += key
 305     temp0 temp2 ADD
 306     ! if(get(cache) == class)
 307     temp0 [] temp1 CMP
 308     [ JNE ]
 309     [
 310         ! megamorphic_cache_hits++
 311         temp1 0 MOV rc-absolute-cell rel-megamorphic-cache-hits
 312         temp1 [] 1 ADD
 313         ! goto get(cache + bootstrap-cell)
 314         temp0 temp0 bootstrap-cell [+] MOV
 315         temp0 word-entry-point-offset [+] JMP
 316         ! fall-through on miss
 317     ] jit-conditional
 318 ] mega-lookup jit-define
 319
 320 ! ! ! Sub-primitives
 321
 322 ! Objects
 323 [
 324     ! load from stack
 325     temp0 ds-reg [] MOV
 326     ! compute tag
 327     temp0 tag-mask get AND
 328     ! tag the tag
 329     temp0 tag-bits get SHL
 330     ! push to stack
 331     ds-reg [] temp0 MOV
 332 ] \ tag define-sub-primitive
 333
 334 [
 335     ! load slot number
 336     temp0 ds-reg [] MOV
 337     ! adjust stack pointer
 338     ds-reg bootstrap-cell SUB
 339     ! load object
 340     temp1 ds-reg [] MOV
 341     ! turn slot number into offset
 342     fixnum>slot@
 343     ! mask off tag
 344     temp1 tag-bits get SHR
 345     temp1 tag-bits get SHL
 346     ! load slot value
 347     temp0 temp1 temp0 [+] MOV
 348     ! push to stack
 349     ds-reg [] temp0 MOV
 350 ] \ slot define-sub-primitive
 351
 352 [
 353     ! load string index from stack
 354     temp0 ds-reg bootstrap-cell neg [+] MOV
 355     temp0 tag-bits get SHR
 356     ! load string from stack
 357     temp1 ds-reg [] MOV
 358     ! load character
 359     temp0 8-bit-version-of temp0 temp1 string-offset [++] MOV
 360     temp0 temp0 8-bit-version-of MOVZX
 361     temp0 tag-bits get SHL
 362     ! store character to stack
 363     ds-reg bootstrap-cell SUB
 364     ds-reg [] temp0 MOV
 365 ] \ string-nth-fast define-sub-primitive
 366
 367 ! Shufflers
 368 [
 369     ds-reg bootstrap-cell SUB
 370 ] \ drop define-sub-primitive
 371
 372 [
 373     ds-reg 2 bootstrap-cells SUB
 374 ] \ 2drop define-sub-primitive
 375
 376 [
 377     ds-reg 3 bootstrap-cells SUB
 378 ] \ 3drop define-sub-primitive
 379
 380 [
 381     temp0 ds-reg [] MOV
 382     ds-reg bootstrap-cell ADD
 383     ds-reg [] temp0 MOV
 384 ] \ dup define-sub-primitive
 385
 386 [
 387     temp0 ds-reg [] MOV
 388     temp1 ds-reg bootstrap-cell neg [+] MOV
 389     ds-reg 2 bootstrap-cells ADD
 390     ds-reg [] temp0 MOV
 391     ds-reg bootstrap-cell neg [+] temp1 MOV
 392 ] \ 2dup define-sub-primitive
 393
 394 [
 395     temp0 ds-reg [] MOV
 396     temp1 ds-reg -1 bootstrap-cells [+] MOV
 397     temp3 ds-reg -2 bootstrap-cells [+] MOV
 398     ds-reg 3 bootstrap-cells ADD
 399     ds-reg [] temp0 MOV
 400     ds-reg -1 bootstrap-cells [+] temp1 MOV
 401     ds-reg -2 bootstrap-cells [+] temp3 MOV
 402 ] \ 3dup define-sub-primitive
 403
 404 [
 405     temp0 ds-reg [] MOV
 406     ds-reg bootstrap-cell SUB
 407     ds-reg [] temp0 MOV
 408 ] \ nip define-sub-primitive
 409
 410 [
 411     temp0 ds-reg [] MOV
 412     ds-reg 2 bootstrap-cells SUB
 413     ds-reg [] temp0 MOV
 414 ] \ 2nip define-sub-primitive
 415
 416 [
 417     temp0 ds-reg -1 bootstrap-cells [+] MOV
 418     ds-reg bootstrap-cell ADD
 419     ds-reg [] temp0 MOV
 420 ] \ over define-sub-primitive
 421
 422 [
 423     temp0 ds-reg -2 bootstrap-cells [+] MOV
 424     ds-reg bootstrap-cell ADD
 425     ds-reg [] temp0 MOV
 426 ] \ pick define-sub-primitive
 427
 428 [
 429     temp0 ds-reg [] MOV
 430     temp1 ds-reg -1 bootstrap-cells [+] MOV
 431     ds-reg [] temp1 MOV
 432     ds-reg bootstrap-cell ADD
 433     ds-reg [] temp0 MOV
 434 ] \ dupd define-sub-primitive
 435
 436 [
 437     temp0 ds-reg [] MOV
 438     temp1 ds-reg bootstrap-cell neg [+] MOV
 439     ds-reg bootstrap-cell neg [+] temp0 MOV
 440     ds-reg [] temp1 MOV
 441 ] \ swap define-sub-primitive
 442
 443 [
 444     temp0 ds-reg -1 bootstrap-cells [+] MOV
 445     temp1 ds-reg -2 bootstrap-cells [+] MOV
 446     ds-reg -2 bootstrap-cells [+] temp0 MOV
 447     ds-reg -1 bootstrap-cells [+] temp1 MOV
 448 ] \ swapd define-sub-primitive
 449
 450 [
 451     temp0 ds-reg [] MOV
 452     temp1 ds-reg -1 bootstrap-cells [+] MOV
 453     temp3 ds-reg -2 bootstrap-cells [+] MOV
 454     ds-reg -2 bootstrap-cells [+] temp1 MOV
 455     ds-reg -1 bootstrap-cells [+] temp0 MOV
 456     ds-reg [] temp3 MOV
 457 ] \ rot define-sub-primitive
 458
 459 [
 460     temp0 ds-reg [] MOV
 461     temp1 ds-reg -1 bootstrap-cells [+] MOV
 462     temp3 ds-reg -2 bootstrap-cells [+] MOV
 463     ds-reg -2 bootstrap-cells [+] temp0 MOV
 464     ds-reg -1 bootstrap-cells [+] temp3 MOV
 465     ds-reg [] temp1 MOV
 466 ] \ -rot define-sub-primitive
 467
 468 [ jit->r ] \ load-local define-sub-primitive
 469
 470 ! Comparisons
 471 : jit-compare ( insn -- )
 472     ! load t
 473     temp3 0 MOV t rc-absolute-cell rel-literal
 474     ! load f
 475     temp1 \ f type-number MOV
 476     ! load first value
 477     temp0 ds-reg [] MOV
 478     ! adjust stack pointer
 479     ds-reg bootstrap-cell SUB
 480     ! compare with second value
 481     ds-reg [] temp0 CMP
 482     ! move t if true
 483     [ temp1 temp3 ] dip execute( dst src -- )
 484     ! store
 485     ds-reg [] temp1 MOV ;
 486
 487 : define-jit-compare ( insn word -- )
 488     [ [ jit-compare ] curry ] dip define-sub-primitive ;
 489
 490 \ CMOVE \ eq? define-jit-compare
 491 \ CMOVGE \ fixnum>= define-jit-compare
 492 \ CMOVLE \ fixnum<= define-jit-compare
 493 \ CMOVG \ fixnum> define-jit-compare
 494 \ CMOVL \ fixnum< define-jit-compare
 495
 496 ! Math
 497 : jit-math ( insn -- )
 498     ! load second input
 499     temp0 ds-reg [] MOV
 500     ! pop stack
 501     ds-reg bootstrap-cell SUB
 502     ! compute result
 503     [ ds-reg [] temp0 ] dip execute( dst src -- ) ;
 504
 505 [ \ ADD jit-math ] \ fixnum+fast define-sub-primitive
 506
 507 [ \ SUB jit-math ] \ fixnum-fast define-sub-primitive
 508
 509 [
 510     ! load second input
 511     temp0 ds-reg [] MOV
 512     ! pop stack
 513     ds-reg bootstrap-cell SUB
 514     ! load first input
 515     temp1 ds-reg [] MOV
 516     ! untag second input
 517     temp0 tag-bits get SAR
 518     ! multiply
 519     temp0 temp1 IMUL2
 520     ! push result
 521     ds-reg [] temp0 MOV
 522 ] \ fixnum*fast define-sub-primitive
 523
 524 [ \ AND jit-math ] \ fixnum-bitand define-sub-primitive
 525
 526 [ \ OR jit-math ] \ fixnum-bitor define-sub-primitive
 527
 528 [ \ XOR jit-math ] \ fixnum-bitxor define-sub-primitive
 529
 530 [
 531     ! complement
 532     ds-reg [] NOT
 533     ! clear tag bits
 534     ds-reg [] tag-mask get XOR
 535 ] \ fixnum-bitnot define-sub-primitive
 536
 537 [
 538     ! load shift count
 539     shift-arg ds-reg [] MOV
 540     ! untag shift count
 541     shift-arg tag-bits get SAR
 542     ! adjust stack pointer
 543     ds-reg bootstrap-cell SUB
 544     ! load value
 545     temp3 ds-reg [] MOV
 546     ! make a copy
 547     temp2 temp3 MOV
 548     ! compute positive shift value in temp2
 549     temp2 CL SHL
 550     shift-arg NEG
 551     ! compute negative shift value in temp3
 552     temp3 CL SAR
 553     temp3 tag-mask get bitnot AND
 554     shift-arg 0 CMP
 555     ! if shift count was negative, move temp0 to temp2
 556     temp2 temp3 CMOVGE
 557     ! push to stack
 558     ds-reg [] temp2 MOV
 559 ] \ fixnum-shift-fast define-sub-primitive
 560
 561 : jit-fixnum-/mod ( -- )
 562     ! load second parameter
 563     temp1 ds-reg [] MOV
 564     ! load first parameter
 565     div-arg ds-reg bootstrap-cell neg [+] MOV
 566     ! make a copy
 567     mod-arg div-arg MOV
 568     ! sign-extend
 569     mod-arg bootstrap-cell-bits 1 - SAR
 570     ! divide
 571     temp1 IDIV ;
 572
 573 [
 574     jit-fixnum-/mod
 575     ! adjust stack pointer
 576     ds-reg bootstrap-cell SUB
 577     ! push to stack
 578     ds-reg [] mod-arg MOV
 579 ] \ fixnum-mod define-sub-primitive
 580
 581 [
 582     jit-fixnum-/mod
 583     ! adjust stack pointer
 584     ds-reg bootstrap-cell SUB
 585     ! tag it
 586     div-arg tag-bits get SHL
 587     ! push to stack
 588     ds-reg [] div-arg MOV
 589 ] \ fixnum/i-fast define-sub-primitive
 590
 591 [
 592     jit-fixnum-/mod
 593     ! tag it
 594     div-arg tag-bits get SHL
 595     ! push to stack
 596     ds-reg [] mod-arg MOV
 597     ds-reg bootstrap-cell neg [+] div-arg MOV
 598 ] \ fixnum/mod-fast define-sub-primitive
 599
 600 [
 601     temp0 ds-reg [] MOV
 602     ds-reg bootstrap-cell SUB
 603     temp0 ds-reg [] OR
 604     temp0 tag-mask get TEST
 605     temp0 \ f type-number MOV
 606     temp1 1 tag-fixnum MOV
 607     temp0 temp1 CMOVE
 608     ds-reg [] temp0 MOV
 609 ] \ both-fixnums? define-sub-primitive
 610
 611 [
 612     ! load local number
 613     temp0 ds-reg [] MOV
 614     ! turn local number into offset
 615     fixnum>slot@
 616     ! load local value
 617     temp0 rs-reg temp0 [+] MOV
 618     ! push to stack
 619     ds-reg [] temp0 MOV
 620 ] \ get-local define-sub-primitive
 621
 622 [
 623     ! load local count
 624     temp0 ds-reg [] MOV
 625     ! adjust stack pointer
 626     ds-reg bootstrap-cell SUB
 627     ! turn local number into offset
 628     fixnum>slot@
 629     ! decrement retain stack pointer
 630     rs-reg temp0 SUB
 631 ] \ drop-locals define-sub-primitive
 632
 633 [ "bootstrap.x86" forget-vocab ] with-compilation-unit