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

1.7       pazsan      1: \ MISC simulator
                      2: 
1.10    ! anton       3: \ Copyright (C) 1998,2000,2003,2004,2007 Free Software Foundation, Inc.
1.7       pazsan      4: 
                      5: \ This file is part of Gforth.
                      6: 
                      7: \ Gforth is free software; you can redistribute it and/or
                      8: \ modify it under the terms of the GNU General Public License
1.9       anton       9: \ as published by the Free Software Foundation, either version 3
1.7       pazsan     10: \ of the License, or (at your option) any later version.
                     11: 
                     12: \ This program is distributed in the hope that it will be useful,
                     13: \ but WITHOUT ANY WARRANTY; without even the implied warranty of
                     14: \ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
                     15: \ GNU General Public License for more details.
                     16: 
                     17: \ You should have received a copy of the GNU General Public License
1.9       anton      18: \ along with this program. If not, see http://www.gnu.org/licenses/.
1.1       pazsan     19: 
                     20: decimal
                     21: 
                     22: : .####  base @ >r hex
                     23:        0 <# # # # # #> type space r> base ! ;
                     24: 
                     25: variable ndp   : here ndp @ ;
                     26: variable src   variable dst    variable pc     $10 pc !
                     27: Variable pc-old
                     28: 
                     29: variable zf
                     30: variable sf
                     31: variable cf
                     32: 
                     33: variable accu
                     34: 
                     35: variable mem-size      128 1024 * mem-size !
                     36: mem-size @ allocate throw
                     37: constant mem 
                     38: 
                     39: 0 ndp !
                     40: 
                     41: \ Jumping
                     42: 
                     43: : pc>          src @ 2* pc @ + ;
                     44: : >pc          pc ! ;
                     45: : >pcsf                sf @ IF >pc ELSE drop THEN ;
                     46: : >pczf                zf @ IF >pc ELSE drop THEN ;
                     47: : >pccf                cf @ IF >pc ELSE drop THEN ;
                     48: 
                     49: \ Memory
                     50: 
                     51: : ram>         2* mem + dup c@ 8 lshift swap char+ c@ or ;
                     52: 
1.6       pazsan     53: : >ram         \ dup $4000 u< ABORT" Memory below $4000 is read-only"
1.4       jwilke     54:                 2* mem + over 8 rshift over c! char+ c! ;
1.1       pazsan     55: 
                     56: \ IO
                     57: 
                     58: variable nesting 0 nesting !
                     59: : .hs
1.5       jwilke     60:        ." RP: " $4000 ram> .####
                     61:        ." SP: " $4001 ram> .####
                     62:        ." UP: " $4002 ram> .#### ;
                     63: 
                     64: : .ip
                     65:        $4003 ram> ." IP: " .#### ;
                     66: : trace
                     67:                cr nesting @ spaces 
                     68:                dup CASE [char] : OF 1 nesting +! .ip ENDOF 
                     69:                [char] ; OF -1 nesting +! ENDOF ENDCASE ;
1.1       pazsan     70: 
                     71: : >txd         
1.5       jwilke     72: \                trace
1.3       pazsan     73:                [IFDEF] curoff curoff [THEN]
1.1       pazsan     74:                dup bl < IF
                     75:                    CASE
                     76:                        #cr OF  ENDOF
                     77:                        #lf OF  cr  ENDOF
                     78:                        [IFDEF] del #bs OF  del  ENDOF [THEN]
                     79:                        dup emit  ENDCASE
                     80:                    ELSE  emit  THEN
1.3       pazsan     81:                [IFDEF] tflush tflush [ELSE] key? drop [THEN]
                     82:                [IFDEF] curon curon [THEN] [IFDEF] pause pause [THEN] ;
1.1       pazsan     83: : tx?>         1 ;
                     84: : rxd>         key [IFDEF] curon curon [THEN] ;
1.3       pazsan     85: : rx?>         key? 1 and [IFDEF] pause pause [THEN] ;
1.1       pazsan     86: 
                     87: \ Arithmetic
                     88: 
                     89: : accu!        ( u -- ) dup 0= zf ! dup $8000 and 0<> sf ! $FFFF and accu ! ;          
                     90: 
                     91: : >shr  cf @ >r dup 1 and 0<> cf !
                     92:     1 rshift r> IF $8000 or THEN accu! ;
                     93: : >xor  accu @ xor accu! ;
                     94: : >or   accu @ or accu! ;
                     95: : >and  accu @ and accu! ;
                     96: 
                     97: : (>sub) 2dup u< cf ! - accu! ;
                     98: : >sub9         accu @ swap (>sub) ;
                     99: : >subA  accu @ (>sub) ;
                    100:  
                    101: : >add  accu @ + $FFFF and dup accu @ u< cf ! accu! ;
                    102: 
                    103: : sf>  sf @ 1 and ;
                    104: : zf>  zf @ 1 and ;
                    105: : cf>  cf @ 1 and ;
                    106: 
                    107: : accu>                accu @ ;
                    108: : >accu                accu! ;
                    109: 
1.2       pazsan    110: : aind> accu @ ram> ;
                    111: : >aind accu @ >ram ;
                    112: 
1.1       pazsan    113: : crash  -$200 throw ;
                    114: 
                    115: create table>
                    116:        ' crash ,       ' tx?> ,        ' rxd> ,        ' rx?> ,
                    117:        ' pc> ,         ' pc> ,         ' pc> ,         ' pc> ,
