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

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

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