basis/cpu/x86/bootstrap.factor

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