qemu/roms/openbios/forth/device/other.fs

   1 \ tag: Other FCode functions
   2 \
   3 \ this code implements IEEE 1275-1994 ch. 5.3.7
   4 \
   5 \ Copyright (C) 2003 Stefan Reinauer
   6 \
   7 \ See the file "COPYING" for further information about
   8 \ the copyright and warranty status of this work.
   9 \
  10
  11 \ The current diagnostic setting
  12 defer _diag-switch?
  13
  14
  15 \
  16 \ 5.3.7 Other FCode functions
  17 \
  18
  19 hex
  20
  21 \ 5.3.7.1 Peek/poke
  22
  23 defer (peek)
  24 :noname
  25   execute true
  26 ; to (peek)
  27
  28 : cpeek    ( addr -- false | byte true )
  29   ['] c@ (peek)
  30   ;
  31
  32 : wpeek    ( waddr -- false | w true )
  33   ['] w@ (peek)
  34   ;
  35
  36 : lpeek    ( qaddr -- false | quad true )
  37   ['] l@ (peek)
  38   ;
  39
  40 defer (poke)
  41 :noname
  42   execute true
  43 ; to (poke)
  44
  45 : cpoke    ( byte addr -- okay? )
  46   ['] c! (poke)
  47   ;
  48
  49 : wpoke    ( w waddr -- okay? )
  50   ['] w! (poke)
  51   ;
  52
  53 : lpoke    ( quad qaddr -- okay? )
  54   ['] l! (poke)
  55   ;
  56
  57
  58 \ 5.3.7.2 Device-register access
  59
  60 : rb@    ( addr -- byte )
  61   ;
  62
  63 : rw@    ( waddr -- w )
  64   ;
  65
  66 : rl@    ( qaddr -- quad )
  67   ;
  68
  69 : rb!    ( byte addr -- )
  70   ;
  71
  72 : rw!    ( w waddr -- )
  73   ;
  74
  75 : rl!    ( quad qaddr -- )
  76   ;
  77
  78 : rx@ ( oaddr - o )
  79   state @ if
  80     h# 22e get-token if , else execute then
  81   else
  82     h# 22e get-token drop execute
  83   then
  84   ; immediate
  85
  86 : rx! ( o oaddr -- )
  87   state @ if
  88     h# 22f get-token if , else execute then
  89   else
  90     h# 22f get-token drop execute
  91   then
  92   ; immediate
  93
  94 \ 5.3.7.3 Time
  95
  96 \ Pointer to OBP tick value updated by timer interrupt
  97 variable obp-ticks
  98
  99 \ Dummy implementation for platforms without a timer interrupt
 100 0 value dummy-msecs
 101
 102 : get-msecs    ( -- n )
 103   \ If obp-ticks pointer is set, use it. Otherwise fall back to
 104   \ dummy implementation
 105   obp-ticks @ 0<> if
 106     obp-ticks @
 107   else
 108     dummy-msecs dup 1+ to dummy-msecs
 109   then
 110   ;
 111
 112 : ms    ( n -- )
 113   get-msecs +
 114   begin dup get-msecs < until
 115   drop
 116   ;
 117
 118 : alarm    ( xt n -- )
 119   2drop
 120   ;
 121
 122 : user-abort    ( ... -- )  ( R: ... -- )
 123   ;
 124
 125
 126 \ 5.3.7.4 System information
 127 0003.0000 value fcode-revision    ( -- n )
 128
 129 : mac-address    ( -- mac-str mac-len )
 130   ;
 131
 132
 133 \ 5.3.7.5 FCode self-test
 134 : display-status    ( n -- )
 135   ;
 136
 137 : memory-test-suite ( addr len -- fail? )
 138   ;
 139
 140 : mask    ( -- a-addr )
 141   ;
 142
 143 : diagnostic-mode?     ( -- diag? )
 144   \ Return the NVRAM diag-switch? setting
 145   _diag-switch?
 146   ;
 147
 148 \ 5.3.7.6 Start and end.
 149
 150 \ Begin program with spread 0 followed by FCode-header.
 151 : start0 ( -- )
 152   0 fcode-spread !
 153   offset16
 154   fcode-header
 155   ;
 156
 157 \ Begin program with spread 1 followed by FCode-header.
 158 : start1 ( -- )
 159   1 to fcode-spread
 160   offset16
 161   fcode-header
 162   ;
 163
 164 \ Begin program with spread 2 followed by FCode-header.
 165 : start2 ( -- )
 166   2 to fcode-spread
 167   offset16
 168   fcode-header
 169   ;
 170
 171 \ Begin program with spread 4 followed by FCode-header.
 172 : start4 ( -- )
 173   4 to fcode-spread
 174   offset16
 175   fcode-header
 176   ;
 177
 178 \ Begin program with spread 1 followed by FCode-header.
 179 : version1 ( -- )
 180   1 to fcode-spread
 181   fcode-header
 182   ;
 183
 184 \ Cease evaluating this FCode program.
 185 : end0 ( -- )
 186   true fcode-end !
 187   ; immediate
 188
 189 \ Cease evaluating this FCode program.
 190 : end1 ( -- )
 191   end0
 192   ;
 193
 194 \ Standard FCode number for undefined FCode functions.
 195 : ferror ( -- )
 196   ." undefined fcode# encountered." cr
 197   true fcode-end !
 198   ;
 199
 200 \ Pause FCode evaluation if desired; can resume later.
 201 : suspend-fcode ( -- )
 202   \ NOT YET IMPLEMENTED.
 203   ;
 204
 205
 206 \ Evaluate FCode beginning at location addr.
 207
 208 \ : byte-load ( addr xt -- )
 209 \   \ this word is implemented in feval.fs
 210 \   ;
 211
 212 \ Set address and arguments of new device node.
 213 : set-args ( arg-str arg-len unit-str unit-len -- )
 214   ?my-self drop
 215
 216   depth 1- >r
 217   " decode-unit" ['] $call-parent catch if
 218     2drop 2drop
 219   then
 220
 221   my-self ihandle>phandle >dn.probe-addr \ offset
 222   begin depth r@ > while
 223     dup na1+ >r ! r>
 224   repeat
 225   r> 2drop
 226
 227   my-self >in.arguments 2@ free-mem
 228   strdup my-self >in.arguments 2!
 229 ;
 230
 231 : dma-alloc
 232   s" dma-alloc" $call-parent
 233   ;