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