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