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

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

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