1:
2: start-macros
3:
4: $04 Rb: tosl $05 Rb: tosh
5: $08 Rb: temp1l $09 Rb: temp1h
6:
7: $00 Rw: sp $01 Rw: rp $02 Rw: tos $03 Rw: ip
8: $04 Rw: temp1 $05 Rw: temp2
9:
10: : next,
11: \ cc_uc , (debug calla, \ Debugger-Aufruf
12: temp1 , ip ]+ mov, \ fetch cfa
13: temp2 , temp1 ]+ mov, \ get code address
14: cc_uc , temp2 ] jmpi,
15: ;
16:
17: : next1,
18: temp2 , temp1 ]+ mov,
19: cc_uc , temp2 ] jmpi,
20: ;
21:
22: end-macros
23:
24: Label into-forth
25: ip , $ffff # mov,
26: sp , $fd80 # mov,
27: rp , $fde0 # mov,
28: next,
29: End-Label
30:
31: Label (dout)
32: _s0tic . 7 , here jnb, _s0tic . 7 bclr,
33: _s0tbuf , rl6 movb, ret,
34: End-Label
35:
36: Start-Macros
37:
38: \ : dout, >r rl6 , r> # movb,
39: \ cc_uc , (dout) Calla, ;
40:
41: : dout, drop ;
42:
43: end-macros
44:
45: Code: :docol
46: ': dout,
47: rp -] , ip mov, \ store IP on return stack
48: ip , temp1 mov, \
49: ip , 2 # add, \ zum PFA
50: next,
51: End-Code
52:
53: Code ;s
54: '; dout,
55: ip , rp ]+ mov, \ fetch callback address
56: next,
57: End-Code
58:
59: \ Rest 25jul97jaw
60:
61: Code: :dovar
62: '2 dout,
63: sp -] , tos mov,
64: temp1 , 2 # add,
65: tos , temp1 mov,
66: next,
67: End-Code
68:
69: Code: :docon
70: '1 dout,
71: sp -] , tos mov,
72: temp1 , 2 # add,
73: tos , temp1 ] mov,
74: next,
75: End-Code
76:
77: Code: :dodoes
78: '6 dout,
79: rp -] , ip mov,
80: ip , temp1 ] mov,
81: sp -] , tos mov,
82: temp1 , 2 # add,
83: tos , temp1 mov,
84: next,
85: End-Code
86:
87: Code: :dodefer
88: '4 dout,
89: temp1 , 2 # add,
90: temp1 , temp1 ] mov,
91: Next1,
92: End-Code
93:
94: Code execute ( xt -- ) \ execute colon definition
95: 'E dout,
96: temp1 , tos mov,
97: tos , sp ]+ mov,
98: Next1,
99: End-Code
100:
101: \ Zusatzroutinen zu bedingten Befehlen ( 17.06.96/KK )
102: Code branch ( -- ) \ Inline-Sprung ausfhren
103: ip , ip ] add, next,
104: End-Code
105:
106: Code ?branch ( f -- ) \ Test und Sprung bei 0
107: tos , tos mov,
108: cc_z IF, tos , sp ]+ mov, ip , ip ] add, next, THEN,
109: tos , sp ]+ mov, ip , 2 s# add, next,
110: End-Code
111:
112: Code lit ( -- n ) \ Inline-Literal lesen
113: sp -] , tos mov, tos , ip ]+ mov, next,
114: End-Code
115:
116: \ Stack Words ( 17.06.96/KK )
117:
118: Code dup ( n -- n n ) \ TOS verdoppeln
119: sp -] , tos mov, next,
120: End-Code
121:
122: Code 2dup ( d -- d d ) \ TOS/NOS verdoppeln
123: temp1 , sp ] mov, sp -] , tos mov,
124: sp -] , temp1 mov, next,
125: End-Code
126:
127: Code drop ( n -- ) \ TOS entfernen
128: tos , sp ]+ mov, next,
129: End-Code
130:
131: Code 2drop ( d -- ) \ TOS/NOS entfernen
132: sp , 2 s# add, tos , sp ]+ mov, next,
133: End-Code
134:
135: Code swap ( n1 n2 -- n2 n1 ) \ TOS/NOS vertauschen
136: temp1 , sp ] mov, sp ] , tos mov, tos , temp1 mov,
137: next,
138: End-Code
139:
140: Code over ( n1 n2 -- n1 n2 n1 ) \ NOS verdoppeln
141: sp -] , tos mov, tos , sp 2 #] mov, next,
142: End-Code
143:
144: Code rot ( n1 n2 n3 -- n2 n3 n1 ) \ Rotieren
145: temp1 , sp ]+ mov, temp2 , sp ]+ mov,
146: sp -] , temp1 mov, sp -] , tos mov,
147: tos , temp2 mov, next, End-Code
148:
149: Code -rot ( n1 n2 n3 -- n3 n1 n2 ) \ Rotieren
150: temp1 , sp ]+ mov, temp2 , sp ]+ mov,
151: sp -] , tos mov, sp -] , temp2 mov,
152: tos , temp1 mov, next, End-Code
153:
154: Code sp@
155: sp -] , tos mov,
156: tos , sp mov,
157: next,
158: End-Code
159:
160: Code sp!
161: sp , tos mov,
162: tos , sp ]+ mov,
163: next,
164: End-Code
165:
166: Code rp@
167: sp -] , tos mov,
168: tos , rp mov,
169: next,
170: End-Code
171:
172: Code rp!
173: rp , tos mov,
174: tos , sp ]+ mov,
175: next,
176: End-Code
177:
178: Code r>
179: sp -] , tos mov,
180: tos , rp ]+ mov,
181: next,
182: End-Code
183:
184: Code >r
185: rp -] , tos mov,
186: tos , sp ]+ mov,
187: next,
188: End-Code
189:
190: Code r@
191: sp -] , tos mov,
192: tos , rp ] mov,
193: next,
194: End-Code
195:
196: \ Arithmetik ( 17.06.96/KK )
197:
198: Code + ( n1 n2 -- n3 ) \ Addition
199: tos , sp ]+ add, next,
200: End-Code
201:
202: Code - ( n1 n2 -- n3 ) \ Subtraktion
203: temp1 , tos mov, tos , sp ]+ mov,
204: tos , temp1 sub, next,
205: End-Code
206:
207: Code and ( n1 n2 -- n3 ) \ Logische AND-Verknpfung
208: tos , sp ]+ and, next,
209: End-Code
210:
211: Code xor ( n1 n2 -- n3 ) \ Logische AND-Verknpfung
212: tos , sp ]+ xor, next,
213: End-Code
214:
215: Code or ( n1 n2 -- n3 ) \ Logische OR-Verknpfung
216: tos , sp ]+ or, next,
217: End-Code
218:
219: Code 0= ( n -- f ) \ Test auf 0
220: tos , tos mov,
221: cc_z IF, tos , -1 # mov, ELSE, tos , 0 s# mov, THEN,
222: next,
223: End-Code
224:
225: Code = ( n1 n2 -- f ) \ Test auf Gleichheit
226: tos , sp ]+ sub,
227: cc_z IF, tos , -1 # mov, ELSE, tos , 0 s# mov, THEN,
228: next,
229: End-Code
230:
231: \ Memory ( 01.01.97/KK )
232:
233: Code c@ ( addr -- c ) \ Byte auslesen
234: tosl , tos ] movb, tosh , 0 s# movb, next,
235: End-Code
236:
237: Code @ ( addr -- n ) \ Wort auslesen
238: tos , tos ] mov, next,
239: End-Code
240:
241: Code c! ( c addr -- ) \ Byte schreiben
242: temp1 , sp ]+ mov, tos ] , temp1l movb,
243: tos , sp ]+ mov, next,
244: End-Code
245:
246: Code ! ( n addr -- ) \ Wort schreiben
247: temp1 , sp ]+ mov, tos ] , temp1 mov,
248: tos , sp ]+ mov, next,
249: End-Code
250:
251:
252: \ SIO-Grundroutinen ( 09.06.96/KK )
253: Code key? ( -- f ) \ Flag, ob Zeichen anliegt
254: sp -] , tos mov, tos , 0 s# mov,
255: _s0ric . 7 , here 6 + jnb,
256: tos , 1 s# sub, next, End-Code
257: Code (key) ( -- char ) \ Zeichen holen
258: _s0ric . 7 , here jnb, _s0ric . 7 bclr, sp -] , tos mov,
259: tosh , 0 s# movb, tosl , _s0rbuf movb, next, End-Code
260: Code emit? ( -- f ) \ Flag, ob Zeichen ausgebbar
261: sp -] , tos mov, tos , 0 s# mov,
262: _s0tic . 7 , here 6 + jnb,
263: tos , 1 s# sub, next, End-Code
264: Code (emit) ( char -- ) \ Zeichen ausgeben
265: _s0tic . 7 , here jnb, _s0tic . 7 bclr,
266: _s0tbuf , tosl movb, tos , sp ]+ mov, next, End-Code
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to prim.fs CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [gforth] / gforth / arch / c165