basis/cpu/x86/bootstrap.factor

   1 ! Copyright (C) 2007, 2009 Slava Pestov.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: bootstrap.image.private kernel kernel.private namespaces system
   4 layouts compiler.units math math.private compiler.constants vocabs
   5 slots.private words locals.backend make sequences combinators arrays
   6  cpu.x86.assembler cpu.x86.assembler.operands ;
   7 IN: bootstrap.x86
   8
   9 big-endian off
  10
  11 [
  12     ! Load word
  13     temp0 0 MOV rc-absolute-cell rt-immediate jit-rel
  14     ! Bump profiling counter
  15     temp0 profile-count-offset [+] 1 tag-fixnum ADD
  16     ! Load word->code
  17     temp0 temp0 word-code-offset [+] MOV
  18     ! Compute word XT
  19     temp0 compiled-header-size ADD
  20     ! Jump to XT
  21     temp0 JMP
  22 ] jit-profiling jit-define
  23
  24 [
  25     ! load XT
  26     temp0 0 MOV rc-absolute-cell rt-this jit-rel
  27     ! save stack frame size
  28     stack-frame-size PUSH
  29     ! push XT
  30     temp0 PUSH
  31     ! alignment
  32     stack-reg stack-frame-size 3 bootstrap-cells - SUB
  33 ] jit-prolog jit-define
  34
  35 [
  36     ! load literal
  37     temp0 0 MOV rc-absolute-cell rt-immediate jit-rel
  38     ! increment datastack pointer
  39     ds-reg bootstrap-cell ADD
  40     ! store literal on datastack
  41     ds-reg [] temp0 MOV
  42 ] jit-push-immediate jit-define
  43
  44 [
  45     temp3 0 MOV rc-absolute-cell rt-here jit-rel
  46     0 JMP rc-relative rt-xt-pic-tail jit-rel
  47 ] jit-word-jump jit-define
  48
  49 [
  50     0 CALL rc-relative rt-xt-pic jit-rel
  51 ] jit-word-call jit-define
  52
  53 [
  54     0 JMP rc-relative rt-xt jit-rel
  55 ] jit-word-special jit-define
  56
  57 [
  58     ! load boolean
  59     temp0 ds-reg [] MOV
  60     ! pop boolean
  61     ds-reg bootstrap-cell SUB
  62     ! compare boolean with f
  63     temp0 \ f tag-number CMP
  64     ! jump to true branch if not equal
  65     0 JNE rc-relative rt-xt jit-rel
  66     ! jump to false branch if equal
  67     0 JMP rc-relative rt-xt jit-rel
  68 ] jit-if jit-define
  69
  70 : jit->r ( -- )
  71     rs-reg bootstrap-cell ADD
  72     temp0 ds-reg [] MOV
  73     ds-reg bootstrap-cell SUB
  74     rs-reg [] temp0 MOV ;
  75
  76 : jit-2>r ( -- )
  77     rs-reg 2 bootstrap-cells ADD
  78     temp0 ds-reg [] MOV
  79     temp1 ds-reg -1 bootstrap-cells [+] MOV
  80     ds-reg 2 bootstrap-cells SUB
  81     rs-reg [] temp0 MOV
  82     rs-reg -1 bootstrap-cells [+] temp1 MOV ;
  83
  84 : jit-3>r ( -- )
  85     rs-reg 3 bootstrap-cells ADD
  86     temp0 ds-reg [] MOV
  87     temp1 ds-reg -1 bootstrap-cells [+] MOV
  88     temp2 ds-reg -2 bootstrap-cells [+] MOV
  89     ds-reg 3 bootstrap-cells SUB
  90     rs-reg [] temp0 MOV
  91     rs-reg -1 bootstrap-cells [+] temp1 MOV
  92     rs-reg -2 bootstrap-cells [+] temp2 MOV ;
  93
  94 : jit-r> ( -- )
  95     ds-reg bootstrap-cell ADD
  96     temp0 rs-reg [] MOV
  97     rs-reg bootstrap-cell SUB
  98     ds-reg [] temp0 MOV ;
  99
 100 : jit-2r> ( -- )
 101     ds-reg 2 bootstrap-cells ADD
 102     temp0 rs-reg [] MOV
 103     temp1 rs-reg -1 bootstrap-cells [+] MOV
 104     rs-reg 2 bootstrap-cells SUB
 105     ds-reg [] temp0 MOV
 106     ds-reg -1 bootstrap-cells [+] temp1 MOV ;
 107
 108 : jit-3r> ( -- )
 109     ds-reg 3 bootstrap-cells ADD
 110     temp0 rs-reg [] MOV
 111     temp1 rs-reg -1 bootstrap-cells [+] MOV
 112     temp2 rs-reg -2 bootstrap-cells [+] MOV
 113     rs-reg 3 bootstrap-cells SUB
 114     ds-reg [] temp0 MOV
 115     ds-reg -1 bootstrap-cells [+] temp1 MOV
 116     ds-reg -2 bootstrap-cells [+] temp2 MOV ;
 117
 118 [
 119     jit->r
 120     0 CALL rc-relative rt-xt jit-rel
 121     jit-r>
 122 ] jit-dip jit-define
 123
 124 [
 125     jit-2>r
 126     0 CALL rc-relative rt-xt jit-rel
 127     jit-2r>
 128 ] jit-2dip jit-define
 129
 130 [
 131     jit-3>r
 132     0 CALL rc-relative rt-xt jit-rel
 133     jit-3r>
 134 ] jit-3dip jit-define
 135
 136 : prepare-(execute) ( -- operand )
 137     ! load from stack
 138     temp0 ds-reg [] MOV
 139     ! pop stack
 140     ds-reg bootstrap-cell SUB
 141     ! execute word
 142     temp0 word-xt-offset [+] ;
 143
 144 [ prepare-(execute) JMP ] jit-execute-jump jit-define
 145
 146 [ prepare-(execute) CALL ] jit-execute-call jit-define
 147
 148 [
 149     ! unwind stack frame
 150     stack-reg stack-frame-size bootstrap-cell - ADD
 151 ] jit-epilog jit-define
 152
 153 [ 0 RET ] jit-return jit-define
 154
 155 ! ! ! Polymorphic inline caches
 156
 157 ! The PIC and megamorphic code stubs are not permitted to touch temp3.
 158
 159 ! Load a value from a stack position
 160 [
 161     temp1 ds-reg HEX: ffffffff [+] MOV rc-absolute rt-untagged jit-rel
 162 ] pic-load jit-define
 163
 164 ! Tag
 165 : load-tag ( -- )
 166     temp1 tag-mask get AND
 167     temp1 tag-bits get SHL ;
 168
 169 [ load-tag ] pic-tag jit-define
 170
 171 ! The 'make' trick lets us compute the jump distance for the
 172 ! conditional branches there
 173
 174 ! Hi-tag
 175 [
 176     temp0 temp1 MOV
 177     load-tag
 178     temp1 object tag-number tag-fixnum CMP
 179     [ temp1 temp0 object tag-number neg [+] MOV ] { } make
 180     [ length JNE ] [ % ] bi
 181 ] pic-hi-tag jit-define
 182
 183 ! Tuple
 184 [
 185     temp0 temp1 MOV
 186     load-tag
 187     temp1 tuple tag-number tag-fixnum CMP
 188     [ temp1 temp0 tuple tag-number neg bootstrap-cell + [+] MOV ] { } make
 189     [ length JNE ] [ % ] bi
 190 ] pic-tuple jit-define
 191
 192 ! Hi-tag and tuple
 193 [
 194     temp0 temp1 MOV
 195     load-tag
 196     ! If bits 2 and 3 are set, the tag is either 6 (object) or 7 (tuple)
 197     temp1 BIN: 110 tag-fixnum CMP
 198     [
 199         ! Untag temp0
 200         temp0 tag-mask get bitnot AND
 201         ! Set temp1 to 0 for objects, and bootstrap-cell for tuples
 202         temp1 1 tag-fixnum AND
 203         bootstrap-cell 4 = [ temp1 1 SHR ] when
 204         ! Load header cell or tuple layout cell
 205         temp1 temp0 temp1 [+] MOV
 206     ] [ ] make [ length JL ] [ % ] bi
 207 ] pic-hi-tag-tuple jit-define
 208
 209 [
 210     temp1 HEX: ffffffff CMP rc-absolute rt-immediate jit-rel
 211 ] pic-check-tag jit-define
 212
 213 [
 214     temp2 HEX: ffffffff MOV rc-absolute-cell rt-immediate jit-rel
 215     temp1 temp2 CMP
 216 ] pic-check jit-define
 217
 218 [ 0 JE rc-relative rt-xt jit-rel ] pic-hit jit-define
 219
 220 ! ! ! Megamorphic caches
 221
 222 [
 223     ! cache = ...
 224     temp0 0 MOV rc-absolute-cell rt-immediate jit-rel
 225     ! key = class
 226     temp2 temp1 MOV
 227     bootstrap-cell 8 = [ temp2 1 SHL ] when
 228     ! key &= cache.length - 1
 229     temp2 mega-cache-size get 1 - bootstrap-cell * AND
 230     ! cache += array-start-offset
 231     temp0 array-start-offset ADD
 232     ! cache += key
 233     temp0 temp2 ADD
 234     ! if(get(cache) == class)
 235     temp0 [] temp1 CMP
 236     bootstrap-cell 4 = 14 22 ? JNE ! Yuck!
 237     ! megamorphic_cache_hits++
 238     temp1 0 MOV rc-absolute-cell rt-megamorphic-cache-hits jit-rel
 239     temp1 [] 1 ADD
 240     ! goto get(cache + bootstrap-cell)
 241     temp0 temp0 bootstrap-cell [+] MOV
 242     temp0 word-xt-offset [+] JMP
 243     ! fall-through on miss
 244 ] mega-lookup jit-define
 245
 246 ! ! ! Sub-primitives
 247
 248 ! Quotations and words
 249 [
 250     ! load from stack
 251     arg ds-reg [] MOV
 252     ! pop stack
 253     ds-reg bootstrap-cell SUB
 254     ! call quotation
 255     arg quot-xt-offset [+] JMP
 256 ] \ (call) define-sub-primitive
 257
 258 ! Objects
 259 [
 260     ! load from stack
 261     temp0 ds-reg [] MOV
 262     ! compute tag
 263     temp0 tag-mask get AND
 264     ! tag the tag
 265     temp0 tag-bits get SHL
 266     ! push to stack
 267     ds-reg [] temp0 MOV
 268 ] \ tag define-sub-primitive
 269
 270 [
 271     ! load slot number
 272     temp0 ds-reg [] MOV
 273     ! adjust stack pointer
 274     ds-reg bootstrap-cell SUB
 275     ! load object
 276     temp1 ds-reg [] MOV
 277     ! turn slot number into offset
 278     fixnum>slot@
 279     ! mask off tag
 280     temp1 tag-bits get SHR
 281     temp1 tag-bits get SHL
 282     ! load slot value
 283     temp0 temp1 temp0 [+] MOV
 284     ! push to stack
 285     ds-reg [] temp0 MOV
 286 ] \ slot define-sub-primitive
 287
 288 ! Shufflers
 289 [
 290     ds-reg bootstrap-cell SUB
 291 ] \ drop define-sub-primitive
 292
 293 [
 294     ds-reg 2 bootstrap-cells SUB
 295 ] \ 2drop define-sub-primitive
 296
 297 [
 298     ds-reg 3 bootstrap-cells SUB
 299 ] \ 3drop define-sub-primitive
 300
 301 [
 302     temp0 ds-reg [] MOV
 303     ds-reg bootstrap-cell ADD
 304     ds-reg [] temp0 MOV
 305 ] \ dup define-sub-primitive
 306
 307 [
 308     temp0 ds-reg [] MOV
 309     temp1 ds-reg bootstrap-cell neg [+] MOV
 310     ds-reg 2 bootstrap-cells ADD
 311     ds-reg [] temp0 MOV
 312     ds-reg bootstrap-cell neg [+] temp1 MOV
 313 ] \ 2dup define-sub-primitive
 314
 315 [
 316     temp0 ds-reg [] MOV
 317     temp1 ds-reg -1 bootstrap-cells [+] MOV
 318     temp3 ds-reg -2 bootstrap-cells [+] MOV
 319     ds-reg 3 bootstrap-cells ADD
 320     ds-reg [] temp0 MOV
 321     ds-reg -1 bootstrap-cells [+] temp1 MOV
 322     ds-reg -2 bootstrap-cells [+] temp3 MOV
 323 ] \ 3dup define-sub-primitive
 324
 325 [
 326     temp0 ds-reg [] MOV
 327     ds-reg bootstrap-cell SUB
 328     ds-reg [] temp0 MOV
 329 ] \ nip define-sub-primitive
 330
 331 [
 332     temp0 ds-reg [] MOV
 333     ds-reg 2 bootstrap-cells SUB
 334     ds-reg [] temp0 MOV
 335 ] \ 2nip define-sub-primitive
 336
 337 [
 338     temp0 ds-reg -1 bootstrap-cells [+] MOV
 339     ds-reg bootstrap-cell ADD
 340     ds-reg [] temp0 MOV
 341 ] \ over define-sub-primitive
 342
 343 [
 344     temp0 ds-reg -2 bootstrap-cells [+] MOV
 345     ds-reg bootstrap-cell ADD
 346     ds-reg [] temp0 MOV
 347 ] \ pick define-sub-primitive
 348
 349 [
 350     temp0 ds-reg [] MOV
 351     temp1 ds-reg -1 bootstrap-cells [+] MOV
 352     ds-reg [] temp1 MOV
 353     ds-reg bootstrap-cell ADD
 354     ds-reg [] temp0 MOV
 355 ] \ dupd define-sub-primitive
 356
 357 [
 358     temp0 ds-reg [] MOV
 359     temp1 ds-reg -1 bootstrap-cells [+] MOV
 360     ds-reg bootstrap-cell ADD
 361     ds-reg [] temp0 MOV
 362     ds-reg -1 bootstrap-cells [+] temp1 MOV
 363     ds-reg -2 bootstrap-cells [+] temp0 MOV
 364 ] \ tuck define-sub-primitive
 365
 366 [
 367     temp0 ds-reg [] MOV
 368     temp1 ds-reg bootstrap-cell neg [+] MOV
 369     ds-reg bootstrap-cell neg [+] temp0 MOV
 370     ds-reg [] temp1 MOV
 371 ] \ swap define-sub-primitive
 372
 373 [
 374     temp0 ds-reg -1 bootstrap-cells [+] MOV
 375     temp1 ds-reg -2 bootstrap-cells [+] MOV
 376     ds-reg -2 bootstrap-cells [+] temp0 MOV
 377     ds-reg -1 bootstrap-cells [+] temp1 MOV
 378 ] \ swapd define-sub-primitive
 379
 380 [
 381     temp0 ds-reg [] MOV
 382     temp1 ds-reg -1 bootstrap-cells [+] MOV
 383     temp3 ds-reg -2 bootstrap-cells [+] MOV
 384     ds-reg -2 bootstrap-cells [+] temp1 MOV
 385     ds-reg -1 bootstrap-cells [+] temp0 MOV
 386     ds-reg [] temp3 MOV
 387 ] \ rot define-sub-primitive
 388
 389 [
 390     temp0 ds-reg [] MOV
 391     temp1 ds-reg -1 bootstrap-cells [+] MOV
 392     temp3 ds-reg -2 bootstrap-cells [+] MOV
 393     ds-reg -2 bootstrap-cells [+] temp0 MOV
 394     ds-reg -1 bootstrap-cells [+] temp3 MOV
 395     ds-reg [] temp1 MOV
 396 ] \ -rot define-sub-primitive
 397
 398 [ jit->r ] \ load-local define-sub-primitive
 399
 400 ! Comparisons
 401 : jit-compare ( insn -- )
 402     ! load t
 403     temp3 0 MOV rc-absolute-cell rt-immediate jit-rel
 404     ! load f
 405     temp1 \ f tag-number MOV
 406     ! load first value
 407     temp0 ds-reg [] MOV
 408     ! adjust stack pointer
 409     ds-reg bootstrap-cell SUB
 410     ! compare with second value
 411     ds-reg [] temp0 CMP
 412     ! move t if true
 413     [ temp1 temp3 ] dip execute( dst src -- )
 414     ! store
 415     ds-reg [] temp1 MOV ;
 416
 417 : define-jit-compare ( insn word -- )
 418     [ [ jit-compare ] curry ] dip define-sub-primitive ;
 419
 420 \ CMOVE \ eq? define-jit-compare
 421 \ CMOVGE \ fixnum>= define-jit-compare
 422 \ CMOVLE \ fixnum<= define-jit-compare
 423 \ CMOVG \ fixnum> define-jit-compare
 424 \ CMOVL \ fixnum< define-jit-compare
 425
 426 ! Math
 427 : jit-math ( insn -- )
 428     ! load second input
 429     temp0 ds-reg [] MOV
 430     ! pop stack
 431     ds-reg bootstrap-cell SUB
 432     ! compute result
 433     [ ds-reg [] temp0 ] dip execute( dst src -- ) ;
 434
 435 [ \ ADD jit-math ] \ fixnum+fast define-sub-primitive
 436
 437 [ \ SUB jit-math ] \ fixnum-fast define-sub-primitive
 438
 439 [
 440     ! load second input
 441     temp0 ds-reg [] MOV
 442     ! pop stack
 443     ds-reg bootstrap-cell SUB
 444     ! load first input
 445     temp1 ds-reg [] MOV
 446     ! untag second input
 447     temp0 tag-bits get SAR
 448     ! multiply
 449     temp0 temp1 IMUL2
 450     ! push result
 451     ds-reg [] temp1 MOV
 452 ] \ fixnum*fast define-sub-primitive
 453
 454 [ \ AND jit-math ] \ fixnum-bitand define-sub-primitive
 455
 456 [ \ OR jit-math ] \ fixnum-bitor define-sub-primitive
 457
 458 [ \ XOR jit-math ] \ fixnum-bitxor define-sub-primitive
 459
 460 [
 461     ! complement
 462     ds-reg [] NOT
 463     ! clear tag bits
 464     ds-reg [] tag-mask get XOR
 465 ] \ fixnum-bitnot define-sub-primitive
 466
 467 [
 468     ! load shift count
 469     shift-arg ds-reg [] MOV
 470     ! untag shift count
 471     shift-arg tag-bits get SAR
 472     ! adjust stack pointer
 473     ds-reg bootstrap-cell SUB
 474     ! load value
 475     temp3 ds-reg [] MOV
 476     ! make a copy
 477     temp1 temp3 MOV
 478     ! compute positive shift value in temp1
 479     temp1 CL SHL
 480     shift-arg NEG
 481     ! compute negative shift value in temp3
 482     temp3 CL SAR
 483     temp3 tag-mask get bitnot AND
 484     shift-arg 0 CMP
 485     ! if shift count was negative, move temp0 to temp1
 486     temp1 temp3 CMOVGE
 487     ! push to stack
 488     ds-reg [] temp1 MOV
 489 ] \ fixnum-shift-fast define-sub-primitive
 490
 491 : jit-fixnum-/mod ( -- )
 492     ! load second parameter
 493     temp3 ds-reg [] MOV
 494     ! load first parameter
 495     div-arg ds-reg bootstrap-cell neg [+] MOV
 496     ! make a copy
 497     mod-arg div-arg MOV
 498     ! sign-extend
 499     mod-arg bootstrap-cell-bits 1 - SAR
 500     ! divide
 501     temp3 IDIV ;
 502
 503 [
 504     jit-fixnum-/mod
 505     ! adjust stack pointer
 506     ds-reg bootstrap-cell SUB
 507     ! push to stack
 508     ds-reg [] mod-arg MOV
 509 ] \ fixnum-mod define-sub-primitive
 510
 511 [
 512     jit-fixnum-/mod
 513     ! adjust stack pointer
 514     ds-reg bootstrap-cell SUB
 515     ! tag it
 516     div-arg tag-bits get SHL
 517     ! push to stack
 518     ds-reg [] div-arg MOV
 519 ] \ fixnum/i-fast define-sub-primitive
 520
 521 [
 522     jit-fixnum-/mod
 523     ! tag it
 524     div-arg tag-bits get SHL
 525     ! push to stack
 526     ds-reg [] mod-arg MOV
 527     ds-reg bootstrap-cell neg [+] div-arg MOV
 528 ] \ fixnum/mod-fast define-sub-primitive
 529
 530 [
 531     temp0 ds-reg [] MOV
 532     ds-reg bootstrap-cell SUB
 533     temp0 ds-reg [] OR
 534     temp0 tag-mask get AND
 535     temp0 \ f tag-number MOV
 536     temp1 1 tag-fixnum MOV
 537     temp0 temp1 CMOVE
 538     ds-reg [] temp0 MOV
 539 ] \ both-fixnums? define-sub-primitive
 540
 541 [
 542     ! load local number
 543     temp0 ds-reg [] MOV
 544     ! turn local number into offset
 545     fixnum>slot@
 546     ! load local value
 547     temp0 rs-reg temp0 [+] MOV
 548     ! push to stack
 549     ds-reg [] temp0 MOV
 550 ] \ get-local define-sub-primitive
 551
 552 [
 553     ! load local count
 554     temp0 ds-reg [] MOV
 555     ! adjust stack pointer
 556     ds-reg bootstrap-cell SUB
 557     ! turn local number into offset
 558     fixnum>slot@
 559     ! decrement retain stack pointer
 560     rs-reg temp0 SUB
 561 ] \ drop-locals define-sub-primitive
 562
 563 [ "bootstrap.x86" forget-vocab ] with-compilation-unit