home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
64'er 1985 August
/
64er_Magazin_85-08_1985_Markt__Technik_de.d64
/
vocabulary.sorce
(
.txt
)
< prev
next >
Wrap
Commodore BASIC
|
2022-10-26
|
12KB
|
489 lines
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