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