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-literal 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 literal
  26     temp0 0 MOV rc-absolute-cell rt-literal jit-rel
  27     ! increment datastack pointer
  28     ds-reg bootstrap-cell ADD
  29     ! store literal on datastack
  30     ds-reg [] temp0 MOV
  31 ] jit-push-immediate jit-define
  32
  33 [
  34     temp3 0 MOV rc-absolute-cell rt-here jit-rel
  35     0 JMP rc-relative rt-xt-pic-tail jit-rel
  36 ] jit-word-jump jit-define
  37
  38 [
  39     0 CALL rc-relative rt-xt-pic jit-rel
  40 ] jit-word-call jit-define
  41
  42 [
  43     ! load boolean
  44     temp0 ds-reg [] MOV
  45     ! pop boolean
  46     ds-reg bootstrap-cell SUB
  47     ! compare boolean with f
  48     temp0 \ f type-number CMP
  49     ! jump to true branch if not equal
  50     0 JNE rc-relative rt-xt jit-rel
  51     ! jump to false branch if equal
  52     0 JMP rc-relative rt-xt jit-rel
  53 ] jit-if jit-define
  54
  55 : jit->r ( -- )
  56     rs-reg bootstrap-cell ADD
  57     temp0 ds-reg [] MOV
  58     ds-reg bootstrap-cell SUB
  59     rs-reg [] temp0 MOV ;
  60
  61 : jit-2>r ( -- )
  62     rs-reg 2 bootstrap-cells ADD
  63     temp0 ds-reg [] MOV
  64     temp1 ds-reg -1 bootstrap-cells [+] MOV
  65     ds-reg 2 bootstrap-cells SUB
  66     rs-reg [] temp0 MOV
  67     rs-reg -1 bootstrap-cells [+] temp1 MOV ;
  68
  69 : jit-3>r ( -- )
  70     rs-reg 3 bootstrap-cells ADD
  71     temp0 ds-reg [] MOV
  72     temp1 ds-reg -1 bootstrap-cells [+] MOV
  73     temp2 ds-reg -2 bootstrap-cells [+] MOV
  74     ds-reg 3 bootstrap-cells SUB
  75     rs-reg [] temp0 MOV
  76     rs-reg -1 bootstrap-cells [+] temp1 MOV
  77     rs-reg -2 bootstrap-cells [+] temp2 MOV ;
  78
  79 : jit-r> ( -- )
  80     ds-reg bootstrap-cell ADD
  81     temp0 rs-reg [] MOV
  82     rs-reg bootstrap-cell SUB
  83     ds-reg [] temp0 MOV ;
  84
  85 : jit-2r> ( -- )
  86     ds-reg 2 bootstrap-cells ADD
  87     temp0 rs-reg [] MOV
  88     temp1 rs-reg -1 bootstrap-cells [+] MOV
  89     rs-reg 2 bootstrap-cells SUB
  90     ds-reg [] temp0 MOV
  91     ds-reg -1 bootstrap-cells [+] temp1 MOV ;
  92
  93 : jit-3r> ( -- )
  94     ds-reg 3 bootstrap-cells ADD
  95     temp0 rs-reg [] MOV
  96     temp1 rs-reg -1 bootstrap-cells [+] MOV
  97     temp2 rs-reg -2 bootstrap-cells [+] MOV
  98     rs-reg 3 bootstrap-cells SUB
  99     ds-reg [] temp0 MOV
 100     ds-reg -1 bootstrap-cells [+] temp1 MOV
 101     ds-reg -2 bootstrap-cells [+] temp2 MOV ;
 102
 103 [
 104     jit->r
 105     0 CALL rc-relative rt-xt jit-rel
 106     jit-r>
 107 ] jit-dip jit-define
 108
 109 [
 110     jit-2>r
 111     0 CALL rc-relative rt-xt jit-rel
 112     jit-2r>
 113 ] jit-2dip jit-define
 114
 115 [
 116     jit-3>r
 117     0 CALL rc-relative rt-xt jit-rel
 118     jit-3r>
 119 ] jit-3dip jit-define
 120
 121 [
 122     ! load from stack
 123     arg1 ds-reg [] MOV
 124     ! pop stack
 125     ds-reg bootstrap-cell SUB
 126     ! pass vm pointer
 127     arg2 0 MOV 0 rc-absolute-cell jit-vm
 128 ]
 129 [ arg1 quot-xt-offset [+] CALL ]
 130 [ arg1 quot-xt-offset [+] JMP ]
 131 \ (call) define-sub-primitive*
 132
 133 [
 134     ! load from stack
 135     arg1 ds-reg [] MOV
 136     ! pop stack
 137     ds-reg bootstrap-cell SUB
 138 ]
 139 [ arg1 word-xt-offset [+] CALL ]
 140 [ arg1 word-xt-offset [+] JMP ]
 141 \ (execute) define-sub-primitive*
 142
 143 [
 144     arg1 ds-reg [] MOV
 145     ds-reg bootstrap-cell SUB
 146     arg1 word-xt-offset [+] JMP
 147 ] jit-execute jit-define
 148
 149 [
 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     [ JNE ]
 180     [ temp1 temp0 tuple type-number neg bootstrap-cell + [+] MOV ]
 181     jit-conditional
 182 ] pic-tuple jit-define
 183
 184 [
 185     temp1 HEX: ffffffff CMP rc-absolute rt-literal jit-rel
 186 ] pic-check-tag jit-define
 187
 188 [
 189     temp2 HEX: ffffffff MOV rc-absolute-cell rt-literal jit-rel
 190     temp1 temp2 CMP
 191 ] pic-check-tuple jit-define
 192
 193 [ 0 JE rc-relative rt-xt jit-rel ] pic-hit jit-define
 194
 195 ! ! ! Megamorphic caches
 196
 197 [
 198     ! cache = ...
 199     temp0 0 MOV rc-absolute-cell rt-literal jit-rel
 200     ! key = hashcode(class)
 201     temp2 temp1 MOV
 202     bootstrap-cell 4 = [ temp2 1 SHR ] when
 203     ! key &= cache.length - 1
 204     temp2 mega-cache-size get 1 - bootstrap-cell * AND
 205     ! cache += array-start-offset
 206     temp0 array-start-offset ADD
 207     ! cache += key
 208     temp0 temp2 ADD
 209     ! if(get(cache) == class)
 210     temp0 [] temp1 CMP
 211     bootstrap-cell 4 = 14 22 ? JNE ! Yuck!
 212     ! megamorphic_cache_hits++
 213     temp1 0 MOV rc-absolute-cell rt-megamorphic-cache-hits jit-rel
 214     temp1 [] 1 ADD
 215     ! goto get(cache + bootstrap-cell)
 216     temp0 temp0 bootstrap-cell [+] MOV
 217     temp0 word-xt-offset [+] JMP
 218     ! fall-through on miss
 219 ] mega-lookup jit-define
 220
 221 [
 222     safe-reg 0 MOV rc-absolute-cell rt-xt jit-rel
 223     safe-reg JMP
 224 ] callback-stub jit-define
 225
 226 ! ! ! Sub-primitives
 227
 228 ! Objects
 229 [
 230     ! load from stack
 231     temp0 ds-reg [] MOV
 232     ! compute tag
 233     temp0 tag-mask get AND
 234     ! tag the tag
 235     temp0 tag-bits get SHL
 236     ! push to stack
 237     ds-reg [] temp0 MOV
 238 ] \ tag define-sub-primitive
 239
 240 [
 241     ! load slot number
 242     temp0 ds-reg [] MOV
 243     ! adjust stack pointer
 244     ds-reg bootstrap-cell SUB
 245     ! load object
 246     temp1 ds-reg [] MOV
 247     ! turn slot number into offset
 248     fixnum>slot@
 249     ! mask off tag
 250     temp1 tag-bits get SHR
 251     temp1 tag-bits get SHL
 252     ! load slot value
 253     temp0 temp1 temp0 [+] MOV
 254     ! push to stack
 255     ds-reg [] temp0 MOV
 256 ] \ slot define-sub-primitive
 257
 258 ! Shufflers
 259 [
 260     ds-reg bootstrap-cell SUB
 261 ] \ drop define-sub-primitive
 262
 263 [
 264     ds-reg 2 bootstrap-cells SUB
 265 ] \ 2drop define-sub-primitive
 266
 267 [
 268     ds-reg 3 bootstrap-cells SUB
 269 ] \ 3drop define-sub-primitive
 270
 271 [
 272     temp0 ds-reg [] MOV
 273     ds-reg bootstrap-cell ADD
 274     ds-reg [] temp0 MOV
 275 ] \ dup define-sub-primitive
 276
 277 [
 278     temp0 ds-reg [] MOV
 279     temp1 ds-reg bootstrap-cell neg [+] MOV
 280     ds-reg 2 bootstrap-cells ADD
 281     ds-reg [] temp0 MOV
 282     ds-reg bootstrap-cell neg [+] temp1 MOV
 283 ] \ 2dup define-sub-primitive
 284
 285 [
 286     temp0 ds-reg [] MOV
 287     temp1 ds-reg -1 bootstrap-cells [+] MOV
 288     temp3 ds-reg -2 bootstrap-cells [+] MOV
 289     ds-reg 3 bootstrap-cells ADD
 290     ds-reg [] temp0 MOV
 291     ds-reg -1 bootstrap-cells [+] temp1 MOV
 292     ds-reg -2 bootstrap-cells [+] temp3 MOV
 293 ] \ 3dup define-sub-primitive
 294
 295 [
 296     temp0 ds-reg [] MOV
 297     ds-reg bootstrap-cell SUB
 298     ds-reg [] temp0 MOV
 299 ] \ nip define-sub-primitive
 300
 301 [
 302     temp0 ds-reg [] MOV
 303     ds-reg 2 bootstrap-cells SUB
 304     ds-reg [] temp0 MOV
 305 ] \ 2nip define-sub-primitive
 306
 307 [
 308     temp0 ds-reg -1 bootstrap-cells [+] MOV
 309     ds-reg bootstrap-cell ADD
 310     ds-reg [] temp0 MOV
 311 ] \ over define-sub-primitive
 312
 313 [
 314     temp0 ds-reg -2 bootstrap-cells [+] MOV
 315     ds-reg bootstrap-cell ADD
 316     ds-reg [] temp0 MOV
 317 ] \ pick define-sub-primitive
 318
 319 [
 320     temp0 ds-reg [] MOV
 321     temp1 ds-reg -1 bootstrap-cells [+] MOV
 322     ds-reg [] temp1 MOV
 323     ds-reg bootstrap-cell ADD
 324     ds-reg [] temp0 MOV
 325 ] \ dupd define-sub-primitive
 326
 327 [
 328     temp0 ds-reg [] MOV
 329     temp1 ds-reg bootstrap-cell neg [+] MOV
 330     ds-reg bootstrap-cell neg [+] temp0 MOV
 331     ds-reg [] temp1 MOV
 332 ] \ swap define-sub-primitive
 333
 334 [
 335     temp0 ds-reg -1 bootstrap-cells [+] MOV
 336     temp1 ds-reg -2 bootstrap-cells [+] MOV
 337     ds-reg -2 bootstrap-cells [+] temp0 MOV
 338     ds-reg -1 bootstrap-cells [+] temp1 MOV
 339 ] \ swapd define-sub-primitive
 340
 341 [
 342     temp0 ds-reg [] MOV
 343     temp1 ds-reg -1 bootstrap-cells [+] MOV
 344     temp3 ds-reg -2 bootstrap-cells [+] MOV
 345     ds-reg -2 bootstrap-cells [+] temp1 MOV
 346     ds-reg -1 bootstrap-cells [+] temp0 MOV
 347     ds-reg [] temp3 MOV
 348 ] \ rot define-sub-primitive
 349
 350 [
 351     temp0 ds-reg [] MOV
 352     temp1 ds-reg -1 bootstrap-cells [+] MOV
 353     temp3 ds-reg -2 bootstrap-cells [+] MOV
 354     ds-reg -2 bootstrap-cells [+] temp0 MOV
 355     ds-reg -1 bootstrap-cells [+] temp3 MOV
 356     ds-reg [] temp1 MOV
 357 ] \ -rot define-sub-primitive
 358
 359 [ jit->r ] \ load-local define-sub-primitive
 360
 361 ! Comparisons
 362 : jit-compare ( insn -- )
 363     ! load t
 364     t jit-literal
 365     temp3 0 MOV rc-absolute-cell rt-literal jit-rel
 366     ! load f
 367     temp1 \ f type-number MOV
 368     ! load first value
 369     temp0 ds-reg [] MOV
 370     ! adjust stack pointer
 371     ds-reg bootstrap-cell SUB
 372     ! compare with second value
 373     ds-reg [] temp0 CMP
 374     ! move t if true
 375     [ temp1 temp3 ] dip execute( dst src -- )
 376     ! store
 377     ds-reg [] temp1 MOV ;
 378
 379 : define-jit-compare ( insn word -- )
 380     [ [ jit-compare ] curry ] dip define-sub-primitive ;
 381
 382 \ CMOVE \ eq? define-jit-compare
 383 \ CMOVGE \ fixnum>= define-jit-compare
 384 \ CMOVLE \ fixnum<= define-jit-compare
 385 \ CMOVG \ fixnum> define-jit-compare
 386 \ CMOVL \ fixnum< define-jit-compare
 387
 388 ! Math
 389 : jit-math ( insn -- )
 390     ! load second input
 391     temp0 ds-reg [] MOV
 392     ! pop stack
 393     ds-reg bootstrap-cell SUB
 394     ! compute result
 395     [ ds-reg [] temp0 ] dip execute( dst src -- ) ;
 396
 397 [ \ ADD jit-math ] \ fixnum+fast define-sub-primitive
 398
 399 [ \ SUB jit-math ] \ fixnum-fast define-sub-primitive
 400
 401 [
 402     ! load second input
 403     temp0 ds-reg [] MOV
 404     ! pop stack
 405     ds-reg bootstrap-cell SUB
 406     ! load first input
 407     temp1 ds-reg [] MOV
 408     ! untag second input
 409     temp0 tag-bits get SAR
 410     ! multiply
 411     temp0 temp1 IMUL2
 412     ! push result
 413     ds-reg [] temp1 MOV
 414 ] \ fixnum*fast define-sub-primitive
 415
 416 [ \ AND jit-math ] \ fixnum-bitand define-sub-primitive
 417
 418 [ \ OR jit-math ] \ fixnum-bitor define-sub-primitive
 419
 420 [ \ XOR jit-math ] \ fixnum-bitxor define-sub-primitive
 421
 422 [
 423     ! complement
 424     ds-reg [] NOT
 425     ! clear tag bits
 426     ds-reg [] tag-mask get XOR
 427 ] \ fixnum-bitnot define-sub-primitive
 428
 429 [
 430     ! load shift count
 431     shift-arg ds-reg [] MOV
 432     ! untag shift count
 433     shift-arg tag-bits get SAR
 434     ! adjust stack pointer
 435     ds-reg bootstrap-cell SUB
 436     ! load value
 437     temp3 ds-reg [] MOV
 438     ! make a copy
 439     temp1 temp3 MOV
 440     ! compute positive shift value in temp1
 441     temp1 CL SHL
 442     shift-arg NEG
 443     ! compute negative shift value in temp3
 444     temp3 CL SAR
 445     temp3 tag-mask get bitnot AND
 446     shift-arg 0 CMP
 447     ! if shift count was negative, move temp0 to temp1
 448     temp1 temp3 CMOVGE
 449     ! push to stack
 450     ds-reg [] temp1 MOV
 451 ] \ fixnum-shift-fast define-sub-primitive
 452
 453 : jit-fixnum-/mod ( -- )
 454     ! load second parameter
 455     temp3 ds-reg [] MOV
 456     ! load first parameter
 457     div-arg ds-reg bootstrap-cell neg [+] MOV
 458     ! make a copy
 459     mod-arg div-arg MOV
 460     ! sign-extend
 461     mod-arg bootstrap-cell-bits 1 - SAR
 462     ! divide
 463     temp3 IDIV ;
 464
 465 [
 466     jit-fixnum-/mod
 467     ! adjust stack pointer
 468     ds-reg bootstrap-cell SUB
 469     ! push to stack
 470     ds-reg [] mod-arg MOV
 471 ] \ fixnum-mod define-sub-primitive
 472
 473 [
 474     jit-fixnum-/mod
 475     ! adjust stack pointer
 476     ds-reg bootstrap-cell SUB
 477     ! tag it
 478     div-arg tag-bits get SHL
 479     ! push to stack
 480     ds-reg [] div-arg MOV
 481 ] \ fixnum/i-fast define-sub-primitive
 482
 483 [
 484     jit-fixnum-/mod
 485     ! tag it
 486     div-arg tag-bits get SHL
 487     ! push to stack
 488     ds-reg [] mod-arg MOV
 489     ds-reg bootstrap-cell neg [+] div-arg MOV
 490 ] \ fixnum/mod-fast define-sub-primitive
 491
 492 [
 493     temp0 ds-reg [] MOV
 494     ds-reg bootstrap-cell SUB
 495     temp0 ds-reg [] OR
 496     temp0 tag-mask get AND
 497     temp0 \ f type-number MOV
 498     temp1 1 tag-fixnum MOV
 499     temp0 temp1 CMOVE
 500     ds-reg [] temp0 MOV
 501 ] \ both-fixnums? define-sub-primitive
 502
 503 [
 504     ! load local number
 505     temp0 ds-reg [] MOV
 506     ! turn local number into offset
 507     fixnum>slot@
 508     ! load local value
 509     temp0 rs-reg temp0 [+] MOV
 510     ! push to stack
 511     ds-reg [] temp0 MOV
 512 ] \ get-local define-sub-primitive
 513
 514 [
 515     ! load local count
 516     temp0 ds-reg [] MOV
 517     ! adjust stack pointer
 518     ds-reg bootstrap-cell SUB
 519     ! turn local number into offset
 520     fixnum>slot@
 521     ! decrement retain stack pointer
 522     rs-reg temp0 SUB
 523 ] \ drop-locals define-sub-primitive
 524
 525 [ "bootstrap.x86" forget-vocab ] with-compilation-unit