0 GOTO 7000' TCOMP.121 by Mike Weiblen (CIS: 72506,2072; Delphi: EKIM) 7/21/85; TCOMP.DVI (Disk mods) by Robert Toft [74716,476] 1 GOTO 8000 2 POKEM,R:M=M+1:IFM64ANDP<91)OR(P>47ANDP<58)THENC=C+CHR$(P):GOSUB4:GOTO31 32 IFC=""THENER=2:GOTO7900ELSEC=LEFT$(C,2):IFP=40THENC=C+"(" 33 V=0:FORJ=1TONV:IFC=V$(J)THENV=V(J):J=NV 34 NEXT:IFV=0ANDP<>40THENVT=VT-2:V=VT:NV=NV+1:V(NV)=V:V$(NV)=C 35 RETURN 37 GOSUB4:GOSUB30:V1=V:IFP<>40THENRETURN 38 IFVTHENV1=-V:GOSUB50:R=229:GOSUB2:IFP=41THEN4ELSE7900ELSEER=3:GOTO7900 40 C=""'Num 41 IFP>47ANDP<58ORP=45THENC=C+CHR$(P):GOSUB4:GOTO41 42 V=VAL(C):IFV<0THENV=V+65536 43 IFV>=0ORV<65536THENRETURNELSEER=4:GOTO7900 49 GOSUB4:GOSUB40:IFC<>""THENRETURNELSEER=2:GOTO7900 50 GF=-1'Expr 51 NU=NU+1:G=0:G!=0:GL=-1 52 U%(NU)=G:U(NU)=G! 53 GOSUB4 54 G!=INSTR(CM,CHR$(P)):IFG!=0AND(P<128ORP=227)THEN60ELSEG=ASC(MID$(CP,G!+1)):IFG=0THENGOSUB70:NU=NU-1:RETURN 55 IFP=40THENGOSUB51:GL=0:GOTO53 56 IFP=209ANDGLTHENG=20:G!=18 57 IFGL>219ANDGL<223THENIFP>219ANDP<223THENU(NU)=VAL(MID$("032301210",(GL-220)*3+P-219,1))+18:GOTO53 58 IFU%(NU)GTHENGOSUB70:NU=NU+1ELSEGOSUB75 59 GL=P:GOTO52 60 IFP=227THENGOSUB4:GOSUB49:CR=CHR$(219)+CHR$(V)+"o&"+CHR$(0):GOTO66 61 GOSUB40:IFC<>""THENCR="!":GOTO65 62 GOSUB30:IFP<>40THENCR="*":GOTO65 63 NU=NU+1:U(NU)=V:GOSUB51:R2=INT(U(NU)/256):CR=CHR$(6)+CHR$(R2)+CHR$(14)+CHR$(U(NU)-R2*256):GOSUB3 64 NU=NU-1:V=11:GOSUB6:GL=0:GOTO53 65 R2=INT(V/256):CR=CR+CHR$(V-R2*256)+CHR$(R2) 66 IFGF>0THENR=213:GOSUB2 67 IFGF=>0THENR=235:GOSUB2 68 GF=GF+1:GL=0:GOSUB3:GOTO54 70 IFU%(NU)THENGOSUB75:NU=NU-1:GOTO70ELSE:RETURN 75 IFU%(NU)<20ANDU%(NU)<>6THENIFGFTHENGF=0ELSER=209:GOSUB2 76 ONU(NU)GOTO80,81,82,83,84,85,86,87,88,89,84,90,91,92,93,94,95,96,97,98,99 80 V=4:GOTO6 81 R=25:GOTO2 82 CR=CHR$(235)+"BK"+CHR$(8):GOTO3 83 V=1:GOTO6 84 V=2:GOTO6 85 V=7:GOTO6 86 V=9:GOTO6 87 V=8:GOTO6 88 V=10:GOTO6 89 V=2:GOSUB6:R=235:GOTO2 90 R=235:GOSUB2:V=14:GOTO6 91 V=15:GOTO6 92 V=14:GOTO6 93 V=17:GOTO6 94 V=16:GOTO6 95 CR="~o&"+CHR$(0):GOTO3 96 R=43:GOSUB2:GOTO80 97 R=235:GOSUB2:V=14:GOSUB6:GOTO80 98 V=15:GOSUB6:GOTO80 99 V=14:GOSUB6:GOTO80 100 GOSUB 1: Q=Q+1: Z0=ZZ: GOSUB 1: Q=Q+1: IF Z0+ZZ THEN NL=NL+1: GOSUB 1: Q=Q+1: Z0=ZZ: GOSUB 1: Q=Q+1: L(NL)=Z0+ZZ*256: M(NL)=M: PRINT@16,L(NL)"="M ELSE 200 120 GOSUB4:IFP<>131ANDX(0)>0THENER=5:GOTO7900 140 IF P>64 AND P<91 THEN Q=Q-1: N=1 ELSE N=INSTR(CX,CHR$(P)) 150 ONNGOSUB500,520,530,540,550,690,570,580,680,590,600,610,620,630,640,650,660,670,560,900,900,900,7900 160 IFP=177THENV=16937:GOSUB7ELSEIFP=186THENV=22423:GOSUB7ELSEIFP=176THENV=16945:GOSUB7 170 IFP=128ORP=141ORP=143THENR=201:GOSUB2 190 IFPTHEN120ELSE100 200 PRINT"Support Routines":RESTORE 210 IFS%(5)ORS%(16)THENS%(4)=1 211 IFS%(6)ORS%(20)THENS%(2)=1 212 IFS%(7)ORS%(20)THENS%(1)=1 213 IFS%(19)THENS%(14)=1 250 FOR I=0 TO 21: S(I)=M: PRINT I;CHR$(13); 260 READR:IFR=999THEN290 270 IFS%(I)THENIFR>=0THENGOSUB2ELSEREADV:IFR=-9THENV=V+M:GOSUB9ELSENA=NA+1:A%(NA)=-R:A(NA)=M:GOSUB9 280 GOTO260 290 NEXT 300 PRINT: PRINT "Adjusting Jumps": X(1)=VT: X(2)=Z-VT-1: X(3)=VT-M-1: V(3)=V(3)-1 301 FOR I=1 TO NA: Q=A(I): M=PEEK(Q)+PEEK(Q+1)*256: ON A%(I) GOSUB 310,320,330,340,340 302 R2=INT(V/256): POKE Q,V-R2*256: POKE Q+1,R2: NEXT: GOTO 7500 310 V=S(M):RETURN 320 V=V(M):RETURN 330 V=X(M):RETURN 340 V=0:FORJ=1TONL:IFM=L(J)THENV=J:J=NL 341 NEXT:IFVTHENIFA%(I)=4THENV=M(V+1)ELSEV=M(V)ELSEER=6:GOTO7900 342 RETURN 500 GOSUB37:IFP=36THEN510'Let 501 GOSUB 4:IF P<>231 THEN Q=Q-1: GOSUB 50: GOTO 503 502 GOSUB4:GOSUB50:R=229:GOSUB2:GOSUB4:IFP=210THENGOSUB50:R=209:GOSUB2:V=20:GOSUB6ELSE7900'Rnd 503 V=ABS(V1):IFV1>0THENR=34:GOTO8 504 R2=INT(V/256):CR=CHR$(6)+CHR$(R2)+CHR$(14)+CHR$(V-R2*256)+CHR$(235)+CHR$(225):GOSUB3:V=12:GOTO6 510 GOSUB4:GOSUB4:IFP=201THENV=29250:GOSUB7:CR="o&"+CHR$(0):GOSUB3:GOSUB503:GOTO900ELSE7900'Inkey$ 520 GOSUB4:IFP=64THENGOSUB50:V=6:GOSUB6:GOSUB4ELSE527'Print 521 IFP=0ORP=58THENRETURN 522 IFP=250THENGOSUB50:CR="}"+CHR$(231):GOSUB3:GOTO527'Chr$ 523 IF P<>34 THEN Q=Q-1: GOSUB 50: V=5: GOSUB 6:GOTO 527 524 V=3:GOSUB6 525 GOSUB 1: Q=Q+1: R=ZZ: IF R<>34 AND R<>0 THEN GOSUB 2: GOTO 525 526 P=R:R=0:GOSUB2:IFPTHENGOSUB4 527 IFP=0ORP=58THENV=16930:GOTO7 528 IFP=59THENGOSUB4 529 GOTO521 530 GOSUB50:CR="|"+CHR$(181):GOSUB3'If 531 GOSUB 4: Q=Q-1: IF P<48 OR P>57 THEN NA=NA+1: A%(NA)=4: A(NA)=M+1: R=202: V=L(NL): GOTO 8 ELSE R=194: GOTO 551 540 R=205:GOTO551'Gosub 550 R=195'Goto 551 GOSUB49 552 NA=NA+1:A%(NA)=5:A(NA)=M+1:GOTO8 560 GOSUB50:R=125:GOSUB2:IFP=136THENV1=202ELSEV1=204'On Goto/Gosub 561 R=61:GOSUB2:GOSUB4:GOSUB40:IFC<>""THENR=V1:GOSUB552 562 IFP=44THEN561ELSERETURN 570 V1=29772:GOTO581'Pset 580 V1=29773'Preset 581 GOSUB4:GOSUB50:R=229:GOSUB2:GOSUB50:CR="]"+CHR$(225)+"U":GOSUB3:V=V1:GOTO7 590 GOSUB50:R=229:GOSUB2:GOSUB50:CR="}"+CHR$(225)+"w":GOTO3'Poke 600 GOSUB50:R=229:GOSUB2:GOSUB50:CR="E"+CHR$(209):GOSUB3:V=29381:GOTO7'Sound 610 GOSUB4:GOSUB30:IFVTHENER=7:GOTO7900'Dim 611 NV=NV+1:V$(NV)=C:GOSUB49:VT=VT-2*(V+1):V(NV)=VT:GOSUB4:IFP=44THEN610ELSERETURN 620 IFX(0)=0THENX(0)=M'Data 621 GOSUB49:GOSUB9:IFP=44THEN621ELSERETURN 630 NA=NA+1:A%(NA)=5:A(NA)=M+1:R=33:GOSUB49:GOSUB8:R=34:V=V(1):GOSUB33:GOTO8'Restore 640 GOSUB37:V=13:GOSUB6:GOSUB503:IFP=44THEN640ELSERETURN'Read 650 GOSUB4:GOSUB50:CR="e"+CHR$(229):GOSUB3:GOSUB50:CR=CHR$(209)+"]"+CHR$(213):GOSUB3'Line 651 GOSUB4:GOSUB4:GOSUB50:CR="e"+CHR$(229):GOSUB3:GOSUB50:CR=CHR$(209)+"]"+CHR$(213):GOSUB3 652 GOSUB 4: IF P=44 THEN GOSUB 50 ELSE Q=Q-1: R=33: V=1: GOSUB 8 653 V=21:GOTO6 660 GOSUB500:IFP<>193THEN7900'For 661 GOSUB50:V=18:GOSUB6 662 IFP=207THENGOSUB50ELSER=33:V=1:GOSUB8 663 V=18:GOSUB6:R=33:V=M+12:GOSUB8:V=18:GOSUB6:R=33:V=V1:GOSUB8:V=18:GOTO6 670 GOSUB4:GOSUB30:R=33:GOSUB8:V=19:GOSUB6:IFP=44THEN670ELSERETURN'Next 680 GOSUB49:V1=V:GOSUB50:CR="}"+CHR$(211)+CHR$(V1):GOTO3'Out 690 GOSUB49:V1=V:IFP<>44THEN692'Call 691 GOSUB50:IFP=44THENR=229:GOSUB2:GOSUB50:CR=CHR$(209)+"{":GOSUB3ELSER=125:GOSUB2 692 V=V1:GOTO7 900 GOSUB4:IFPTHEN900ELSERETURN'Skip 7000 SCREEN 1: WIDTH 80: CLS: PRINT TAB(20)"TCOMP.121.DSK - Tiny Basic Compiler": PRINT 7010 EX=0:INPUT"Starting Address";EX:IFEX=0THENMENU 7011 IFEX>MAXRAMTHENPRINT"That is above MAXRAM":BEEP:GOTO7010 7020 ON ERROR GOTO 7300 7021 CLEAR 800,EX: DEFSNG A-Z: DEFINT G,I,J,N,P,R: DEFSTR C 7022 ON ERROR GOTO 7300 7023 DIM P,C,R,Q,M,V,L(200),M(200),S%(21),S(21),U%(10),U(10),V$(50),V(50),A%(1000),A(1000),X(3) 7030 Z=MAXRAM:INPUT"Ending Address";Z:IFZ>MAXRAMORZ96ANDP<123THENMID$(CS,I,1)=CHR$(P-32) 7042 NEXT: IF INSTR(CS,"0:")=0 THEN CS="0:"+CS 7045 ON ERROR GOTO 7058 7050 OPEN CS FOR INPUT AS 1 7052 CLOSE 1 7054 ON ERROR GOTO 7400 7056 GOTO 7060 7058 CLS:LFILES:PRINT:PRINT"File not found":BEEP:RESUME 7040 7060 INPUT"Object .OBJ File";CO 7062 IF INSTR(CO,".") THEN PRINT "Extensions not allowed": BEEP: GOTO 7060 7070 Q=1: EX=HIMEM: M=EX: VT=Z 7071 C=".DP":GOSUB7210:C=".FP":GOSUB7210:C=".FS":VT=VT-38:GOSUB7210:C=".RN":GOSUB7210 7072 RESTORE9910:GOSUB7200:CX=C:GOSUB7200:CM=C:GOSUB7200:CP=C 7090 CLS: PRINT "Compiling BASIC:": V=0: GOSUB 6: OPEN CS FOR INPUT AS 1: ZZ$=INPUT$(200,1): GOTO 100 7200 C="" 7201 READN:IFN<999THENC=C+CHR$(N):GOTO7201ELSERETURN 7210 VT=VT-2:NV=NV+1:V(NV)=VT:V$(NV)=C:RETURN 7300 PRINT "SYSTEM OM ERROR: Try a higher START address": RESUME 7010 7400 PRINT "SYSTEM ERROR #";ERL;"OCCURED IN LINE #";ERL 7410 END 7500 CLS: PRINT "Compile Complete": PRINT: CLOSE 1: Z=Z-X(3)+10 7510 PRINT"Top"EX:PRINT"End"Z:PRINT"Exe"EX 7520 IF CO<>"" THEN SAVEM "0:"+CO+".OBJ",EX,Z,EX 7590 END 7900 PRINT:PRINT"Compiler Error: "MID$("SNOMTMNDOVDTULDD",ER*2+1,2):END 8000 REM read char 8002 IF Q<1 THEN PRINT"Compiler error: too many reverse reads": END 8010 IF Q<=LEN(ZZ$) THEN ZZ=ASC(MID$(ZZ$,Q,1)): GOTO 8099 8020 I9=1 8025 IF EOF(1) THEN PRINT "Unexpected END of SOURCE file.": END 8026 Z0$="" 8030 IF EOF(1) THEN 8060 8040 Z0$=Z0$+INPUT$(1,1) 8050 I9=I9+1: IF I9<=100 THEN 8030 8060 ZZ$=RIGHT$(ZZ$,100)+Z0$ 8070 Q=101 8080 GOTO 8010 8099 RETURN 8100 ' 8999 'Init 9000 DATA33,-3,1,17,-3,2,54,0,35,27,122,179,194,-9,-7,33,-2,3,34,-2,2,33,-3,0,34,-2,1,33,35,249,235,33,37,249,25,34,-2,4,201,999 9009 '* 9010 DATA68,77,33,0,0,62,16,41,235,41,235,210,-9,3,9,61,194,-9,-10,201,999 9019 '\ 9020 DATA124,181,200,235,66,75,17,0,0,19,8,210,-9,-3,27,9,235,201,999 9029 'PrStr 9030 DATA225,205,88,90,35,233,999 9039 'Not 9040 DATA124,47,103,125,47,111,201,999 9049 'PrNum 9050 DATA124,183,62,32,242,-9,8,205,-1,4,35,62,45,231,205,212,57,62,32,231,201,999 9059 '@ 9060 DATA235,33,40,0,205,-1,2,99,36,44,195,124,66,999 9069 '^ 9070 DATA68,77,33,1,0,120,177,200,197,213,205,-1,1,209,193,11,195,-9,-12,999 9079 'Or 9080 DATA124,178,103,125,179,111,201,999 9089 'And 9090 DATA124,162,103,125,163,111,201,999 9099 'Xor 9100 DATA124,170,103,125,171,111,201,999 9109 'Ld Array 9110 DATA41,9,126,35,102,111,201,999 9119 'St Array 9120 DATA41,9,115,35,114,201,999 9129 'Read 9130 DATA42,-2,1,78,35,70,35,34,-2,1,96,105,201,999 9139 '> 9140 DATA124,238,128,103,122,238,128,188,194,-9,4,123,189,218,-9,6,33,0,0,201,33,255,255,201,999 9149 '= 9150 DATA124,186,194,-9,11,125,187,194,-9,6,33,255,255,201,33,0,0,201,999 9159 'Abs 9160 DATA124,183,240,43,195,-0,4,999 9169 'Sgn 9170 DATA124,183,250,-9,9,125,183,200,33,1,0,201,33,255,255,201,999 9179 'For 9180 DATA235,42,-2,2,35,115,35,114,34,-2,2,201,999 9189 'Next 9190 DATA235,42,-2,2,126,43,186,194,-9,7,126,187,202,-9,9,1,7,0,8,195,-9,-16,43,43,229,43,70,43,78,43,229,237,9,235,115,35 9192 DATA114,225,126,43,110,103,120,183,250,-9,3,235,205,-1,14,218,-9,6,209,225,237,233,225,1,5,0,8,34,-2,2,201,999 9199 'Rnd 9200 DATA229,42,-2,4,122,179,202,-9,16,235,33,85,98,205,-1,1,17,25,54,25,34,-2,4,209,235,205,-1,2,235,201,999 9209 'Line 9210 DATA125,33,76,116,230,1,194,-9,4,46,77,34,97,246,193,225,209,197,195,217,28,999 9909 'Statement Tokens 9910 DATA135,163,138,140,136,185,180,181,150,162,178,133,131,139,134,146,129,130,151,142,161,255,145,999 9919 'Math Tokens 9920 DATA206,208,209,210,211,212,213,214,215,218,219,220,221,222,223,225,238,0,40,41,44,58,59,999 9929 'Math Priority 9930 DATA0,6,8,8,10,10,11,5,4,3,9,10,7,7,7,21,21,21,0,99,0,0,0,0,999