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     arg1 ds-reg [] MOV
 252     ! pop stack
 253     ds-reg bootstrap-cell SUB
 254     ! pass vm pointer
 255     arg2 0 MOV 0 jit-literal rc-absolute-cell rt-vm jit-rel
 256     ! call quotation
 257     arg1 quot-xt-offset [+] JMP
 258 ] \ (call) define-sub-primitive
 259
 260 ! Objects
 261 [
 262     ! load from stack
 263     temp0 ds-reg [] MOV
 264     ! compute tag
 265     temp0 tag-mask get AND
 266     ! tag the tag
 267     temp0 tag-bits get SHL
 268     ! push to stack
 269     ds-reg [] temp0 MOV
 270 ] \ tag define-sub-primitive
 271
 272 [
 273     ! load slot number
 274     temp0 ds-reg [] MOV
 275     ! adjust stack pointer
 276     ds-reg bootstrap-cell SUB
 277     ! load object
 278     temp1 ds-reg [] MOV
 279     ! turn slot number into offset
 280     fixnum>slot@
 281     ! mask off tag
 282     temp1 tag-bits get SHR
 283     temp1 tag-bits get SHL
 284     ! load slot value
 285     temp0 temp1 temp0 [+] MOV
 286     ! push to stack
 287     ds-reg [] temp0 MOV
 288 ] \ slot define-sub-primitive
 289
 290 ! Shufflers
 291 [
 292     ds-reg bootstrap-cell SUB
 293 ] \ drop define-sub-primitive
 294
 295 [
 296     ds-reg 2 bootstrap-cells SUB
 297 ] \ 2drop define-sub-primitive
 298
 299 [
 300     ds-reg 3 bootstrap-cells SUB
 301 ] \ 3drop define-sub-primitive
 302
 303 [
 304     temp0 ds-reg [] MOV
 305     ds-reg bootstrap-cell ADD
 306     ds-reg [] temp0 MOV
 307 ] \ dup define-sub-primitive
 308
 309 [
 310     temp0 ds-reg [] MOV
 311     temp1 ds-reg bootstrap-cell neg [+] MOV
 312     ds-reg 2 bootstrap-cells ADD
 313     ds-reg [] temp0 MOV
 314     ds-reg bootstrap-cell neg [+] temp1 MOV
 315 ] \ 2dup define-sub-primitive
 316
 317 [
 318     temp0 ds-reg [] MOV
 319     temp1 ds-reg -1 bootstrap-cells [+] MOV
 320     temp3 ds-reg -2 bootstrap-cells [+] MOV
 321     ds-reg 3 bootstrap-cells ADD
 322     ds-reg [] temp0 MOV
 323     ds-reg -1 bootstrap-cells [+] temp1 MOV
 324     ds-reg -2 bootstrap-cells [+] temp3 MOV
 325 ] \ 3dup define-sub-primitive
 326
 327 [
 328     temp0 ds-reg [] MOV
 329     ds-reg bootstrap-cell SUB
 330     ds-reg [] temp0 MOV
 331 ] \ nip define-sub-primitive
 332
 333 [
 334     temp0 ds-reg [] MOV
 335     ds-reg 2 bootstrap-cells SUB
 336     ds-reg [] temp0 MOV
 337 ] \ 2nip define-sub-primitive
 338
 339 [
 340     temp0 ds-reg -1 bootstrap-cells [+] MOV
 341     ds-reg bootstrap-cell ADD
 342     ds-reg [] temp0 MOV
 343 ] \ over define-sub-primitive
 344
 345 [
 346     temp0 ds-reg -2 bootstrap-cells [+] MOV
 347     ds-reg bootstrap-cell ADD
 348     ds-reg [] temp0 MOV
 349 ] \ pick define-sub-primitive
 350
 351 [
 352     temp0 ds-reg [] MOV
 353     temp1 ds-reg -1 bootstrap-cells [+] MOV
 354     ds-reg [] temp1 MOV
 355     ds-reg bootstrap-cell ADD
 356     ds-reg [] temp0 MOV
 357 ] \ dupd define-sub-primitive
 358
 359 [
 360     temp0 ds-reg [] MOV
 361     temp1 ds-reg -1 bootstrap-cells [+] MOV
 362     ds-reg bootstrap-cell ADD
 363     ds-reg [] temp0 MOV
 364     ds-reg -1 bootstrap-cells [+] temp1 MOV
 365     ds-reg -2 bootstrap-cells [+] temp0 MOV
 366 ] \ tuck define-sub-primitive
 367
 368 [
 369     temp0 ds-reg [] MOV
 370     temp1 ds-reg bootstrap-cell neg [+] MOV
 371     ds-reg bootstrap-cell neg [+] temp0 MOV
 372     ds-reg [] temp1 MOV
 373 ] \ swap define-sub-primitive
 374
 375 [
 376     temp0 ds-reg -1 bootstrap-cells [+] MOV
 377     temp1 ds-reg -2 bootstrap-cells [+] MOV
 378     ds-reg -2 bootstrap-cells [+] temp0 MOV
 379     ds-reg -1 bootstrap-cells [+] temp1 MOV
 380 ] \ swapd 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 -2 bootstrap-cells [+] temp1 MOV
 387     ds-reg -1 bootstrap-cells [+] temp0 MOV
 388     ds-reg [] temp3 MOV
 389 ] \ rot define-sub-primitive
 390
 391 [
 392     temp0 ds-reg [] MOV
 393     temp1 ds-reg -1 bootstrap-cells [+] MOV
 394     temp3 ds-reg -2 bootstrap-cells [+] MOV
 395     ds-reg -2 bootstrap-cells [+] temp0 MOV
 396     ds-reg -1 bootstrap-cells [+] temp3 MOV
 397     ds-reg [] temp1 MOV
 398 ] \ -rot define-sub-primitive
 399
 400 [ jit->r ] \ load-local define-sub-primitive
 401
 402 ! Comparisons
 403 : jit-compare ( insn -- )
 404     ! load t
 405     t jit-literal
 406     temp3 0 MOV rc-absolute-cell rt-immediate jit-rel
 407     ! load f
 408     temp1 \ f tag-number MOV
 409     ! load first value
 410     temp0 ds-reg [] MOV
 411     ! adjust stack pointer
 412     ds-reg bootstrap-cell SUB
 413     ! compare with second value
 414     ds-reg [] temp0 CMP
 415     ! move t if true
 416     [ temp1 temp3 ] dip execute( dst src -- )
 417     ! store
 418     ds-reg [] temp1 MOV ;
 419
 420 : define-jit-compare ( insn word -- )
 421     [ [ jit-compare ] curry ] dip define-sub-primitive ;
 422
 423 \ CMOVE \ eq? define-jit-compare
 424 \ CMOVGE \ fixnum>= define-jit-compare
 425 \ CMOVLE \ fixnum<= define-jit-compare
 426 \ CMOVG \ fixnum> define-jit-compare
 427 \ CMOVL \ fixnum< define-jit-compare
 428
 429 ! Math
 430 : jit-math ( insn -- )
 431     ! load second input
 432     temp0 ds-reg [] MOV
 433     ! pop stack
 434     ds-reg bootstrap-cell SUB
 435     ! compute result
 436     [ ds-reg [] temp0 ] dip execute( dst src -- ) ;
 437
 438 [ \ ADD jit-math ] \ fixnum+fast define-sub-primitive
 439
 440 [ \ SUB jit-math ] \ fixnum-fast define-sub-primitive
 441
 442 [
 443     ! load second input
 444     temp0 ds-reg [] MOV
 445     ! pop stack
 446     ds-reg bootstrap-cell SUB
 447     ! load first input
 448     temp1 ds-reg [] MOV
 449     ! untag second input
 450     temp0 tag-bits get SAR
 451     ! multiply
 452     temp0 temp1 IMUL2
 453     ! push result
 454     ds-reg [] temp1 MOV
 455 ] \ fixnum*fast define-sub-primitive
 456
 457 [ \ AND jit-math ] \ fixnum-bitand define-sub-primitive
 458
 459 [ \ OR jit-math ] \ fixnum-bitor define-sub-primitive
 460
 461 [ \ XOR jit-math ] \ fixnum-bitxor define-sub-primitive
 462
 463 [
 464     ! complement
 465     ds-reg [] NOT
 466     ! clear tag bits
 467     ds-reg [] tag-mask get XOR
 468 ] \ fixnum-bitnot define-sub-primitive
 469
 470 [
 471     ! load shift count
 472     shift-arg ds-reg [] MOV
 473     ! untag shift count
 474     shift-arg tag-bits get SAR
 475     ! adjust stack pointer
 476     ds-reg bootstrap-cell SUB
 477     ! load value
 478     temp3 ds-reg [] MOV
 479     ! make a copy
 480     temp1 temp3 MOV
 481     ! compute positive shift value in temp1
 482     temp1 CL SHL
 483     shift-arg NEG
 484     ! compute negative shift value in temp3
 485     temp3 CL SAR
 486     temp3 tag-mask get bitnot AND
 487     shift-arg 0 CMP
 488     ! if shift count was negative, move temp0 to temp1
 489     temp1 temp3 CMOVGE
 490     ! push to stack
 491     ds-reg [] temp1 MOV
 492 ] \ fixnum-shift-fast define-sub-primitive
 493
 494 : jit-fixnum-/mod ( -- )
 495     ! load second parameter
 496     temp3 ds-reg [] MOV
 497     ! load first parameter
 498     div-arg ds-reg bootstrap-cell neg [+] MOV
 499     ! make a copy
 500     mod-arg div-arg MOV
 501     ! sign-extend
 502     mod-arg bootstrap-cell-bits 1 - SAR
 503     ! divide
 504     temp3 IDIV ;
 505
 506 [
 507     jit-fixnum-/mod
 508     ! adjust stack pointer
 509     ds-reg bootstrap-cell SUB
 510     ! push to stack
 511     ds-reg [] mod-arg MOV
 512 ] \ fixnum-mod define-sub-primitive
 513
 514 [
 515     jit-fixnum-/mod
 516     ! adjust stack pointer
 517     ds-reg bootstrap-cell SUB
 518     ! tag it
 519     div-arg tag-bits get SHL
 520     ! push to stack
 521     ds-reg [] div-arg MOV
 522 ] \ fixnum/i-fast define-sub-primitive
 523
 524 [
 525     jit-fixnum-/mod
 526     ! tag it
 527     div-arg tag-bits get SHL
 528     ! push to stack
 529     ds-reg [] mod-arg MOV
 530     ds-reg bootstrap-cell neg [+] div-arg MOV
 531 ] \ fixnum/mod-fast define-sub-primitive
 532
 533 [
 534     temp0 ds-reg [] MOV
 535     ds-reg bootstrap-cell SUB
 536     temp0 ds-reg [] OR
 537     temp0 tag-mask get AND
 538     temp0 \ f tag-number MOV
 539     temp1 1 tag-fixnum MOV
 540     temp0 temp1 CMOVE
 541     ds-reg [] temp0 MOV
 542 ] \ both-fixnums? define-sub-primitive
 543
 544 [
 545     ! load local number
 546     temp0 ds-reg [] MOV
 547     ! turn local number into offset
 548     fixnum>slot@
 549     ! load local value
 550     temp0 rs-reg temp0 [+] MOV
 551     ! push to stack
 552     ds-reg [] temp0 MOV
 553 ] \ get-local define-sub-primitive
 554
 555 [
 556     ! load local count
 557     temp0 ds-reg [] MOV
 558     ! adjust stack pointer
 559     ds-reg bootstrap-cell SUB
 560     ! turn local number into offset
 561     fixnum>slot@
 562     ! decrement retain stack pointer
 563     rs-reg temp0 SUB
 564 ] \ drop-locals define-sub-primitive
 565
 566 [ "bootstrap.x86" forget-vocab ] with-compilation-unit