Return to other.fs CVS log

Up to [Qemu by Fabrice Bellard] / qemu / roms / openbios / forth / device

Annotation of qemu/roms/openbios/forth/device/other.fs, revision 1.1

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

This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.