![[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:
1.4 jwilke 175: Code: :doesjump
176: end-code
177:
1.1 pazsan 178: Code ! sym !
179: \ "A" , tx ,
180: SP , accu ,
1.2 pazsan 181: *accu , t0 ,
1.1 pazsan 182: #1 , add ,
1.2 pazsan 183: *accu , t1 ,
1.1 pazsan 184: #1 , add ,
185: accu , SP ,
1.2 pazsan 186: t0 , shr ,
187: t1 , *accu ,
1.1 pazsan 188: "Next" , jmp ,
189: end-code
190:
191: Code @ sym @
192: \ "B" , tx ,
193: #0 , add ,
1.2 pazsan 194: SP , accu ,
195: *accu , shr ,
196: *accu , t0 ,
197: SP , accu ,
198: t0 , *accu ,
1.1 pazsan 199: "Next" , jmp ,
200: end-code
201:
202: Code x! sym x!
203: \ "C" , tx ,
204: SP , accu ,
1.2 pazsan 205: *accu , dstx ,
1.1 pazsan 206: #1 , add ,
1.2 pazsan 207: accu , srcx ,
1.1 pazsan 208: #1 , add ,
209: accu , SP ,
1.2 pazsan 210: "xmov" , jmp ,
1.1 pazsan 211: end-code
212:
213: Code x@ sym x@
214: \ "D" , tx ,
1.2 pazsan 215: SP , accu ,
216: *accu , srcx ,
217: accu , dstx ,
218: "xmov" , jmp ,
1.1 pazsan 219: end-code
220:
221: Code execute sym execute
222: \ "E" , tx ,
223: SP , accu ,
1.2 pazsan 224: *accu , W ,
1.1 pazsan 225: #1 , add ,
226: accu , SP ,
227: "Next1" , jmp ,
228: end-code
229:
230: Code ;s sym ;s
231: \ "F" , tx ,
232: RP , accu ,
233: #1 , add ,
234: accu , RP ,
1.2 pazsan 235: #1 , sub ,
236: *accu , IP ,
1.1 pazsan 237: "Next" , jmp ,
238: end-code
239:
240: Code ?branch sym ?branch
241: \ "?" , tx ,
242: #0 , add ,
243: IP , shr ,
1.2 pazsan 244: accu , t0 ,
1.1 pazsan 245: #1 , add ,
246: accu , add ,
247: accu , IP ,
248: SP , accu ,
249: accu , 1 m ,
250: #1 , add ,
251: accu , SP ,
252: 1 r , accu ,
253: pc+4 , jz ,
254: sym no-branch
255: "Next" , jmp ,
256: \ "+" , tx ,
1.2 pazsan 257: t0 , accu ,
258: *accu , accu ,
1.1 pazsan 259: Label >branch sym branch-o
260: IP , add ,
261: #2 , sub ,
262: sym branch-to
263: accu , IP ,
264: "Next" , jmp ,
265: Label "branch" >branch ,
266: end-code
267:
268: Code branch sym branch
269: \ "/" , tx ,
270: #0 , add ,
271: IP , shr ,
1.2 pazsan 272: *accu , accu ,
1.1 pazsan 273: IP , add ,
274: accu , IP ,
275: "Next" , jmp ,
276: end-code
277:
278: Code (loop) sym (loop)
279: #0 , add ,
280: IP , shr ,
1.2 pazsan 281: *accu , t0 ,
1.1 pazsan 282: #1 , add ,
283: accu , add ,
284: accu , IP ,
285: RP , accu ,
1.2 pazsan 286: *accu , t2 ,
1.1 pazsan 287: #1 , add ,
1.2 pazsan 288: *accu , t3 ,
289: t2 , accu ,
1.1 pazsan 290: #1 , add ,
1.2 pazsan 291: accu , t1 ,
292: RP , accu ,
293: t1 , *accu ,
294: t1 , accu ,
295: t3 , sub ,
1.1 pazsan 296: "Next" , jz ,
1.2 pazsan 297: t0 , accu ,
1.1 pazsan 298: "branch" , jmp ,
299: end-code
300:
301: Code xor sym xor
302: \ "H" , tx ,
303: SP , accu ,
1.2 pazsan 304: *accu , t0 ,
1.1 pazsan 305: #1 , add ,
306: accu , SP ,
1.2 pazsan 307: *accu , accu ,
308: t0 , xor ,
309: accu , t0 ,
310: SP , accu ,
311: t0 , *accu ,
1.1 pazsan 312: "Next" , jmp ,
313: end-code
314:
315: Code or sym or
316: \ "I" , tx ,
317: SP , accu ,
1.2 pazsan 318: *accu , t0 ,
1.1 pazsan 319: #1 , add ,
320: accu , SP ,
1.2 pazsan 321: *accu , accu ,
322: t0 , or ,
323: accu , t0 ,
324: SP , accu ,
325: t0 , *accu ,
1.1 pazsan 326: "Next" , jmp ,
327: end-code
328:
329: Code and sym and
330: \ "J" , tx ,
331: SP , accu ,
1.2 pazsan 332: *accu , t0 ,
1.1 pazsan 333: #1 , add ,
334: accu , SP ,
1.2 pazsan 335: *accu , accu ,
336: t0 , and ,
337: accu , t0 ,
338: SP , accu ,
339: t0 , *accu ,
1.1 pazsan 340: "Next" , jmp ,
341: end-code
342:
343: Code + sym +
344: \ "K" , tx ,
345: SP , accu ,
1.2 pazsan 346: *accu , t0 ,
1.1 pazsan 347: #1 , add ,
348: accu , SP ,
1.2 pazsan 349: *accu , accu ,
350: t0 , add ,
351: accu , t0 ,
352: SP , accu ,
353: t0 , *accu ,
1.1 pazsan 354: "Next" , jmp ,
355: end-code
356:
357: Code - sym -
358: \ "L" , tx ,
359: SP , accu ,
1.2 pazsan 360: *accu , t0 ,
1.1 pazsan 361: #1 , add ,
362: accu , SP ,
1.2 pazsan 363: *accu , accu ,
364: t0 , sub ,
365: accu , t0 ,
366: SP , accu ,
367: t0 , *accu ,
1.1 pazsan 368: "Next" , jmp ,
369: end-code
370:
371: Code 2/ sym 2\/
372: \ "M" , tx ,
373: #0 , add ,
1.2 pazsan 374: SP , accu ,
375: *accu , accu ,
1.1 pazsan 376: PC+6 , js ,
377: accu , shr ,
378: PC+6 , jmp ,
379: accu , shr ,
380: #$8000 , or ,
1.2 pazsan 381: accu , t0 ,
382: SP , accu ,
383: t0 , *accu ,
1.1 pazsan 384: "Next" , jmp ,
385: end-code
386:
387: Code 0= sym 0=
1.2 pazsan 388: SP , accu ,
389: *accu , accu ,
1.1 pazsan 390: ZF , accu ,
1.2 pazsan 391: #1 , xor ,
392: #1 , sub ,
393: accu , t0 ,
394: SP , accu ,
395: t0 , *accu ,
1.1 pazsan 396: "Next" , jmp ,
397: end-code
398:
399: Code 0<> sym 0<>
1.2 pazsan 400: SP , accu ,
401: *accu , accu ,
1.1 pazsan 402: ZF , accu ,
1.2 pazsan 403: #1 , sub ,
404: accu , t0 ,
405: SP , accu ,
406: t0 , *accu ,
1.1 pazsan 407: "Next" , jmp ,
408: end-code
409:
410: Code = sym =
411: SP , accu ,
1.2 pazsan 412: *accu , t0 ,
1.1 pazsan 413: #1 , add ,
414: accu , SP ,
1.2 pazsan 415: *accu , accu ,
416: t0 , sub ,
1.1 pazsan 417: ZF , accu ,
1.2 pazsan 418: #1 , xor ,
419: #1 , sub ,
420: accu , t0 ,
421: SP , accu ,
422: t0 , *accu ,
1.1 pazsan 423: "Next" , jmp ,
424: end-code
425:
426: Code u< sym u<
427: SP , accu ,
1.2 pazsan 428: *accu , t0 ,
1.1 pazsan 429: #1 , add ,
430: accu , SP ,
1.2 pazsan 431: *accu , accu ,
432: t0 , sub ,
1.1 pazsan 433: CF , accu ,
1.2 pazsan 434: #1 , xor ,
435: #1 , sub ,
436: accu , t0 ,
437: SP , accu ,
438: t0 , *accu ,
1.1 pazsan 439: "Next" , jmp ,
440: end-code
441:
442: Code 1+ sym 1+
1.2 pazsan 443: SP , accu ,
444: *accu , accu ,
1.1 pazsan 445: #1 , add ,
1.2 pazsan 446: accu , t0 ,
447: SP , accu ,
448: t0 , *accu ,
1.1 pazsan 449: "Next" , jmp ,
450: end-code
451:
452: Code cell+ sym cell+
1.2 pazsan 453: SP , accu ,
454: *accu , accu ,
1.1 pazsan 455: #2 , add ,
1.2 pazsan 456: accu , t0 ,
457: SP , accu ,
458: t0 , *accu ,
1.1 pazsan 459: "Next" , jmp ,
460: end-code
461:
462: Code 8<< sym 8<<
463: \ "T" , tx ,
464: #0 , add ,
465: SP , accu ,
1.2 pazsan 466: *accu , accu ,
1.1 pazsan 467: accu , add ,
468: accu , add ,
469: accu , add ,
470: accu , add ,
471: accu , add ,
472: accu , add ,
473: accu , add ,
474: accu , add ,
1.2 pazsan 475: accu , t0 ,
476: SP , accu ,
477: t0 , *accu ,
1.1 pazsan 478: "Next" , jmp ,
479: end-code
480:
481: Code 8>> sym 8>>
482: \ "T" , tx ,
483: #0 , add ,
484: SP , accu ,
1.2 pazsan 485: Label c-even@ *accu , shr ,
1.1 pazsan 486: accu , shr ,
487: accu , shr ,
488: accu , shr ,
489: accu , shr ,
490: accu , shr ,
491: accu , shr ,
492: accu , shr ,
493: #FF , and ,
1.2 pazsan 494: accu , t0 ,
495: SP , accu ,
496: t0 , *accu ,
1.1 pazsan 497: "Next" , jmp ,
498: Label "c-even@" c-even@ ,
499: end-code
500:
501: Code c@ sym c@
502: #0 , add ,
1.2 pazsan 503: SP , accu ,
504: *accu , shr ,
1.1 pazsan 505: PC+4 , jc ,
506: "c-even@" , jmp ,
1.2 pazsan 507: *accu , accu ,
1.1 pazsan 508: #FF , and ,
1.2 pazsan 509: accu , t0 ,
510: SP , accu ,
511: t0 , *accu ,
1.1 pazsan 512: "Next" , jmp ,
513:
514: Code 2* sym 2*
515: \ "N" , tx ,
1.2 pazsan 516: SP , accu ,
517: *accu , accu ,
1.1 pazsan 518: accu , add ,
1.2 pazsan 519: accu , t0 ,
520: SP , accu ,
521: t0 , *accu ,
1.1 pazsan 522: "Next" , jmp ,
523: end-code
524:
525: Code >r sym >r
526: \ "O" , tx ,
1.2 pazsan 527: SP , accu ,
528: *accu , t0 ,
529: #1 , add ,
530: accu , SP ,
1.1 pazsan 531: RP , accu ,
532: #1 , sub ,
533: accu , RP ,
1.2 pazsan 534: t0 , *accu ,
1.1 pazsan 535: "Next" , jmp ,
536: end-code
537:
538: Code r> sym r>
539: \ "P" , tx ,
540: RP , accu ,
1.2 pazsan 541: *accu , t0 ,
1.1 pazsan 542: #1 , add ,
543: accu , RP ,
544: SP , accu ,
545: #1 , sub ,
546: accu , SP ,
1.2 pazsan 547: t0 , *accu ,
1.1 pazsan 548: "Next" , jmp ,
549: end-code
550:
551: Code sp@ sym sp@
552: \ "Q" , tx ,
553: SP , accu ,
1.2 pazsan 554: accu , add ,
555: accu , t0 ,
556: SP , accu ,
1.1 pazsan 557: #1 , sub ,
558: accu , SP ,
1.2 pazsan 559: t0 , *accu ,
1.1 pazsan 560: "Next" , jmp ,
561: end-code
562:
563: Code sp! sym sp!
564: #0 , add ,
1.2 pazsan 565: SP , accu ,
566: *accu , shr ,
1.1 pazsan 567: accu , SP ,
568: "Next" , jmp ,
569: end-code
570:
571: Code rp@ sym rp@
572: \ "R" , tx ,
1.2 pazsan 573: RP , accu ,
574: accu , add ,
575: accu , t0 ,
1.1 pazsan 576: SP , accu ,
577: #1 , sub ,
578: accu , SP ,
1.2 pazsan 579: t0 , *accu ,
1.1 pazsan 580: "Next" , jmp ,
581: end-code
582:
583: Code rp! sym rp!
584: SP , accu ,
1.2 pazsan 585: *accu , t0 ,
1.1 pazsan 586: #1 , add ,
587: accu , SP ,
588: #0 , add ,
1.2 pazsan 589: t0 , shr ,
1.1 pazsan 590: accu , RP ,
591: "Next" , jmp ,
592: end-code
593:
594: Code drop sym drop
595: \ "S" , tx ,
596: SP , accu ,
597: #1 , add ,
598: accu , SP ,
599: "Next" , jmp ,
600: end-code
601:
602: Code lit sym lit
603: \ "#" , tx ,
604: IP , shr ,
1.2 pazsan 605: *accu , t0 ,
1.1 pazsan 606: #1 , add ,
607: accu , add ,
608: accu , IP ,
1.2 pazsan 609: SP , accu ,
610: #1 , sub ,
611: accu , SP ,
612: t0 , *accu ,
1.1 pazsan 613: "Next" , jmp ,
614: end-code
615:
616: Code dup sym dup
617: SP , accu ,
1.2 pazsan 618: *accu , t0 ,
1.1 pazsan 619: #1 , sub ,
620: accu , SP ,
1.2 pazsan 621: t0 , *accu ,
1.1 pazsan 622: "Next" , jmp ,
623: end-code
624:
625: Code I sym r@
1.2 pazsan 626: RP , accu ,
627: *accu , t0 ,
1.1 pazsan 628: SP , accu ,
629: #1 , sub ,
630: accu , SP ,
1.2 pazsan 631: t0 , *accu ,
1.1 pazsan 632: "Next" , jmp ,
633: end-code
634:
635: Code over sym over
636: SP , accu ,
637: #1 , add ,
1.2 pazsan 638: *accu , t0 ,
1.1 pazsan 639: #2 , sub ,
640: accu , SP ,
1.2 pazsan 641: t0 , *accu ,
1.1 pazsan 642: "Next" , jmp ,
643: end-code
644:
645: Code swap sym swap
646: SP , accu ,
1.2 pazsan 647: *accu , t0 ,
1.1 pazsan 648: #1 , add ,
1.2 pazsan 649: *accu , t1 ,
650: t0 , *accu ,
651: #1 , sub ,
652: t1 , *accu ,
1.1 pazsan 653: "Next" , jmp ,
654: end-code
655:
656: Code d+ sym d+
657: SP , accu ,
1.2 pazsan 658: *accu , t0 ,
1.1 pazsan 659: #1 , add ,
1.2 pazsan 660: *accu , t1 ,
1.1 pazsan 661: #1 , add ,
1.2 pazsan 662: *accu , t2 ,
1.1 pazsan 663: accu , SP ,
664: #1 , add ,
1.2 pazsan 665: *accu , accu ,
666: t1 , add ,
667: accu , t1 ,
1.1 pazsan 668: CF , accu ,
1.2 pazsan 669: t2 , add ,
670: t0 , add ,
671: accu , t0 ,
672: SP , accu ,
673: t0 , *accu ,
674: #1 , add ,
675: t1 , *accu ,
1.1 pazsan 676: "Next" , jmp ,
677: end-code
678:
679: Label cf1 0 ,
680: Code d2*+ sym d2*+
1.2 pazsan 681: SP , accu ,
682: Label >d2*+ *accu , t0 ,
683: #1 , add ,
684: *accu , t1 ,
1.1 pazsan 685: #1 , add ,
1.2 pazsan 686: *accu , t2 ,
687: accu , t3 ,
688: t0 , accu ,
689: t2 , add ,
690: t2 , add ,
691: accu , t2 ,
692: CF , accu ,
693: t1 , add ,
694: t1 , add ,
695: accu , t0 ,
696: t1 , accu ,
1.1 pazsan 697: #$8000 , and ,
1.2 pazsan 698: accu , t1 ,
699: t3 , accu ,
700: t2 , *accu ,
701: #1 , sub ,
702: t0 , *accu ,
703: #1 , sub ,
704: t1 , *accu ,
1.1 pazsan 705: "Next" , jmp ,
706: end-code
707:
708: Label res1 0 ,
709: Label "d2*+" >d2*+ ,
710: Code /modstep ( ud c R: u -- ud-?u 0/1 )
711: sym /modstep
712: SP , accu ,
1.2 pazsan 713: *accu , t0 ,
714: #1 , add ,
715: *accu , t1 ,
1.1 pazsan 716: #1 , add ,
1.2 pazsan 717: *accu , t2 ,
718: t2 , accu ,
719: t0 , sub ,
720: accu , t0 ,
1.1 pazsan 721: CF , accu ,
1.2 pazsan 722: t1 , or ,
1.1 pazsan 723: PC+6 , JZ ,
724: #0 , accu ,
725: PC+6 , jmp ,
1.2 pazsan 726: t0 , t2 ,
1.1 pazsan 727: #1 , accu ,
1.2 pazsan 728: accu , t0 ,
729: SP , accu ,
730: #1 , add ,
731: t0 , *accu ,
732: #1 , add ,
733: t2 , *accu ,
734: #1 , sub ,
1.1 pazsan 735: "d2*+" , jmp ,
736: end-code
737:
738: RP 2* Constant RP
739: SP 2* Constant SP
740: UP 2* Constant UP
741: IP 2* Constant IP
742:
1.5 ! pazsan 743: \ c: sp! 2/ sp ! ;
! 744: \ c: sp@ sp @ 1+ 2* ;
! 745: \ c: rp@ rp @ 2* ;
! 746: \ c: rp! r> swap 2/ rp ! >r ;
! 747: : up@ up @ ;
! 748: : up! up ! ;
1.1 pazsan 749:
1.3 pazsan 750: include ./key.fs