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.generator.fixup compiler.constants vocabs
   6 slots.private words words.private ;
   7 IN: bootstrap.x86
   8
   9 big-endian off
  10
  11 1 jit-code-format set
  12
  13 : stack-frame-size ( -- n ) 4 bootstrap-cells ;
  14
  15 [
  16     ! Load word
  17     temp-reg 0 MOV
  18     temp-reg dup [] MOV
  19     ! Bump profiling counter
  20     temp-reg profile-count-offset [+] 1 tag-fixnum ADD
  21     ! Load word->code
  22     temp-reg temp-reg word-code-offset [+] MOV
  23     ! Compute word XT
  24     temp-reg compiled-header-size ADD
  25     ! Jump to XT
  26     temp-reg JMP
  27 ] rc-absolute-cell rt-literal 1 rex-length + jit-profiling jit-define
  28
  29 [
  30     temp-reg 0 MOV                             ! load XT
  31     stack-frame-size PUSH                      ! save stack frame size
  32     temp-reg PUSH                              ! push XT
  33     arg1 PUSH                                  ! alignment
  34 ] rc-absolute-cell rt-label 1 rex-length + jit-prolog jit-define
  35
  36 [
  37     arg0 0 MOV                                 ! load literal
  38     arg0 dup [] MOV
  39     ds-reg bootstrap-cell ADD                  ! increment datastack pointer
  40     ds-reg [] arg0 MOV                         ! store literal on datastack
  41 ] rc-absolute-cell rt-literal 1 rex-length + jit-push-literal jit-define
  42
  43 [
  44     arg0 0 MOV                                 ! load literal
  45     ds-reg bootstrap-cell ADD                  ! increment datastack pointer
  46     ds-reg [] arg0 MOV                         ! store literal on datastack
  47 ] rc-absolute-cell rt-immediate 1 rex-length + jit-push-immediate jit-define
  48
  49 [
  50     arg0 0 MOV                                 ! load XT
  51     arg1 stack-reg MOV                         ! pass callstack pointer as arg 2
  52     arg0 JMP                                   ! go
  53 ] rc-absolute-cell rt-primitive 1 rex-length + jit-primitive jit-define
  54
  55 [
  56     (JMP) drop
  57 ] rc-relative rt-xt 1 jit-word-jump jit-define
  58
  59 [
  60     (CALL) drop
  61 ] rc-relative rt-xt 1 jit-word-call jit-define
  62
  63 [
  64     arg1 0 MOV                                 ! load addr of true quotation
  65     arg0 ds-reg [] MOV                         ! load boolean
  66     ds-reg bootstrap-cell SUB                  ! pop boolean
  67     arg0 \ f tag-number CMP                    ! compare it with f
  68     arg0 arg1 [] CMOVNE                        ! load true branch if not equal
  69     arg0 arg1 bootstrap-cell [+] CMOVE         ! load false branch if equal
  70     arg0 quot-xt-offset [+] JMP                ! jump to quotation-xt
  71 ] rc-absolute-cell rt-literal 1 rex-length + jit-if-jump jit-define
  72
  73 [
  74     arg1 0 MOV                                 ! load dispatch table
  75     arg1 dup [] MOV
  76     arg0 ds-reg [] MOV                         ! load index
  77     fixnum>slot@                               ! turn it into an array offset
  78     ds-reg bootstrap-cell SUB                  ! pop index
  79     arg0 arg1 ADD                              ! compute quotation location
  80     arg0 arg0 array-start-offset [+] MOV       ! load quotation
  81     arg0 quot-xt-offset [+] JMP                ! execute branch
  82 ] rc-absolute-cell rt-literal 1 rex-length + jit-dispatch jit-define
  83
  84 [
  85     stack-reg stack-frame-size bootstrap-cell - ADD ! unwind stack frame
  86 ] f f f jit-epilog jit-define
  87
  88 [ 0 RET ] f f f jit-return jit-define
  89
  90 ! Sub-primitives
  91
  92 ! Quotations and words
  93 [
  94     arg0 ds-reg [] MOV                         ! load from stack
  95     ds-reg bootstrap-cell SUB                  ! pop stack
  96     arg0 quot-xt-offset [+] JMP                ! call quotation
  97 ] f f f \ (call) define-sub-primitive
  98
  99 [
 100     arg0 ds-reg [] MOV                         ! load from stack
 101     ds-reg bootstrap-cell SUB                  ! pop stack
 102     arg0 word-xt-offset [+] JMP                ! execute word
 103 ] f f f \ (execute) define-sub-primitive
 104
 105 ! Objects
 106 [
 107     arg1 ds-reg [] MOV                         ! load from stack
 108     arg1 tag-mask get AND                      ! compute tag
 109     arg1 tag-bits get SHL                      ! tag the tag
 110     ds-reg [] arg1 MOV                         ! push to stack
 111 ] f f f \ tag define-sub-primitive
 112
 113 [
 114     arg0 ds-reg [] MOV                         ! load slot number
 115     ds-reg bootstrap-cell SUB                  ! adjust stack pointer
 116     arg1 ds-reg [] MOV                         ! load object
 117     fixnum>slot@                               ! turn slot number into offset
 118     arg1 tag-bits get SHR                      ! mask off tag
 119     arg1 tag-bits get SHL
 120     arg0 arg1 arg0 [+] MOV                     ! load slot value
 121     ds-reg [] arg0 MOV                         ! push to stack
 122 ] f f f \ slot define-sub-primitive
 123
 124 ! Shufflers
 125 [
 126     ds-reg bootstrap-cell SUB
 127 ] f f f \ drop define-sub-primitive
 128
 129 [
 130     ds-reg 2 bootstrap-cells SUB
 131 ] f f f \ 2drop define-sub-primitive
 132
 133 [
 134     ds-reg 3 bootstrap-cells SUB
 135 ] f f f \ 3drop define-sub-primitive
 136
 137 [
 138     arg0 ds-reg [] MOV
 139     ds-reg bootstrap-cell ADD
 140     ds-reg [] arg0 MOV
 141 ] f f f \ dup define-sub-primitive
 142
 143 [
 144     arg0 ds-reg [] MOV
 145     arg1 ds-reg bootstrap-cell neg [+] MOV
 146     ds-reg 2 bootstrap-cells ADD
 147     ds-reg [] arg0 MOV
 148     ds-reg bootstrap-cell neg [+] arg1 MOV
 149 ] f f f \ 2dup define-sub-primitive
 150
 151 [
 152     arg0 ds-reg [] MOV
 153     arg1 ds-reg -1 bootstrap-cells [+] MOV
 154     temp-reg ds-reg -2 bootstrap-cells [+] MOV
 155     ds-reg 3 bootstrap-cells ADD
 156     ds-reg [] arg0 MOV
 157     ds-reg -1 bootstrap-cells [+] arg1 MOV
 158     ds-reg -2 bootstrap-cells [+] temp-reg MOV
 159 ] f f f \ 3dup define-sub-primitive
 160
 161 [
 162     arg0 ds-reg [] MOV
 163     ds-reg bootstrap-cell SUB
 164     ds-reg [] arg0 MOV
 165 ] f f f \ nip define-sub-primitive
 166
 167 [
 168     arg0 ds-reg [] MOV
 169     ds-reg 2 bootstrap-cells SUB
 170     ds-reg [] arg0 MOV
 171 ] f f f \ 2nip define-sub-primitive
 172
 173 [
 174     arg0 ds-reg -1 bootstrap-cells [+] MOV
 175     ds-reg bootstrap-cell ADD
 176     ds-reg [] arg0 MOV
 177 ] f f f \ over define-sub-primitive
 178
 179 [
 180     arg0 ds-reg -2 bootstrap-cells [+] MOV
 181     ds-reg bootstrap-cell ADD
 182     ds-reg [] arg0 MOV
 183 ] f f f \ pick define-sub-primitive
 184
 185 [
 186     arg0 ds-reg [] MOV
 187     arg1 ds-reg -1 bootstrap-cells [+] MOV
 188     ds-reg [] arg1 MOV
 189     ds-reg bootstrap-cell ADD
 190     ds-reg [] arg0 MOV
 191 ] f f f \ dupd define-sub-primitive
 192
 193 [
 194     arg0 ds-reg [] MOV
 195     arg1 ds-reg -1 bootstrap-cells [+] MOV
 196     ds-reg bootstrap-cell ADD
 197     ds-reg [] arg0 MOV
 198     ds-reg -1 bootstrap-cells [+] arg1 MOV
 199     ds-reg -2 bootstrap-cells [+] arg0 MOV
 200 ] f f f \ tuck define-sub-primitive
 201
 202 [
 203     arg0 ds-reg [] MOV
 204     arg1 ds-reg bootstrap-cell neg [+] MOV
 205     ds-reg bootstrap-cell neg [+] arg0 MOV
 206     ds-reg [] arg1 MOV
 207 ] f f f \ swap define-sub-primitive
 208
 209 [
 210     arg0 ds-reg -1 bootstrap-cells [+] MOV
 211     arg1 ds-reg -2 bootstrap-cells [+] MOV
 212     ds-reg -2 bootstrap-cells [+] arg0 MOV
 213     ds-reg -1 bootstrap-cells [+] arg1 MOV
 214 ] f f f \ swapd define-sub-primitive
 215
 216 [
 217     arg0 ds-reg [] MOV
 218     arg1 ds-reg -1 bootstrap-cells [+] MOV
 219     temp-reg ds-reg -2 bootstrap-cells [+] MOV
 220     ds-reg -2 bootstrap-cells [+] arg1 MOV
 221     ds-reg -1 bootstrap-cells [+] arg0 MOV
 222     ds-reg [] temp-reg MOV
 223 ] f f f \ rot define-sub-primitive
 224
 225 [
 226     arg0 ds-reg [] MOV
 227     arg1 ds-reg -1 bootstrap-cells [+] MOV
 228     temp-reg ds-reg -2 bootstrap-cells [+] MOV
 229     ds-reg -2 bootstrap-cells [+] arg0 MOV
 230     ds-reg -1 bootstrap-cells [+] temp-reg MOV
 231     ds-reg [] arg1 MOV
 232 ] f f f \ -rot define-sub-primitive
 233
 234 [
 235     rs-reg bootstrap-cell ADD
 236     arg0 ds-reg [] MOV
 237     ds-reg bootstrap-cell SUB
 238     rs-reg [] arg0 MOV
 239 ] f f f \ >r define-sub-primitive
 240
 241 [
 242     ds-reg bootstrap-cell ADD
 243     arg0 rs-reg [] MOV
 244     rs-reg bootstrap-cell SUB
 245     ds-reg [] arg0 MOV
 246 ] f f f \ r> define-sub-primitive
 247
 248 ! Comparisons
 249 : jit-compare ( insn -- )
 250     arg1 0 MOV                                 ! load t
 251     arg1 dup [] MOV
 252     temp-reg \ f tag-number MOV                ! load f
 253     arg0 ds-reg [] MOV                         ! load first value
 254     ds-reg bootstrap-cell SUB                  ! adjust stack pointer
 255     ds-reg [] arg0 CMP                         ! compare with second value
 256     [ arg1 temp-reg ] dip execute              ! move t if true
 257     ds-reg [] arg1 MOV                         ! store
 258     ;
 259
 260 : define-jit-compare ( insn word -- )
 261     [ [ jit-compare ] curry rc-absolute-cell rt-literal 1 rex-length + ] dip
 262     define-sub-primitive ;
 263
 264 \ CMOVNE \ eq? define-jit-compare
 265 \ CMOVL \ fixnum>= define-jit-compare
 266 \ CMOVG \ fixnum<= define-jit-compare
 267 \ CMOVLE \ fixnum> define-jit-compare
 268 \ CMOVGE \ fixnum< define-jit-compare
 269
 270 ! Math
 271 : jit-math ( insn -- )
 272     arg0 ds-reg [] MOV                         ! load second input
 273     ds-reg bootstrap-cell SUB                  ! pop stack
 274     arg1 ds-reg [] MOV                         ! load first input
 275     [ arg1 arg0 ] dip execute                  ! compute result
 276     ds-reg [] arg1 MOV                         ! push result
 277     ;
 278
 279 [ \ ADD jit-math ] f f f \ fixnum+fast define-sub-primitive
 280
 281 [ \ SUB jit-math ] f f f \ fixnum-fast define-sub-primitive
 282
 283 [
 284     arg0 ds-reg [] MOV                         ! load second input
 285     ds-reg bootstrap-cell SUB                  ! pop stack
 286     arg1 ds-reg [] MOV                         ! load first input
 287     arg0 tag-bits get SAR                      ! untag second input
 288     arg0 arg1 IMUL2                            ! multiply
 289     ds-reg [] arg1 MOV                         ! push result
 290 ] f f f \ fixnum*fast define-sub-primitive
 291
 292 [ \ AND jit-math ] f f f \ fixnum-bitand define-sub-primitive
 293
 294 [ \ OR jit-math ] f f f \ fixnum-bitor define-sub-primitive
 295
 296 [ \ XOR jit-math ] f f f \ fixnum-bitxor define-sub-primitive
 297
 298 [
 299     arg0 ds-reg [] MOV                         ! load input input
 300     arg0 NOT                                   ! complement
 301     arg0 tag-mask get XOR                      ! clear tag bits
 302     ds-reg [] arg0 MOV                         ! save
 303 ] f f f \ fixnum-bitnot define-sub-primitive
 304
 305 [ "bootstrap.x86" forget-vocab ] with-compilation-unit