basis/cpu/x86/architecture/architecture.factor

   1 ! Copyright (C) 2005, 2008 Slava Pestov.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: accessors alien alien.c-types arrays cpu.x86.assembler
   4 cpu.x86.assembler.private cpu.architecture kernel kernel.private
   5 math memory namespaces make sequences words compiler.generator
   6 compiler.generator.registers compiler.generator.fixup system
   7 layouts combinators compiler.constants math.order ;
   8 IN: cpu.x86.architecture
   9
  10 HOOK: ds-reg cpu ( -- reg )
  11 HOOK: rs-reg cpu ( -- reg )
  12 HOOK: stack-reg cpu ( -- reg )
  13 HOOK: stack-save-reg cpu ( -- reg )
  14
  15 : stack@ ( n -- op ) stack-reg swap [+] ;
  16
  17 : reg-stack ( n reg -- op ) swap cells neg [+] ;
  18
  19 M: ds-loc v>operand n>> ds-reg reg-stack ;
  20 M: rs-loc v>operand n>> rs-reg reg-stack ;
  21
  22 M: int-regs %save-param-reg drop >r stack@ r> MOV ;
  23 M: int-regs %load-param-reg drop swap stack@ MOV ;
  24
  25 GENERIC: MOVSS/D ( dst src reg-class -- )
  26
  27 M: single-float-regs MOVSS/D drop MOVSS ;
  28
  29 M: double-float-regs MOVSS/D drop MOVSD ;
  30
  31 M: float-regs %save-param-reg >r >r stack@ r> r> MOVSS/D ;
  32 M: float-regs %load-param-reg >r swap stack@ r> MOVSS/D ;
  33
  34 GENERIC: push-return-reg ( reg-class -- )
  35 GENERIC: load-return-reg ( stack@ reg-class -- )
  36 GENERIC: store-return-reg ( stack@ reg-class -- )
  37
  38 ! Only used by inline allocation
  39 HOOK: temp-reg-1 cpu ( -- reg )
  40 HOOK: temp-reg-2 cpu ( -- reg )
  41
  42 HOOK: address-operand cpu ( address -- operand )
  43
  44 HOOK: fixnum>slot@ cpu ( op -- )
  45
  46 HOOK: prepare-division cpu ( -- )
  47
  48 M: immediate load-literal v>operand swap v>operand MOV ;
  49
  50 M: x86 stack-frame ( n -- i )
  51     3 cells + 16 align cell - ;
  52
  53 M: x86 %save-word-xt ( -- )
  54     temp-reg v>operand 0 MOV rc-absolute-cell rel-this ;
  55
  56 : factor-area-size ( -- n ) 4 cells ;
  57
  58 M: x86 %prologue ( n -- )
  59     dup cell + PUSH
  60     temp-reg v>operand PUSH
  61     stack-reg swap 2 cells - SUB ;
  62
  63 M: x86 %epilogue ( n -- )
  64     stack-reg swap ADD ;
  65
  66 HOOK: %alien-global cpu ( symbol dll register -- )
  67
  68 M: x86 %prepare-alien-invoke
  69     #! Save Factor stack pointers in case the C code calls a
  70     #! callback which does a GC, which must reliably trace
  71     #! all roots.
  72     "stack_chain" f temp-reg v>operand %alien-global
  73     temp-reg v>operand [] stack-reg MOV
  74     temp-reg v>operand [] cell SUB
  75     temp-reg v>operand 2 cells [+] ds-reg MOV
  76     temp-reg v>operand 3 cells [+] rs-reg MOV ;
  77
  78 M: x86 %call ( label -- ) CALL ;
  79
  80 M: x86 %jump-label ( label -- ) JMP ;
  81
  82 M: x86 %jump-f ( label -- )
  83     "flag" operand f v>operand CMP JE ;
  84
  85 : code-alignment ( -- n )
  86     building get length dup cell align swap - ;
  87
  88 : align-code ( n -- )
  89     0 <repetition> % ;
  90
  91 M: x86 %dispatch ( -- )
  92     [
  93         %epilogue-later
  94         ! Load jump table base. We use a temporary register
  95         ! since on AMD64 we have to load a 64-bit immediate. On
  96         ! x86, this is redundant.
  97         ! Untag and multiply to get a jump table offset
  98         "n" operand fixnum>slot@
  99         ! Add jump table base
 100         "offset" operand HEX: ffffffff MOV rc-absolute-cell rel-here
 101         "n" operand "offset" operand ADD
 102         "n" operand HEX: 7f [+] JMP
 103         ! Fix up the displacement above
 104         code-alignment dup bootstrap-cell 8 = 15 9 ? +
 105         building get dup pop* push
 106         align-code
 107     ] H{
 108         { +input+ { { f "n" } } }
 109         { +scratch+ { { f "offset" } } }
 110         { +clobber+ { "n" } }
 111     } with-template ;
 112
 113 M: x86 %dispatch-label ( word -- )
 114     0 cell, rc-absolute-cell rel-word ;
 115
 116 M: x86 %unbox-float ( dst src -- )
 117     [ v>operand ] bi@ float-offset [+] MOVSD ;
 118
 119 M: x86 %peek [ v>operand ] bi@ MOV ;
 120
 121 M: x86 %replace swap %peek ;
 122
 123 : (%inc) ( n reg -- ) swap cells dup 0 > [ ADD ] [ neg SUB ] if ;
 124
 125 M: x86 %inc-d ( n -- ) ds-reg (%inc) ;
 126
 127 M: x86 %inc-r ( n -- ) rs-reg (%inc) ;
 128
 129 M: x86 fp-shadows-int? ( -- ? ) f ;
 130
 131 M: x86 value-structs? t ;
 132
 133 M: x86 small-enough? ( n -- ? )
 134     HEX: -80000000 HEX: 7fffffff between? ;
 135
 136 : %untag ( reg -- ) tag-mask get bitnot AND ;
 137
 138 : %untag-fixnum ( reg -- ) tag-bits get SAR ;
 139
 140 : %tag-fixnum ( reg -- ) tag-bits get SHL ;
 141
 142 : temp@ ( n -- op ) stack-reg \ stack-frame get rot - [+] ;
 143
 144 : struct-return@ ( size n -- n )
 145     [
 146         stack-frame* cell + +
 147     ] [
 148         \ stack-frame get swap -
 149     ] ?if ;
 150
 151 HOOK: %unbox-struct-1 cpu ( -- )
 152
 153 HOOK: %unbox-struct-2 cpu ( -- )
 154
 155 M: x86 %unbox-small-struct ( size -- )
 156     #! Alien must be in EAX.
 157     cell align cell /i {
 158         { 1 [ %unbox-struct-1 ] }
 159         { 2 [ %unbox-struct-2 ] }
 160     } case ;
 161
 162 M: x86 struct-small-enough? ( size -- ? )
 163     { 1 2 4 8 } member?
 164     os { linux netbsd solaris } member? not and ;
 165
 166 M: x86 %return ( -- ) 0 %unwind ;
 167
 168 ! Alien intrinsics
 169 M: x86 %unbox-byte-array ( dst src -- )
 170     [ v>operand ] bi@ byte-array-offset [+] LEA ;
 171
 172 M: x86 %unbox-alien ( dst src -- )
 173     [ v>operand ] bi@ alien-offset [+] MOV ;
 174
 175 M: x86 %unbox-f ( dst src -- )
 176     drop v>operand 0 MOV ;
 177
 178 M: x86 %unbox-any-c-ptr ( dst src -- )
 179     { "is-byte-array" "end" "start" } [ define-label ] each
 180     ! Address is computed in ds-reg
 181     ds-reg PUSH
 182     ds-reg 0 MOV
 183     ! Object is stored in ds-reg
 184     rs-reg PUSH
 185     rs-reg swap v>operand MOV
 186     ! We come back here with displaced aliens
 187     "start" resolve-label
 188     ! Is the object f?
 189     rs-reg f v>operand CMP
 190     "end" get JE
 191     ! Is the object an alien?
 192     rs-reg header-offset [+] alien type-number tag-fixnum CMP
 193     "is-byte-array" get JNE
 194     ! If so, load the offset and add it to the address
 195     ds-reg rs-reg alien-offset [+] ADD
 196     ! Now recurse on the underlying alien
 197     rs-reg rs-reg underlying-alien-offset [+] MOV
 198     "start" get JMP
 199     "is-byte-array" resolve-label
 200     ! Add byte array address to address being computed
 201     ds-reg rs-reg ADD
 202     ! Add an offset to start of byte array's data
 203     ds-reg byte-array-offset ADD
 204     "end" resolve-label
 205     ! Done, store address in destination register
 206     v>operand ds-reg MOV
 207     ! Restore rs-reg
 208     rs-reg POP
 209     ! Restore ds-reg
 210     ds-reg POP ;