Annotation of gforth/arch/r8c/prim.fs, revision 1.2
1.1 pazsan 1: \ r8c/m16c primitives
2:
3: \ Copyright (C) 2006 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.
20:
21: \ * Register using for r8c
22: \ Renesas Forth used for
23: \ R0 TOS oberstes Stackelement
24: \ R3 RP Returnstack Pointer
25: \ SP SP Stack Pointer
26: \ A1 IP Instruction Pointer
27: \ A0 W Arbeitsregister
28: \
29: \ * Memory ( use only one 64K-Page ): TBD
30: \ **************************************************************
31:
32:
33: start-macros
34: \ register definition
35: ' R3 Alias rp
36: ' R0 Alias tos
1.2 ! pazsan 37: ' R0L Alias tos.b
1.1 pazsan 38: ' A1 Alias ip
39: ' A0 Alias w
40: ' [A1] Alias [ip]
41: ' [A0] Alias [w]
42:
43: \ system depending macros
44: : next,
45: [ip] , w mov.w:g
46: # 2 , ip add.w:q
47: [w] jmpi.w ;
48: \ note that this is really for 8086 and 286, and _not_ intented to run
49: \ fast on a Pentium (Pro). These old chips load their code from real RAM
50: \ and do it slow, anyway.
51: \ If you really want to have a fast 16 bit Forth on modern processors,
52: \ redefine it as
53: \ : next, [ip] w mov, 2 # ip add, [w] jmp, ;
54:
55: end-macros
56:
57: unlock
1.2 ! pazsan 58: $0000 $FFFF region address-space
! 59: $C000 $4000 region rom-dictionary
! 60: $0400 $0400 region ram-dictionary
! 61: .regions
! 62: setup-target
1.1 pazsan 63: lock
64:
65: \ ==============================================================
66: \ rom starts with jump to GFORTH-kernel (must be at $0000 !!!)
67: \ ==============================================================
68: Label into-forth
69: # $ffff , ip mov.w:g \ ip will be patched
1.2 ! pazsan 70: # $fef0 , sp ldc \ sp at $FD80...$FEF0
1.1 pazsan 71: # $fd80 , rp mov.w:g \ rp at $F.00...$FD80
72: next,
73: End-Label
74:
75:
76: \ ==============================================================
77: \ GFORTH minimal primitive set
78: \ ==============================================================
79: \ inner interpreter
80: Code: :docol
81: \ ': dout, \ only for debugging
82: # -2 , rp add.w:q
83: w , r2 mov.w:g
84: rp , w mov.w:g ip , [w] mov.w:g
85: # 4 , r2 add.w:q r2 , ip mov.w:g
86: next,
87: End-Code
88:
89: Code: :dovar
90: \ '2 dout, \ only for debugging
1.2 ! pazsan 91: tos push.w:g
1.1 pazsan 92: # 4 , w add.w:q
93: w , tos mov.w:g
94: next,
95: End-Code
96:
97: Code: :dodoes ( -- pfa ) \ get pfa and execute DOES> part
98: \ '6 dout, \ only for debugging
99: next, \ execute does> part
100: End-Code
101:
102:
103: \ program flow
104: Code ;s ( -- ) \ exit colon definition
105: \ '; dout, \ only for debugging
106: rp , w mov.w:g # 2 , rp add.w:q
107: [w] , ip mov.w:g
108: next,
109: End-Code
110:
111: Code execute ( xt -- ) \ execute colon definition
112: \ 'E dout, \ only for debugging
113: tos , w mov.w:g \ copy tos to w
1.2 ! pazsan 114: tos pop.w:g \ get new tos
! 115: [w] jmpi.w \ execute
1.1 pazsan 116: End-Code
117:
118: Code ?branch ( f -- ) \ jump on f<>0
1.2 ! pazsan 119: [ip] , w mov.w:g
! 120: tos , tos tst.w 0<> IF w , ip mov.w:g THEN
! 121: next,
1.1 pazsan 122: End-Code
123:
124:
125: \ memory access
126: Code @ ( addr -- n ) \ read cell
1.2 ! pazsan 127: tos , w mov.w:g [w] , tos mov.w:g
1.1 pazsan 128: next,
129: End-Code
130:
131: Code ! ( n addr -- ) \ write cell
1.2 ! pazsan 132: tos , w mov.w:g tos pop.w:g tos , [w] mov.w:g
! 133: tos pop.w:g
! 134: next,
! 135: End-Code
! 136:
! 137: Code c@ ( addr -- n ) \ read cell
! 138: tos , w mov.w:g tos , tos xor.w [w] , tos.b mov.b:g
! 139: next,
! 140: End-Code
! 141:
! 142: Code c! ( n addr -- ) \ write cell
! 143: tos , w mov.w:g tos pop.w:g tos.b , [w] mov.b:g
! 144: tos pop.w:g
! 145: next,
! 146: End-Code
! 147:
! 148: \ arithmetic and logic
! 149: Code + ( n1 n2 -- n3 ) \ addition
! 150: r1 pop.w:g
! 151: r1 , tos add.w:g
! 152: next,
! 153: End-Code
! 154:
! 155: Code - ( n1 n2 -- n3 ) \ addition
! 156: r1 pop.w:g
! 157: tos , r1 sub.w:g
! 158: r1 , tos mov.w:g
! 159: next,
! 160: End-Code
! 161:
! 162: Code and ( n1 n2 -- n3 ) \ addition
! 163: r1 pop.w:g
! 164: r1 , tos and.w:g
! 165: next,
! 166: End-Code
! 167:
! 168: Code or ( n1 n2 -- n3 ) \ addition
! 169: r1 pop.w:g
! 170: r1 , tos or.w:g
! 171: next,
! 172: End-Code
! 173:
! 174: Code xor ( n1 n2 -- n3 ) \ addition
! 175: r1 pop.w:g
! 176: r1 , tos xor.w
! 177: next,
! 178: End-Code
! 179:
! 180: \ moving datas between stacks
! 181: Code r> ( -- n ; R: n -- )
! 182: tos push.w:g
! 183: rp , w mov.w:g
! 184: [w] , tos mov.w:g
! 185: # 2 , rp add.w:g
1.1 pazsan 186: next,
187: End-Code
188:
1.2 ! pazsan 189: Code >r ( n -- ; R: -- n )
! 190: # -2 , rp add.w:g
! 191: rp , w mov.w:g
! 192: tos , [w] mov.w:g
! 193: tos pop.w:g
! 194: next,
! 195: End-Code
! 196:
1.1 pazsan 197: \ datastack and returnstack address
198: Code sp@ ( -- sp ) \ get stack address
1.2 ! pazsan 199: tos push.w:g
! 200: sp , tos stc
! 201: next,
! 202: End-Code
1.1 pazsan 203:
204: Code sp! ( sp -- ) \ set stack address
1.2 ! pazsan 205: tos , sp ldc
! 206: tos pop.w:g
! 207: next,
1.1 pazsan 208: End-Code
209:
210: Code rp@ ( -- rp ) \ get returnstack address
1.2 ! pazsan 211: tos push.w:g
! 212: rp , tos mov.w:g
1.1 pazsan 213: next,
214: End-Code
215:
216: Code rp! ( rp -- ) \ set returnstack address
1.2 ! pazsan 217: tos , rp mov.w:g
! 218: tos pop.w:g
! 219: next,
1.1 pazsan 220: End-Code
221:
1.2 ! pazsan 222: Code: :docon
! 223: tos push.w:g
! 224: 4 [w] , tos mov.w:g
! 225: next,
! 226: End-Code
1.1 pazsan 227:
1.2 ! pazsan 228: Code: :dodefer
! 229: 4 [w] , w mov.w:g
! 230: [w] jmpi.w
! 231: End-Code
1.1 pazsan 232:
1.2 ! pazsan 233: Code branch ( -- ) \ unconditional branch
! 234: [ip] , ip mov.w:g
! 235: next,
1.1 pazsan 236: End-Code
237:
1.2 ! pazsan 238: Code lit ( -- n ) \ inline literal
! 239: tos push.w:g
! 240: [ip] , tos mov.w:g
! 241: # 2 , ip add.w:g
! 242: next,
1.1 pazsan 243: End-Code
244:
1.2 ! pazsan 245: Code: :doesjump
! 246: end-code
1.1 pazsan 247:
1.2 ! pazsan 248: 0 [IF]
1.1 pazsan 249: \ i/o
250: Variable lastkey \ Flag und Zeichencode der letzen Taste
251:
252: Code (key) ( -- char ) \ get character
253: tos push,
254: lastkey #) ax mov,
255: ah ah or, 0= IF, 7 # ah mov, $21 int, THEN,
256: 0 # lastkey #) mov,
257: ah ah xor,
258: ax tos mov,
259: next,
260: End-Code
261:
262: Code (emit) ( char -- ) \ output character
263: tosl dl mov,
264: 6 # ah mov,
265: $ff # dl cmp, 0= IF, dl dec, THEN,
266: $21 int,
267: tos pop,
268: next,
269: End-Code
270:
271: \ ==============================================================
272: \ usefull lowlevel words
273: \ ==============================================================
274: \ word definitions
275:
276:
277: \ branch and literal
278: Code branch ( -- ) \ unconditional branch
279: f[ip] fip mov,
280: next,
281: End-Code
282:
283: Code lit ( -- n ) \ inline literal
284: tos push,
285: lods,
286: ax tos mov,
287: next,
288: End-Code
289:
290:
291: \ data stack words
292: Code dup ( n -- n n )
293: tos push,
294: next,
295: End-Code
296:
297: Code 2dup ( d -- d d )
298: ax pop,
299: ax push,
300: tos push,
301: ax push,
302: next,
303: End-Code
304:
305: Code drop ( n -- )
306: tos pop,
307: next,
308: End-Code
309:
310: Code 2drop ( d -- )
311: 2 # fsp add,
312: tos pop,
313: next,
314: End-Code
315:
316: Code swap ( n1 n2 -- n2 n1 )
317: ax pop,
318: tos push,
319: ax tos mov,
320: next,
321: End-Code
322:
323: Code over ( n1 n2 -- n1 n2 n1 )
324: tos ax mov,
325: tos pop,
326: tos push,
327: ax push,
328: next,
329: End-Code
330:
331: Code rot ( n1 n2 n3 -- n2 n3 n1 )
332: tos ax mov,
333: cx pop,
334: tos pop,
335: cx push,
336: ax push,
337: next,
338: End-Code
339:
340: Code -rot ( n1 n2 n3 -- n3 n1 n2 )
341: tos ax mov,
342: tos pop,
343: cx pop,
344: ax push,
345: cx push,
346: next,
347: End-Code
348:
349:
350: \ return stack
351: Code r@ ( -- n ; R: n -- n )
352: tos push,
353: frp ) tos mov,
354: next,
355: End-Code
356:
357:
358: \ arithmetic
359: Code - ( n1 n2 -- n3 ) \ Subtraktion
360: ax pop,
361: tos ax sub,
362: ax tos mov,
363: next,
364: End-Code
365:
366: Code um* ( u1 u2 -- ud ) \ unsigned multiply
367: tos ax mov,
368: cx pop,
369: cx mul,
370: ax push,
371: dx tos mov,
372: next,
373: End-Code
374:
375: Code um/mod ( ud u -- r q ) \ unsiged divide
376: tos cx mov,
377: dx pop,
378: ax pop,
379: cx div,
380: dx push,
381: ax tos mov,
382: next,
383: End-Code
384:
385:
386: \ logic
387: Code or ( n1 n2 -- n3 ) \ logic OR
388: ax pop, ax tos or, next,
389: End-Code
390:
391:
392: \ shift
393: Code 2/ ( n1 -- n2 ) \ arithmetic shift right
394: tos sar,
395: next,
396: End-Code
397:
398: Code lshift ( n1 n2 -- n3 ) \ shift n1 left n2 bits
399: tos cx mov,
400: tos pop,
401: cx cx or, 0<> IF, tos c* shl, THEN,
402: next,
403: End-Code
404:
405: Code rshift ( n1 n2 -- n3 ) \ shift n1 right n2 bits
406: tos cx mov,
407: tos pop,
408: cx cx or, 0<> IF, tos c* shr, THEN,
409: next,
410: End-Code
411:
412:
413: \ compare
414: Code 0= ( n -- f ) \ Test auf 0
415: tos tos or,
416: 0 # tos mov,
417: 0= IF, tos dec, THEN,
418: next,
419: End-Code
420:
421: Code = ( n1 n2 -- f ) \ Test auf Gleichheit
422: ax pop,
423: ax tos sub,
424: 0= IF, -1 # tos mov, next,
425: ELSE, 0 # tos mov, next,
426: THEN,
427: End-Code
428:
429:
430: \ additon io routines
431: Code (key?) ( -- f ) \ check for read sio character
432: tos push, lastkey # tos mov,
433: 1 tos d) ah mov, ah ah or,
434: 0= IF, $ff # dl mov, 6 # ah mov, $21 int,
435: 0 # ah mov,
436: 0<> IF, dl ah mov, ax tos ) mov, THEN,
437: THEN, ah tosl mov, ah tosh mov,
438: next,
439: End-Code
440:
441: Code emit? ( -- f ) \ check for write character to sio
442: tos push,
443: -1 # tos mov, \ output always possible
444: next,
445: End-Code
446:
447: Code (bye) ( -- ) \ back to DOS
448: ax pop, $4c # ah mov, $21 int,
449: End-Code
450:
451: : bye ( -- ) 0 (bye) ;
452:
453: Code: :doesjump
454: end-code
1.2 ! pazsan 455: [then]
! 456:
! 457: Code (bye) ( 0 -- ) \ back to DOS
! 458: tos pop.w:g
! 459: next,
! 460: End-Code
! 461:
! 462: : bye ( -- ) 0 (bye) ;
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 / r8c