Annotation of gforth/arch/misc/sim.fs, revision 1.4

1.1       pazsan      1: 
                      2: decimal
                      3: 
                      4: : .####  base @ >r hex
                      5:        0 <# # # # # #> type space r> base ! ;
                      6: 
                      7: variable ndp   : here ndp @ ;
                      8: variable src   variable dst    variable pc     $10 pc !
                      9: Variable pc-old
                     10: 
                     11: variable zf
                     12: variable sf
                     13: variable cf
                     14: 
                     15: variable accu
                     16: 
                     17: variable mem-size      128 1024 * mem-size !
                     18: mem-size @ allocate throw
                     19: constant mem 
                     20: 
                     21: 0 ndp !
                     22: 
                     23: \ Jumping
                     24: 
                     25: : pc>          src @ 2* pc @ + ;
                     26: : >pc          pc ! ;
                     27: : >pcsf                sf @ IF >pc ELSE drop THEN ;
                     28: : >pczf                zf @ IF >pc ELSE drop THEN ;
                     29: : >pccf                cf @ IF >pc ELSE drop THEN ;
                     30: 
                     31: \ Memory
                     32: 
                     33: : ram>         2* mem + dup c@ 8 lshift swap char+ c@ or ;
                     34: 
1.4     ! jwilke     35: : >ram         dup $4000 u< ABORT" Memory below $4000 is read-only"
        !            36:                 2* mem + over 8 rshift over c! char+ c! ;
1.1       pazsan     37: 
                     38: \ IO
                     39: 
                     40: variable nesting 0 nesting !
                     41: : .hs
                     42:        ." RP: " $12 ram> .####
                     43:        ." SP: " $13 ram> .####
                     44:        ." UP: " $14 ram> .#### ;
                     45: 
                     46: : >txd         
                     47:                \ cr nesting @ spaces 
                     48:                \ $15 ram> ." IP: " .#### .hs
                     49:                \ dup CASE [char] : OF 1 nesting +! ENDOF 
                     50:                \ [char] ; OF -1 nesting +! ENDOF ENDCASE
1.3       pazsan     51:                [IFDEF] curoff curoff [THEN]
1.1       pazsan     52:                dup bl < IF
                     53:                    CASE
                     54:                        #cr OF  ENDOF
                     55:                        #lf OF  cr  ENDOF
                     56:                        [IFDEF] del #bs OF  del  ENDOF [THEN]
                     57:                        dup emit  ENDCASE
                     58:                    ELSE  emit  THEN
1.3       pazsan     59:                [IFDEF] tflush tflush [ELSE] key? drop [THEN]
                     60:                [IFDEF] curon curon [THEN] [IFDEF] pause pause [THEN] ;
1.1       pazsan     61: : tx?>         1 ;
                     62: : rxd>         key [IFDEF] curon curon [THEN] ;
1.3       pazsan     63: : rx?>         key? 1 and [IFDEF] pause pause [THEN] ;
1.1       pazsan     64: 
                     65: \ Arithmetic
                     66: 
                     67: : accu!        ( u -- ) dup 0= zf ! dup $8000 and 0<> sf ! $FFFF and accu ! ;          
                     68: 
                     69: : >shr  cf @ >r dup 1 and 0<> cf !
                     70:     1 rshift r> IF $8000 or THEN accu! ;
                     71: : >xor  accu @ xor accu! ;
                     72: : >or   accu @ or accu! ;
                     73: : >and  accu @ and accu! ;
                     74: 
                     75: : (>sub) 2dup u< cf ! - accu! ;
                     76: : >sub9         accu @ swap (>sub) ;
                     77: : >subA  accu @ (>sub) ;
                     78:  
                     79: : >add  accu @ + $FFFF and dup accu @ u< cf ! accu! ;
                     80: 
                     81: : sf>  sf @ 1 and ;
                     82: : zf>  zf @ 1 and ;
                     83: : cf>  cf @ 1 and ;
                     84: 
                     85: : accu>                accu @ ;
                     86: : >accu                accu! ;
                     87: 
1.2       pazsan     88: : aind> accu @ ram> ;
                     89: : >aind accu @ >ram ;
                     90: 
1.1       pazsan     91: : crash  -$200 throw ;
                     92: 
                     93: create table>
                     94:        ' crash ,       ' tx?> ,        ' rxd> ,        ' rx?> ,
                     95:        ' pc> ,         ' pc> ,         ' pc> ,         ' pc> ,
1.2       pazsan     96:        ' crash ,       ' crash ,       ' crash ,       ' aind> ,
1.1       pazsan     97:        ' accu> ,       ' sf> ,         ' zf> ,         ' crash ,
                     98:        ' cf> ,         ' crash ,       ' crash ,       ' crash ,
                     99: 
                    100: create >table
                    101:        ' >txd ,        ' crash ,       ' crash ,       ' crash ,
                    102:        ' >pc ,         ' >pcsf ,       ' >pczf ,       ' crash ,
