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