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 compiler.constants
   4 compiler.units cpu.x86.assembler cpu.x86.assembler.operands
   5 kernel kernel.private layouts locals.backend make math
   6 math.private namespaces sequences slots.private vocabs ;
   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 type-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 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 ! Tuple
 175 [
 176     temp0 temp1 MOV
 177     load-tag
 178     temp1 tuple type-number tag-fixnum CMP
 179     [ temp1 temp0 tuple type-number neg bootstrap-cell + [+] MOV ] { } make
 180     [ length JNE ] [ % ] bi
 181 ] pic-tuple jit-define
 182
 183 [
 184     temp1 HEX: ffffffff CMP rc-absolute rt-immediate jit-rel
 185 ] pic-check-tag jit-define
 186
 187 [
 188     temp2 HEX: ffffffff MOV rc-absolute-cell rt-immediate jit-rel
 189     temp1 temp2 CMP
 190 ] pic-check-tuple jit-define
 191
 192 [ 0 JE rc-relative rt-xt jit-rel ] pic-hit jit-define
 193
 194 ! ! ! Megamorphic caches
 195
 196 [
 197     ! cache = ...
 198     temp0 0 MOV rc-absolute-cell rt-immediate jit-rel
 199     ! key = hashcode(class)
 200     temp2 temp1 MOV
 201     bootstrap-cell 4 = [ temp2 1 SHR ] when
 202     ! key &= cache.length - 1
 203     temp2 mega-cache-size get 1 - bootstrap-cell * AND
 204     ! cache += array-start-offset
 205     temp0 array-start-offset ADD
 206     ! cache += key
 207     temp0 temp2 ADD
 208     ! if(get(cache) == class)
 209     temp0 [] temp1 CMP
 210     bootstrap-cell 4 = 14 22 ? JNE ! Yuck!
 211     ! megamorphic_cache_hits++
 212     temp1 0 MOV rc-absolute-cell rt-megamorphic-cache-hits jit-rel
 213     temp1 [] 1 ADD
 214     ! goto get(cache + bootstrap-cell)
 215     temp0 temp0 bootstrap-cell [+] MOV
 216     temp0 word-xt-offset [+] JMP
 217     ! fall-through on miss
 218 ] mega-lookup jit-define
 219
 220 [
 221     safe-reg 0 MOV rc-absolute-cell rt-xt jit-rel
 222     safe-reg JMP
 223 ] callback-stub jit-define
 224
 225 ! ! ! Sub-primitives
 226
 227 ! Quotations and words
 228 [
 229     ! load from stack
 230     arg1 ds-reg [] MOV
 231     ! pop stack
 232     ds-reg bootstrap-cell SUB
 233     ! pass vm pointer
 234     arg2 0 MOV 0 jit-literal rc-absolute-cell rt-vm jit-rel
 235     ! call quotation
 236     arg1 quot-xt-offset [+] JMP
 237 ] \ (call) define-sub-primitive
 238
 239 ! Objects
 240 [
 241     ! load from stack
 242     temp0 ds-reg [] MOV
 243     ! compute tag
 244     temp0 tag-mask get AND
 245     ! tag the tag
 246     temp0 tag-bits get SHL
 247     ! push to stack
 248     ds-reg [] temp0 MOV
 249 ] \ tag define-sub-primitive
 250
 251 [
 252     ! load slot number
 253     temp0 ds-reg [] MOV
 254     ! adjust stack pointer
 255     ds-reg bootstrap-cell SUB
 256     ! load object
 257     temp1 ds-reg [] MOV
 258     ! turn slot number into offset
 259     fixnum>slot@
 260     ! mask off tag
 261     temp1 tag-bits get SHR
 262     temp1 tag-bits get SHL
 263     ! load slot value
 264     temp0 temp1 temp0 [+] MOV
 265     ! push to stack
 266     ds-reg [] temp0 MOV
 267 ] \ slot define-sub-primitive
 268
 269 ! Shufflers
 270 [
 271     ds-reg bootstrap-cell SUB
 272 ] \ drop define-sub-primitive
 273
 274 [
 275     ds-reg 2 bootstrap-cells SUB
 276 ] \ 2drop define-sub-primitive
 277
 278 [
 279     ds-reg 3 bootstrap-cells SUB
 280 ] \ 3drop define-sub-primitive
 281
 282 [
 283     temp0 ds-reg [] MOV
 284     ds-reg bootstrap-cell ADD
 285     ds-reg [] temp0 MOV
 286 ] \ dup define-sub-primitive
 287
 288 [
 289     temp0 ds-reg [] MOV
 290     temp1 ds-reg bootstrap-cell neg [+] MOV
 291     ds-reg 2 bootstrap-cells ADD
 292     ds-reg [] temp0 MOV
 293     ds-reg bootstrap-cell neg [+] temp1 MOV
 294 ] \ 2dup define-sub-primitive
 295
 296 [
 297     temp0 ds-reg [] MOV
 298     temp1 ds-reg -1 bootstrap-cells [+] MOV
 299     temp3 ds-reg -2 bootstrap-cells [+] MOV
 300     ds-reg 3 bootstrap-cells ADD
 301     ds-reg [] temp0 MOV
 302     ds-reg -1 bootstrap-cells [+] temp1 MOV
 303     ds-reg -2 bootstrap-cells [+] temp3 MOV
 304 ] \ 3dup define-sub-primitive
 305
 306 [
 307     temp0 ds-reg [] MOV
 308     ds-reg bootstrap-cell SUB
 309     ds-reg [] temp0 MOV
 310 ] \ nip define-sub-primitive
 311
 312 [
 313     temp0 ds-reg [] MOV
 314     ds-reg 2 bootstrap-cells SUB
 315     ds-reg [] temp0 MOV
 316 ] \ 2nip define-sub-primitive
 317
 318 [
 319     temp0 ds-reg -1 bootstrap-cells [+] MOV
 320     ds-reg bootstrap-cell ADD
 321     ds-reg [] temp0 MOV
 322 ] \ over define-sub-primitive
 323
 324 [
 325     temp0 ds-reg -2 bootstrap-cells [+] MOV
 326     ds-reg bootstrap-cell ADD
 327     ds-reg [] temp0 MOV
 328 ] \ pick define-sub-primitive
 329
 330 [
 331     temp0 ds-reg [] MOV
 332     temp1 ds-reg -1 bootstrap-cells [+] MOV
 333     ds-reg [] temp1 MOV
 334     ds-reg bootstrap-cell ADD
 335     ds-reg [] temp0 MOV
 336 ] \ dupd define-sub-primitive
 337
 338 [
 339     temp0 ds-reg [] MOV
 340     temp1 ds-reg -1 bootstrap-cells [+] MOV
 341     ds-reg bootstrap-cell ADD
 342     ds-reg [] temp0 MOV
 343     ds-reg -1 bootstrap-cells [+] temp1 MOV
 344     ds-reg -2 bootstrap-cells [+] temp0 MOV
 345 ] \ tuck define-sub-primitive
 346
 347 [
 348     temp0 ds-reg [] MOV
 349     temp1 ds-reg bootstrap-cell neg [+] MOV
 350     ds-reg bootstrap-cell neg [+] temp0 MOV
 351     ds-reg [] temp1 MOV
 352 ] \ swap define-sub-primitive
 353
 354 [
 355     temp0 ds-reg -1 bootstrap-cells [+] MOV
 356     temp1 ds-reg -2 bootstrap-cells [+] MOV
 357     ds-reg -2 bootstrap-cells [+] temp0 MOV
 358     ds-reg -1 bootstrap-cells [+] temp1 MOV
 359 ] \ swapd define-sub-primitive
 360
 361 [
 362     temp0 ds-reg [] MOV
 363     temp1 ds-reg -1 bootstrap-cells [+] MOV
 364     temp3 ds-reg -2 bootstrap-cells [+] MOV
 365     ds-reg -2 bootstrap-cells [+] temp1 MOV
 366     ds-reg -1 bootstrap-cells [+] temp0 MOV
 367     ds-reg [] temp3 MOV
 368 ] \ rot define-sub-primitive
 369
 370 [
 371     temp0 ds-reg [] MOV
 372     temp1 ds-reg -1 bootstrap-cells [+] MOV
 373     temp3 ds-reg -2 bootstrap-cells [+] MOV
 374     ds-reg -2 bootstrap-cells [+] temp0 MOV
 375     ds-reg -1 bootstrap-cells [+] temp3 MOV
 376     ds-reg [] temp1 MOV
 377 ] \ -rot define-sub-primitive
 378
 379 [ jit->r ] \ load-local define-sub-primitive
 380
 381 ! Comparisons
 382 : jit-compare ( insn -- )
 383     ! load t
 384     t jit-literal
 385     temp3 0 MOV rc-absolute-cell rt-immediate jit-rel
 386     ! load f
 387     temp1 \ f type-number MOV
 388     ! load first value
 389     temp0 ds-reg [] MOV
 390     ! adjust stack pointer
 391     ds-reg bootstrap-cell SUB
 392     ! compare with second value
 393     ds-reg [] temp0 CMP
 394     ! move t if true
 395     [ temp1 temp3 ] dip execute( dst src -- )
 396     ! store
 397     ds-reg [] temp1 MOV ;
 398
 399 : define-jit-compare ( insn word -- )
 400     [ [ jit-compare ] curry ] dip define-sub-primitive ;
 401
 402 \ CMOVE \ eq? define-jit-compare
 403 \ CMOVGE \ fixnum>= define-jit-compare
 404 \ CMOVLE \ fixnum<= define-jit-compare
 405 \ CMOVG \ fixnum> define-jit-compare
 406 \ CMOVL \ fixnum< define-jit-compare
 407
 408 ! Math
 409 : jit-math ( insn -- )
 410     ! load second input
 411     temp0 ds-reg [] MOV
 412     ! pop stack
 413     ds-reg bootstrap-cell SUB
 414     ! compute result
 415     [ ds-reg [] temp0 ] dip execute( dst src -- ) ;
 416
 417 [ \ ADD jit-math ] \ fixnum+fast define-sub-primitive
 418
 419 [ \ SUB jit-math ] \ fixnum-fast define-sub-primitive
 420
 421 [
 422     ! load second input
 423     temp0 ds-reg [] MOV
 424     ! pop stack
 425     ds-reg bootstrap-cell SUB
 426     ! load first input
 427     temp1 ds-reg [] MOV
 428     ! untag second input
 429     temp0 tag-bits get SAR
 430     ! multiply
 431     temp0 temp1 IMUL2
 432     ! push result
 433     ds-reg [] temp1 MOV
 434 ] \ fixnum*fast define-sub-primitive
 435
 436 [ \ AND jit-math ] \ fixnum-bitand define-sub-primitive
 437
 438 [ \ OR jit-math ] \ fixnum-bitor define-sub-primitive
 439
 440 [ \ XOR jit-math ] \ fixnum-bitxor define-sub-primitive
 441
 442 [
 443     ! complement
 444     ds-reg [] NOT
 445     ! clear tag bits
 446     ds-reg [] tag-mask get XOR
 447 ] \ fixnum-bitnot define-sub-primitive
 448
 449 [
 450     ! load shift count
 451     shift-arg ds-reg [] MOV
 452     ! untag shift count
 453     shift-arg tag-bits get SAR
 454     ! adjust stack pointer
 455     ds-reg bootstrap-cell SUB
 456     ! load value
 457     temp3 ds-reg [] MOV
 458     ! make a copy
 459     temp1 temp3 MOV
 460     ! compute positive shift value in temp1
 461     temp1 CL SHL
 462     shift-arg NEG
 463     ! compute negative shift value in temp3
 464     temp3 CL SAR
 465     temp3 tag-mask get bitnot AND
 466     shift-arg 0 CMP
 467     ! if shift count was negative, move temp0 to temp1
 468     temp1 temp3 CMOVGE
 469     ! push to stack
 470     ds-reg [] temp1 MOV
 471 ] \ fixnum-shift-fast define-sub-primitive
 472
 473 : jit-fixnum-/mod ( -- )
 474     ! load second parameter
 475     temp3 ds-reg [] MOV
 476     ! load first parameter
 477     div-arg ds-reg bootstrap-cell neg [+] MOV
 478     ! make a copy
 479     mod-arg div-arg MOV
 480     ! sign-extend
 481     mod-arg bootstrap-cell-bits 1 - SAR
 482     ! divide
 483     temp3 IDIV ;
 484
 485 [
 486     jit-fixnum-/mod
 487     ! adjust stack pointer
 488     ds-reg bootstrap-cell SUB
 489     ! push to stack
 490     ds-reg [] mod-arg MOV
 491 ] \ fixnum-mod define-sub-primitive
 492
 493 [
 494     jit-fixnum-/mod
 495     ! adjust stack pointer
 496     ds-reg bootstrap-cell SUB
 497     ! tag it
 498     div-arg tag-bits get SHL
 499     ! push to stack
 500     ds-reg [] div-arg MOV
 501 ] \ fixnum/i-fast define-sub-primitive
 502
 503 [
 504     jit-fixnum-/mod
 505     ! tag it
 506     div-arg tag-bits get SHL
 507     ! push to stack
 508     ds-reg [] mod-arg MOV
 509     ds-reg bootstrap-cell neg [+] div-arg MOV
 510 ] \ fixnum/mod-fast define-sub-primitive
 511
 512 [
 513     temp0 ds-reg [] MOV
 514     ds-reg bootstrap-cell SUB
 515     temp0 ds-reg [] OR
 516     temp0 tag-mask get AND
 517     temp0 \ f type-number MOV
 518     temp1 1 tag-fixnum MOV
 519     temp0 temp1 CMOVE
 520     ds-reg [] temp0 MOV
 521 ] \ both-fixnums? define-sub-primitive
 522
 523 [
 524     ! load local number
 525     temp0 ds-reg [] MOV
 526     ! turn local number into offset
 527     fixnum>slot@
 528     ! load local value
 529     temp0 rs-reg temp0 [+] MOV
 530     ! push to stack
 531     ds-reg [] temp0 MOV
 532 ] \ get-local define-sub-primitive
 533
 534 [
 535     ! load local count
 536     temp0 ds-reg [] MOV
 537     ! adjust stack pointer
 538     ds-reg bootstrap-cell SUB
 539     ! turn local number into offset
 540     fixnum>slot@
 541     ! decrement retain stack pointer
 542     rs-reg temp0 SUB
 543 ] \ drop-locals define-sub-primitive
 544
 545 [ "bootstrap.x86" forget-vocab ] with-compilation-unit