Annotation of gforth/arch/r8c/prim.fs, revision 1.11
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
1.2 pazsan 35: ' R0L Alias tos.b
1.1 pazsan 36:
1.7 pazsan 37: \ hfs wichtig, damit der erste Befehl richtig compiliert wird
38: reset \ hfs
39:
1.1 pazsan 40: \ system depending macros
1.8 pazsan 41: : next1,
42: [w] , r1 mov.w:g r1 jmpi.a ;
1.1 pazsan 43: : next,
44: [ip] , w mov.w:g
1.8 pazsan 45: # 2 , ip add.w:q next1, ;
1.1 pazsan 46: \ note that this is really for 8086 and 286, and _not_ intented to run
47: \ fast on a Pentium (Pro). These old chips load their code from real RAM
48: \ and do it slow, anyway.
49: \ If you really want to have a fast 16 bit Forth on modern processors,
50: \ redefine it as
51: \ : next, [ip] w mov, 2 # ip add, [w] jmp, ;
52:
53: end-macros
54:
55: unlock
1.2 pazsan 56: $0000 $FFFF region address-space
57: $C000 $4000 region rom-dictionary
1.5 pazsan 58: $0400 $0400 region ram-dictionary
1.2 pazsan 59: .regions
60: setup-target
1.1 pazsan 61: lock
62:
63: \ ==============================================================
64: \ rom starts with jump to GFORTH-kernel (must be at $0000 !!!)
65: \ ==============================================================
66: Label into-forth
67: # $ffff , ip mov.w:g \ ip will be patched
1.5 pazsan 68: # $07FE , sp ldc \ sp at $0700...$07FE
69: # $0700 , rp mov.w:g \ rp at $0600...$0700
1.9 pazsan 70: # $0F , $E3 mov.b:g
71: # $0F , $E1 mov.b:g
72: Label clock-init \ default is 125kHz/8
1.10 pazsan 73: # $01 , $0A mov.b:g
74: # $28 , $07 mov.b:g
1.9 pazsan 75: # $08 , $06 mov.b:g
1.10 pazsan 76: # $00 , $0A mov.b:g
77: r1 , r1 mov.w:g
78: r1 , r1 mov.w:g
79: r1 , r1 mov.w:g
80: r1 , r1 mov.w:g
1.9 pazsan 81: # $00 , $08 mov.b:g \ set to 20MHz
1.5 pazsan 82: Label uart-init
1.10 pazsan 83: # $23 , $B0 mov.b:g \ hfs
1.7 pazsan 84: # $8105 , $A8 mov.w:g \ ser1: 9600 baud, 8N1 \ hfs
1.10 pazsan 85: # $0500 , $AC mov.w:g \ hfs
86: next,
1.1 pazsan 87: End-Label
88:
89:
90: \ ==============================================================
91: \ GFORTH minimal primitive set
92: \ ==============================================================
93: \ inner interpreter
94: Code: :docol
95: \ ': dout, \ only for debugging
96: # -2 , rp add.w:q
1.7 pazsan 97: w , r1 mov.w:g
1.1 pazsan 98: rp , w mov.w:g ip , [w] mov.w:g
1.7 pazsan 99: # 4 , r1 add.w:q r1 , ip mov.w:g
1.1 pazsan 100: next,
101: End-Code
102:
103: Code: :dovar
104: \ '2 dout, \ only for debugging
1.2 pazsan 105: tos push.w:g
1.1 pazsan 106: # 4 , w add.w:q
107: w , tos mov.w:g
108: next,
109: End-Code
110:
1.4 pazsan 111: Code: :docon
112: \ '2 dout, \ only for debugging
113: tos push.w:g
1.10 pazsan 114: 4 [w] , tos mov.w:g
1.4 pazsan 115: next,
116: End-Code
117:
1.8 pazsan 118: Code: :dovalue
119: \ '2 dout, \ only for debugging
120: tos push.w:g
1.10 pazsan 121: 4 [w] , w mov.w:g [w] , tos mov.w:g
1.8 pazsan 122: next,
1.4 pazsan 123: End-Code
124:
1.9 pazsan 125: Code: :dodefer
1.10 pazsan 126: \ # $05 , $E1 mov.b:g
127: 4 [w] , w mov.w:g [w] , w mov.w:g
1.9 pazsan 128: next1,
129: End-Code
1.8 pazsan 130:
1.1 pazsan 131: Code: :dodoes ( -- pfa ) \ get pfa and execute DOES> part
132: \ '6 dout, \ only for debugging
1.8 pazsan 133: \ # $06 , $E1 mov.b:g
134: tos push.w:g
135: w , tos mov.w:g # 4 , tos add.w:q
1.7 pazsan 136: # -2 , rp add.w:q
1.10 pazsan 137: 2 [w] , r1 mov.w:g
1.7 pazsan 138: rp , w mov.w:g ip , [w] mov.w:g
139: # 4 , r1 add.w:q r1 , ip mov.w:g
1.1 pazsan 140: next, \ execute does> part
1.5 pazsan 141: End-Code
142:
1.1 pazsan 143: \ program flow
144: Code ;s ( -- ) \ exit colon definition
145: \ '; dout, \ only for debugging
146: rp , w mov.w:g # 2 , rp add.w:q
147: [w] , ip mov.w:g
148: next,
149: End-Code
150:
151: Code execute ( xt -- ) \ execute colon definition
152: \ 'E dout, \ only for debugging
1.10 pazsan 153: \ # $07 , $E1 mov.b:g
1.8 pazsan 154: tos , w mov.w:g \ copy tos to w
155: tos pop.w:g \ get new tos
156: next1,
1.1 pazsan 157: End-Code
158:
1.10 pazsan 159: Code ?branch ( f -- ) \ jump on f=0
1.7 pazsan 160: # 2 , ip add.w:q
1.10 pazsan 161: tos , tos tst.w 0= IF -2 [ip] , ip mov.w:g THEN
1.11 ! pazsan 162: tos pop.w:g
1.2 pazsan 163: next,
1.1 pazsan 164: End-Code
165:
1.10 pazsan 166: Code (for) ( n -- r:0 r:n )
167: # -4 , rp add.w:q rp , w mov.w:g
168: r3 , 2 [w] mov.w:g
169: tos , [w] mov.w:g
170: tos pop.w:g
171: next,
172: End-Code
173:
174: Code (?do) ( n -- r:0 r:n )
175: # 2 , ip add.w:q
176: # -4 , rp add.w:q rp , w mov.w:g
177: tos , [w] mov.w:g
178: r1 pop.w:g
179: r1 , 2 [w] mov.w:g
180: tos pop.w:g
181: [w] , r1 sub.w:g
182: 0= IF -2 [ip] , ip mov.w:g THEN
183: next,
184: End-Code
185:
186: Code (do) ( n -- r:0 r:n )
187: # -4 , rp add.w:q rp , w mov.w:g
188: tos , [w] mov.w:g
189: tos pop.w:g
190: tos , 2 [w] mov.w:g
191: tos pop.w:g
192: next,
193: End-Code
194:
195: Code (next) ( -- )
196: # 2 , ip add.w:q
197: rp , w mov.w:g [w] , r1 mov.w:g
198: # -1 , r1 add.w:q r1 , [w] mov.w:g
199: u>= IF -2 [ip] , ip mov.w:g THEN
200: next,
201: End-Code
202:
203: Code (loop) ( -- )
204: # 2 , ip add.w:q
205: rp , w mov.w:g [w] , r1 mov.w:g
206: # 1 , r1 add.w:q r1 , [w] mov.w:g
207: 2 [w] , r1 sub.w:g
208: 0<> IF -2 [ip] , ip mov.w:g THEN
209: next,
210: End-Code
1.1 pazsan 211:
212: \ memory access
213: Code @ ( addr -- n ) \ read cell
1.2 pazsan 214: tos , w mov.w:g [w] , tos mov.w:g
1.1 pazsan 215: next,
216: End-Code
217:
218: Code ! ( n addr -- ) \ write cell
1.2 pazsan 219: tos , w mov.w:g tos pop.w:g tos , [w] mov.w:g
220: tos pop.w:g
221: next,
222: End-Code
223:
224: Code c@ ( addr -- n ) \ read cell
225: tos , w mov.w:g tos , tos xor.w [w] , tos.b mov.b:g
226: next,
227: End-Code
228:
229: Code c! ( n addr -- ) \ write cell
230: tos , w mov.w:g tos pop.w:g tos.b , [w] mov.b:g
231: tos pop.w:g
232: next,
233: End-Code
234:
235: \ arithmetic and logic
236: Code + ( n1 n2 -- n3 ) \ addition
237: r1 pop.w:g
238: r1 , tos add.w:g
239: next,
240: End-Code
241:
242: Code - ( n1 n2 -- n3 ) \ addition
243: r1 pop.w:g
244: tos , r1 sub.w:g
245: r1 , tos mov.w:g
246: next,
247: End-Code
248:
249: Code and ( n1 n2 -- n3 ) \ addition
250: r1 pop.w:g
251: r1 , tos and.w:g
252: next,
253: End-Code
254:
255: Code or ( n1 n2 -- n3 ) \ addition
256: r1 pop.w:g
257: r1 , tos or.w:g
258: next,
259: End-Code
260:
261: Code xor ( n1 n2 -- n3 ) \ addition
262: r1 pop.w:g
263: r1 , tos xor.w
264: next,
265: End-Code
266:
267: \ moving datas between stacks
268: Code r> ( -- n ; R: n -- )
269: tos push.w:g
270: rp , w mov.w:g
271: [w] , tos mov.w:g
1.7 pazsan 272: # 2 , rp add.w:q \ ? hfs
1.1 pazsan 273: next,
274: End-Code
275:
1.2 pazsan 276: Code >r ( n -- ; R: -- n )
1.7 pazsan 277: # -2 , rp add.w:q \ ? hfs
1.2 pazsan 278: rp , w mov.w:g
279: tos , [w] mov.w:g
280: tos pop.w:g
281: next,
282: End-Code
283:
1.10 pazsan 284: Code rdrop ( R:n -- )
285: # 2 , rp add.w:q \ ? hfs
286: next,
287: End-Code
288:
289: Code unloop ( R:n -- )
290: # 4 , rp add.w:q \ ? hfs
291: next,
292: End-Code
293:
1.1 pazsan 294: \ datastack and returnstack address
295: Code sp@ ( -- sp ) \ get stack address
1.2 pazsan 296: tos push.w:g
297: sp , tos stc
298: next,
299: End-Code
1.1 pazsan 300:
301: Code sp! ( sp -- ) \ set stack address
1.2 pazsan 302: tos , sp ldc
303: tos pop.w:g
304: next,
1.1 pazsan 305: End-Code
306:
307: Code rp@ ( -- rp ) \ get returnstack address
1.2 pazsan 308: tos push.w:g
309: rp , tos mov.w:g
1.1 pazsan 310: next,
311: End-Code
312:
313: Code rp! ( rp -- ) \ set returnstack address
1.2 pazsan 314: tos , rp mov.w:g
315: tos pop.w:g
316: next,
317: End-Code
1.1 pazsan 318:
1.2 pazsan 319: Code branch ( -- ) \ unconditional branch
320: [ip] , ip mov.w:g
321: next,
1.1 pazsan 322: End-Code
323:
1.2 pazsan 324: Code lit ( -- n ) \ inline literal
325: tos push.w:g
326: [ip] , tos mov.w:g
1.3 pazsan 327: # 2 , ip add.w:q
1.2 pazsan 328: next,
1.1 pazsan 329: End-Code
330:
1.2 pazsan 331: Code: :doesjump
332: end-code
1.1 pazsan 333:
334: \ ==============================================================
335: \ usefull lowlevel words
336: \ ==============================================================
337: \ word definitions
338:
339:
340: \ branch and literal
341:
342: \ data stack words
343: Code dup ( n -- n n )
1.3 pazsan 344: tos push.w:g
1.1 pazsan 345: next,
346: End-Code
347:
348: Code 2dup ( d -- d d )
1.3 pazsan 349: r1 pop.w:g
350: r1 push.w:g
351: tos push.w:g
352: r1 push.w:g
1.1 pazsan 353: next,
354: End-Code
355:
356: Code drop ( n -- )
1.3 pazsan 357: tos pop.w:g
1.1 pazsan 358: next,
359: End-Code
360:
361: Code 2drop ( d -- )
1.3 pazsan 362: tos pop.w:g
363: tos pop.w:g
1.1 pazsan 364: next,
365: End-Code
366:
367: Code swap ( n1 n2 -- n2 n1 )
1.5 pazsan 368: r1 pop.w:g
369: tos push.w:g
370: r1 , tos mov.w:g
1.1 pazsan 371: next,
372: End-Code
373:
374: Code over ( n1 n2 -- n1 n2 n1 )
1.5 pazsan 375: tos , r1 mov.w:g
376: tos pop.w:g
377: tos push.w:g
378: r1 push.w:g
1.1 pazsan 379: next,
380: End-Code
381:
382: Code rot ( n1 n2 n3 -- n2 n3 n1 )
1.5 pazsan 383: tos , r1 mov.w:g
1.7 pazsan 384: r3 pop.w:g
1.5 pazsan 385: tos pop.w:g
1.7 pazsan 386: r3 push.w:g
1.5 pazsan 387: r1 push.w:g
1.7 pazsan 388: r3 , r3 xor.w
1.1 pazsan 389: next,
390: End-Code
391:
392: Code -rot ( n1 n2 n3 -- n3 n1 n2 )
1.5 pazsan 393: tos , r1 mov.w:g
394: tos pop.w:g
1.7 pazsan 395: r3 pop.w:g
1.5 pazsan 396: r1 push.w:g
1.7 pazsan 397: r3 push.w:g
398: r3 , r3 xor.w
1.1 pazsan 399: next,
400: End-Code
401:
402:
403: \ return stack
404: Code r@ ( -- n ; R: n -- n )
1.5 pazsan 405: tos push.w:g
406: rp , w mov.w:g
407: [w] , tos mov.w:g
1.1 pazsan 408: next,
409: End-Code
410:
411:
412: \ arithmetic
413:
414: Code um* ( u1 u2 -- ud ) \ unsigned multiply
1.7 pazsan 415: rp , r3 mov.w:g
1.5 pazsan 416: r2 pop.w:g
417: r2 , r0 mulu.w:g
418: r0 push.w:g
419: r2 , tos mov.w:g
1.7 pazsan 420: r3 , rp mov.w:g
421: r3 , r3 xor.w
1.5 pazsan 422: next,
1.1 pazsan 423: End-Code
424:
425: Code um/mod ( ud u -- r q ) \ unsiged divide
1.7 pazsan 426: rp , r3 mov.w:g
1.5 pazsan 427: tos , r1 mov.w:g
428: r2 pop.w:g
429: tos pop.w:g
430: r1 divu.w
431: r2 push.w:g
1.7 pazsan 432: r3 , rp mov.w:g
433: r3 , r3 xor.w
1.5 pazsan 434: next,
1.1 pazsan 435: End-Code
436:
437: \ shift
438: Code 2/ ( n1 -- n2 ) \ arithmetic shift right
1.7 pazsan 439: \ hfs geht noch nicht !!! # -1 , tos sha.w
440: # -1 , r1h mov.b:q
441: r1h , tos sha.w
1.1 pazsan 442: next,
443: End-Code
444:
1.5 pazsan 445: 0 [IF]
1.1 pazsan 446: Code lshift ( n1 n2 -- n3 ) \ shift n1 left n2 bits
1.7 pazsan 447: \ tos.b , r1h mov.w:g
448: tos.b , r1h mov.b:g \ ? hfs
1.5 pazsan 449: r1h , tos shl.w
1.1 pazsan 450: next,
451: End-Code
452:
453: Code rshift ( n1 n2 -- n3 ) \ shift n1 right n2 bits
1.7 pazsan 454: \ tos.b , r1h mov.w:g
455: tos.b , r1h mov.b:g \ ? hfs
1.5 pazsan 456: r1h neg.b
457: r1h , tos shl.w
1.1 pazsan 458: next,
459: End-Code
1.5 pazsan 460: [THEN]
1.1 pazsan 461:
462: \ compare
463: Code 0= ( n -- f ) \ Test auf 0
1.5 pazsan 464: tos , tos tst.w
465: 0= IF # -1 , tos mov.w:g next,
466: THEN # 0 , tos mov.w:g next,
1.1 pazsan 467: next,
468: End-Code
469:
1.10 pazsan 470: Code 0< ( n -- f ) \ Test auf 0
471: tos , tos tst.w
472: 0< IF # -1 , tos mov.w:g next,
473: THEN # 0 , tos mov.w:g next,
474: next,
475: End-Code
476:
1.1 pazsan 477: Code = ( n1 n2 -- f ) \ Test auf Gleichheit
1.5 pazsan 478: r1 pop.w:g
479: r1 , tos sub.w:g
480: 0= IF # -1 , tos mov.w:g next,
481: THEN # 0 , tos mov.w:g next,
1.1 pazsan 482: End-Code
483:
1.10 pazsan 484: Code u< ( n1 n2 -- f ) \ Test auf Gleichheit
485: r1 pop.w:g
486: r1 , tos sub.w:g
487: u> IF # -1 , tos mov.w:g next,
488: THEN # 0 , tos mov.w:g next,
489: End-Code
490:
491: Code u> ( n1 n2 -- f ) \ Test auf Gleichheit
492: r1 pop.w:g
493: r1 , tos sub.w:g
494: u< IF # -1 , tos mov.w:g next,
495: THEN # 0 , tos mov.w:g next,
496: End-Code
497:
1.3 pazsan 498: Code (key) ( -- char ) \ get character
1.8 pazsan 499: # $08 , $E1 mov.b:g
1.5 pazsan 500: tos push.w:g
1.7 pazsan 501: \ BEGIN # $08 , $AD abs:16 tst.b 0<> UNTIL
502: BEGIN # $08 , $AD tst.b 0<> UNTIL
1.5 pazsan 503: tos , tos xor.w
1.7 pazsan 504: \ $AE abs:16 , tos.b mov.b:g
505: $AE , tos.b mov.b:g
1.3 pazsan 506: next,
507: End-Code
508:
509: Code (emit) ( char -- ) \ output character
1.10 pazsan 510: \ BEGIN # $08 , $AC tst.b 0= UNTIL
1.7 pazsan 511: tos.b , $AA mov.b:g
1.5 pazsan 512: tos pop.w:g
513: next,
1.3 pazsan 514: End-Code
515:
1.1 pazsan 516: \ additon io routines
517: Code (key?) ( -- f ) \ check for read sio character
1.5 pazsan 518: tos push.w:g
1.7 pazsan 519: \ # $08 , $AD abs:16 tst.b
520: # $08 , $AD tst.b
1.5 pazsan 521: 0<> IF # -1 , tos mov.w:g next,
522: THEN # 0 , tos mov.w:g next,
1.1 pazsan 523: End-Code
524:
525: Code emit? ( -- f ) \ check for write character to sio
1.5 pazsan 526: tos push.w:g
1.7 pazsan 527: \ # $02 , $AD abs:16 tst.b
1.10 pazsan 528: # $08 , $AC tst.b
1.5 pazsan 529: 0= IF # -1 , tos mov.w:g next,
530: THEN # 0 , tos mov.w:g next,
1.1 pazsan 531: End-Code
532:
1.3 pazsan 533: [then]
534: : (bye) ( 0 -- ) \ back to DOS
535: drop ;
1.1 pazsan 536:
537: : bye ( -- ) 0 (bye) ;
538:
1.3 pazsan 539: : compile-prim1 ;
540: : finish-code ;
541: : x@+/string ( addr u -- addr' u' c )
542: over c@ >r 1 /string r> ;
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