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