-
Notifications
You must be signed in to change notification settings - Fork 2
/
Copy pathORIGLISP.BAS
182 lines (181 loc) · 10.4 KB
/
ORIGLISP.BAS
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
1 REM
** COPYRIGHT 1982 80 MICRO MAGAZINE **
A DIVISION OF WAYNE GREEN INC.
DOCUMENTATION CONTAINED SOLELY IN 80 MICRO
CALL 800-258-5473 FOR BACK ISSUES
5 REM * BASIC LISP VER 1.1 *
10 REM * BY RANDY BEER; AUG., 1981 *
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
22 PRINTTAB(23)"BASIC LISP VER 1.1":PRINT:PRINT"INITIALIZING . . . WAIT":PRINT
24 FORJ=0TO48:READOB(J),PT(J):NEXT:PE=48:FE=1:OB(46)=CHR$(13):FP(1)=MEM
26 FORJ=1TO1099:PL(J)=J+1:NEXT:PL(1100)=N:AS=1
28 T=3001:LP=3043:RP=3044:CC=33:N1=58:N2=44:LB=3031:QU=3030:NB=3032
30 A=0:QT=0:J=0:PRINT:PRINT"$ ";:ONERRORGOTO26000:GOSUB50:GOSUB265:GOSUB210:GOTO30
50 J1=0:PRINTCHR$(14);:GOSUB90
55 GOSUB100:IFX<>LPRETURN
60 J1=J1+1:X1(J1)=AS:T1(J1)=AS:LM(T1(J1))=0:AS=PL(AS):IFQRETURN
65 GOSUB55:IFX=RPGOTO80
70 IFLM(T1(J1))<>0THENPL(T1(J1))=AS:T1(J1)=AS:AS=PL(AS)
75 LM(T1(J1))=X:IFQRETURN:ELSE65
80 PL(T1(J1))=N:X=X1(J1):IFLM(X)=0ANDPL(X)=NTHENPL(X)=AS:AS=X:X=N
85 J1=J1-1:RETURN
90 A$=INKEY$:IFA$=""THEN90:ELSEPRINTA$;:KK=ASC(A$):RETURN
100 IFKK=40THENX=LP:GOTO200
105 IFKK=41THENX=RP:IFJ1=1ORJ1=2ANDQTRETURN:ELSE200
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
115 IFKK<CCGOSUB90:GOTO100:ELSE125
120 IFKK<CCORKK=40ORKK=41ORKK=39THEN130
125 I$=I$+A$:GOSUB90:GOTO120
130 IFASC(I$)<N1ANDASC(I$)>N2THEN150
135 FORJ=0TOPE:IFOB(J)=I$THENX=J+N:I$="":J=0:RETURN:ELSENEXT
145 J=0:PE=PE+1:OB(PE)=I$:X=PE+N:I$="":RETURN
150 WW=VAL(I$):GOSUB10000:I$="":RETURN
200 GOSUB90:RETURN
210 IFA$<>CHR$(13)PRINT
215 J1=1:X1(J1)=X:GOSUB225:PRINT:RETURN
225 IFX>5000PRINT"; UNPRINTABLE MACHINE CODE";:RETURN:ELSEIFX>4000PRINTFP(X-4000);CHR$(24);:RETURN
230 IFX>=NPRINTOB(X-N);:RETURN
235 IFX=0RETURN
237 IFLM(X)=QUPRINT"'";:X=LM(PL(X)):GOSUB225:RETURN
240 J1=J1+1:X1(J1)=X:PRINT"(";
245 X=X1(J1):X=LM(X):GOSUB225
250 X=X1(J1):J1=J1-1:X=PL(X):IFX=NPRINT")";:RETURN:ELSEIFX>NPRINT" . ";:GOSUB225:PRINT")";:RETURN:ELSEIFX=0THENX=1/0
255 J1=J1+1:X1(J1)=X:PRINT" ";:GOTO245
265 FP(1)=MEM:IFX>4000ANDX<5001ORX=NORX=TRETURN
270 IFX>NTHENV=X:X=PT(X-N):IFX=0ANDA=0THENER=6:GOTO25000:ELSERETURN
275 ST(A+1)=TT:ST(A+2)=AL:ST(A+3)=C:ST(A+4)=E:A=A+4
280 AL=PL(X):E=X:X=LM(X):GOSUB265
285 IFX>=NANDX<4001THENER=1:GOTO25000
290 IFX>6000THEN320:ELSEIFX>5000THEN315:ELSEIFLM(X)=LBTHEN335:ELSEIFLM(X)=NBTHEN337:ELSEER=1:GOTO25000
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
320 R=X:X=AL:ONR-6000GOSUB4050,50,4120,4150,4190,4285,4265,4275,4399,4500,4600,4650,4700,4750
330 E=ST(A):C=ST(A-1):AL=ST(A-2):TT=ST(A-3):A=A-4:RETURN
335 TT=AL:E=PL(X):AL=LM(E):GOSUB500:AL=TT:GOSUB500:C=LM(E):A=A-ST(A):GOTO340
337 TT=AL:E=PL(X):AL=LM(E):GOSUB500
338 ST(A+1)=TT:ST(A+2)=1:C=LM(E):A=A+1
340 IFC<>NTHENPT(LM(C)-N)=ST(A):A=A+1:C=PL(C):GOTO340
345 A=A-ST(A)-1:TT=PL(E)
350 IFTT<>NTHENX=LM(TT):GOSUB265:TT=PL(TT):GOTO350
355 C=LM(E):A=A-ST(A)
360 IFC<>NTHENPT(LM(C)-N)=ST(A):A=A+1:C=PL(C):GOTO360
365 A=A-ST(A)-1:GOTO330
500 C=0:IFAL=NTHENIFC=0THENA=A+1:ST(A)=0:GOTO510:ELSE510
505 X=LM(AL):GOSUB265:C=C+1:A=A+1:ST(A)=X:IFPL(AL)<>NTHENAL=PL(AL):GOTO505
510 A=A+1:ST(A)=C:RETURN
4000 IFST(A)<>1THENER=2:GOTO25000
4005 A=A-1:IFST(A)=NTHENX=N:A=A-1:RETURN
4006 IFST(A)<2001ANDST(A)>0THENX=LM(ST(A)):A=A-1:RETURN
4007 ER=4:GOTO25000
4010 IFST(A)<>1THENER=2:GOTO25000
4015 A=A-1:IFST(A)=NTHENX=N:A=A-1:RETURN
4017 IFST(A)<2001ANDST(A)>0THENX=PL(ST(A)):A=A-1:RETURN
4020 ER=4:GOTO25000
8121 IFST(A)<>2THRNER=2:GOTO25000
4030 A=A-1:T2=AS:AS=PL(AS):LM(T2)=ST(A-1):PL(T2)=ST(A):A=A-2:X=T2:RETURN
4035 IFST(A)<>2THENER=2:GOTO25000
4040 A=A-1:IFST(A-1)<NORST(A-1)>4000THENER=3:GOTO25000
4045 PT(ST(A-1)-N)=ST(A):A=A-2:RETURN
4050 X=LM(AL):RETURN
4060 WW=0:FORJ=1TOST(A):A=A-1:IFST(A)>4000ANDST(A)<5001THENWW=WW+FP(ST(A)-4000):NEXT:ELSEER=5:GOTO25000
4065 A=A-1:GOSUB10000:RETURN
4070 IFST(A)<>2THENER=2:GOTO25000
4075 A=A-1:IFST(A)<4001ORST(A)>5000ORST(A-1)<4001ORST(A-1)>5000THENER=5:GOTO25000
4080 WW=FP(ST(A-1)-4000)-FP(ST(A)-4000):A=A-2:GOSUB10000:RETURN
4085 WW=1:FORJ=1TOST(A):A=A-1:IFST(A)>4000ANDST(A)<5001THENWW=WW*FP(ST(A)-4000):NEXT:ELSEER=5:GOTO25000
4090 A=A-1:GOSUB10000:RETURN
4095 IFST(A)<>2THENER=2:GOTO25000
4100 A=A-1:IFST(A)<4001ORST(A)>5000THENER=5:GOTO25000
4105 A=A-1:IFST(A)<4001ORST(A)>5000THENER=5:GOTO25000
4110 IFFP(ST(A+1)-4000)=0THENER=7:GOTO25000
4115 WW=FP(ST(A)-4000)/FP(ST(A+1)-4000):A=A-1:GOSUB10000:RETURN
4120 IFLM(AL)>=NANDLM(AL)<4000THENX=LM(PL(AL)):GOSUB265:PT(LM(AL)-N)=X:ELSEER=3:GOTO25000
4125 AL=PL(AL):IFAL=NTHENER=2:GOTO25000:ELSEAL=PL(AL):IFAL=NRETURN:ELSE4120
4130 IFST(A)<>1THENER=2:GOTO25000
4135 A=A-1:IFST(A)>=NANDST(A)<5000THENX=T:A=A-1:RETURN:ELSEX=N:A=A-1:RETURN
4150 C=LM(AL):X=LM(C):GOSUB265:IFX=NTHENAL=PL(AL):IFAL=NRETURN:ELSE4150
4155 AL=PL(C)
4160 X=LM(AL):GOSUB265:IFPL(AL)=NRETURN:ELSEAL=PL(AL):GOTO4160
4165 AL=PL(C)
4170 IFST(A)<>2THENER=2:GOTO25000
4175 A=A-1:IFST(A)=ST(A-1)THENX=T:ELSEX=N
4180 A=A-2:RETURN
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
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
4220 A=A-1:IFST(A)=NTHENX=T:ELSEX=N
4225 A=A-1:RETURN
4230 IFST(A)<>1THENER=2:GOTO25000:ELSEA=A-1
4235 IFST(A)>4000ANDST(A)<5000THENX=T:ELSEX=N
4240 A=A-1:RETURN
4245 IFST(A-1)>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:ELSE4252:ELSE4250
4250 ER=5:GOTO25000
4252 X=N:A=A-2:RETURN
4255 IFST(A-1)>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
4260 ER=5:GOTO25000
4261 X=N:A=A-2:RETURN
4265 IFAL<>NTHENX=LM(AL):GOSUB265:IFX<>NTHENAL=PL(AL):GOTO4265
4270 RETURN
4275 IFAL<>NTHENX=LM(AL):GOSUB265:IFX=NTHENAL=PL(AL):GOTO4275
4280 RETURN
4285 X=E:RETURN
4290 IFST(A)<>1THENER=2:GOTO25000:ELSEA=A-1:X=ST(A):GOSUB210:X=0:A=A-1:RETURN
4295 IFST(A)<>1THENER=2:GOTO25000:ELSEA=A-1:X=ST(A):GOSUB265:A=A-1:RETURN
4300 IFST(A)<>1THENER=2:GOTO25000
4305 A=A-1:X=ST(A):IFX>=NANDX<5000GOSUB225:X=0:A=A-1:RETURN:ELSEER=3:GOTO25000
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
4312 IFY<>NTHENZ=AS:AS=PL(AS):LM(Z)=LM(Y):Y=PL(Y):GOTO4312
4313 NEXT
4314 A=A-ST(A)-1:PL(Z)=N:RETURN
4315 IFST(A)<>2THENER=2:GOTO25000
4320 A=A-1:IFST(A)<4001ORST(A)>5000THENER=5:GOTO25000
4325 A=A-1:IFST(A)<4001ORST(A)>5000THENER=5:GOTO25000
4330 WW=FP(ST(A)-4000)[FP(ST(A+1)-4000):GOSUB10000:A=A-1:RETURN
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
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
4405 T2=PL(T2):IFT2<>NPRINT:PRINTTAB(3);:X1(J2)=-2:X=LM(T2):GOSUB4410:GOTO4405:ELSEPRINT"))";:X=0:RETURN
4410 IFX>4000PRINTFP(X-4000);CHR$(24);:RETURN
4415 IFX>=NPRINTOB(X-N);:RETURN
4420 IFLM(X)=QUPRINT"'";:X=LM(PL(X)):GOSUB225:RETURN
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
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
4435 T1(J)=PL(T1(J)):PRINTTAB(X1(J2)+2)"(";:J2=J2+1:X1(J2)=POS(0):X=D:GOSUB4415:PRINT
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
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
4447 E=0:LM(E)=LM(AL):GOTO25000
4450 IFST(A)<>2THENER=2:GOTO25000:ELSEA=A-1:IFST(A)>2000THENER=4:GOTO25000:ELSEA=A-1:IFST(A)<NORST(A)>4000THENER=3:GOTO25000:ELSEJ=ST(A+1):D=ST(A):X=AS:Z=N
4455 IFJ<>NTHENIFLM(J)=DGOTO4460:ELSEZ=AS:AS=PL(AS):LM(Z)=LM(J):ELSEIFZ=NTHENX=N:RETURN:ELSEPL(Z)=N:RETURN
4460 J=PL(J):GOTO4455
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
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
4650 X=0:A=A-1:IFPE>48THENPRINT:PRINT"; ";OB(PE);" DELETED FROM OB LIST";:PT(PE)=0:OB(PE)="":PE=PE-1
4655 RETURN
4700 TT=LM(AL):E=PL(AL):AL=E
4705 X=TT:GOSUB265:IFX<>NTHENAL=E:GOSUB4800:GOTO4705:ELSERETURN
4750 TT=LM(AL):E=PL(AL):AL=E
4755 X=TT:GOSUB265:IFX=NTHENAL=E:GOSUB4800:GOTO4755:ELSERETURN
4800 IFAL<>NTHENX=LM(AL):GOSUB265:AL=PL(AL):GOTO4800
4805 RETURN
10000 FORJ=1TOFE:IFFP(J)=WWTHEN10010
10005 NEXT:FE=FE+1:FP(FE)=WW:X=FE+4000:RETURN
10010 X=J+4000:RETURN
25000 X=ST(A):J1=1:X1(J)=X:IFA$<>CHR$(13)THENPRINT
25001 A$=CHR$(13):ONERGOTO25002,25003,25004,25005,25006,25007,25008
25002 PRINT"; ";:X=LM(E):GOSUB230:PRINT" INVALID FUNCTION NAME";:GOTO25050
25003 PRINT"; IMPROPER NUMBER OF ARGUEMENTS TO SUBR OR NSUBR";:GOTO25050
25004 PRINT"; ";:GOSUB225:PRINT" INVALID ATOM";:GOTO25050
25005 PRINT"; ";:GOSUB225:PRINT" INVALID LIST";:GOTO25050
25006 PRINT"; ";:GOSUB230:PRINT" INVALID NUMBER";:GOTO25050
25007 PRINT"; ";:X=V:GOSUB230:PRINT" UNBOUND ATOM";:GOTO25050
25008 PRINT"; DIVISION BY ZERO";:GOTO25050
25050 X=0:ONERRORGOTO25051:P=1/0
25051 PRINT:RESUME30
26000 IFA$<>CHR$(13)PRINT
26001 IFPE>90PRINT"; OB LIST FULL":PE=90:I$="":GOTO27100
26005 IFFE>50PRINT"; FP FULL":FE=50:I$="":GOTO27100
26010 IFAS=NPRINT"; LIST MEMORY FULL":GOTO27100
26013 IFERR/2+1=9THENIFA>350ORJ1>15ORJ2>15ORJ>15PRINT"; STACK OVERFLOW":GOTO27000
26015 PRINT"; ERROR"
27000 RESUME30
27100 PRINT"; HIT ENTER TO REINTIALIZE, ANY OTHER KEY TO CONTINUE ":GOSUB90:IFA$=CHR$(13)PRINTCHR$(15):RUN:ELSE27000
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
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
50002 DATASP,3047,DOWHILE,6013,DOUNTIL,6014,%,6012,(,0,),0,',0,CR,0," ",0,FREE,4001