├── LISP.BA ├── ORIGLISP.BAS └── README.md /LISP.BA: -------------------------------------------------------------------------------- 1 | 1 REM 2 | ** COPYRIGHT 1982 80 MICRO MAGAZINE ** 3 | A DIVISION OF WAYNE GREEN INC. 4 | DOCUMENTATION CONTAINED SOLELY IN 80 MICRO 5 | CALL 800-258-5473 FOR BACK ISSUES 6 | 5 REM * BASIC LISP VER 1.1 * 7 | 10 REM * BY RANDY BEER; AUG., 1981 * MODIFIED BY NINO IVANOV FOR TANDY MODEL T, DECEMBER 2019 8 | 15 CLS:CLEAR325:DEFINTA-E,G-V,X-Z:DEFSTRO:DIMLM(1100),PL(1100),OB(90),PT(90),ST(350),FP(50),T1(15),X1(15):N=3000 9 | 22 PRINTTAB(23)"BASIC LISP VER 1.1":PRINT:PRINT"INITIALIZING . . . WAIT":PRINT 10 | 24 FORJ=0TO48:READOB(J),PT(J):NEXT:PE=48:FE=1:OB(46)=CHR$(13):FP(1)=MEM 11 | 26 FORJ=1TO1099:PL(J)=J+1:NEXT:PL(1100)=N:AS=1 12 | 28 T=3001:LP=3043:RP=3044:CC=33:N1=58:N2=44:LB=3031:QU=3030:NB=3032 13 | 30 A=0:QT=0:J=0:PRINT:PRINT"$ ";:ONERRORGOTO26000:GOSUB50:GOSUB265:GOSUB210:GOTO30 14 | 50 J1=0:PRINTCHR$(01);:GOSUB90 15 | 55 GOSUB100:IFX<>LPTHENRETURN 16 | 60 J1=J1+1:X1(J1)=AS:T1(J1)=AS:LM(T1(J1))=0:AS=PL(AS):IFQ<>0THENRETURN 17 | 65 GOSUB55:IFX=RPTHENGOTO80 18 | 70 IFLM(T1(J1))<>0THENPL(T1(J1))=AS:T1(J1)=AS:AS=PL(AS) 19 | 75 LM(T1(J1))=X:IFQ<>0THENRETURNELSE65 20 | 80 PL(T1(J1))=N:X=X1(J1):IFLM(X)=0ANDPL(X)=NTHENPL(X)=AS:AS=X:X=N 21 | 85 J1=J1-1:RETURN 22 | 90 A$=INKEY$:IFA$=""THEN90:ELSEPRINTA$;:KK=ASC(A$):RETURN 23 | 100 IFKK=40THENX=LP:GOTO200 24 | 105 IFKK=41THENX=RP:IFJ1=1ORJ1=2ANDQT<>0THENRETURNELSE200 25 | 110 IFKK=39THENQ=-1:QT=QT+1:GOSUB60:LM(T1(J1))=QU:Q=0:GOSUB90:GOSUB55:Q=-1:GOSUB70:Q=0:GOSUB80:QT=QT-1:RETURN 26 | 115 IFKKN2THEN150 30 | 135 FORJ=0TOPE:IFOB(J)=I$THENX=J+N:I$="":J=0:RETURN:ELSENEXT 31 | 145 J=0:PE=PE+1:OB(PE)=I$:X=PE+N:I$="":RETURN 32 | 150 WW=VAL(I$):GOSUB10000:I$="":RETURN 33 | 200 GOSUB90:RETURN 34 | 210 IFA$<>CHR$(13)THENPRINT 35 | 215 J1=1:X1(J1)=X:GOSUB225:PRINT:RETURN 36 | 225 IFX>5000THENPRINT"; UNPRINTABLE MACHINE CODE";:RETURNELSEIFX>4000THENPRINTFP(X-4000);CHR$(28);:RETURN 37 | 230 IFX>=NTHENPRINTOB(X-N);:RETURN 38 | 235 IFX=0THENRETURN 39 | 237 IFLM(X)=QUTHENPRINT"'";:X=LM(PL(X)):GOSUB225:RETURN 40 | 240 J1=J1+1:X1(J1)=X:PRINT"("; 41 | 245 X=X1(J1):X=LM(X):GOSUB225 42 | 250 X=X1(J1):J1=J1-1:X=PL(X):IFX=NTHENPRINT")";:RETURNELSEIFX>NTHENPRINT" . ";:GOSUB225:PRINT")";:RETURNELSEIFX=0THENX=1/0 43 | 255 J1=J1+1:X1(J1)=X:PRINT" ";:GOTO245 44 | 265 FP(1)=MEM:IFX>4000ANDX<5001ORX=NORX=TTHENRETURN 45 | 270 IFX>NTHENV=X:X=PT(X-N):IFX=0ANDA=0THENER=6:GOTO25000:ELSERETURN 46 | 275 ST(A+1)=TT:ST(A+2)=AL:ST(A+3)=C:ST(A+4)=E:A=A+4 47 | 280 AL=PL(X):E=X:X=LM(X):GOSUB265 48 | 285 IFX>=NANDX<4001THENER=1:GOTO25000 49 | 290 IFX>6000THEN320:ELSEIFX>5000THEN315:ELSEIFLM(X)=LBTHEN335:ELSEIFLM(X)=NBTHEN337:ELSEER=1:GOTO25000 50 | 315 TT=X:GOSUB500:ONTT-5000GOSUB4000,4010,4025,4035,4060,4070,4295,4290,4085,4095,4130,4170,4200,4220,4230,4245,4255,4300,4315,4310,4450:GOTO330 51 | 320 R=X:X=AL:ONR-6000GOSUB4050,50,4120,4150,4190,4285,4265,4275,4399,4500,4600,4650,4700,4750 52 | 330 E=ST(A):C=ST(A-1):AL=ST(A-2):TT=ST(A-3):A=A-4:RETURN 53 | 335 TT=AL:E=PL(X):AL=LM(E):GOSUB500:AL=TT:GOSUB500:C=LM(E):A=A-ST(A):GOTO340 54 | 337 TT=AL:E=PL(X):AL=LM(E):GOSUB500 55 | 338 ST(A+1)=TT:ST(A+2)=1:C=LM(E):A=A+1 56 | 340 IFC<>NTHENPT(LM(C)-N)=ST(A):A=A+1:C=PL(C):GOTO340 57 | 345 A=A-ST(A)-1:TT=PL(E) 58 | 350 IFTT<>NTHENX=LM(TT):GOSUB265:TT=PL(TT):GOTO350 59 | 355 C=LM(E):A=A-ST(A) 60 | 360 IFC<>NTHENPT(LM(C)-N)=ST(A):A=A+1:C=PL(C):GOTO360 61 | 365 A=A-ST(A)-1:GOTO330 62 | 500 C=0:IFAL=NTHENIFC=0THENA=A+1:ST(A)=0:GOTO510:ELSE510 63 | 505 X=LM(AL):GOSUB265:C=C+1:A=A+1:ST(A)=X:IFPL(AL)<>NTHENAL=PL(AL):GOTO505 64 | 510 A=A+1:ST(A)=C:RETURN 65 | 4000 IFST(A)<>1THENER=2:GOTO25000 66 | 4005 A=A-1:IFST(A)=NTHENX=N:A=A-1:RETURN 67 | 4006 IFST(A)<2001ANDST(A)>0THENX=LM(ST(A)):A=A-1:RETURN 68 | 4007 ER=4:GOTO25000 69 | 4010 IFST(A)<>1THENER=2:GOTO25000 70 | 4015 A=A-1:IFST(A)=NTHENX=N:A=A-1:RETURN 71 | 4017 IFST(A)<2001ANDST(A)>0THENX=PL(ST(A)):A=A-1:RETURN 72 | 4020 ER=4:GOTO25000 73 | 4025 IFST(A)<>2THENER=2:GOTO25000 74 | 4030 A=A-1:T2=AS:AS=PL(AS):LM(T2)=ST(A-1):PL(T2)=ST(A):A=A-2:X=T2:RETURN 75 | 4035 IFST(A)<>2THENER=2:GOTO25000 76 | 4040 A=A-1:IFST(A-1)4000THENER=3:GOTO25000 77 | 4045 PT(ST(A-1)-N)=ST(A):A=A-2:RETURN 78 | 4050 X=LM(AL):RETURN 79 | 4060 WW=0:FORJ=1TOST(A):A=A-1:IFST(A)>4000ANDST(A)<5001THENWW=WW+FP(ST(A)-4000):NEXT:ELSEER=5:GOTO25000 80 | 4065 A=A-1:GOSUB10000:RETURN 81 | 4070 IFST(A)<>2THENER=2:GOTO25000 82 | 4075 A=A-1:IFST(A)<4001ORST(A)>5000ORST(A-1)<4001ORST(A-1)>5000THENER=5:GOTO25000 83 | 4080 WW=FP(ST(A-1)-4000)-FP(ST(A)-4000):A=A-2:GOSUB10000:RETURN 84 | 4085 WW=1:FORJ=1TOST(A):A=A-1:IFST(A)>4000ANDST(A)<5001THENWW=WW*FP(ST(A)-4000):NEXT:ELSEER=5:GOTO25000 85 | 4090 A=A-1:GOSUB10000:RETURN 86 | 4095 IFST(A)<>2THENER=2:GOTO25000 87 | 4100 A=A-1:IFST(A)<4001ORST(A)>5000THENER=5:GOTO25000 88 | 4105 A=A-1:IFST(A)<4001ORST(A)>5000THENER=5:GOTO25000 89 | 4110 IFFP(ST(A+1)-4000)=0THENER=7:GOTO25000 90 | 4115 WW=FP(ST(A)-4000)/FP(ST(A+1)-4000):A=A-1:GOSUB10000:RETURN 91 | 4120 IFLM(AL)>=NANDLM(AL)<4000THENX=LM(PL(AL)):GOSUB265:PT(LM(AL)-N)=X:ELSEER=3:GOTO25000 92 | 4125 AL=PL(AL):IFAL=NTHENER=2:GOTO25000ELSEAL=PL(AL):IFAL=NTHENRETURNELSE4120 93 | 4130 IFST(A)<>1THENER=2:GOTO25000 94 | 4135 A=A-1:IFST(A)>=NANDST(A)<5000THENX=T:A=A-1:RETURN:ELSEX=N:A=A-1:RETURN 95 | 4150 C=LM(AL):X=LM(C):GOSUB265:IFX=NTHENAL=PL(AL):IFAL=NTHENRETURNELSE4150 96 | 4155 AL=PL(C) 97 | 4160 X=LM(AL):GOSUB265:IFPL(AL)=NTHENRETURNELSEAL=PL(AL):GOTO4160 98 | 4165 AL=PL(C) 99 | 4170 IFST(A)<>2THENER=2:GOTO25000 100 | 4175 A=A-1:IFST(A)=ST(A-1)THENX=T:ELSEX=N 101 | 4180 A=A-2:RETURN 102 | 4190 PL(E)=AS:AS=E:X=LM(AL):PT(X-N)=AL:IFLM(PL(AL))=NTHENLM(AL)=LB:RETURN:ELSEIFLM(LM(PL(AL)))=LBORLM(LM(PL(AL)))=NBTHENPT(X-N)=LM(PL(AL)):RETURN:ELSELM(AL)=LB:RETURN 103 | 4200 IFST(A)=0THENX=N:A=A-1:RETURN:ELSEX=AS:F=ST(A):A=A-F:FORJ=1TOF:IFST(A)=0THENER=4:GOTO25000:ELSEG=AS:AS=PL(AS):LM(G)=ST(A):A=A+1:NEXT:PL(G)=N:A=A-ST(A)-1:RETURN 104 | 4220 A=A-1:IFST(A)=NTHENX=T:ELSEX=N 105 | 4225 A=A-1:RETURN 106 | 4230 IFST(A)<>1THENER=2:GOTO25000:ELSEA=A-1 107 | 4235 IFST(A)>4000ANDST(A)<5000THENX=T:ELSEX=N 108 | 4240 A=A-1:RETURN 109 | 4245 IFST(A-1)>4000ANDST(A-1)<5000THENFORJ=1TOST(A)-1:A=A-1:IFST(A-1)>4000ANDST(A-1)<5000THENIFFP(ST(A)-4000)4000ANDST(A-1)<5000THENFORJ=1TOST(A)-1:A=A-1:IFST(A-1)>4000ANDST(A-1)<5000THENIFFP(ST(A)-4000)>FP(ST(A-1)-4000)THENX=T:NEXT:A=A-2:RETURN:ELSE4261:ELSE4260 113 | 4260 ER=5:GOTO25000 114 | 4261 X=N:A=A-2:RETURN 115 | 4265 IFAL<>NTHENX=LM(AL):GOSUB265:IFX<>NTHENAL=PL(AL):GOTO4265 116 | 4270 RETURN 117 | 4275 IFAL<>NTHENX=LM(AL):GOSUB265:IFX=NTHENAL=PL(AL):GOTO4275 118 | 4280 RETURN 119 | 4285 X=E:RETURN 120 | 4290 IFST(A)<>1THENER=2:GOTO25000:ELSEA=A-1:X=ST(A):GOSUB210:X=0:A=A-1:RETURN 121 | 4295 IFST(A)<>1THENER=2:GOTO25000:ELSEA=A-1:X=ST(A):GOSUB265:A=A-1:RETURN 122 | 4300 IFST(A)<>1THENER=2:GOTO25000 123 | 4305 A=A-1:X=ST(A):IFX>=NANDX<5000THENGOSUB225:X=0:A=A-1:RETURNELSEER=3:GOTO25000 124 | 4310 IFST(A)=0ORST(A-1)=NTHENX=N:A=A-ST(A)-1:RETURN:ELSEX=AS:FORJ=A-ST(A)TOA-1:Y=ST(J):IFY=0ORY>2000ANDY<>NTHENER=4:ST(A)=Y:GOTO25000 125 | 4312 IFY<>NTHENZ=AS:AS=PL(AS):LM(Z)=LM(Y):Y=PL(Y):GOTO4312 126 | 4313 NEXT 127 | 4314 A=A-ST(A)-1:PL(Z)=N:RETURN 128 | 4315 IFST(A)<>2THENER=2:GOTO25000 129 | 4320 A=A-1:IFST(A)<4001ORST(A)>5000THENER=5:GOTO25000 130 | 4325 A=A-1:IFST(A)<4001ORST(A)>5000THENER=5:GOTO25000 131 | 4330 WW=FP(ST(A)-4000)^FP(ST(A+1)-4000):GOSUB10000:A=A-1:RETURN 132 | 4399 IFLM(AL)<3000ORLM(AL)>4000THENER=1:GOTO4447:ELSET2=PT(LM(AL)-N):IFT2>2000ORT2=0THENER=1:GOTO4447:ELSEIFLM(T2)<>LBANDLM(T2)<>NBTHENER=1:GOTO4447 133 | 4400 PRINT:PRINT:PRINT"(DEFUN ";:X=LM(AL):A$=CHR$(13):GOSUB230:PRINT" (";:X=LM(T2):GOSUB230:PRINT" ";:T2=PL(T2):X=LM(T2):J1=1:X1(J1)=X:GOSUB225:J=0:J2=0 134 | 4405 T2=PL(T2):IFT2<>NTHENPRINT:PRINTTAB(3);:X1(J2)=-2:X=LM(T2):GOSUB4410:GOTO4405ELSEPRINT"))";:X=0:RETURN 135 | 4410 IFX>4000THENPRINTFP(X-4000);CHR$(28);:RETURN 136 | 4415 IFX>=NTHENPRINTOB(X-N);:RETURN 137 | 4420 IFLM(X)=QUTHENPRINT"'";:X=LM(PL(X)):GOSUB225:RETURN 138 | 4425 J=J+1:T1(J)=X:D=LM(X):B=D-N:IFB=40ORB=41ORB=31THEN4445:ELSEIFB<>6ANDB<>9ANDB<>10ANDB<>14ANDB<>20ANDB<>21PRINT"(";:ELSE4435 139 | 4430 X=T1(J):X=LM(X):GOSUB4410:X=T1(J):J=J-1:X=PL(X):IFX=NPRINT")";:RETURN:ELSEJ=J+1:T1(J)=X:PRINT" ";:GOTO4430 140 | 4435 T1(J)=PL(T1(J)):PRINTTAB(X1(J2)+2)"(";:J2=J2+1:X1(J2)=POS(0):X=D:GOSUB4415:PRINT 141 | 4440 X=LM(T1(J)):PRINTTAB(X1(J2)+2);:GOSUB4410:X=T1(J):J=J-1:X=PL(X):IFX=NTHENJ2=J1-1:PRINT")";:RETURN:ELSEPRINT:J=J+1:T1(J)=X:GOTO4440 142 | 4445 T1(J)=PL(T1(J)):PRINTTAB(X1(J2)+2)"(";:J2=J2+1:X1(J2)=POS(0):X=D:GOSUB4415:PRINT" ";:X=LM(T1(J)):GOSUB4410:PRINT:T1(J)=PL(T1(J)):GOTO4440 143 | 4447 E=0:LM(E)=LM(AL):GOTO25000 144 | 4450 IFST(A)<>2THENER=2:GOTO25000:ELSEA=A-1:IFST(A)>2000THENER=4:GOTO25000:ELSEA=A-1:IFST(A)4000THENER=3:GOTO25000:ELSEJ=ST(A+1):D=ST(A):X=AS:Z=N 145 | 4455 IFJ<>NTHENIFLM(J)=DGOTO4460:ELSEZ=AS:AS=PL(AS):LM(Z)=LM(J):ELSEIFZ=NTHENX=N:RETURN:ELSEPL(Z)=N:RETURN 146 | 4460 J=PL(J):GOTO4455 147 | 4500 PRINT:PRINT"; HIT ENTER TO BEGIN";:GOSUB90:PRINT#-1,FE,PE,AS:FORJ=2TOFE:PRINT#-1,FP(J):NEXT:FORJ=49TOPE:PRINT#-1,OB(J),PT(J):NEXT:FORJ=1TOAS:PRINT#-1,LM(J),PL(J):NEXT:X=0:RETURN 148 | 4600 PRINT:PRINT"; HIT ENTER TO BEGIN";:GOSUB90:INPUT#-1,FE,PE,AS:FORJ=2TOFE:INPUT#-1,FP(J):NEXT:FORJ=49TOPE:INPUT#-1,OB(J),PT(J):NEXT:FORJ=1TOAS:INPUT#-1,LM(J),PL(J):NEXT:X=0:RETURN 149 | 4650 X=0:A=A-1:IFPE>48THENPRINT:PRINT"; ";OB(PE);" DELETED FROM OB LIST";:PT(PE)=0:OB(PE)="":PE=PE-1 150 | 4655 RETURN 151 | 4700 TT=LM(AL):E=PL(AL):AL=E 152 | 4705 X=TT:GOSUB265:IFX<>NTHENAL=E:GOSUB4800:GOTO4705:ELSERETURN 153 | 4750 TT=LM(AL):E=PL(AL):AL=E 154 | 4755 X=TT:GOSUB265:IFX=NTHENAL=E:GOSUB4800:GOTO4755:ELSERETURN 155 | 4800 IFAL<>NTHENX=LM(AL):GOSUB265:AL=PL(AL):GOTO4800 156 | 4805 RETURN 157 | 10000 FORJ=1TOFE:IFFP(J)=WWTHEN10010 158 | 10005 NEXT:FE=FE+1:FP(FE)=WW:X=FE+4000:RETURN 159 | 10010 X=J+4000:RETURN 160 | 25000 X=ST(A):J1=1:X1(J)=X:IFA$<>CHR$(13)THENPRINT 161 | 25001 A$=CHR$(13):ONERGOTO25002,25003,25004,25005,25006,25007,25008 162 | 25002 PRINT"; ";:X=LM(E):GOSUB230:PRINT" INVALID FUNCTION NAME";:GOTO25050 163 | 25003 PRINT"; IMPROPER NUMBER OF ARGUEMENTS TO SUBR OR NSUBR";:GOTO25050 164 | 25004 PRINT"; ";:GOSUB225:PRINT" INVALID ATOM";:GOTO25050 165 | 25005 PRINT"; ";:GOSUB225:PRINT" INVALID LIST";:GOTO25050 166 | 25006 PRINT"; ";:GOSUB230:PRINT" INVALID NUMBER";:GOTO25050 167 | 25007 PRINT"; ";:X=V:GOSUB230:PRINT" UNBOUND ATOM";:GOTO25050 168 | 25008 PRINT"; DIVISION BY ZERO";:GOTO25050 169 | 25050 X=0:ONERRORGOTO25051:P=1/0 170 | 25051 PRINT:RESUME30 171 | 26000 IFA$<>CHR$(13)THENPRINT 172 | 26001 IFPE>90THENPRINT"; OB LIST FULL":PE=90:I$="":GOTO27100 173 | 26005 IFFE>50THENPRINT"; FP FULL":FE=50:I$="":GOTO27100 174 | 26010 IFAS=NTHENPRINT"; LIST MEMORY FULL":GOTO27100 175 | 26013 IFERR/2+1=9THENIFA>350ORJ1>15ORJ2>15ORJ>15PRINT"; STACK OVERFLOW":GOTO27000 176 | 26015 PRINT"; ERROR" 177 | 27000 RESUME30 178 | 27100 PRINT"; HIT ENTER TO REINTIALIZE, ANY OTHER KEY TO CONTINUE ":GOSUB90:IFA$=CHR$(13)THENPRINTCHR$(02):RUNELSE27000 179 | 50000 DATANIL,3000,T,3001,SETQ,6003,EQ,5012,CAR,5001,CDR,5002,COND,6004,DEFUN,6005,ATOM,5011,LIST,5013,APPEND,5020,ADD,5005,SUB,5006,MUL,5009,CONS,5003,NUMBERP,5015,GREATERP,5016,LESSP,5017,EVAL,5007 180 | 50001 DATAPRINTF,6009,AND,6007,OR,6008,DELETE,5021,SET,5004,DIV,5010,NOT,5014,POWER,5019,PRINT,5008,PATOM,5018,READ,6002,QUOTE,6001,LAMBDA,6006,NLAMBDA,6006,SAVE,6010,LOAD,6011,RPAREN,3044,LPAREN,3043,QT,3045,CR,3046 181 | 50002 DATASP,3047,DOWHILE,6013,DOUNTIL,6014,%,6012,(,0,),0,',0,CR,0," ",0,FREE,4001 182 | 183 | -------------------------------------------------------------------------------- /ORIGLISP.BAS: -------------------------------------------------------------------------------- 1 | 1 REM 2 | ** COPYRIGHT 1982 80 MICRO MAGAZINE ** 3 | A DIVISION OF WAYNE GREEN INC. 4 | DOCUMENTATION CONTAINED SOLELY IN 80 MICRO 5 | CALL 800-258-5473 FOR BACK ISSUES 6 | 5 REM * BASIC LISP VER 1.1 * 7 | 10 REM * BY RANDY BEER; AUG., 1981 * 8 | 15 CLS:CLEAR325:DEFINTA-E,G-V,X-Z:DEFSTRO:DIMLM(1100),PL(1100),OB(90),PT(90),ST(350),FP(50),T1(15),X1(15):N=3000 9 | 22 PRINTTAB(23)"BASIC LISP VER 1.1":PRINT:PRINT"INITIALIZING . . . WAIT":PRINT 10 | 24 FORJ=0TO48:READOB(J),PT(J):NEXT:PE=48:FE=1:OB(46)=CHR$(13):FP(1)=MEM 11 | 26 FORJ=1TO1099:PL(J)=J+1:NEXT:PL(1100)=N:AS=1 12 | 28 T=3001:LP=3043:RP=3044:CC=33:N1=58:N2=44:LB=3031:QU=3030:NB=3032 13 | 30 A=0:QT=0:J=0:PRINT:PRINT"$ ";:ONERRORGOTO26000:GOSUB50:GOSUB265:GOSUB210:GOTO30 14 | 50 J1=0:PRINTCHR$(14);:GOSUB90 15 | 55 GOSUB100:IFX<>LPRETURN 16 | 60 J1=J1+1:X1(J1)=AS:T1(J1)=AS:LM(T1(J1))=0:AS=PL(AS):IFQRETURN 17 | 65 GOSUB55:IFX=RPGOTO80 18 | 70 IFLM(T1(J1))<>0THENPL(T1(J1))=AS:T1(J1)=AS:AS=PL(AS) 19 | 75 LM(T1(J1))=X:IFQRETURN:ELSE65 20 | 80 PL(T1(J1))=N:X=X1(J1):IFLM(X)=0ANDPL(X)=NTHENPL(X)=AS:AS=X:X=N 21 | 85 J1=J1-1:RETURN 22 | 90 A$=INKEY$:IFA$=""THEN90:ELSEPRINTA$;:KK=ASC(A$):RETURN 23 | 100 IFKK=40THENX=LP:GOTO200 24 | 105 IFKK=41THENX=RP:IFJ1=1ORJ1=2ANDQTRETURN:ELSE200 25 | 110 IFKK=39THENQ=-1:QT=QT+1:GOSUB60:LM(T1(J1))=QU:Q=0:GOSUB90:GOSUB55:Q=-1:GOSUB70:Q=0:GOSUB80:QT=QT-1:RETURN 26 | 115 IFKKN2THEN150 30 | 135 FORJ=0TOPE:IFOB(J)=I$THENX=J+N:I$="":J=0:RETURN:ELSENEXT 31 | 145 J=0:PE=PE+1:OB(PE)=I$:X=PE+N:I$="":RETURN 32 | 150 WW=VAL(I$):GOSUB10000:I$="":RETURN 33 | 200 GOSUB90:RETURN 34 | 210 IFA$<>CHR$(13)PRINT 35 | 215 J1=1:X1(J1)=X:GOSUB225:PRINT:RETURN 36 | 225 IFX>5000PRINT"; UNPRINTABLE MACHINE CODE";:RETURN:ELSEIFX>4000PRINTFP(X-4000);CHR$(24);:RETURN 37 | 230 IFX>=NPRINTOB(X-N);:RETURN 38 | 235 IFX=0RETURN 39 | 237 IFLM(X)=QUPRINT"'";:X=LM(PL(X)):GOSUB225:RETURN 40 | 240 J1=J1+1:X1(J1)=X:PRINT"("; 41 | 245 X=X1(J1):X=LM(X):GOSUB225 42 | 250 X=X1(J1):J1=J1-1:X=PL(X):IFX=NPRINT")";:RETURN:ELSEIFX>NPRINT" . ";:GOSUB225:PRINT")";:RETURN:ELSEIFX=0THENX=1/0 43 | 255 J1=J1+1:X1(J1)=X:PRINT" ";:GOTO245 44 | 265 FP(1)=MEM:IFX>4000ANDX<5001ORX=NORX=TRETURN 45 | 270 IFX>NTHENV=X:X=PT(X-N):IFX=0ANDA=0THENER=6:GOTO25000:ELSERETURN 46 | 275 ST(A+1)=TT:ST(A+2)=AL:ST(A+3)=C:ST(A+4)=E:A=A+4 47 | 280 AL=PL(X):E=X:X=LM(X):GOSUB265 48 | 285 IFX>=NANDX<4001THENER=1:GOTO25000 49 | 290 IFX>6000THEN320:ELSEIFX>5000THEN315:ELSEIFLM(X)=LBTHEN335:ELSEIFLM(X)=NBTHEN337:ELSEER=1:GOTO25000 50 | 315 TT=X:GOSUB500:ONTT-5000GOSUB4000,4010,4025,4035,4060,4070,4295,4290,4085,4095,4130,4170,4200,4220,4230,4245,4255,4300,4315,4310,4450:GOTO330 51 | 320 R=X:X=AL:ONR-6000GOSUB4050,50,4120,4150,4190,4285,4265,4275,4399,4500,4600,4650,4700,4750 52 | 330 E=ST(A):C=ST(A-1):AL=ST(A-2):TT=ST(A-3):A=A-4:RETURN 53 | 335 TT=AL:E=PL(X):AL=LM(E):GOSUB500:AL=TT:GOSUB500:C=LM(E):A=A-ST(A):GOTO340 54 | 337 TT=AL:E=PL(X):AL=LM(E):GOSUB500 55 | 338 ST(A+1)=TT:ST(A+2)=1:C=LM(E):A=A+1 56 | 340 IFC<>NTHENPT(LM(C)-N)=ST(A):A=A+1:C=PL(C):GOTO340 57 | 345 A=A-ST(A)-1:TT=PL(E) 58 | 350 IFTT<>NTHENX=LM(TT):GOSUB265:TT=PL(TT):GOTO350 59 | 355 C=LM(E):A=A-ST(A) 60 | 360 IFC<>NTHENPT(LM(C)-N)=ST(A):A=A+1:C=PL(C):GOTO360 61 | 365 A=A-ST(A)-1:GOTO330 62 | 500 C=0:IFAL=NTHENIFC=0THENA=A+1:ST(A)=0:GOTO510:ELSE510 63 | 505 X=LM(AL):GOSUB265:C=C+1:A=A+1:ST(A)=X:IFPL(AL)<>NTHENAL=PL(AL):GOTO505 64 | 510 A=A+1:ST(A)=C:RETURN 65 | 4000 IFST(A)<>1THENER=2:GOTO25000 66 | 4005 A=A-1:IFST(A)=NTHENX=N:A=A-1:RETURN 67 | 4006 IFST(A)<2001ANDST(A)>0THENX=LM(ST(A)):A=A-1:RETURN 68 | 4007 ER=4:GOTO25000 69 | 4010 IFST(A)<>1THENER=2:GOTO25000 70 | 4015 A=A-1:IFST(A)=NTHENX=N:A=A-1:RETURN 71 | 4017 IFST(A)<2001ANDST(A)>0THENX=PL(ST(A)):A=A-1:RETURN 72 | 4020 ER=4:GOTO25000 73 | 8121 IFST(A)<>2THRNER=2:GOTO25000 74 | 4030 A=A-1:T2=AS:AS=PL(AS):LM(T2)=ST(A-1):PL(T2)=ST(A):A=A-2:X=T2:RETURN 75 | 4035 IFST(A)<>2THENER=2:GOTO25000 76 | 4040 A=A-1:IFST(A-1)4000THENER=3:GOTO25000 77 | 4045 PT(ST(A-1)-N)=ST(A):A=A-2:RETURN 78 | 4050 X=LM(AL):RETURN 79 | 4060 WW=0:FORJ=1TOST(A):A=A-1:IFST(A)>4000ANDST(A)<5001THENWW=WW+FP(ST(A)-4000):NEXT:ELSEER=5:GOTO25000 80 | 4065 A=A-1:GOSUB10000:RETURN 81 | 4070 IFST(A)<>2THENER=2:GOTO25000 82 | 4075 A=A-1:IFST(A)<4001ORST(A)>5000ORST(A-1)<4001ORST(A-1)>5000THENER=5:GOTO25000 83 | 4080 WW=FP(ST(A-1)-4000)-FP(ST(A)-4000):A=A-2:GOSUB10000:RETURN 84 | 4085 WW=1:FORJ=1TOST(A):A=A-1:IFST(A)>4000ANDST(A)<5001THENWW=WW*FP(ST(A)-4000):NEXT:ELSEER=5:GOTO25000 85 | 4090 A=A-1:GOSUB10000:RETURN 86 | 4095 IFST(A)<>2THENER=2:GOTO25000 87 | 4100 A=A-1:IFST(A)<4001ORST(A)>5000THENER=5:GOTO25000 88 | 4105 A=A-1:IFST(A)<4001ORST(A)>5000THENER=5:GOTO25000 89 | 4110 IFFP(ST(A+1)-4000)=0THENER=7:GOTO25000 90 | 4115 WW=FP(ST(A)-4000)/FP(ST(A+1)-4000):A=A-1:GOSUB10000:RETURN 91 | 4120 IFLM(AL)>=NANDLM(AL)<4000THENX=LM(PL(AL)):GOSUB265:PT(LM(AL)-N)=X:ELSEER=3:GOTO25000 92 | 4125 AL=PL(AL):IFAL=NTHENER=2:GOTO25000:ELSEAL=PL(AL):IFAL=NRETURN:ELSE4120 93 | 4130 IFST(A)<>1THENER=2:GOTO25000 94 | 4135 A=A-1:IFST(A)>=NANDST(A)<5000THENX=T:A=A-1:RETURN:ELSEX=N:A=A-1:RETURN 95 | 4150 C=LM(AL):X=LM(C):GOSUB265:IFX=NTHENAL=PL(AL):IFAL=NRETURN:ELSE4150 96 | 4155 AL=PL(C) 97 | 4160 X=LM(AL):GOSUB265:IFPL(AL)=NRETURN:ELSEAL=PL(AL):GOTO4160 98 | 4165 AL=PL(C) 99 | 4170 IFST(A)<>2THENER=2:GOTO25000 100 | 4175 A=A-1:IFST(A)=ST(A-1)THENX=T:ELSEX=N 101 | 4180 A=A-2:RETURN 102 | 4190 PL(E)=AS:AS=E:X=LM(AL):PT(X-N)=AL:IFLM(PL(AL))=NTHENLM(AL)=LB:RETURN:ELSEIFLM(LM(PL(AL)))=LBORLM(LM(PL(AL)))=NBTHENPT(X-N)=LM(PL(AL)):RETURN:ELSELM(AL)=LB:RETURN 103 | 4200 IFST(A)=0THENX=N:A=A-1:RETURN:ELSEX=AS:F=ST(A):A=A-F:FORJ=1TOF:IFST(A)=0THENER=4:GOTO25000:ELSEG=AS:AS=PL(AS):LM(G)=ST(A):A=A+1:NEXT:PL(G)=N:A=A-ST(A)-1:RETURN 104 | 4220 A=A-1:IFST(A)=NTHENX=T:ELSEX=N 105 | 4225 A=A-1:RETURN 106 | 4230 IFST(A)<>1THENER=2:GOTO25000:ELSEA=A-1 107 | 4235 IFST(A)>4000ANDST(A)<5000THENX=T:ELSEX=N 108 | 4240 A=A-1:RETURN 109 | 4245 IFST(A-1)>4000ANDST(A-1)<5000THENFORJ=1TOST(A)-1:A=A-1:IFST(A-1)>4000ANDST(A-1)<5000THENIFFP(ST(A)-4000)4000ANDST(A-1)<5000THENFORJ=1TOST(A)-1:A=A-1:IFST(A-1)>4000ANDST(A-1)<5000THENIFFP(ST(A)-4000)>FP(ST(A-1)-4000)THENX=T:NEXT:A=A-2:RETURN:ELSE4261:ELSE4260 113 | 4260 ER=5:GOTO25000 114 | 4261 X=N:A=A-2:RETURN 115 | 4265 IFAL<>NTHENX=LM(AL):GOSUB265:IFX<>NTHENAL=PL(AL):GOTO4265 116 | 4270 RETURN 117 | 4275 IFAL<>NTHENX=LM(AL):GOSUB265:IFX=NTHENAL=PL(AL):GOTO4275 118 | 4280 RETURN 119 | 4285 X=E:RETURN 120 | 4290 IFST(A)<>1THENER=2:GOTO25000:ELSEA=A-1:X=ST(A):GOSUB210:X=0:A=A-1:RETURN 121 | 4295 IFST(A)<>1THENER=2:GOTO25000:ELSEA=A-1:X=ST(A):GOSUB265:A=A-1:RETURN 122 | 4300 IFST(A)<>1THENER=2:GOTO25000 123 | 4305 A=A-1:X=ST(A):IFX>=NANDX<5000GOSUB225:X=0:A=A-1:RETURN:ELSEER=3:GOTO25000 124 | 4310 IFST(A)=0ORST(A-1)=NTHENX=N:A=A-ST(A)-1:RETURN:ELSEX=AS:FORJ=A-ST(A)TOA-1:Y=ST(J):IFY=0ORY>2000ANDY<>NTHENER=4:ST(A)=Y:GOTO25000 125 | 4312 IFY<>NTHENZ=AS:AS=PL(AS):LM(Z)=LM(Y):Y=PL(Y):GOTO4312 126 | 4313 NEXT 127 | 4314 A=A-ST(A)-1:PL(Z)=N:RETURN 128 | 4315 IFST(A)<>2THENER=2:GOTO25000 129 | 4320 A=A-1:IFST(A)<4001ORST(A)>5000THENER=5:GOTO25000 130 | 4325 A=A-1:IFST(A)<4001ORST(A)>5000THENER=5:GOTO25000 131 | 4330 WW=FP(ST(A)-4000)[FP(ST(A+1)-4000):GOSUB10000:A=A-1:RETURN 132 | 4399 IFLM(AL)<3000ORLM(AL)>4000THENER=1:GOTO4447:ELSET2=PT(LM(AL)-N):IFT2>2000ORT2=0THENER=1:GOTO4447:ELSEIFLM(T2)<>LBANDLM(T2)<>NBTHENER=1:GOTO4447 133 | 4400 PRINT:PRINT:PRINT"(DEFUN ";:X=LM(AL):A$=CHR$(13):GOSUB230:PRINT" (";:X=LM(T2):GOSUB230:PRINT" ";:T2=PL(T2):X=LM(T2):J1=1:X1(J1)=X:GOSUB225:J=0:J2=0 134 | 4405 T2=PL(T2):IFT2<>NPRINT:PRINTTAB(3);:X1(J2)=-2:X=LM(T2):GOSUB4410:GOTO4405:ELSEPRINT"))";:X=0:RETURN 135 | 4410 IFX>4000PRINTFP(X-4000);CHR$(24);:RETURN 136 | 4415 IFX>=NPRINTOB(X-N);:RETURN 137 | 4420 IFLM(X)=QUPRINT"'";:X=LM(PL(X)):GOSUB225:RETURN 138 | 4425 J=J+1:T1(J)=X:D=LM(X):B=D-N:IFB=40ORB=41ORB=31THEN4445:ELSEIFB<>6ANDB<>9ANDB<>10ANDB<>14ANDB<>20ANDB<>21PRINT"(";:ELSE4435 139 | 4430 X=T1(J):X=LM(X):GOSUB4410:X=T1(J):J=J-1:X=PL(X):IFX=NPRINT")";:RETURN:ELSEJ=J+1:T1(J)=X:PRINT" ";:GOTO4430 140 | 4435 T1(J)=PL(T1(J)):PRINTTAB(X1(J2)+2)"(";:J2=J2+1:X1(J2)=POS(0):X=D:GOSUB4415:PRINT 141 | 4440 X=LM(T1(J)):PRINTTAB(X1(J2)+2);:GOSUB4410:X=T1(J):J=J-1:X=PL(X):IFX=NTHENJ2=J1-1:PRINT")";:RETURN:ELSEPRINT:J=J+1:T1(J)=X:GOTO4440 142 | 4445 T1(J)=PL(T1(J)):PRINTTAB(X1(J2)+2)"(";:J2=J2+1:X1(J2)=POS(0):X=D:GOSUB4415:PRINT" ";:X=LM(T1(J)):GOSUB4410:PRINT:T1(J)=PL(T1(J)):GOTO4440 143 | 4447 E=0:LM(E)=LM(AL):GOTO25000 144 | 4450 IFST(A)<>2THENER=2:GOTO25000:ELSEA=A-1:IFST(A)>2000THENER=4:GOTO25000:ELSEA=A-1:IFST(A)4000THENER=3:GOTO25000:ELSEJ=ST(A+1):D=ST(A):X=AS:Z=N 145 | 4455 IFJ<>NTHENIFLM(J)=DGOTO4460:ELSEZ=AS:AS=PL(AS):LM(Z)=LM(J):ELSEIFZ=NTHENX=N:RETURN:ELSEPL(Z)=N:RETURN 146 | 4460 J=PL(J):GOTO4455 147 | 4500 PRINT:PRINT"; HIT ENTER TO BEGIN";:GOSUB90:PRINT#-1,FE,PE,AS:FORJ=2TOFE:PRINT#-1,FP(J):NEXT:FORJ=49TOPE:PRINT#-1,OB(J),PT(J):NEXT:FORJ=1TOAS:PRINT#-1,LM(J),PL(J):NEXT:X=0:RETURN 148 | 4600 PRINT:PRINT"; HIT ENTER TO BEGIN";:GOSUB90:INPUT#-1,FE,PE,AS:FORJ=2TOFE:INPUT#-1,FP(J):NEXT:FORJ=49TOPE:INPUT#-1,OB(J),PT(J):NEXT:FORJ=1TOAS:INPUT#-1,LM(J),PL(J):NEXT:X=0:RETURN 149 | 4650 X=0:A=A-1:IFPE>48THENPRINT:PRINT"; ";OB(PE);" DELETED FROM OB LIST";:PT(PE)=0:OB(PE)="":PE=PE-1 150 | 4655 RETURN 151 | 4700 TT=LM(AL):E=PL(AL):AL=E 152 | 4705 X=TT:GOSUB265:IFX<>NTHENAL=E:GOSUB4800:GOTO4705:ELSERETURN 153 | 4750 TT=LM(AL):E=PL(AL):AL=E 154 | 4755 X=TT:GOSUB265:IFX=NTHENAL=E:GOSUB4800:GOTO4755:ELSERETURN 155 | 4800 IFAL<>NTHENX=LM(AL):GOSUB265:AL=PL(AL):GOTO4800 156 | 4805 RETURN 157 | 10000 FORJ=1TOFE:IFFP(J)=WWTHEN10010 158 | 10005 NEXT:FE=FE+1:FP(FE)=WW:X=FE+4000:RETURN 159 | 10010 X=J+4000:RETURN 160 | 25000 X=ST(A):J1=1:X1(J)=X:IFA$<>CHR$(13)THENPRINT 161 | 25001 A$=CHR$(13):ONERGOTO25002,25003,25004,25005,25006,25007,25008 162 | 25002 PRINT"; ";:X=LM(E):GOSUB230:PRINT" INVALID FUNCTION NAME";:GOTO25050 163 | 25003 PRINT"; IMPROPER NUMBER OF ARGUEMENTS TO SUBR OR NSUBR";:GOTO25050 164 | 25004 PRINT"; ";:GOSUB225:PRINT" INVALID ATOM";:GOTO25050 165 | 25005 PRINT"; ";:GOSUB225:PRINT" INVALID LIST";:GOTO25050 166 | 25006 PRINT"; ";:GOSUB230:PRINT" INVALID NUMBER";:GOTO25050 167 | 25007 PRINT"; ";:X=V:GOSUB230:PRINT" UNBOUND ATOM";:GOTO25050 168 | 25008 PRINT"; DIVISION BY ZERO";:GOTO25050 169 | 25050 X=0:ONERRORGOTO25051:P=1/0 170 | 25051 PRINT:RESUME30 171 | 26000 IFA$<>CHR$(13)PRINT 172 | 26001 IFPE>90PRINT"; OB LIST FULL":PE=90:I$="":GOTO27100 173 | 26005 IFFE>50PRINT"; FP FULL":FE=50:I$="":GOTO27100 174 | 26010 IFAS=NPRINT"; LIST MEMORY FULL":GOTO27100 175 | 26013 IFERR/2+1=9THENIFA>350ORJ1>15ORJ2>15ORJ>15PRINT"; STACK OVERFLOW":GOTO27000 176 | 26015 PRINT"; ERROR" 177 | 27000 RESUME30 178 | 27100 PRINT"; HIT ENTER TO REINTIALIZE, ANY OTHER KEY TO CONTINUE ":GOSUB90:IFA$=CHR$(13)PRINTCHR$(15):RUN:ELSE27000 179 | 50000 DATANIL,3000,T,3001,SETQ,6003,EQ,5012,CAR,5001,CDR,5002,COND,6004,DEFUN,6005,ATOM,5011,LIST,5013,APPEND,5020,ADD,5005,SUB,5006,MUL,5009,CONS,5003,NUMBERP,5015,GREATERP,5016,LESSP,5017,EVAL,5007 180 | 50001 DATAPRINTF,6009,AND,6007,OR,6008,DELETE,5021,SET,5004,DIV,5010,NOT,5014,POWER,5019,PRINT,5008,PATOM,5018,READ,6002,QUOTE,6001,LAMBDA,6006,NLAMBDA,6006,SAVE,6010,LOAD,6011,RPAREN,3044,LPAREN,3043,QT,3045,CR,3046 181 | 50002 DATASP,3047,DOWHILE,6013,DOUNTIL,6014,%,6012,(,0,),0,',0,CR,0," ",0,FREE,4001 182 | 183 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # LispForTandy 2 | Ported Lisp in BASIC to Tandy TRS-80 Model 100 (Kyocera KC-85 family), originally written by Randy Beer 1981. 3 | 4 | As discussed here: 5 | 6 | https://news.ycombinator.com/item?id=21921044 7 | 8 | This is a port of a Lisp system written in BASIC by Randy Beer 1981. 9 | 10 | The source I used was this: 11 | 12 | https://willus.com/trs80/?-a+1+-p+124763+-f+1 13 | 14 | The issues of March and April of this magazine (particularly March) were the original publishing place of his code: 15 | 16 | http://www.colorcomputerarchive.com/coco/Documents/Magazines/80%20Micro/1983/ 17 | 18 | I made minor adjustments to the code and slight error corrections to facilitate its operation on the Tandy TRS-80 Model 100. So far, I have run in under emulation in Virtual T: 19 | 20 | https://sourceforge.net/projects/virtualt/ 21 | 22 | Have fun! :) 23 | 24 | Nino Ivanov 25 | --------------------------------------------------------------------------------