1.2       pazsan    118:        ' crash ,       ' crash ,       ' crash ,       ' aind> ,
1.1       pazsan    119:        ' accu> ,       ' sf> ,         ' zf> ,         ' crash ,
                    120:        ' cf> ,         ' crash ,       ' crash ,       ' crash ,
                    121: 
                    122: create >table
                    123:        ' >txd ,        ' crash ,       ' crash ,       ' crash ,
                    124:        ' >pc ,         ' >pcsf ,       ' >pczf ,       ' crash ,
1.2       pazsan    125:        ' >pccf ,       ' crash ,       ' crash ,       ' >aind ,
1.1       pazsan    126:        ' >accu ,       ' >sub9 ,       ' >suba ,       ' >add ,
                    127:        ' >xor ,        ' >or ,         ' >and ,        ' >shr ,
                    128:        
                    129: : special? ( n -- ) $10 $FFFC within 0= ;
                    130: 
                    131: ' special? ALIAS special>?     ' special? ALIAS >special?
                    132: 
                    133: : dotable ( /trans table n -- trans/ )
                    134:     4 + $FFFF and cells + perform ;
                    135: 
                    136: : do>  ( -- val )
                    137:        src @ >special?
                    138:        IF      table> src @ dotable
                    139:        ELSE    src @ ram> 
1.2       pazsan    140:        THEN  ;
1.1       pazsan    141: 
                    142: : >do  ( val -- )
                    143:        dst @ >special?
                    144:        IF      >table dst @ dotable
                    145:        ELSE    dst @ >ram
                    146:        THEN ;
                    147: 
                    148: variable trans -1 trans !
                    149: 
                    150: : .stat
                    151:        ." PC: " pc-old @ .#### 
                    152:        ." : " src @ .####
                    153:        ." -( " trans @ .####
                    154:        ." )-> " dst @ .####
                    155:         ." ACCU: " accu @ .#### ;
                    156: 
                    157: variable steps 0 steps !
                    158: 
                    159: : step  1 steps +!
                    160:        pc @ pc-old !
                    161:        pc @ ram> src !
                    162:        pc @ 1+ ram> dst !
                    163:        do>     pc @ 2 + pc !
                    164:                dup trans ! 
                    165:        >do ;
                    166: 
                    167: : s step .stat cr ;
                    168: 
                    169: : load 
                    170:        bl word count r/o bin open-file throw >r
                    171:        mem mem-size @ r@ read-file throw
                    172:        r> close-file throw 
                    173:        . cr ;
                    174: 
                    175: : n,   ndp @ >ram 1 ndp +! ;
                    176: 
                    177: 
                    178: \ DUMP                       2may93jaw - 9may93jaw    06jul93py
                    179: 
                    180: Variable /dump
                    181: 
                    182: : .4 ( addr -- addr' )
                    183:     3 FOR  -1 /dump +!  /dump @ 0<
                    184:         IF  ."    "  ELSE  dup c@ 0 <# # # #> type space  THEN
                    185:     char+ NEXT ;
                    186: : .chars ( addr -- )
                    187:     /dump @ bounds
                    188:     ?DO I c@ dup $7F bl within
                    189:        IF  drop [char] .  THEN  emit
                    190:     LOOP ;
                    191: 
                    192: : .line ( addr -- )
                    193:   dup .4 space .4 ." - " .4 space .4 drop  10 /dump +!  space .chars ;
                    194: 
                    195: : d  ( addr u -- )
                    196:     swap 2* mem + swap
                    197:     cr base @ >r hex        \ save base on return stack
                    198:     0 ?DO  I' I - 10 min /dump !
                    199:         dup mem - 2/ 8 u.r ." : " dup .line cr  10 +
                    200:         10 +LOOP
                    201:     drop r> base ! ;
                    202: 
                    203: defer end? ' noop IS end?
                    204: 
                    205: variable t1 variable t2
                    206: 
                    207: : token2 t1 @ src @ = t2 @ dst @ = and or ;
                    208: 
                    209: : jmp?   dst @ 5 < or ;
                    210: : surejmp? dst @ 0= or ;
                    211: 
                    212: : st
                    213:   dup ram> t1 ! 1+ ram> t2 ! 
                    214:   ['] token2 IS end? ;
                    215: 
                    216: : stepinto BEGIN step false end? UNTIL ;
                    217: 
                    218: : g
                    219:     [IFDEF] curon curon [THEN]
                    220:     BEGIN step AGAIN
                    221:     [IFDEF] curoff curoff [THEN] ;
                    222: 
                    223: : si stepinto ." Stopped" cr .stat cr ;
                    224: 
                    225: variable stepcnt
                    226: 
                    227: : sq s 
                    228:        BEGIN key steps @ stepcnt ! CASE 
                    229:                [char] q OF EXIT ENDOF
                    230:                [char] j OF ['] jmp? IS end? stepinto ENDOF
                    231:                [char] s OF ['] surejmp? IS end? stepinto ENDOF
                    232:                [char] g OF ['] g catch -$200 = IF ." crashed " THEN  ENDOF
                    233:                step
                    234:                ENDCASE
                    235:                ." [" steps @ stepcnt @ - 0 <# #S #> type ." ]"
                    236:                .stat cr
                    237:        AGAIN ;
                    238: 

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