1.2       pazsan    103:        ' >pccf ,       ' crash ,       ' crash ,       ' >aind ,
1.1       pazsan    104:        ' >accu ,       ' >sub9 ,       ' >suba ,       ' >add ,
                    105:        ' >xor ,        ' >or ,         ' >and ,        ' >shr ,
                    106:        
                    107: : special? ( n -- ) $10 $FFFC within 0= ;
                    108: 
                    109: ' special? ALIAS special>?     ' special? ALIAS >special?
                    110: 
                    111: : dotable ( /trans table n -- trans/ )
                    112:     4 + $FFFF and cells + perform ;
                    113: 
                    114: : do>  ( -- val )
                    115:        src @ >special?
                    116:        IF      table> src @ dotable
                    117:        ELSE    src @ ram> 
1.2       pazsan    118:        THEN  ;
1.1       pazsan    119: 
                    120: : >do  ( val -- )
                    121:        dst @ >special?
                    122:        IF      >table dst @ dotable
                    123:        ELSE    dst @ >ram
                    124:        THEN ;
                    125: 
                    126: variable trans -1 trans !
                    127: 
                    128: : .stat
                    129:        ." PC: " pc-old @ .#### 
                    130:        ." : " src @ .####
                    131:        ." -( " trans @ .####
                    132:        ." )-> " dst @ .####
                    133:         ." ACCU: " accu @ .#### ;
                    134: 
                    135: variable steps 0 steps !
                    136: 
                    137: : step  1 steps +!
                    138:        pc @ pc-old !
                    139:        pc @ ram> src !
                    140:        pc @ 1+ ram> dst !
                    141:        do>     pc @ 2 + pc !
                    142:                dup trans ! 
                    143:        >do ;
                    144: 
                    145: : s step .stat cr ;
                    146: 
                    147: : load 
                    148:        bl word count r/o bin open-file throw >r
                    149:        mem mem-size @ r@ read-file throw
                    150:        r> close-file throw 
                    151:        . cr ;
                    152: 
                    153: : n,   ndp @ >ram 1 ndp +! ;
                    154: 
                    155: 
                    156: \ DUMP                       2may93jaw - 9may93jaw    06jul93py
                    157: 
                    158: Variable /dump
                    159: 
                    160: : .4 ( addr -- addr' )
                    161:     3 FOR  -1 /dump +!  /dump @ 0<
                    162:         IF  ."    "  ELSE  dup c@ 0 <# # # #> type space  THEN
                    163:     char+ NEXT ;
                    164: : .chars ( addr -- )
                    165:     /dump @ bounds
                    166:     ?DO I c@ dup $7F bl within
                    167:        IF  drop [char] .  THEN  emit
                    168:     LOOP ;
                    169: 
                    170: : .line ( addr -- )
                    171:   dup .4 space .4 ." - " .4 space .4 drop  10 /dump +!  space .chars ;
                    172: 
                    173: : d  ( addr u -- )
                    174:     swap 2* mem + swap
                    175:     cr base @ >r hex        \ save base on return stack
                    176:     0 ?DO  I' I - 10 min /dump !
                    177:         dup mem - 2/ 8 u.r ." : " dup .line cr  10 +
                    178:         10 +LOOP
                    179:     drop r> base ! ;
                    180: 
                    181: defer end? ' noop IS end?
                    182: 
                    183: variable t1 variable t2
                    184: 
                    185: : token2 t1 @ src @ = t2 @ dst @ = and or ;
                    186: 
                    187: : jmp?   dst @ 5 < or ;
                    188: : surejmp? dst @ 0= or ;
                    189: 
                    190: : st
                    191:   dup ram> t1 ! 1+ ram> t2 ! 
                    192:   ['] token2 IS end? ;
                    193: 
                    194: : stepinto BEGIN step false end? UNTIL ;
                    195: 
                    196: : g
                    197:     [IFDEF] curon curon [THEN]
                    198:     BEGIN step AGAIN
                    199:     [IFDEF] curoff curoff [THEN] ;
                    200: 
                    201: : si stepinto ." Stopped" cr .stat cr ;
                    202: 
                    203: variable stepcnt
                    204: 
                    205: : sq s 
                    206:        BEGIN key steps @ stepcnt ! CASE 
                    207:                [char] q OF EXIT ENDOF
                    208:                [char] j OF ['] jmp? IS end? stepinto ENDOF
                    209:                [char] s OF ['] surejmp? IS end? stepinto ENDOF
                    210:                [char] g OF ['] g catch -$200 = IF ." crashed " THEN  ENDOF
                    211:                step
                    212:                ENDCASE
                    213:                ." [" steps @ stepcnt @ - 0 <# #S #> type ." ]"
                    214:                .stat cr
                    215:        AGAIN ;
                    216: 

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>