File:  [gforth] / gforth / arch / misc / sim.fs
Revision 1.10: download - view: text, annotated - select for diffs
Mon Dec 31 19:02:25 2007 UTC (14 years, 11 months ago) by anton
Branches: MAIN
CVS tags: v0-7-0, HEAD
updated copyright year after changing license notice

    1: \ MISC simulator
    2: 
    3: \ Copyright (C) 1998,2000,2003,2004,2007 Free Software Foundation, Inc.
    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
    9: \ as published by the Free Software Foundation, either version 3
   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
   18: \ along with this program. If not, see http://www.gnu.org/licenses/.
   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: 
   53: : >ram		\ dup $4000 u< ABORT" Memory below $4000 is read-only"
   54:                 2* mem + over 8 rshift over c! char+ c! ;
   55: 
   56: \ IO
   57: 
   58: variable nesting 0 nesting !
   59: : .hs
   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 ;
   70: 
   71: : >txd		
   72: \                trace
   73: 		[IFDEF] curoff curoff [THEN]
   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
   81: 		[IFDEF] tflush tflush [ELSE] key? drop [THEN]
   82: 		[IFDEF] curon curon [THEN] [IFDEF] pause pause [THEN] ;
   83: : tx?>		1 ;
   84: : rxd>		key [IFDEF] curon curon [THEN] ;
   85: : rx?>		key? 1 and [IFDEF] pause pause [THEN] ;
   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: 
  110: : aind> accu @ ram> ;
  111: : >aind accu @ >ram ;
  112: 
  113: : crash  -$200 throw ;
  114: 
  115: create table>
  116: 	' crash ,	' tx?> ,	' rxd> ,	' rx?> ,
  117: 	' pc> ,		' pc> ,		' pc> ,		' pc> ,
  118: 	' crash ,	' crash ,	' crash ,	' aind> ,
  119: 	' accu> ,	' sf> ,		' zf> ,		' crash ,
  120: 	' cf> ,		' crash ,	' crash ,	' crash ,
  121: 
  122: create >table
  123: 	' >txd ,	' crash ,	' crash ,	' crash ,
  124: 	' >pc ,		' >pcsf , 	' >pczf ,	' crash ,
  125: 	' >pccf ,	' crash ,	' crash ,	' >aind ,
  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> 
  140: 	THEN  ;
  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>