40 OPEN1,8,15,"S:FORTH.VOC":CLOSE1 50 OPEN1,8,1,"FORTH.VOC" 60 : 70 : 100 : SYS 9*4096 105 : .OPT OO 110 STACK = $CF00 115 RETSTACK = $CE00 120 POS = $0002 122 RETPOS = $00FC 125 L = $00FD 130 H = $00FE 135 HL = $00FD 140 PRINT = $FFD2 145 : *= $C000 146 REG1 *= *+2 147 REG2 *= *+2 148 REG3 *= *+2 150 ;---------------------- 155 CLS LDA #"[147]" 160 : JMP PRINT 165 ;---------------------- 170 SHOW JSR POP 175 : STA $62 180 : STX $63 185 : LDX #$90 190 : LDA $62 195 : BMI MINUS 200 PLUS LDA #" " 205 : JSR PRINT 210 : SEC 215 : JMP $BDD4 220 MINUS LDA #"-" 225 : JSR PRINT 230 : CLC 235 : JMP $BDD4 240 ;---------------------- 245 PUSH STA H 250 : STX L 255 PUSH1 LDX POS 260 : LDA H 265 : STA STACK,X 270 : INX 275 : LDA L 280 : STA STACK,X 285 : INX 290 : STX POS 295 : RTS 300 ;---------------------- 305 POP LDX POS 310 : DEX 315 : LDA STACK,X 320 : STA L 325 : DEX 330 : LDA STACK,X 335 : STA H 340 : STX POS 345 : LDA H 350 : LDX L 355 : RTS 360 ;---------------------- 365 DROP JMP POP 370 ;---------------------- 375 DUP JSR POP 380 : JSR PUSH 385 : JMP PUSH1 390 ;---------------------- 395 SWAP JSR POP 400 : STA REG1 405 : STX REG1+1 410 : JSR POP 415 : STA REG2 420 : STX REG2+1 425 : LDA REG1 430 : LDX REG1+1 435 : JSR PUSH 440 : LDA REG2 445 : LDX REG2+1 450 : JMP PUSH 455 ;---------------------- 460 OVER DEC POS 465 : DEC POS 470 : JSR POP 475 : INC POS 480 : INC POS 485 : INC POS 490 : INC POS 495 : JMP PUSH 500 ;---------------------- 505 RETPOP LDX RETPOS 510 : DEX 515 : LDA RETSTACK,X 520 : STA L 525 : DEX 530 : LDA RETSTACK,X 535 : STA H 540 : STX RETPOS 545 : LDA H 550 : LDX L 555 : RTS 560 ;---------------------- 565 RETPUSH STA H 570 : STX L 575 RETPUSH1 LDX RETPOS 580 : LDA H 585 : STA RETSTACK,X 590 : INX 595 : LDA L 600 : STA RETSTACK,X 605 : INX 610 : STX RETPOS 615 : RTS 620 ;----------------------- 625 SUBTRAKTION SEC 630 : LDA REG1 635 : SBC REG2 640 : STA REG3 645 : LDA REG1+1 650 : SBC REG2+1 655 : STA REG3+1 660 : RTS 665 ;----------------------- 670 ADDITION CLC 675 : LDA REG1 680 : ADC REG2 685 : STA REG3 690 : LDA REG1+1 695 : ADC REG2+1 700 : STA REG3+1 705 : RTS 710 ;----------------------- 715 CR LDA #13 720 : JMP PRINT 725 ;----------------------- 730 VERGLEICH JSR POP 735 : STX REG1 740 : STA REG1+1 745 : JSR POP 750 : STX REG2 755 : STA REG2+1 760 : JMP SUBTRAKTION 765 ;----------------------- 770 GLEICH JSR VERGLEICH 771 : LDA REG3 772 : ORA REG3+1 775 : BEQ WAHR1 780 FALSCH1 LDA #0 785 : TAX 790 : JMP PUSH 795 WAHR1 LDA #0 800 : LDX #1 805 : JMP PUSH 810 ;----------------------- 815 GROESSER JSR VERGLEICH 820 : BCC WAHR2 825 FALSCH2 LDA #0 830 : TAX 835 : JMP PUSH 840 WAHR2 LDA #0 845 : LDX #1 850 : JMP PUSH 855 ;----------------------- 860 KLEINER JSR SWAP 865 : JMP GROESSER 870 ;----------------------- 875 NICHT JSR POP 880 : ORA L 885 : BEQ WAHR3 890 FALSCH3 LDA #0 895 : TAX 900 : JMP PUSH 905 WAHR3 LDA #0 910 : LDX #1 915 : JMP PUSH 920 ;----------------------- 925 HOLE JSR POP 930 : STX REG1 935 : STA REG1+1 940 : JSR POP 945 : STX REG2 950 : STA REG2+1 955 : RTS 960 ;----------------------- 965 UND JSR HOLE 970 : LDA REG1 975 : AND REG2 980 : STA L 985 : LDA REG1+1 990 : AND REG2+1 995 : STA H 1000 : JMP PUSH1 1005 ;----------------------- 1010 ODER JSR HOLE 1015 : LDA REG1 1020 : ORA REG2 1025 : STA L 1030 : LDA REG1+1 1035 : ORA REG2+1 1040 : STA H 1045 : JMP PUSH1 1050 ;----------------------- 1055 EXODER JSR HOLE 1060 : LDA REG1 1065 : EOR REG2 1070 : STA L 1075 : LDA REG1+1 1080 : EOR REG2+1 1085 : STA H 1090 : JMP PUSH1 1095 ;----------------------- 1100 ADD JSR HOLE 1105 : JSR ADDITION 1110 : LDX REG3 1115 : LDA REG3+1 1120 : JMP PUSH 1125 ;----------------------- 1130 SUB JSR SWAP 1135 : JSR HOLE 1140 : JSR SUBTRAKTION 1145 : LDX REG3 1150 : LDA REG3+1 1155 : JMP PUSH 1160 ;----------------------- 1165 MUL JSR HOLE 1170 : LDY #0 1175 : STY REG3 1180 : STY REG3+1 1185 : LDY #16 1190 LOOP16 ASL REG3 1195 : ROL REG3+1 1200 : ROL REG2 1205 : ROL REG2+1 1210 : BCC LAB2 1215 : CLC 1220 : LDA REG3 1225 : ADC REG1 1230 : STA REG3 1235 : LDA REG3+1 1240 : ADC REG1+1 1245 : STA REG3+1 1250 : BCC LAB2 1255 : INC REG2 1260 : BNE LAB2 1265 : INC REG2+1 1270 LAB2 DEY 1275 : BNE LOOP16 1280 : LDX REG3 1285 : LDA REG3+1 1290 : JMP PUSH 1295 ;----------------------- 1300 DIVISION JSR HOLE 1305 : LDY #16 1310 : LDA #0 1315 : STA REG3 1320 : STA REG3+1 1325 LOOP17 ROL REG2 1330 : ROL REG2+1 1335 : ROL REG3 1340 : ROL REG3+1 1345 : SEC 1350 : LDA REG3 1355 : SBC REG1 1360 : TAX 1365 : LDA REG3+1 1370 : SBC REG1+1 1375 : BCC LAB4 1380 : STA REG3+1 1385 : STX REG3 1390 LAB4 DEY 1395 : BNE LOOP17 1400 : ROL REG2 1405 : ROL REG2+1 1410 : RTS 1415 ;----------------------- 1420 DIV JSR DIVISION 1425 : LDX REG2 1430 : LDA REG2+1 1435 : JMP PUSH 1440 ;----------------------- 1445 MOD JSR DIVISION 1450 : LDX REG3 1455 : LDA REG3+1 1460 : JMP PUSH 1465 ;----------------------- 1470 TRS JSR RETPOP 1475 : JMP PUSH 1480 ;----------------------- 1485 TSR JSR POP 1490 : JMP RETPUSH 1495 ;----------------------- 1500 DO JSR SWAP 1505 : JSR TSR 1510 : JMP TSR 1515 ;----------------------- 1520 IND JSR TRS 1525 : INC RETPOS 1530 : INC RETPOS 1535 : RTS 1540 ;----------------------- 1545 LOOP1 JSR TRS 1550 : JSR DUP 1555 : JSR TRS 1560 : JSR SWAP 1565 VERGL JSR VERGLEICH 1570 : BCC WAHR4 1571 FALSCH4 JSR DROP 1575 : JSR DROP 1579 : SEC 1580 : RTS 1585 WAHR4 INC RETPOS 1590 : INC RETPOS 1595 : JSR ADD 1600 : JSR TSR 1605 : CLC 1610 : RTS 1615 ;----------------------- 1620 LOOP LDA #0 1625 : LDX #1 1630 : JSR PUSH 1635 : JMP LOOP1 1640 ;----------------------- 1645 LOOPPLUS JSR POP 1650 : INC POS 1655 : INC POS 1660 : LDA H 1665 : BPL LOOP1 1670 : JSR TRS 1675 : JSR DUP 1680 : JSR TRS 1685 : JMP VERGL 1690 ;----------------------- 1695 IF JSR POP 1700 : ORA L 1705 : BEQ NEIN 1710 JA SEC 1715 : RTS 1720 NEIN CLC 1725 : RTS 1730 ;----------------------- 1735 EMIT JSR POP 1740 : TXA 1745 : JMP PRINT 1750 ;----------------------- 1755 GET JSR $EA87 1760 : CPX #255 1765 : BEQ NULL 1766 : CPX #13 1767 : BCS NONULL 1770 NULL LDX #$00 1775 NONULL LDA #$00 1780 : JMP PUSH 1785 ;----------------------- 1790 KEY JSR GET 1795 : JSR DUP 1800 : JSR IF 1805 : BCS NEXT5 1810 : JSR DROP 1815 : JMP KEY 1820 NEXT5 RTS 1825 ;----------------------- 1830 PUTZEILE STX L 1835 : STA H 1840 : LDY #0 1845 LOOPPUT LDA (HL),Y 1850 : BEQ ENDPUT 1855 : JSR PRINT 1860 : INY 1865 : BNE LOOPPUT 1870 ENDPUT RTS 1875 ;----------------------- 1880 TYPE JSR POP 1885 : STX $F7 1890 : JSR POP 1895 : LDY #0 1900 LOOPTYPE LDA (HL),Y 1905 : JSR PRINT 1910 : INY 1915 : CPY $F7 1920 : BNE LOOPTYPE 1925 : RTS 1930 ;----------------------- 1935 EXPECT JSR POP 1940 : STX $F9 1945 : JSR POP 1950 : STX $F7 1955 : STA $F8 1960 : LDX #0 1965 : LDY #0 1970 LOOPEX JSR $FFCF 1975 : STA ($F7),Y 1980 : CMP #13 1985 : BEQ ENDEX 1990 : INX 1995 : INY 2000 : CPY $F9 2005 : BNE LOOPEX 2010 ENDEX RTS 2015 ;----------------------- 2020 DEPTH LDA POS 2025 : LSR A 2030 : TAX 2035 : LDA #0 2040 : JMP PUSH 2045 ;----------------------- 2050 DPOKE JSR POP 2055 : STX $F7 2060 : STA $F8 2065 : JSR POP 2070 : LDY #1 2075 : STA ($F7),Y 2080 : TXA 2085 : DEY 2090 : STA ($F7),Y 2095 : RTS 2100 ;---------------------- 2105 POKE JSR POP 2110 : STX $F7 2115 : STA $F8 2120 : JSR POP 2125 : LDY #0 2130 : TXA 2135 : STA ($F7),Y 2140 : RTS 2145 ;---------------------- 2150 DPEEK JSR POP 2155 : STX $F7 2160 : STA $F8 2165 : LDY #0 2170 : LDA ($F7),Y 2175 : TAX 2180 : INY 2185 : LDA ($F7),Y 2190 : JMP PUSH 2195 ;---------------------- 2200 PEEK JSR POP 2205 : STX $F7 2210 : STA $F8 2215 : LDY #0 2220 : LDA ($F7),Y 2225 : TAX 2230 : LDA #0 2235 : JMP PUSH 2240 ;---------------------- 2245 CALL JSR POP 2246 : LDA 780 2247 : LDX 781 2248 : LDY 782 2250 : JMP (HL) 2255 ;---------------------- 2260 PICK JSR POP 2265 : LDY POS 2270 : STY REG1 2275 : TXA 2280 : ASL A 2285 : STA POS 2290 : JSR POP 2300 : LDY REG1 2305 : STY POS 2312 : JMP PUSH 2313 ;---------------------- 2315 ROT JSR POP 2320 : STX REG1 2325 : STA REG1+1 2330 : JSR POP 2335 : STX REG2 2340 : STA REG2+1 2345 : JSR POP 2350 : STX REG3 2355 : STA REG3+1 2360 : LDX REG2 2365 : LDA REG2+1 2370 : JSR PUSH 2375 : LDX REG1 2380 : LDA REG1+1 2385 : JSR PUSH 2390 : LDX REG3 2395 : LDA REG3+1 2400 : JMP PUSH 2405 ;---------------------- 2410 LOAD JSR $AEFD 2415 : JSR $E1D4 2420 : LDA #1 2425 : STA $B9 2430 : LDA #0 2435 : JMP $FFD5 2440 ;---------------------- 9600 : .SST 8,2,"@:LABEL,S,W" 9610 : .END