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