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