1 too%=7:DIM tn%(84):FOR k%=0 TO 12*too%:tn%(k%)=4095/(2^(k%/too%)):NEXT:DIM ko%(24) 10 'FORMAT von Bart Jongejan, Amersfoort, Niederlande, 1986 20 GOSUB 300:'Initialisierung 30 INPUT "Beispiele (j/n) ?",a$:IF a$="j" THEN 40 ELSE 290 40 lyst$(1)="F;o;r;m;a;t":nr%=1:GOSUB 460 50 PRINT "addieren" 60 lyst$(1)="b;1.444;a;-8":nr%=1:GOSUB 460 70 PRINT "subtrahieren" 80 lyst$(1)="a;-1*a":nr%=1:GOSUB 460 90 PRINT "multiplizieren" 100 lyst$(1)="b*1.444*a*-8":nr%=1:GOSUB 460 110 PRINT "dividieren" 120 lyst$(1)="a*a^-1":nr%=1:GOSUB 460 130 PRINT "Klammern" 140 lyst$(1)="(a;b)*(a;b*-1)":nr%=1:GOSUB 460 150 PRINT "potenzieren" 160 lyst$(1)="a*a*-1;a^2":nr%=1:GOSUB 460 170 PRINT "Logarithmus (10 Basis: LOG)" 180 lyst$(1)="10L100":nr%=1:GOSUB 460 190 PRINT "Logarithmus (Basis willkuerlich)" 200 lyst$(1)="66L100":nr%=1:GOSUB 460 210 PRINT "differenzieren nach x von einer gegebenen Funktion" 220 lyst$(1)="xD(x^2)":nr%=1:GOSUB 460:aa$=lyst$(1) 230 PRINT "differenzieren nach r von einer unbekannten Funktion von r" 240 lyst$(1)="rDf":nr%=1:GOSUB 460 250 PRINT "differenzieren nach x von einer gegebenen Funktion von r" 260 lyst$(1)="xD(e^(r^2))":nr%=1:GOSUB 460:bb$=lyst$(1) 270 PRINT "alte Resultaten kombinieren" 280 lyst$(1)=aa$+"*"+bb$:nr%=1:GOSUB 460 290 GOSUB 450:GOTO 290 300 BORDER 13:INK 0,13:INK 1,0:MODE 2 310 SYMBOL AFTER 59 320 SYMBOL 59,0,24,24,126,126,24,24,0 330 SYMBOL 170,0,102,60,255,60,102,0,170 340 SYMBOL 187,0,24,24,126,126,24,24,170 350 SYMBOL 196,248,108,102,102,102,108,196,170 360 SYMBOL 204,240,96,96,96,98,102,254,170 370 SYMBOL 222,24,60,126,24,24,24,24,170 375 SYMBOL 150,0,0,0,14,24,24,24,0 376 SYMBOL 156,0,0,0,112,24,24,24,0 380 DEF FNa$(i%)=MID$((CHR$(ASC(a$(i%)+" ") MOD 128)+MID$((a$(i%)+" "),2)),1,LEN(a$(i%))):'liefert a$(i%) mit ausgeschaltetem "fertig-"bit 390 DEF FNum(a$)=-SGN((ABS(CREAL(VAL(a$))))+INSTR(" 0",a$)):'a$ numerisch? 400 DEF FNop(a$)=INSTR(" ;*^LD",CHR$(ASC(a$+" ") MOD 128)):'Prioritaet von a$ 410 DEF FNop$(h%)=MID$(" ;*^LD",h%,1):'in:prioritaet.aus:operator mit ausgeschaltetem "fertig-"bit 440 mm%=1000:DIM a$(1000):DIM n%(1000,3):RETURN:'mm%=Anzahl Knoten 450 INPUT lyst$(1):nr%=1:'mehrere elemente von lyst$ koennen angeliefert werden. nr% dementsprechend erhoehen 460 i%=1:bg%=1:'bg%="root" der Baum.Veraenderlich 470 FOR j%=1 TO nr%:PRINT lyst$(j%);:NEXT:PRINT:'Eingabe 480 GOSUB 510:GOSUB 770 490 FOR j%=1 TO nr%:PRINT lyst$(j%);:NEXT:PRINT:'Resultat 500 RETURN 510 l%=INSTR(lyst$(1),"#"):IF l%>0 THEN k=@lyst$(1):a=256*PEEK(k+2)+PEEK(k+1):FOR k=a TO PEEK(k)+a-1:POKE k,(PEEK(k) AND 127):NEXT:'lyst$(n) in (Sub-)Baum verwandeln 520 k%=0:WHILE l%>k%:l%=l%+1:m%=VAL(MID$(lyst$(1),l%)):h%=n%(t%(m%),3):IF n%(h%,1)=t%(m%) THEN n%(h%,1)=0 ELSE IF n%(h%,2)=t%(m%) THEN n%(h%,2)=0:'Subbaum schutzen vor auswischen 530 k%=l%:l%=k%-1+INSTR(MID$(lyst$(1),l%),"#"):WEND 540 h%=i%:GOSUB 1930:'alte Subbaum auswischen 550 lnt%=0:FOR j%=1 TO nr%:lnt%=lnt%+LEN(lyst$(j%)):NEXT 560 n%(i%,1)=1:n%(i%,2)=lnt% 570 lv%=0:mop%=32767:mlv%=32767:'Baum aufbauen.In:a$(i%) enthaelt arithmetische Ausdruck,n%(i%,1) Anfangsposition dieser Ausdruck,n%(i%,2) Endeposition und n%(i%,3) (i%<>bg%) weist zurueck zu Operator mit niedriger Prioritaet. 580 FOR k%=n%(i%,2) TO n%(i%,1) STEP -1:h%=k%:l%=1:WHILE LEN(lyst$(l%))lv% THEN mlv%=lv%:gt%=-1 ELSE IF mlv%=lv% THEN eq%=-1 600 op%=FNop(a$):IF op%>1 THEN IF (eq% AND mop%>op%) OR gt% THEN mop%=op%:wort%=k%:a$(i%)=a$ 610 NEXT 620 IF mop%=32767 THEN 660 630 GOSUB 730:n%(j%,1)=n%(i%,1)+mlv%:n%(i%,1)=j%:n%(j%,2)=wort%-1:n%(j%,3)=i%:GOSUB 730:n%(j%,1)=wort%+1:n%(j%,2)=n%(i%,2)-mlv%:n%(i%,2)=j%:n%(j%,3)=i% 640 i%=n%(i%,1):GOSUB 570:i%=n%(n%(i%,3),2):GOSUB 570:i%=n%(i%,3) 650 RETURN:'aus:a$(i%) enthaelt operator mit niedrigster Prioritaet,n%(i%,1) und n%(i%,2) zeigen die zwei Operanden (arithmetische Ausdruecke) an. 660 a%=n%(i%,1)+mlv%:b%=n%(i%,2)-mlv%:h%=1:WHILE b%>LEN(lyst$(h%)):b%=b%-LEN(lyst$(h%)):a%=a%-LEN(lyst$(h%)):h%=h%+1:WEND:a$(i%)=MID$(lyst$(h%),a%,b%-a%+1) 670 IF FNum(a$(i%)) THEN a$(i%)=STR$(VAL(a$(i%))):RETURN 680 IF LEFT$(a$(i%),1)="@" THEN h%=t%(VAL(MID$(a$(i%),2))):GOSUB 1970 ELSE IF LEFT$(a$(i%),1)="#" THEN l%=VAL(MID$(a$(i%),2)):k%=t%(l%) ELSE RETURN 690 a$(i%)="":n%(k%,3)=n%(i%,3):IF n%(n%(i%,3),1)=i% THEN n%(n%(k%,3),1)=k% ELSE IF n%(n%(i%,3),2)=i% THEN n%(n%(k%,3),2)=k% 700 IF i%=bg% THEN i%=k%:bg%=k% ELSE i%=k% 710 RETURN 720 a=256*PEEK(a+2)+PEEK(a+1):POKE a,(PEEK(a) AND 127):RETURN:'"fertig-"bit Null machen 730 vr%=1+vr% MOD(mm%):WHILE a$(vr%)<>"":vr%=1+vr% MOD(mm%):WEND:j%=vr%:'freie Knoten suchen 740 RETURN 750 l%=n%(i%,1):IF FNa$(i%)=FNa$(l%) THEN l%=n%(l%,2):'linker Operand finden 760 RETURN 770 FOR h%=1 TO nr%:lyst$(h%)="":NEXT:'Anfang Baumbearbeitung 780 GOSUB 1060 790 i%=bg%:nr%=1:lyst$(1)="":GOSUB 830 800 FOR i%=1 TO mm%:IF a$(i%)<>"" THEN PRINT "nicht alle Knoten gewischt,Resultat vielleicht falsch" 810 NEXT 820 RETURN 830 IF FNop(a$(i%))>1 THEN GOSUB 1000:GOSUB 1020:i%=n%(i%,1):GOSUB 830:i%=n%(i%,3):GOSUB 860:i%=n%(i%,2):GOSUB 830:i%=n%(i%,3):GOSUB 1000:GOSUB 1040 ELSE GOSUB 870:'Inhalt Resultatbaum nach Ausgabepuffer 840 a$(i%)="" 850 RETURN 860 IF LEN(a$(i%))+LEN(lyst$(nr%))>250 THEN nr%=nr%+1 870 lyst$(nr%)=lyst$(nr%)+a$(i%) 880 RETURN 890 b%=bg%:GOSUB 920:PRINT:RETURN:'Inhalt Baum zeigen(fuer debugging) 900 IF FNop(a$(b%))>1 THEN GOSUB 970:PRINT h1$;:b%=n%(b%,1):GOSUB 900:b%=n%(b%,3):GOSUB 960:b%=n%(b%,2):GOSUB 900:b%=n%(b%,3):GOSUB 970:PRINT h2$; ELSE GOSUB 960 910 RETURN 920 ry%=1:LOCATE 1,1:CLS:GOSUB 930:RETURN 930 IF FNop(a$(b%))>1 THEN ry%=ry%+1:b%=n%(b%,1):GOSUB 930:b%=n%(b%,3):ry%=ry%-1:GOSUB 945:b%=n%(b%,2):ry%=ry%+1:GOSUB 930:b%=n%(b%,3):ry%=ry%-1:GOSUB 941 ELSE GOSUB 946 940 RETURN 941 o%=POS(#0):LOCATE ko%(ry%)+1,ry%:FOR j%=ko%(ry%) TO ko%(ry%+1)-2:PRINT"-";:NEXT:PRINT CHR$(156);:LOCATE o%,ry%:RETURN 945 ko%(ry%)=POS(#0):LOCATE ko%(ry%+1),ry%:PRINT CHR$(150);:FOR j%=ko%(ry%+1) TO ko%(ry%)-2:PRINT"-";:NEXT:off%=6*too%:GOTO 950 946 ko%(ry%)=POS(#0):off%=6*too%+1 950 LOCATE POS(#0),ry%:GOSUB 960:RETURN 960 IF b%=i% THEN CALL &BB9C:SOUND 2,tn%((off%-ry%)MOD(too%*12)),10:PRINT a$(b%);:CALL &BB9C ELSE SOUND 2,tn%((off%-ry%)MOD(too%*12)),10:PRINT a$(b%); 965 RETURN 970 fa%=FNop(a$(b%)):IF b%=bg% THEN fb%=2 ELSE fb%=FNop(a$(n%(b%,3))):'Klammern 980 IF fa%3) THEN h1$="(":h2$=")" ELSE h1$="":h2$="" 990 RETURN 1000 fa%=FNop(a$(i%)):IF i%=bg% THEN fb%=99 ELSE fb%=FNop(a$(n%(i%,3))) 1010 RETURN 1020 IF fa%3) THEN lyst$(nr%)=lyst$(nr%)+"(" 1030 RETURN 1040 IF fa%3) THEN lyst$(nr%)=lyst$(nr%)+")" 1050 RETURN 1060 IF FNop(a$(i%))<2 OR ASC(a$(i%)+" ")>127 THEN IF i%=bg% THEN RETURN ELSE i%=n%(i%,3):IF ASC(a$(i%))>127 THEN 1070 ELSE a=@a$(i%):a=256*PEEK(a+2)+PEEK(a+1):POKE a,(PEEK(a) OR 128):i%=n%(i%,2):GOTO 1060 ELSE i%=n%(i%,1):GOTO 1060 1070 GOSUB 890:'Zwischenresultat zeigen 1071 'SOUND 1,tn%(i%MOD(too%*12)),10 1080 ON FNop(a$(i%)) GOSUB 1060,2000,2000,2010:'Baum normalisieren 1090 GOSUB 1250:'substituieren und ausrechnen 1100 IF FNop(a$(i%))=6 THEN GOSUB 1810:'differenzieren 1110 IF FNop(a$(i%))=3 OR FNop(a$(i%))=4 THEN GOSUB 1890:'ausklammern 1120 ON FNop(a$(i%)) GOTO 1060,1140,1130,1150,1170,1060,1060 1130 GOSUB 1710:'Summe als Nenner 1140 IF ASC(a$(i%)+" ")>127 THEN ON FNop(a$(i%)) GOTO 1060,1420,1420,1060,1060,1060 ELSE 1060:'sortieren,Exponenten oder numerische Faktoren einklammern 1150 IF FNa$(n%(i%,1))=";" THEN r=VAL(a$(n%(i%,2))):IF ABS(r)>1 AND r=INT(r) THEN t%(1)=n%(i%,1):IF r<-1 THEN lyst$(1)="(#1^"+STR$(-r)+")^-1":GOSUB 510 ELSE lyst$(1)="#1^"+STR$(r-1)+"*@1":GOSUB 510:'Summe mit numerischen Exponent 1160 s$="L":GOTO 1180 1170 s$="^" 1180 s%=n%(i%,2) 1190 IF FNa$(s%)=s$ THEN r%=s%:GOSUB 1220:'Logarithmen und Potenzierung ausgleichen 1200 IF eq% OR FNa$(s%)<>"*" THEN 1060 ELSE IF FNa$(n%(s%,2))=s$ THEN r%=n%(s%,2):GOSUB 1220:IF eq% THEN 1060 1210 s%=n%(s%,1):GOTO 1190 1220 h%=n%(i%,1):j%=n%(r%,1):GOSUB 1730:IF NOT eq% THEN RETURN 1230 t%(1)=n%(r%,2):t%(3)=n%(i%,2):h%=n%(r%,1):GOSUB 1930:a$(r%)=" 1":IF s$="L" THEN lyst$(1)="(#1^#3)" ELSE t%(2)=n%(i%,1):lyst$(1)="(#1;#2L#3)" 1240 GOSUB 510:WHILE r%<>i%:r%=n%(r%,3):a=@a$(r%):GOSUB 720:WEND:RETURN 1250 GOSUB 750:'einfache Substituierungen 1260 IF FNum(a$(l%)) THEN IF FNum(a$(n%(i%,2))) THEN 1600 1270 a$=FNa$(i%):b$=a$(l%):c$=a$(n%(i%,2)) 1280 IF a$="D" THEN 1360 ELSE IF a$="*" THEN IF b$=" 0" OR c$=" 0" THEN 1670 1290 IF a$=";" AND c$=" 0" OR a$="*" AND c$=" 1" OR a$="^" AND (b$=" 0" OR b$=" 1" OR c$=" 1") THEN t%(1)=n%(i%,1):lyst$(1)="#1":GOTO 510 ELSE IF a$="^" AND c$=" 0" OR a$="L" AND c$=" 1" THEN lyst$(1)=STR$(1-VAL(c$)):GOTO 510 1300 IF a$="^" AND b$="i" AND FNum(c$) THEN c=VAL(c$):c=c-c\4*4+(1-SGN(c))*2 ELSE GOTO 1340:'imaginaire Zahlen 1310 IF 00 THEN IF b$="z" THEN lyst$(1)="(r^-1*(r^ 2;x^ 2*-1;y^ 2*-1)^ 0.5)":GOTO 510 ELSE lyst$(1)="(r^-1*"+b$+")":GOTO 510:'r^2=x^2+y^2+z^2 1380 IF b$="a" AND INSTR("cs",c$)>0 THEN IF c$="c" THEN lyst$(1)="((c^ 2*-1; 1)^ 0.5*-1)":GOTO 510 ELSE lyst$(1)="((s^ 2*-1; 1)^ 0.5)":GOTO 510:'c=cos(a),s=sin(a) 1390 IF b$="r" AND INSTR(c$,"f")>0 THEN lyst$(1)="("+c$+"r)":GOTO 510:'f=f(r) (nicht spezifiziert) 1400 IF FNop(c$)<2 THEN 1670:'Abgeleitete gleich Null 1410 RETURN 1420 GOSUB 750:j%=n%(i%,2):IF FNa$(l%)=";" OR FNa$(j%)=";" THEN 1060:'sortieren,Exponenten oder numerische Factoren einklammern 1430 h%=l%:r%=j% 1440 ON FNop(a$(i%)) GOTO 1060,1450,1480,1060,1060,1060 1450 IF FNa$(h%)="*" AND FNum(a$(n%(h%,2))) THEN h%=n%(h%,1) 1460 IF FNa$(j%)="*" AND FNum(a$(n%(j%,2))) THEN j%=n%(j%,1) 1470 GOTO 1500 1480 IF FNa$(h%)="^" THEN h%=n%(h%,1) 1490 IF FNa$(j%)="^" THEN j%=n%(j%,1) 1500 GOSUB 1730:IF eq% THEN 1510 ELSE IF (gt% OR FNum(a$(h%))) AND NOT FNum(a$(j%)) THEN 1580 ELSE 1060 1510 IF h%<>l% THEN 1530 ELSE IF j%<>r% THEN 1520 ELSE t%(7)=j%:x$=FNop$(FNop(a$(i%))+1):lyst$(1)="#7"+x$+" 2":GOTO 1560:'a*a=a^2,a+a=a*2 1520 x$=a$(r%):t%(1)=j%:t%(2)=n%(r%,2):GOTO 1550:'a*a^b=a^(b+1),a+a*n=a*(n+1) 1530 x$=a$(l%):t%(1)=h%:t%(2)=n%(l%,2):IF j%=r% THEN 1550:'a^b*a=a^(b+1),a*n+a=a*(n+1) 1540 t%(6)=n%(r%,2):lyst$(1)="#1"+x$+"(#2;#6)":GOTO 1560:'a^b*a^c=a^(b+c),a*m+a*n=a*(m+n) 1550 lyst$(1)="#1"+x$+"(#2; 1)" 1560 IF l%<>n%(i%,1) THEN t%(4)=n%(n%(i%,1),1):lyst$(1)="#4"+a$(i%)+lyst$(1) 1570 GOSUB 510:GOTO 1060 1580 t%(1)=n%(i%,2):lyst$(1)="#1"+a$(i%)+"#2":IF FNop(a$(n%(i%,1)))=FNop(a$(i%)) THEN t%(2)=n%(n%(i%,1),2):t%(3)=n%(n%(i%,1),1):lyst$(1)="#3"+a$(i%)+lyst$(1) ELSE t%(2)=n%(i%,1):'sortieren 1590 GOSUB 510:GOTO 1060 1600 op%=FNop(a$(i%)):GOSUB 750:l=VAL(a$(l%)):r=VAL(a$(n%(i%,2))):'ausrechnen 1610 IF op%<4 THEN ON op% GOTO 1620,1630,1640 ELSE IF l%=n%(i%,1) THEN ON op%-3 GOTO 1650,1660,1670 ELSE IF op%=4 THEN 1640 1620 RETURN 1630 lyst$(1)=STR$(l+r):GOTO 1690 1640 lyst$(1)=STR$(l*r):GOTO 1690 1650 lyst$(1)=STR$(l^r):GOTO 510 1660 lyst$(1)=STR$(LOG(r)/LOG(l)):GOTO 510 1670 lyst$(1)=" 0":GOTO 510 1680 lyst$(1)=" 1":GOTO 510 1690 IF l%<>n%(i%,1) THEN t%(1)=n%(n%(i%,1),1):lyst$(1)="#1"+FNa$(i%)+lyst$(1) 1700 GOTO 510 1710 IF FNa$(n%(i%,2))<>"^" THEN RETURN ELSE IF FNa$(n%(n%(i%,2),1))<>";" THEN RETURN ELSE IF a$(n%(n%(i%,2),2))<>"-1" THEN RETURN ELSE h%=n%(i%,1):j%=n%(n%(n%(i%,2),1),2):GOSUB 1730:IF NOT eq% THEN RETURN:'Summe als Nenner 1720 t%(1)=n%(i%,1):t%(2)=n%(n%(n%(i%,2),1),1):lyst$(1)="(#2;#1)^-1*@2*-1; 1":GOTO 510 1730 hb%=n%(h%,3):jb%=n%(j%,3):f%=-1:eq%=-1:'Subbaumen vergleichen (eq%:gleich,gt%:groesser) 1740 WHILE f% 1750 IF eq% THEN eq%=FNa$(h%)=FNa$(j%):gt%=FNa$(h%)>FNa$(j%) 1760 IF FNop(a$(h%))>1 THEN h%=n%(h%,1) ELSE WHILE n%(n%(h%,3),2)=h% AND n%(h%,3)<>hb%:h%=n%(h%,3):WEND:IF n%(h%,3)=hb% THEN f%=0 ELSE h%=n%(n%(h%,3),2) 1770 IF FNop(a$(j%))>1 THEN j%=n%(j%,1) ELSE WHILE n%(n%(j%,3),2)=j% AND n%(j%,3)<>jb%:j%=n%(j%,3):WEND:IF n%(j%,3)=jb% THEN f%=0 ELSE j%=n%(n%(j%,3),2) 1780 WEND 1790 IF n%(h%,3)=hb% XOR n%(j%,3)=jb% THEN eq%=0:gt%=n%(j%,3)=jb% 1800 RETURN 1810 r%=n%(i%,2):b$=a$(n%(r%,1)):ON FNop(a$(r%)) GOTO 1820,1830,1840,1850,1860 1820 RETURN 1830 y$=";":GOTO 1900 1840 lyst$(1)="@1D@2*@3;#2*#1D#3":GOTO 1870 1850 lyst$(1)="#2^(#3;-1)*@3*#1D@2;@2^@3*eL@2*@1D@3":GOTO 1870 1860 lyst$(1)="#2^-1*eL@2^-2*eL#3*#1D@2;@3^-1*eL@2^-1*@1D@3" 1870 t%(2)=n%(r%,1):t%(1)=n%(i%,1):t%(3)=n%(r%,2):GOTO 510 1890 r%=n%(i%,2):GOSUB 750:IF FNa$(i%)="*" AND FNa$(r%)=";" THEN y$=";":GOTO 1900 ELSE IF FNa$(i%)="^" AND FNa$(r%)=";" AND FNa$(n%(i%,1))=";" THEN a=VAL(a$(n%(r%,2))):IF a>0 AND a=INT(a) THEN y$="*":GOTO 1900:'ausklammern 1895 IF FNop(a$(l%))=FNop(a$(i%))-1 THEN t%(1)=n%(l%,1):t%(2)=n%(l%,2):t%(3)=r%:lyst$(1)="#1"+a$(i%)+"#3"+a$(l%)+"#2"+a$(i%)+"@3":GOTO 510 ELSE RETURN 1900 t%(1)=n%(i%,1):t%(2)=n%(r%,1):t%(3)=n%(r%,2):lyst$(1)="#1"+a$(i%)+"#2"+y$+"@1"+a$(i%)+"#3":GOTO 510 1930 beg%=h%:'Subbaum auswischen 1940 IF FNop(a$(h%))<2 THEN a$(h%)="":IF h%=beg% THEN RETURN ELSE 1950 ELSE IF n%(h%,2)>0 THEN h%=n%(h%,2):GOTO 1940 ELSE 1960 1950 h%=n%(h%,3) 1960 IF a$(h%)="" THEN IF h%=beg% THEN RETURN ELSE 1950 ELSE a$(h%)="":IF n%(h%,1)>0 THEN h%=n%(h%,1):GOTO 1940 ELSE 1960 1970 GOSUB 730:k%=j%:beg%=h%:'Subbaum kopieren 1980 IF FNop(a$(h%))<2 THEN a$(k%)=a$(h%):IF h%=beg% THEN RETURN ELSE 1990 ELSE a$(k%)="!":GOSUB 730:n%(k%,1)=j%:n%(j%,3)=k%:k%=j%:h%=n%(h%,1):GOTO 1980 1990 h%=n%(h%,3):k%=n%(k%,3):IF a$(k%)="!" THEN a$(k%)=a$(h%):GOSUB 730:n%(k%,2)=j%:n%(j%,3)=k%:k%=j%:h%=n%(h%,2):GOTO 1980 ELSE IF h%=beg% THEN RETURN ELSE 1990 2000 WHILE FNa$(n%(i%,2))=FNa$(i%):t%(1)=n%(i%,1):r%=n%(i%,2):t%(2)=n%(r%,1):t%(3)=n%(r%,2):lyst$(1)="#1"+a$(i%)+"#2"+a$(i%)+"#3":GOSUB 510:WEND:RETURN 2010 WHILE FNa$(n%(i%,1))="^" AND (a$(n%(i%,2))<>"-1" OR FNa$(n%(n%(i%,1),1))<>";"):a$(n%(i%,1))="*":l%=n%(i%,1):t%(1)=n%(l%,1):t%(2)=n%(l%,2):t%(3)=n%(i%,2):lyst$(1)="#1^(#2*#3)":GOSUB 510:WEND:RETURN 2020 'die wichtigsten Variablen 2030 'a$(n)=Knoten.Blatt oder operator (;,*,^,L,D).Als operator ohne oder mit eingeschaltetem 7. Bit.Dieses Bit dient zur Programsteuerung.Es ermoeglicht sehr tiefe Rekursion ohne belaestigung einer Stack mit RETURN-Adresse. 2040 'gesetztes 7.Bit erscheint auf dem Bildschirm als Unterstreichung des operators.Im Resultat sind alle 7.Bits gesetzt.Nach wiedereingabe eines Resultats erkennt das Programm die gesetzte 7.Bits und wird das Resultat fast sofort zurueckgegeben. 2050 'n%(n,p)=pointer nach links(p=1),nach rechts(p=2),zurueck(p=3).Es gilt immer k=n%(n%(k,1),3) und k=n%(n%(k,2),3) 2060 'i%=Hauptknotenanzeiger 2070 'lyst$(nr%)=input und output Puffer,nr%=Anzahl der eingefuerten Listen 2080 'bg%=Anfang Baum 2090 't%(10)=Tabelle fuer Pointeruebergabe:Wenn lyst$(1) "#3" enthaelt wird die Subbaum unter t%(3) in die neuen Baum integriert statt die Symbole "#3" selbst.Wenn lyst$(1) "@1" enthaelt wird eine Kopie der Subbaum unter t%(1) benutzt.