Annotation of gforth/arch/r8c/prim.fs, revision 1.16
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.15 pazsan 68: # $0780 , sp ldc \ sp at $0600...$0700
1.13 pazsan 69: # $07FE , rp mov.w:g \ rp at $0700...$07FE
1.9 pazsan 70: # $0F , $E3 mov.b:g
71: # $0F , $E1 mov.b:g
1.16 ! pazsan 72: Label mem-init
! 73: $01 , $0A bset
! 74: $00 , $05 bset
! 75: $01 , $0A bclr
1.9 pazsan 76: Label clock-init \ default is 125kHz/8
1.12 pazsan 77: $00 , $0A bset
1.10 pazsan 78: # $28 , $07 mov.b:g
1.9 pazsan 79: # $08 , $06 mov.b:g
1.16 ! pazsan 80: AHEAD THEN
1.12 pazsan 81: 2 , $0C bclr
1.9 pazsan 82: # $00 , $08 mov.b:g \ set to 20MHz
1.12 pazsan 83: $00 , $0A bclr
1.5 pazsan 84: Label uart-init
1.13 pazsan 85: # $27 , $B0 mov.b:g \ hfs
86: # $8105 , $A8 mov.w:g \ ser1: 9600 baud, 8N1 \ hfs
1.10 pazsan 87: # $0500 , $AC mov.w:g \ hfs
1.14 pazsan 88: Label lcd-init
89: $02 , $0A bset
90: # $FD , $E2 mov.b:g
91: next,
1.1 pazsan 92: End-Label
93:
94:
95: \ ==============================================================
96: \ GFORTH minimal primitive set
97: \ ==============================================================
98: \ inner interpreter
99: Code: :docol
100: \ ': dout, \ only for debugging
101: # -2 , rp add.w:q
1.7 pazsan 102: w , r1 mov.w:g
1.1 pazsan 103: rp , w mov.w:g ip , [w] mov.w:g
1.7 pazsan 104: # 4 , r1 add.w:q r1 , ip mov.w:g
1.1 pazsan 105: next,
106: End-Code
107:
108: Code: :dovar
109: \ '2 dout, \ only for debugging
1.2 pazsan 110: tos push.w:g
1.1 pazsan 111: # 4 , w add.w:q
112: w , tos mov.w:g
113: next,
114: End-Code
115:
1.4 pazsan 116: Code: :docon
117: \ '2 dout, \ only for debugging
118: tos push.w:g
1.10 pazsan 119: 4 [w] , tos mov.w:g
1.4 pazsan 120: next,
121: End-Code
122:
1.8 pazsan 123: Code: :dovalue
124: \ '2 dout, \ only for debugging
125: tos push.w:g
1.10 pazsan 126: 4 [w] , w mov.w:g [w] , tos mov.w:g
1.8 pazsan 127: next,
1.4 pazsan 128: End-Code
129:
1.13 pazsan 130: Code: :dofield
131: 4 [w] , tos add.w:g
132: next,
133: end-code
134:
1.9 pazsan 135: Code: :dodefer
1.10 pazsan 136: \ # $05 , $E1 mov.b:g
137: 4 [w] , w mov.w:g [w] , w mov.w:g
1.9 pazsan 138: next1,
139: End-Code
1.8 pazsan 140:
1.1 pazsan 141: Code: :dodoes ( -- pfa ) \ get pfa and execute DOES> part
142: \ '6 dout, \ only for debugging
1.8 pazsan 143: \ # $06 , $E1 mov.b:g
144: tos push.w:g
145: w , tos mov.w:g # 4 , tos add.w:q
1.7 pazsan 146: # -2 , rp add.w:q
1.13 pazsan 147: rp , w mov.w:g ip , [w] mov.w:g
1.10 pazsan 148: 2 [w] , r1 mov.w:g
1.7 pazsan 149: # 4 , r1 add.w:q r1 , ip mov.w:g
1.1 pazsan 150: next, \ execute does> part
1.5 pazsan 151: End-Code
152:
1.1 pazsan 153: \ program flow
154: Code ;s ( -- ) \ exit colon definition
155: \ '; dout, \ only for debugging
156: rp , w mov.w:g # 2 , rp add.w:q
157: [w] , ip mov.w:g
158: next,
159: End-Code
160:
161: Code execute ( xt -- ) \ execute colon definition
162: \ 'E dout, \ only for debugging
1.10 pazsan 163: \ # $07 , $E1 mov.b:g
1.8 pazsan 164: tos , w mov.w:g \ copy tos to w
165: tos pop.w:g \ get new tos
166: next1,
1.1 pazsan 167: End-Code
168:
1.10 pazsan 169: Code ?branch ( f -- ) \ jump on f=0
1.7 pazsan 170: # 2 , ip add.w:q
1.10 pazsan 171: tos , tos tst.w 0= IF -2 [ip] , ip mov.w:g THEN
1.11 pazsan 172: tos pop.w:g
1.2 pazsan 173: next,
1.1 pazsan 174: End-Code
175:
1.10 pazsan 176: Code (for) ( n -- r:0 r:n )
177: # -4 , rp add.w:q rp , w mov.w:g
178: r3 , 2 [w] mov.w:g
179: tos , [w] mov.w:g
180: tos pop.w:g
181: next,
182: End-Code
183:
184: Code (?do) ( n -- r:0 r:n )
185: # 2 , ip add.w:q
186: # -4 , rp add.w:q rp , w mov.w:g
187: tos , [w] mov.w:g
188: r1 pop.w:g
189: r1 , 2 [w] mov.w:g
190: tos pop.w:g
191: [w] , r1 sub.w:g
192: 0= IF -2 [ip] , ip mov.w:g THEN
193: next,
194: End-Code
195:
196: Code (do) ( n -- r:0 r:n )
197: # -4 , rp add.w:q rp , w mov.w:g
198: tos , [w] mov.w:g
199: tos pop.w:g
200: tos , 2 [w] mov.w:g
201: tos pop.w:g
202: next,
203: End-Code
204:
205: Code (next) ( -- )
206: # 2 , ip add.w:q
207: rp , w mov.w:g [w] , r1 mov.w:g
208: # -1 , r1 add.w:q r1 , [w] mov.w:g
209: u>= IF -2 [ip] , ip mov.w:g THEN
210: next,
211: End-Code
212:
213: Code (loop) ( -- )
214: # 2 , ip add.w:q
215: rp , w mov.w:g [w] , r1 mov.w:g
216: # 1 , r1 add.w:q r1 , [w] mov.w:g
217: 2 [w] , r1 sub.w:g
218: 0<> IF -2 [ip] , ip mov.w:g THEN
219: next,
220: End-Code
1.1 pazsan 221:
222: \ memory access
223: Code @ ( addr -- n ) \ read cell
1.2 pazsan 224: tos , w mov.w:g [w] , tos mov.w:g
1.1 pazsan 225: next,
226: End-Code
227:
228: Code ! ( n addr -- ) \ write cell
1.2 pazsan 229: tos , w mov.w:g tos pop.w:g tos , [w] mov.w:g
230: tos pop.w:g
231: next,
232: End-Code
233:
234: Code c@ ( addr -- n ) \ read cell
235: tos , w mov.w:g tos , tos xor.w [w] , tos.b mov.b:g
236: next,
237: End-Code
238:
239: Code c! ( n addr -- ) \ write cell
240: tos , w mov.w:g tos pop.w:g tos.b , [w] mov.b:g
241: tos pop.w:g
242: next,
243: End-Code
244:
245: \ arithmetic and logic
246: Code + ( n1 n2 -- n3 ) \ addition
247: r1 pop.w:g
248: r1 , tos add.w:g
249: next,
250: End-Code
251:
252: Code - ( n1 n2 -- n3 ) \ addition
253: r1 pop.w:g
254: tos , r1 sub.w:g
255: r1 , tos mov.w:g
256: next,
257: End-Code
258:
259: Code and ( n1 n2 -- n3 ) \ addition
260: r1 pop.w:g
261: r1 , tos and.w:g
262: next,
263: End-Code
264:
265: Code or ( n1 n2 -- n3 ) \ addition
266: r1 pop.w:g
267: r1 , tos or.w:g
268: next,
269: End-Code
270:
271: Code xor ( n1 n2 -- n3 ) \ addition
272: r1 pop.w:g
273: r1 , tos xor.w
274: next,
275: End-Code
276:
277: \ moving datas between stacks
278: Code r> ( -- n ; R: n -- )
279: tos push.w:g
280: rp , w mov.w:g
281: [w] , tos mov.w:g
1.7 pazsan 282: # 2 , rp add.w:q \ ? hfs
1.1 pazsan 283: next,
284: End-Code
285:
1.2 pazsan 286: Code >r ( n -- ; R: -- n )
1.7 pazsan 287: # -2 , rp add.w:q \ ? hfs
1.2 pazsan 288: rp , w mov.w:g
289: tos , [w] mov.w:g
290: tos pop.w:g
291: next,
292: End-Code
293:
1.10 pazsan 294: Code rdrop ( R:n -- )
295: # 2 , rp add.w:q \ ? hfs
296: next,
297: End-Code
298:
299: Code unloop ( R:n -- )
300: # 4 , rp add.w:q \ ? hfs
301: next,
302: End-Code
303:
1.1 pazsan 304: \ datastack and returnstack address
305: Code sp@ ( -- sp ) \ get stack address
1.2 pazsan 306: tos push.w:g
307: sp , tos stc
308: next,
309: End-Code
1.1 pazsan 310:
311: Code sp! ( sp -- ) \ set stack address
1.2 pazsan 312: tos , sp ldc
313: tos pop.w:g
314: next,
1.1 pazsan 315: End-Code
316:
317: Code rp@ ( -- rp ) \ get returnstack address
1.2 pazsan 318: tos push.w:g
319: rp , tos mov.w:g
1.1 pazsan 320: next,
321: End-Code
322:
323: Code rp! ( rp -- ) \ set returnstack address
1.2 pazsan 324: tos , rp mov.w:g
325: tos pop.w:g
326: next,
327: End-Code
1.1 pazsan 328:
1.2 pazsan 329: Code branch ( -- ) \ unconditional branch
330: [ip] , ip mov.w:g
331: next,
1.1 pazsan 332: End-Code
333:
1.2 pazsan 334: Code lit ( -- n ) \ inline literal
335: tos push.w:g
336: [ip] , tos mov.w:g
1.3 pazsan 337: # 2 , ip add.w:q
1.2 pazsan 338: next,
1.1 pazsan 339: End-Code
340:
1.2 pazsan 341: Code: :doesjump
342: end-code
1.1 pazsan 343:
344: \ ==============================================================
345: \ usefull lowlevel words
346: \ ==============================================================
347: \ word definitions
348:
349:
350: \ branch and literal
351:
352: \ data stack words
353: Code dup ( n -- n n )
1.3 pazsan 354: tos push.w:g
1.1 pazsan 355: next,
356: End-Code
357:
358: Code 2dup ( d -- d d )
1.3 pazsan 359: r1 pop.w:g
360: r1 push.w:g
361: tos push.w:g
362: r1 push.w:g
1.1 pazsan 363: next,
364: End-Code
365:
366: Code drop ( n -- )
1.3 pazsan 367: tos pop.w:g
1.1 pazsan 368: next,
369: End-Code
370:
371: Code 2drop ( d -- )
1.3 pazsan 372: tos pop.w:g
373: tos pop.w:g
1.1 pazsan 374: next,
375: End-Code
376:
377: Code swap ( n1 n2 -- n2 n1 )
1.5 pazsan 378: r1 pop.w:g
379: tos push.w:g
380: r1 , tos mov.w:g
1.1 pazsan 381: next,
382: End-Code
383:
384: Code over ( n1 n2 -- n1 n2 n1 )
1.5 pazsan 385: tos , r1 mov.w:g
386: tos pop.w:g
387: tos push.w:g
388: r1 push.w:g
1.1 pazsan 389: next,
390: End-Code
391:
392: Code rot ( n1 n2 n3 -- n2 n3 n1 )
1.5 pazsan 393: tos , r1 mov.w:g
1.7 pazsan 394: r3 pop.w:g
1.5 pazsan 395: tos pop.w:g
1.7 pazsan 396: r3 push.w:g
1.5 pazsan 397: r1 push.w:g
1.7 pazsan 398: r3 , r3 xor.w
1.1 pazsan 399: next,
400: End-Code
401:
402: Code -rot ( n1 n2 n3 -- n3 n1 n2 )
1.5 pazsan 403: tos , r1 mov.w:g
404: tos pop.w:g
1.7 pazsan 405: r3 pop.w:g
1.5 pazsan 406: r1 push.w:g
1.7 pazsan 407: r3 push.w:g
408: r3 , r3 xor.w
1.1 pazsan 409: next,
410: End-Code
411:
412:
413: \ return stack
414: Code r@ ( -- n ; R: n -- n )
1.5 pazsan 415: tos push.w:g
416: rp , w mov.w:g
417: [w] , tos mov.w:g
1.1 pazsan 418: next,
419: End-Code
420:
421:
422: \ arithmetic
423:
424: Code um* ( u1 u2 -- ud ) \ unsigned multiply
1.7 pazsan 425: rp , r3 mov.w:g
1.5 pazsan 426: r2 pop.w:g
427: r2 , r0 mulu.w:g
428: r0 push.w:g
429: r2 , tos mov.w:g
1.7 pazsan 430: r3 , rp mov.w:g
431: r3 , r3 xor.w
1.5 pazsan 432: next,
1.1 pazsan 433: End-Code
434:
1.16 ! pazsan 435: Code m* ( u1 u2 -- ud ) \ unsigned multiply
! 436: rp , r3 mov.w:g
! 437: r2 pop.w:g
! 438: r2 , r0 mul.w:g
! 439: r0 push.w:g
! 440: r2 , tos mov.w:g
! 441: r3 , rp mov.w:g
! 442: r3 , r3 xor.w
! 443: next,
! 444: End-Code
! 445:
1.1 pazsan 446: Code um/mod ( ud u -- r q ) \ unsiged divide
1.7 pazsan 447: rp , r3 mov.w:g
1.5 pazsan 448: tos , r1 mov.w:g
449: r2 pop.w:g
450: tos pop.w:g
451: r1 divu.w
452: r2 push.w:g
1.7 pazsan 453: r3 , rp mov.w:g
454: r3 , r3 xor.w
1.5 pazsan 455: next,
1.1 pazsan 456: End-Code
457:
458: \ shift
459: Code 2/ ( n1 -- n2 ) \ arithmetic shift right
1.7 pazsan 460: \ hfs geht noch nicht !!! # -1 , tos sha.w
461: # -1 , r1h mov.b:q
462: r1h , tos sha.w
1.1 pazsan 463: next,
464: End-Code
465:
466: Code lshift ( n1 n2 -- n3 ) \ shift n1 left n2 bits
1.7 pazsan 467: \ tos.b , r1h mov.w:g
1.14 pazsan 468: tos.b , r1h mov.b:g \ ? hfs
469: tos pop.w:g
470: r1h , tos shl.w
471: next,
1.1 pazsan 472: End-Code
473:
474: Code rshift ( n1 n2 -- n3 ) \ shift n1 right n2 bits
1.7 pazsan 475: \ tos.b , r1h mov.w:g
1.14 pazsan 476: tos.b , r1h mov.b:g \ ? hfs
477: r1h neg.b
478: tos pop.w:g
479: r1h , tos shl.w
1.1 pazsan 480: next,
481: End-Code
482:
483: \ compare
484: Code 0= ( n -- f ) \ Test auf 0
1.5 pazsan 485: tos , tos tst.w
486: 0= IF # -1 , tos mov.w:g next,
487: THEN # 0 , tos mov.w:g next,
1.1 pazsan 488: next,
489: End-Code
490:
1.10 pazsan 491: Code 0< ( n -- f ) \ Test auf 0
492: tos , tos tst.w
493: 0< IF # -1 , tos mov.w:g next,
494: THEN # 0 , tos mov.w:g next,
495: next,
496: End-Code
497:
1.1 pazsan 498: Code = ( n1 n2 -- f ) \ Test auf Gleichheit
1.5 pazsan 499: r1 pop.w:g
500: r1 , tos sub.w:g
501: 0= IF # -1 , tos mov.w:g next,
502: THEN # 0 , tos mov.w:g next,
1.1 pazsan 503: End-Code
504:
1.16 ! pazsan 505: ' = alias u=
! 506:
1.10 pazsan 507: Code u< ( n1 n2 -- f ) \ Test auf Gleichheit
508: r1 pop.w:g
509: r1 , tos sub.w:g
510: u> IF # -1 , tos mov.w:g next,
511: THEN # 0 , tos mov.w:g next,
512: End-Code
513:
514: Code u> ( n1 n2 -- f ) \ Test auf Gleichheit
515: r1 pop.w:g
516: r1 , tos sub.w:g
517: u< IF # -1 , tos mov.w:g next,
518: THEN # 0 , tos mov.w:g next,
519: End-Code
520:
1.3 pazsan 521: Code (key) ( -- char ) \ get character
1.5 pazsan 522: tos push.w:g
1.13 pazsan 523: BEGIN 3 , $AD btst 0<> UNTIL
524: $AE , tos mov.w:g
1.3 pazsan 525: next,
526: End-Code
527:
528: Code (emit) ( char -- ) \ output character
1.13 pazsan 529: BEGIN 1 , $AD btst 0<> UNTIL
1.7 pazsan 530: tos.b , $AA mov.b:g
1.5 pazsan 531: tos pop.w:g
532: next,
1.3 pazsan 533: End-Code
534:
1.1 pazsan 535: \ additon io routines
536: Code (key?) ( -- f ) \ check for read sio character
1.5 pazsan 537: tos push.w:g
1.13 pazsan 538: 3 , $AD btst
1.5 pazsan 539: 0<> IF # -1 , tos mov.w:g next,
540: THEN # 0 , tos mov.w:g next,
1.1 pazsan 541: End-Code
542:
543: Code emit? ( -- f ) \ check for write character to sio
1.5 pazsan 544: tos push.w:g
1.13 pazsan 545: 1 , $AD btst
1.12 pazsan 546: 0<> IF # -1 , tos mov.w:g next,
1.5 pazsan 547: THEN # 0 , tos mov.w:g next,
1.1 pazsan 548: End-Code
549:
1.14 pazsan 550: \ Useful code for R8C
551:
1.16 ! pazsan 552: Code us ( n -- ) \ n microseconds delay
! 553: BEGIN AHEAD THEN AHEAD THEN
! 554: r1 , r1 mov.w:g
! 555: # -1 , tos add.w:q 0= UNTIL
1.14 pazsan 556: tos pop.w:g
557: next,
558: end-code
1.16 ! pazsan 559:
! 560: : ms ( n -- ) 0 ?DO &1000 us LOOP ;
1.14 pazsan 561:
562: $E0 Constant port0
563: $E1 Constant port1
564:
565: : led! port1 c! ;
1.16 ! pazsan 566: : >lcd ( 4bit -- )
! 567: 1+ dup port0 c! dup 8 + port0 c! 1 us port0 c!
! 568: &40 us ;
1.14 pazsan 569: : lcdctrl! ( n -- )
570: dup $F0 and >lcd
571: 4 lshift >lcd
1.16 ! pazsan 572: &100 us ;
! 573: : lcdemit ( n -- ) &100 us
1.14 pazsan 574: dup $F0 and 4 + >lcd
575: 4 lshift 4 + >lcd
1.16 ! pazsan 576: &250 us ;
1.14 pazsan 577: : lcdtype bounds ?DO I c@ lcdemit LOOP ;
1.16 ! pazsan 578: : lcdpage $01 lcdctrl! &15 ms ;
1.14 pazsan 579: : lcdcr $C0 lcdctrl! ;
580: : lcdinit ( -- )
1.16 ! pazsan 581: &20 ms $20 >lcd
! 582: &5 ms $28 lcdctrl!
! 583: &1 ms $0C lcdctrl!
! 584: &1 ms lcdpage ;
1.14 pazsan 585: : r8cboot ( -- ) lcdinit s" Gforth EC R8C" lcdtype boot ;
586: ' r8cboot >body $C002 !
587:
1.3 pazsan 588: : (bye) ( 0 -- ) \ back to DOS
589: drop ;
1.1 pazsan 590:
591: : bye ( -- ) 0 (bye) ;
592:
1.3 pazsan 593: : x@+/string ( addr u -- addr' u' c )
594: over c@ >r 1 /string r> ;
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>