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