basis/cpu/architecture/architecture.factor

   1 ! Copyright (C) 2006, 2008 Slava Pestov.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: arrays generic kernel kernel.private math memory
   4 namespaces make sequences layouts system hashtables classes
   5 alien byte-arrays combinators words sets ;
   6 IN: cpu.architecture
   7
   8 ! Register classes
   9 SINGLETON: int-regs
  10 SINGLETON: single-float-regs
  11 SINGLETON: double-float-regs
  12 UNION: float-regs single-float-regs double-float-regs ;
  13 UNION: reg-class int-regs float-regs ;
  14
  15 ! A pseudo-register class for parameters spilled on the stack
  16 SINGLETON: stack-params
  17
  18 ! Return values of this class go here
  19 GENERIC: return-reg ( register-class -- reg )
  20
  21 ! Sequence of registers used for parameter passing in class
  22 GENERIC: param-regs ( register-class -- regs )
  23
  24 GENERIC: param-reg ( n register-class -- reg )
  25
  26 M: object param-reg param-regs nth ;
  27
  28 ! Sequence mapping vreg-n to native assembler registers
  29 GENERIC: vregs ( register-class -- regs )
  30
  31 ! Load a literal (immediate or indirect)
  32 GENERIC# load-literal 1 ( obj vreg -- )
  33
  34 HOOK: load-indirect cpu ( obj reg -- )
  35
  36 HOOK: stack-frame cpu ( frame-size -- n )
  37
  38 : stack-frame* ( -- n )
  39     \ stack-frame get stack-frame ;
  40
  41 ! Set up caller stack frame
  42 HOOK: %prologue cpu ( n -- )
  43
  44 : %prologue-later ( -- ) \ %prologue-later , ;
  45
  46 ! Tear down stack frame
  47 HOOK: %epilogue cpu ( n -- )
  48
  49 : %epilogue-later ( -- ) \ %epilogue-later , ;
  50
  51 ! Store word XT in stack frame
  52 HOOK: %save-word-xt cpu ( -- )
  53
  54 ! Store dispatch branch XT in stack frame
  55 HOOK: %save-dispatch-xt cpu ( -- )
  56
  57 M: object %save-dispatch-xt %save-word-xt ;
  58
  59 ! Call another word
  60 HOOK: %call cpu ( word -- )
  61
  62 ! Local jump for branches
  63 HOOK: %jump-label cpu ( label -- )
  64
  65 ! Test if vreg is 'f' or not
  66 HOOK: %jump-f cpu ( label -- )
  67
  68 HOOK: %dispatch cpu ( -- )
  69
  70 HOOK: %dispatch-label cpu ( word -- )
  71
  72 ! Return to caller
  73 HOOK: %return cpu ( -- )
  74
  75 ! Change datastack height
  76 HOOK: %inc-d cpu ( n -- )
  77
  78 ! Change callstack height
  79 HOOK: %inc-r cpu ( n -- )
  80
  81 ! Load stack into vreg
  82 HOOK: %peek cpu ( vreg loc -- )
  83
  84 ! Store vreg to stack
  85 HOOK: %replace cpu ( vreg loc -- )
  86
  87 ! Box and unbox floats
  88 HOOK: %unbox-float cpu ( dst src -- )
  89 HOOK: %box-float cpu ( dst src -- )
  90
  91 ! FFI stuff
  92
  93 ! Is this integer small enough to appear in value template
  94 ! slots?
  95 HOOK: small-enough? cpu ( n -- ? )
  96
  97 ! Is this structure small enough to be returned in registers?
  98 HOOK: struct-small-enough? cpu ( heap-size -- ? )
  99
 100 ! Do we pass explode value structs?
 101 HOOK: value-structs? cpu ( -- ? )
 102
 103 ! If t, fp parameters are shadowed by dummy int parameters
 104 HOOK: fp-shadows-int? cpu ( -- ? )
 105
 106 HOOK: %prepare-unbox cpu ( -- )
 107
 108 HOOK: %unbox cpu ( n reg-class func -- )
 109
 110 HOOK: %unbox-long-long cpu ( n func -- )
 111
 112 HOOK: %unbox-small-struct cpu ( c-type -- )
 113
 114 HOOK: %unbox-large-struct cpu ( n c-type -- )
 115
 116 HOOK: %box cpu ( n reg-class func -- )
 117
 118 HOOK: %box-long-long cpu ( n func -- )
 119
 120 HOOK: %prepare-box-struct cpu ( size -- )
 121
 122 HOOK: %box-small-struct cpu ( c-type -- )
 123
 124 HOOK: %box-large-struct cpu ( n c-type -- )
 125
 126 GENERIC: %save-param-reg ( stack reg reg-class -- )
 127
 128 GENERIC: %load-param-reg ( stack reg reg-class -- )
 129
 130 HOOK: %prepare-alien-invoke cpu ( -- )
 131
 132 HOOK: %prepare-var-args cpu ( -- )
 133
 134 M: object %prepare-var-args ;
 135
 136 HOOK: %alien-invoke cpu ( function library -- )
 137
 138 HOOK: %cleanup cpu ( alien-node -- )
 139
 140 HOOK: %alien-callback cpu ( quot -- )
 141
 142 HOOK: %callback-value cpu ( ctype -- )
 143
 144 ! Return to caller with stdcall unwinding (only for x86)
 145 HOOK: %unwind cpu ( n -- )
 146
 147 HOOK: %prepare-alien-indirect cpu ( -- )
 148
 149 HOOK: %alien-indirect cpu ( -- )
 150
 151 M: stack-params param-reg drop ;
 152
 153 M: stack-params param-regs drop f ;
 154
 155 GENERIC: v>operand ( obj -- operand )
 156
 157 M: integer v>operand tag-fixnum ;
 158
 159 M: f v>operand drop \ f tag-number ;
 160
 161 M: object load-literal v>operand load-indirect ;
 162
 163 PREDICATE: small-slot < integer cells small-enough? ;
 164
 165 PREDICATE: small-tagged < integer v>operand small-enough? ;
 166
 167 : if-small-struct ( n size true false -- ? )
 168     [ over not over struct-small-enough? and ] 2dip
 169     [ [ nip ] prepose ] dip if ;
 170     inline
 171
 172 : %unbox-struct ( n c-type -- )
 173     [
 174         %unbox-small-struct
 175     ] [
 176         %unbox-large-struct
 177     ] if-small-struct ;
 178
 179 : %box-struct ( n c-type -- )
 180     [
 181         %box-small-struct
 182     ] [
 183         %box-large-struct
 184     ] if-small-struct ;
 185
 186 ! Alien accessors
 187 HOOK: %unbox-byte-array cpu ( dst src -- )
 188
 189 HOOK: %unbox-alien cpu ( dst src -- )
 190
 191 HOOK: %unbox-f cpu ( dst src -- )
 192
 193 HOOK: %unbox-any-c-ptr cpu ( dst src -- )
 194
 195 HOOK: %box-alien cpu ( dst src -- )
 196
 197 ! GC check
 198 HOOK: %gc cpu ( -- )
 199
 200 : operand ( var -- op ) get v>operand ; inline
 201
 202 : unique-operands ( operands quot -- )
 203     >r [ operand ] map prune r> each ; inline