![[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 / misc|
Return to prim.fs CVS log | Up to [gforth] / gforth / arch / misc |
1.1 pazsan 1: \ pie primitives
2:
3: $20 allot
4:
1.2 pazsan 5: Label start ahere $21 + , jmp ,
1.1 pazsan 6:
7: Label #0 0 ,
8: Label #1 1 ,
9: Label RP 0 ,
10: Label SP 0 ,
11: Label UP 0 ,
12: Label IP 0 ,
13: Label W 0 ,
1.2 pazsan 14: Label t0 0 ,
15: Label t1 0 ,
16: Label t2 0 ,
17: Label t3 0 ,
18: Label srcx 0 ,
19: Label dstx 0 ,
20:
21: \ Up to here it's self modified
22: \ If there's a gap here, add a jump to Next after dstx
23:
1.1 pazsan 24: Label Next #0 , add ,
25: IP , shr ,
26: sym Next
1.2 pazsan 27: *accu , W ,
1.1 pazsan 28: #1 , add ,
29: accu , add ,
30: accu , IP ,
1.2 pazsan 31: Label Next1 W , shr ,
32: *accu , shr ,
1.1 pazsan 33: accu , jmp ,
34: Label "Next" Next ,
35: Label "Next1" Next1 ,
1.2 pazsan 36: Label "xmov" srcx ,
37:
38: Label #2 2 ,
39: Label #4 4 ,
40: Label #FF $FF ,
41: Label #$8000 $8000 ,
42: Label #-1 -1 ,
1.1 pazsan 43:
44: Label "0" '< ,
45: Label "1" '1 ,
46: Label "2" '2 ,
47: Label "3" '3 ,
48: Label "4" '4 ,
49: Label "5" '5 ,
50: Label "6" '6 ,
51: Label "A" 'A ,
52: Label "B" 'B ,
53: Label "C" 'C ,
54: Label "D" 'D ,
55: Label "E" 'E ,
56: Label "F" '> ,
57: Label "?" '? ,
58: Label "+" '+ ,
59: Label "/" '/ ,
60: Label "H" 'H ,
61: Label "I" 'I ,
62: Label "J" 'J ,
63: Label "K" 'K ,
64: Label "L" 'L ,
65: Label "M" 'M ,
66: Label "N" 'N ,
67: Label "O" 'O ,
68: Label "P" 'P ,
69: Label "Q" 'Q ,
70: Label "R" 'R ,
71: Label "S" 'S ,
72: Label "T" 'T ,
73: Label "#" '# ,
74:
75: end-label
76:
77: Code: :docol sym docol
78: \ "0" , tx ,
79: RP , accu ,
80: #1 , sub ,
81: accu , RP ,
1.2 pazsan 82: IP , *accu ,
1.1 pazsan 83: W , accu ,
84: #4 , add ,
85: accu , IP ,
86: "Next" , jmp ,
87: end-code
88:
89: Code: :docon sym docon
90: \ "1" , tx ,
1.2 pazsan 91: #0 , add ,
92: W , shr ,
93: #2 , add ,
94: *accu , t0 ,
1.1 pazsan 95: SP , accu ,
96: #1 , sub ,
97: accu , SP ,
1.2 pazsan 98: t0 , *accu ,
1.1 pazsan 99: "Next" , jmp ,
100: end-code
101:
102: Code: :dovar sym dovar
103: \ "2" , tx ,
1.2 pazsan 104: W , accu ,
105: #4 , add ,
106: accu , t0 ,
1.1 pazsan 107: SP , accu ,
108: #1 , sub ,
109: accu , SP ,
1.2 pazsan 110: t0 , *accu ,
1.1 pazsan 111: "Next" , jmp ,
112: end-code
113:
114: Code: :douser sym douser
115: \ "3" , tx ,
116: #0 , add ,
117: W , shr ,
118: #2 , add ,
1.2 pazsan 119: *accu , accu ,
1.1 pazsan 120: UP , add ,
1.2 pazsan 121: accu , t0 ,
122: SP , accu ,
123: #1 , sub ,
124: accu , SP ,
125: t0 , *accu ,
1.1 pazsan 126: "Next" , jmp ,
127: end-code
128:
129: Code: :dodefer sym dodefer
130: \ "4" , tx ,
131: #0 , add ,
132: W , shr ,
133: #2 , add ,
1.2 pazsan 134: *accu , W ,
1.1 pazsan 135: "Next1" , jmp ,
136: end-code
137:
138: Code: :dofield sym dofield
139: \ "5" , tx ,
140: #0 , add ,
141: W , shr ,
142: #2 , add ,
1.2 pazsan 143: *accu , accu ,
144: accu , t0 ,
145: SP , accu ,
146: *accu , accu ,
147: t0 , add ,
148: accu , t0 ,
149: SP , accu ,
150: t0 , *accu ,
1.1 pazsan 151: "Next" , jmp ,
152: end-code
153:
154: Code: :dodoes sym dodoes
155: \ "6" , tx ,
156: RP , accu ,
157: #1 , sub ,
158: accu , RP ,
1.2 pazsan 159: IP , *accu ,
160: W , accu ,
161: #4 , add ,
162: accu , t0 ,
1.1 pazsan 163: SP , accu ,
164: #1 , sub ,
165: accu , SP ,
1.2 pazsan 166: t0 , *accu ,
167: t0 , accu ,
1.1 pazsan 168: #2 , sub ,
169: #0 , add ,
170: accu , shr ,
1.2 pazsan 171: *accu , IP ,
1.1 pazsan 172: "Next" , jmp ,
173: end-code
174:
175: Code ! sym !
176: \ "A" , tx ,
177: SP , accu ,
1.2 pazsan 178: *accu , t0 ,
1.1 pazsan 179: #1 , add ,
1.2 pazsan 180: *accu , t1 ,
1.1 pazsan 181: #1 , add ,
182: accu , SP ,
1.2 pazsan 183: t0 , shr ,
184: t1 , *accu ,
1.1 pazsan 185: "Next" , jmp ,
186: end-code
187:
188: Code @ sym @
189: \ "B" , tx ,
190: #0 , add ,
1.2 pazsan 191: SP , accu ,
192: *accu , shr ,
193: *accu , t0 ,
194: SP , accu ,
195: t0 , *accu ,
1.1 pazsan 196: "Next" , jmp ,
197: end-code
198:
199: Code x! sym x!
200: \ "C" , tx ,
201: SP , accu ,
1.2 pazsan 202: *accu , dstx ,
1.1 pazsan 203: #1 , add ,
1.2 pazsan 204: accu , srcx ,
1.1 pazsan 205: #1 , add ,
206: accu , SP ,
1.2 pazsan 207: "xmov" , jmp ,
1.1 pazsan 208: end-code
209:
210: Code x@ sym x@
211: \ "D" , tx ,
1.2 pazsan 212: SP , accu ,
213: *accu , srcx ,
214: accu , dstx ,
215: "xmov" , jmp ,
1.1 pazsan 216: end-code
217:
218: Code execute sym execute
219: \ "E" , tx ,
220: SP , accu ,
1.2 pazsan 221: *accu , W ,
1.1 pazsan 222: #1 , add ,
223: accu , SP ,
224: "Next1" , jmp ,
225: end-code
226:
227: Code ;s sym ;s
228: \ "F" , tx ,
229: RP , accu ,
230: #1 , add ,
231: accu , RP ,
1.2 pazsan 232: #1 , sub ,
233: *accu , IP ,
1.1 pazsan 234: "Next" , jmp ,
235: end-code
236:
237: Code ?branch sym ?branch
238: \ "?" , tx ,
239: #0 , add ,
240: IP , shr ,
1.2 pazsan 241: accu , t0 ,
1.1 pazsan 242: #1 , add ,
243: accu , add ,
244: accu , IP ,
245: SP , accu ,
246: accu , 1 m ,
247: #1 , add ,
248: accu , SP ,
249: 1 r , accu ,
250: pc+4 , jz ,
251: sym no-branch
252: "Next" , jmp ,
253: \ "+" , tx ,
1.2 pazsan 254: t0 , accu ,
255: *accu , accu ,
1.1 pazsan 256: Label >branch sym branch-o
257: IP , add ,
258: #2 , sub ,
259: sym branch-to
260: accu , IP ,
261: "Next" , jmp ,
262: Label "branch" >branch ,
263: end-code
264:
265: Code branch sym branch
266: \ "/" , tx ,
267: #0 , add ,
268: IP , shr ,
1.2 pazsan 269: *accu , accu ,
1.1 pazsan 270: IP , add ,
271: accu , IP ,
272: "Next" , jmp ,
273: end-code
274:
275: Code (loop) sym (loop)
276: #0 , add ,
277: IP , shr ,
1.2 pazsan 278: *accu , t0 ,
1.1 pazsan 279: #1 , add ,
280: accu , add ,
281: accu , IP ,
282: RP , accu ,
1.2 pazsan 283: *accu , t2 ,
1.1 pazsan 284: #1 , add ,
1.2 pazsan 285: *accu , t3 ,
286: t2 , accu ,
1.1 pazsan 287: #1 , add ,
1.2 pazsan 288: accu , t1 ,
289: RP , accu ,
290: t1 , *accu ,
291: t1 , accu ,
292: t3 , sub ,
1.1 pazsan 293: "Next" , jz ,
1.2 pazsan 294: t0 , accu ,
1.1 pazsan 295: "branch" , jmp ,
296: end-code
297:
298: Code xor sym xor
299: \ "H" , tx ,
300: SP , accu ,
1.2 pazsan 301: *accu , t0 ,
1.1 pazsan 302: #1 , add ,
303: accu , SP ,
1.2 pazsan 304: *accu , accu ,
305: t0 , xor ,
306: accu , t0 ,
307: SP , accu ,
308: t0 , *accu ,
1.1 pazsan 309: "Next" , jmp ,
310: end-code
311:
312: Code or sym or
313: \ "I" , tx ,
314: SP , accu ,
1.2 pazsan 315: *accu , t0 ,
1.1 pazsan 316: #1 , add ,
317: accu , SP ,
1.2 pazsan 318: *accu , accu ,
319: t0 , or ,
320: accu , t0 ,
321: SP , accu ,
322: t0 , *accu ,
1.1 pazsan 323: "Next" , jmp ,
324: end-code
325:
326: Code and sym and
327: \ "J" , tx ,
328: SP , accu ,
1.2 pazsan 329: *accu , t0 ,
1.1 pazsan 330: #1 , add ,
331: accu , SP ,
1.2 pazsan 332: *accu , accu ,
333: t0 , and ,
334: accu , t0 ,
335: SP , accu ,
336: t0 , *accu ,
1.1 pazsan 337: "Next" , jmp ,
338: end-code
339:
340: Code + sym +
341: \ "K" , tx ,
342: SP , accu ,
1.2 pazsan 343: *accu , t0 ,
1.1 pazsan 344: #1 , add ,
345: accu , SP ,
1.2 pazsan 346: *accu , accu ,
347: t0 , add ,
348: accu , t0 ,
349: SP , accu ,
350: t0 , *accu ,
1.1 pazsan 351: "Next" , jmp ,
352: end-code
353:
354: Code - sym -
355: \ "L" , tx ,
356: SP , accu ,
1.2 pazsan 357: *accu , t0 ,
1.1 pazsan 358: #1 , add ,
359: accu , SP ,
1.2 pazsan 360: *accu , accu ,
361: t0 , sub ,
362: accu , t0 ,
363: SP , accu ,
364: t0 , *accu ,
1.1 pazsan 365: "Next" , jmp ,
366: end-code
367:
368: Code 2/ sym 2\/
369: \ "M" , tx ,
370: #0 , add ,
1.2 pazsan 371: SP , accu ,
372: *accu , accu ,
1.1 pazsan 373: PC+6 , js ,
374: accu , shr ,
375: PC+6 , jmp ,
376: accu , shr ,
377: #$8000 , or ,
1.2 pazsan 378: accu , t0 ,
379: SP , accu ,
380: t0 , *accu ,
1.1 pazsan 381: "Next" , jmp ,
382: end-code
383:
384: Code 0= sym 0=
1.2 pazsan 385: SP , accu ,
386: *accu , accu ,
1.1 pazsan 387: ZF , accu ,
1.2 pazsan 388: #1 , xor ,
389: #1 , sub ,
390: accu , t0 ,
391: SP , accu ,
392: t0 , *accu ,
1.1 pazsan 393: "Next" , jmp ,
394: end-code
395:
396: Code 0<> sym 0<>
1.2 pazsan 397: SP , accu ,
398: *accu , accu ,
1.1 pazsan 399: ZF , accu ,
1.2 pazsan 400: #1 , sub ,
401: accu , t0 ,
402: SP , accu ,
403: t0 , *accu ,
1.1 pazsan 404: "Next" , jmp ,
405: end-code
406:
407: Code = sym =
408: SP , accu ,
1.2 pazsan 409: *accu , t0 ,
1.1 pazsan 410: #1 , add ,
411: accu , SP ,
1.2 pazsan 412: *accu , accu ,
413: t0 , sub ,
1.1 pazsan 414: ZF , accu ,
1.2 pazsan 415: #1 , xor ,
416: #1 , sub ,
417: accu , t0 ,
418: SP , accu ,
419: t0 , *accu ,
1.1 pazsan 420: "Next" , jmp ,
421: end-code
422:
423: Code u< sym u<
424: SP , accu ,
1.2 pazsan 425: *accu , t0 ,
1.1 pazsan 426: #1 , add ,
427: accu , SP ,
1.2 pazsan 428: *accu , accu ,
429: t0 , sub ,
1.1 pazsan 430: CF , accu ,
1.2 pazsan 431: #1 , xor ,
432: #1 , sub ,
433: accu , t0 ,
434: SP , accu ,
435: t0 , *accu ,
1.1 pazsan 436: "Next" , jmp ,
437: end-code
438:
439: Code 1+ sym 1+
1.2 pazsan 440: SP , accu ,
441: *accu , accu ,
1.1 pazsan 442: #1 , add ,
1.2 pazsan 443: accu , t0 ,
444: SP , accu ,
445: t0 , *accu ,
1.1 pazsan 446: "Next" , jmp ,
447: end-code
448:
449: Code cell+ sym cell+
1.2 pazsan 450: SP , accu ,
451: *accu , accu ,
1.1 pazsan 452: #2 , add ,
1.2 pazsan 453: accu , t0 ,
454: SP , accu ,
455: t0 , *accu ,
1.1 pazsan 456: "Next" , jmp ,
457: end-code
458:
459: Code 8<< sym 8<<
460: \ "T" , tx ,
461: #0 , add ,
462: SP , accu ,
1.2 pazsan 463: *accu , accu ,
1.1 pazsan 464: accu , add ,
465: accu , add ,
466: accu , add ,
467: accu , add ,
468: accu , add ,
469: accu , add ,
470: accu , add ,
471: accu , add ,
1.2 pazsan 472: accu , t0 ,
473: SP , accu ,
474: t0 , *accu ,
1.1 pazsan 475: "Next" , jmp ,
476: end-code
477:
478: Code 8>> sym 8>>
479: \ "T" , tx ,
480: #0 , add ,
481: SP , accu ,
1.2 pazsan 482: Label c-even@ *accu , shr ,
1.1 pazsan 483: accu , shr ,
484: accu , shr ,
485: accu , shr ,
486: accu , shr ,
487: accu , shr ,
488: accu , shr ,
489: accu , shr ,
490: #FF , and ,
1.2 pazsan 491: accu , t0 ,
492: SP , accu ,
493: t0 , *accu ,
1.1 pazsan 494: "Next" , jmp ,
495: Label "c-even@" c-even@ ,
496: end-code
497:
498: Code c@ sym c@
499: #0 , add ,
1.2 pazsan 500: SP , accu ,
501: *accu , shr ,
1.1 pazsan 502: PC+4 , jc ,
503: "c-even@" , jmp ,
1.2 pazsan 504: *accu , accu ,
1.1 pazsan 505: #FF , and ,
1.2 pazsan 506: accu , t0 ,
507: SP , accu ,
508: t0 , *accu ,
1.1 pazsan 509: "Next" , jmp ,
510:
511: Code 2* sym 2*
512: \ "N" , tx ,
1.2 pazsan 513: SP , accu ,
514: *accu , accu ,
1.1 pazsan 515: accu , add ,
1.2 pazsan 516: accu , t0 ,
517: SP , accu ,
518: t0 , *accu ,
1.1 pazsan 519: "Next" , jmp ,
520: end-code
521:
522: Code >r sym >r
523: \ "O" , tx ,
1.2 pazsan 524: SP , accu ,
525: *accu , t0 ,
526: #1 , add ,
527: accu , SP ,
1.1 pazsan 528: RP , accu ,
529: #1 , sub ,
530: accu , RP ,
1.2 pazsan 531: t0 , *accu ,
1.1 pazsan 532: "Next" , jmp ,
533: end-code
534:
535: Code r> sym r>
536: \ "P" , tx ,
537: RP , accu ,
1.2 pazsan 538: *accu , t0 ,
1.1 pazsan 539: #1 , add ,
540: accu , RP ,
541: SP , accu ,
542: #1 , sub ,
543: accu , SP ,
1.2 pazsan 544: t0 , *accu ,
1.1 pazsan 545: "Next" , jmp ,
546: end-code
547:
548: Code sp@ sym sp@
549: \ "Q" , tx ,
550: SP , accu ,
1.2 pazsan 551: accu , add ,
552: accu , t0 ,
553: SP , accu ,
1.1 pazsan 554: #1 , sub ,
555: accu , SP ,
1.2 pazsan 556: t0 , *accu ,
1.1 pazsan 557: "Next" , jmp ,
558: end-code
559:
560: Code sp! sym sp!
561: #0 , add ,
1.2 pazsan 562: SP , accu ,
563: *accu , shr ,
1.1 pazsan 564: accu , SP ,
565: "Next" , jmp ,
566: end-code
567:
568: Code rp@ sym rp@
569: \ "R" , tx ,
1.2 pazsan 570: RP , accu ,
571: accu , add ,
572: accu , t0 ,
1.1 pazsan 573: SP , accu ,
574: #1 , sub ,
575: accu , SP ,
1.2 pazsan 576: t0 , *accu ,
1.1 pazsan 577: "Next" , jmp ,
578: end-code
579:
580: Code rp! sym rp!
581: SP , accu ,
1.2 pazsan 582: *accu , t0 ,
1.1 pazsan 583: #1 , add ,
584: accu , SP ,
585: #0 , add ,
1.2 pazsan 586: t0 , shr ,
1.1 pazsan 587: accu , RP ,
588: "Next" , jmp ,
589: end-code
590:
591: Code drop sym drop
592: \ "S" , tx ,
593: SP , accu ,
594: #1 , add ,
595: accu , SP ,
596: "Next" , jmp ,
597: end-code
598:
599: Code lit sym lit
600: \ "#" , tx ,
601: IP , shr ,
1.2 pazsan 602: *accu , t0 ,
1.1 pazsan 603: #1 , add ,
604: accu , add ,
605: accu , IP ,
1.2 pazsan 606: SP , accu ,
607: #1 , sub ,
608: accu , SP ,
609: t0 , *accu ,
1.1 pazsan 610: "Next" , jmp ,
611: end-code
612:
613: Code dup sym dup
614: SP , accu ,
1.2 pazsan 615: *accu , t0 ,
1.1 pazsan 616: #1 , sub ,
617: accu , SP ,
1.2 pazsan 618: t0 , *accu ,
1.1 pazsan 619: "Next" , jmp ,
620: end-code
621:
622: Code I sym r@
1.2 pazsan 623: RP , accu ,
624: *accu , t0 ,
1.1 pazsan 625: SP , accu ,
626: #1 , sub ,
627: accu , SP ,
1.2 pazsan 628: t0 , *accu ,
1.1 pazsan 629: "Next" , jmp ,
630: end-code
631:
632: Code over sym over
633: SP , accu ,
634: #1 , add ,
1.2 pazsan 635: *accu , t0 ,
1.1 pazsan 636: #2 , sub ,
637: accu , SP ,
1.2 pazsan 638: t0 , *accu ,
1.1 pazsan 639: "Next" , jmp ,
640: end-code
641:
642: Code swap sym swap
643: SP , accu ,
1.2 pazsan 644: *accu , t0 ,
1.1 pazsan 645: #1 , add ,
1.2 pazsan 646: *accu , t1 ,
647: t0 , *accu ,
648: #1 , sub ,
649: t1 , *accu ,
1.1 pazsan 650: "Next" , jmp ,
651: end-code
652:
653: Code d+ sym d+
654: SP , accu ,
1.2 pazsan 655: *accu , t0 ,
1.1 pazsan 656: #1 , add ,
1.2 pazsan 657: *accu , t1 ,
1.1 pazsan 658: #1 , add ,
1.2 pazsan 659: *accu , t2 ,
1.1 pazsan 660: accu , SP ,
661: #1 , add ,
1.2 pazsan 662: *accu , accu ,
663: t1 , add ,
664: accu , t1 ,
1.1 pazsan 665: CF , accu ,
1.2 pazsan 666: t2 , add ,
667: t0 , add ,
668: accu , t0 ,
669: SP , accu ,
670: t0 , *accu ,
671: #1 , add ,
672: t1 , *accu ,
1.1 pazsan 673: "Next" , jmp ,
674: end-code
675:
676: Label cf1 0 ,
677: Code d2*+ sym d2*+
1.2 pazsan 678: SP , accu ,
679: Label >d2*+ *accu , t0 ,
680: #1 , add ,
681: *accu , t1 ,
1.1 pazsan 682: #1 , add ,
1.2 pazsan 683: *accu , t2 ,
684: accu , t3 ,
685: t0 , accu ,
686: t2 , add ,
687: t2 , add ,
688: accu , t2 ,
689: CF , accu ,
690: t1 , add ,
691: t1 , add ,
692: accu , t0 ,
693: t1 , accu ,
1.1 pazsan 694: #$8000 , and ,
1.2 pazsan 695: accu , t1 ,
696: t3 , accu ,
697: t2 , *accu ,
698: #1 , sub ,
699: t0 , *accu ,
700: #1 , sub ,
701: t1 , *accu ,
1.1 pazsan 702: "Next" , jmp ,
703: end-code
704:
705: Label res1 0 ,
706: Label "d2*+" >d2*+ ,
707: Code /modstep ( ud c R: u -- ud-?u 0/1 )
708: sym /modstep
709: SP , accu ,
1.2 pazsan 710: *accu , t0 ,
711: #1 , add ,
712: *accu , t1 ,
1.1 pazsan 713: #1 , add ,
1.2 pazsan 714: *accu , t2 ,
715: t2 , accu ,
716: t0 , sub ,
717: accu , t0 ,
1.1 pazsan 718: CF , accu ,
1.2 pazsan 719: t1 , or ,
1.1 pazsan 720: PC+6 , JZ ,
721: #0 , accu ,
722: PC+6 , jmp ,
1.2 pazsan 723: t0 , t2 ,
1.1 pazsan 724: #1 , accu ,
1.2 pazsan 725: accu , t0 ,
726: SP , accu ,
727: #1 , add ,
728: t0 , *accu ,
729: #1 , add ,
730: t2 , *accu ,
731: #1 , sub ,
1.1 pazsan 732: "d2*+" , jmp ,
733: end-code
734:
735: RP 2* Constant RP
736: SP 2* Constant SP
737: UP 2* Constant UP
738: IP 2* Constant IP
739:
740: c: sp! 2/ sp ! ;
741: c: sp@ sp @ 1+ 2* ;
742: c: rp@ rp @ 2* ;
743: c: rp! r> swap 2/ rp ! >r ;
744: c: up@ up @ ;
745: c: up! up ! ;
746:
1.3 ! pazsan 747: include ./key.fs