1  COM F$[7],P$[7],L9,L8
2  COM A$[72],A6,A7,A8,A9
3  COM W,W$[64],W0,Y
4  COM M[500],M,M0,M9,Y[150]
5  REM COBOL, HP 36845B, 6/74
10  FILES *,*,*
12  ASSIGN "$COSC4",1,A5
14  READ #1,1;C$
20  ASSIGN F$,1,A5
21  IF  END #1 THEN 300
22  ASSIGN "COSCR",3,A5
28  MAT Y=ZER
30  LET L8=0
32  MAT M=ZER
34  LET M=M0=1
36  LET Y=1
37  MAT Y=ZER
38  LET M9=500
40  READ #1,1
42  LET N=0
50  DIM X$[72],S[100,5]
52  DIM F[10],N$[72],C$[72]
60  IF  END #1 THEN 300
70  PRINT 
100  READ S1
110  MAT  READ S[S1,5]
112  LET E8=N0=W0=0
114  LET W=0
120  GOSUB 9000
122  GOSUB 9100
130  LET S=1
140  GOTO 1000
200  IF E8=1 THEN 310
210  CHAIN "$CODDV"
300  PRINT "*UNEXPECTED END OF FILE REACHED AFTER LINE";N
310  CHAIN P$,L9
1000  REM MAIN TABLE DRIVEN ROUTINE
1010  GOSUB 5000
1020  IF S8=0 THEN 1100
1030  IF S[S,2]=0 THEN 1050
1040  GOSUB 7000
1050  GOSUB 9100
1060  LET S=S[S,3]
1070  IF S <> -100 THEN 1010
1080  GOTO 200
1100  IF S[S,5] <= 0 THEN 1130
1110  GOSUB 4000
1120  GOTO 1140
1130  GOTO -S[S,5]+1 OF 1060,1140,1140
1140  LET S=S[S,4]
1150  GOTO 1070
4000  REM ERROR MESSAGES
4002  LET F7=F8=F9=0
4010  LET S0=S[S,5]
4012  PRINT "*";
4020  IF S0>8 THEN 4040
4030  GOTO S0 OF 4050,4070,4090,4110,4130,4150,4170,4190
4040  GOTO S0-8 OF 4210,4230,4250,4270,4290,4310,4330,4350
4050  PRINT "PROGRAM MUST START WITH IDENTIFICATION DIVISION";
4052  LET F9=1
4060  GOTO 4400
4070  PRINT "'DIVISION' MISSING OR MISSPELLED";
4072  LET F8=1
4080  GOTO 4400
4090  PRINT "END OF PARAGRAPH EXPECTED";
4092  LET F7=1
4100  GOTO 4400
4110  PRINT "'PROGRAM-ID' CLAUSE MISSING";
4120  GOTO 4400
4130  PRINT "PERIOD MISSING";
4140  GOTO 4400
4150  PRINT "ILLEGAL PARAGRAPH IN IDENTIFICATION DIVISION";
4160  GOTO 4400
4170  PRINT "CONFIGURATION SECTION MISSING";
4180  GOTO 4400
4190  PRINT "WRONG SOURCE OR OBJECT COMPUTER";
4192  LET F8=1
4200  GOTO 4400
4210  PRINT "ILLEGAL OBJECT COMPUTER DESCRIPTION";
4212  LET F7=1
4220  GOTO 4400
4230  PRINT "ILLEGAL SPECIAL-NAMES CLAUSE";
4232  LET F7=1
4240  GOTO 4400
4250  PRINT "'SECTION' MISSING OR MISSPELLED";
4252  LET F8=1
4260  GOTO 4400
4270  PRINT "ILLEGAL FILE-CONTROL CLAUSE";
4272  LET F7=1
4280  GOTO 4400
4290  PRINT "ILLEGAL FILE NAME";
4292  LET F8=1
4300  GOTO 4400
4310  PRINT "ILLEGAL ACCESS OR PROCESSING MODE";
4312  LET F8=1
4320  GOTO 4400
4330  PRINT "'IS' MISSING OR MISSPELLED";
4340  GOTO 4400
4350  PRINT "ILLEGAL PARAGRAPH IN ENVIRONMENT DIVISION";
4352  LET F7=1
4360  GOTO 4400
4400  PRINT " AT LINE";N;"CHR";A1
4402  LET E8=1
4410  IF F9=0 THEN 4430
4420  CHAIN "$COMON",5
4430  IF F8=0 THEN 4450
4440  GOSUB 9100
4450  IF F7=0 THEN 4490
4460  IF X$='92 THEN 4490
4470  GOSUB 9100
4480  GOTO 4460
4490  RETURN 
5000  REM LOOK-FOR ROUTINES
5010  LET S9=S[S,1]
5012  LET S8=1
5020  GOTO INT((S9-1)/10)+1 OF 5030,5040,5050,5060,5070,5080
5030  GOTO S9 OF 5100,5110,5120,5130,5140,5150,5160,5170,5180,5190
5040  GOTO S9-10 OF 5200,5210,5220,5230,5240,5250,5260,5270,5280,5290
5050  GOTO S9-20 OF 5300,5310,5320,5330,5340,5350,5360,5370,5380,5390
5060  GOTO S9-30 OF 5400,5410,5420,5430,5440,5450,5460,5470,5480,5490
5070  GOTO S9-40 OF 5500,5510,5520,5530,5540,5550,5560,5570,5580,5590
5080  GOTO S9-50 OF 5600,5610,5620,5630
5100  IF X$="IDENTIFICATION" THEN 5910
5102  GOTO 5900
5110  IF X$="DIVISION" THEN 5910
5112  GOTO 5900
5120  IF X$='92 THEN 5910
5122  GOTO 5900
5130  IF X$="PROGRAM-ID" THEN 5910
5132  GOTO 5900
5140  IF X$="." THEN 5910
5142  GOTO 5900
5150  IF X$ <> '92 THEN 5910
5152  GOTO 5900
5160  IF X$="AUTHOR" THEN 5910
5162  GOTO 5900
5170  IF X$="INSTALLATION" THEN 5910
5172  GOTO 5900
5180  IF X$="DATE-WRITTEN" THEN 5910
5182  GOTO 5900
5190  IF X$="SECURITY" THEN 5910
5192  GOTO 5900
5200  IF X$="REMARKS" THEN 5910
5202  GOTO 5900
5210  IF X$="ENVIRONMENT" THEN 5910
5212  GOTO 5900
5220  IF X$="CONFIGURATION" THEN 5910
5222  GOTO 5900
5230  IF X$="SECTION" THEN 5910
5232  GOTO 5900
5240  IF X$="SOURCE-COMPUTER" THEN 5910
5242  GOTO 5900
5250  IF X$="HEWEY" THEN 5910
5252  IF X$="HP2000C" THEN 5910
5254  GOTO 5900
5260  IF X$="OBJECT-COMPUTER" THEN 5910
5262  GOTO 5900
5270  IF X$="MEMORY" THEN 5910
5272  GOTO 5900
5280  IF X$="SIZE" THEN 5910
5282  GOTO 5900
5290  IF X$[1]<":" THEN 5910
5292  GOTO 5900
5300  IF X$="WORDS" THEN 5910
5302  GOTO 5900
5310  IF X$="CHARACTERS" THEN 5910
5312  GOTO 5900
5320  IF X$="MODULES" THEN 5910
5322  GOTO 5900
5330  IF X$="SEGMENT-LIMIT" THEN 5910
5332  GOTO 5900
5340  IF X$="IS" THEN 5910
5342  IF X$="ARE" THEN 5910
5344  GOTO 5900
5350  IF X$="SPECIAL-NAMES" THEN 5910
5352  GOTO 5900
5360  IF X$="INPUT-OUTPUT" THEN 5910
5362  GOTO 5900
5370  IF X$="FILE-CONTROL" THEN 5910
5372  GOTO 5900
5380  IF X$="SELECT" THEN 5910
5382  GOTO 5900
5390  IF X$="OPTIONAL" THEN 5910
5392  GOTO 5900
5400  IF X$ >= "A" THEN 5910
5402  GOTO 5900
5410  IF X$="ASSIGN" THEN 5910
5412  GOTO 5900
5420  IF X$="TO" THEN 5910
5422  GOTO 5900
5430  IF X$[1,1]="'" THEN 5910
5432  GOTO 5900
5440  IF X$="FOR" THEN 5910
5442  GOTO 5900
5450  IF X$="MULTIPLE" THEN 5910
5452  GOTO 5900
5460  IF X$="REEL" THEN 5910
5462  GOTO 5900
5470  IF X$="UNIT" THEN 5910
5472  GOTO 5900
5480  IF X$="RESERVE" THEN 5910
5482  GOTO 5900
5490  IF X$="NO" THEN 5910
5492  GOTO 5900
5500  IF X$="ALTERNATE" THEN 5910
5502  GOTO 5900
5510  IF X$="AREA" THEN 5910
5512  IF X$="AREAS" THEN 5910
5514  GOTO 5900
5520  IF X$="FILE-LIMIT" THEN 5910
5522  IF X$="FILE-LIMITS" THEN 5910
5524  GOTO 5900
5530  IF X$="THRU" THEN 5910
5532  GOTO 5900
5540  IF X$="ACCESS" THEN 5910
5542  GOTO 5900
5550  IF X$="MODE" THEN 5910
5552  GOTO 5900
5560  IF X$="SEQUENTIAL" THEN 5910
5562  GOTO 5900
5570  IF X$="RANDOM" THEN 5910
5572  GOTO 5900
5580  IF X$="PROCESSING" THEN 5910
5582  GOTO 5900
5590  IF X$="ACTUAL" THEN 5910
5592  GOTO 5900
5600  IF X$="KEY" THEN 5910
5602  GOTO 5900
5610  IF X$="I-O-CONTROL" THEN 5910
5612  GOTO 5900
5620  IF X$="," THEN 5910
5622  IF X$=";" THEN 5910
5624  IF X$="AND" THEN 5910
5626  GOTO 5900
5630  IF X$="DATA" THEN 5910
5632  GOTO 5900
5900  LET S8=0
5910  RETURN 
5999  REM TABLE DATA
6000  DATA 90
6001  DATA 1,0,2,-1,1
6002  DATA 2,0,3,3,2
6003  DATA 3,0,4,4,3
6004  DATA 4,0,5,5,4
6005  DATA 5,0,6,6,5
6006  DATA 3,0,8,7,-1
6007  DATA 6,0,6,-1,0
6008  DATA 7,0,6,9,-1
6009  DATA 8,0,6,10,-1
6010  DATA 9,0,6,11,-1
6011  DATA 10,0,6,12,-1
6012  DATA 11,0,6,13,-1
6013  DATA 12,0,14,6,6
6014  DATA 2,0,15,15,2
6015  DATA 3,0,16,16,3
6016  DATA 13,0,44,42,-1
6017  DATA 15,0,18,21,-1
6018  DATA 5,0,19,19,5
6019  DATA 16,0,20,20,8
6020  DATA 3,0,21,21,3
6021  DATA 17,0,22,35,-1
6022  DATA 5,0,23,23,5
6023  DATA 16,0,24,24,8
6024  DATA 53,0,25,34,-1
6025  DATA 18,0,26,31,-1
6026  DATA 19,0,27,27,-2
6027  DATA 20,0,28,34,9
6028  DATA 21,0,24,29,-1
6029  DATA 22,0,24,30,-1
6030  DATA 23,0,24,34,9
6031  DATA 24,0,32,34,9
6032  DATA 25,0,33,34,9
6033  DATA 20,0,24,34,9
6034  DATA 3,0,35,35,3
6035  DATA 26,0,36,42,-1
6036  DATA 5,0,37,41,-1
6037  DATA 6,0,38,38,0
6038  DATA 25,0,39,39,10
6039  DATA 3,0,42,40,-1
6040  DATA 53,0,37,37,-2
6041  DATA 3,0,42,37,5
6042  DATA 27,0,43,88,-1
6043  DATA 14,0,46,46,11
6044  DATA 14,0,45,45,11
6045  DATA 3,0,17,17,3
6046  DATA 3,0,47,47,3
6047  DATA 28,0,48,86,-1
6048  DATA 3,0,86,49,-1
6049  DATA 5,0,50,50,5
6050  DATA 29,6,51,62,12
6051  DATA 30,1,52,52,-2
6052  DATA 31,2,53,62,12
6053  DATA 32,0,54,62,12
6054  DATA 33,0,55,55,-2
6055  DATA 34,3,56,56,13
6056  DATA 35,0,57,57,-2
6057  DATA 36,0,58,60,-1
6058  DATA 37,4,60,59,-1
6059  DATA 38,4,60,62,12
6060  DATA 53,0,63,61,-1
6061  DATA 5,7,50,62,-1
6062  DATA 3,7,86,63,-1
6063  DATA 39,0,64,68,-1
6064  DATA 40,0,66,65,-1
6065  DATA 20,0,66,62,12
6066  DATA 41,0,67,67,-2
6067  DATA 42,0,60,60,-2
6068  DATA 43,0,69,73,-1
6069  DATA 25,0,70,62,12
6070  DATA 20,0,71,62,12
6071  DATA 44,0,72,62,12
6072  DATA 20,0,60,62,12
6073  DATA 45,0,74,77,-1
6074  DATA 46,0,79,79,-2
6075  DATA 47,0,60,76,-1
6076  DATA 48,5,60,60,14
6077  DATA 49,0,78,82,-1
6078  DATA 46,0,80,80,-2
6079  DATA 25,0,75,75,15
6080  DATA 25,0,81,81,15
6081  DATA 47,0,60,60,14
6082  DATA 50,0,83,62,12
6083  DATA 51,0,84,84,-2
6084  DATA 25,0,85,85,15
6085  DATA 31,8,60,62,12
6086  DATA 52,0,87,88,-1
6087  DATA 3,0,88,88,3
6088  DATA 54,0,89,46,16
6089  DATA 2,0,90,90,2
6090  DATA 3,0,-100,-100,3
7000  REM GENERATORS
7010  LET S0=S[S,2]
7020  GOTO S0 OF 7070,7090,7110,7130,7150,7050,7170,7200
7050  MAT F=ZER[10]
7052  LET W0=W0+1
7054  LET W1=W0*16-15
7056  LET F[8]=-50
7060  RETURN 
7070  LET F[6]=1
7080  RETURN 
7090  LET N$=X$
7100  RETURN 
7110  LET W$[W1]="                "
7112  LET W$[W1,W1+5]=X$[2,7 MIN LEN(X$)-1]
7113  ASSIGN W$[W1,W1+5],2,A5
7114  IF A5<3 THEN 7120
7115  PRINT "*CAN'T OPEN FILE ";W$[W1,W1+5];" AT LINE";N;"  CHR";A1
7116  LET E8=1
7120  ASSIGN "",2,A5
7122  RETURN 
7130  PRINT "*FEATURE NOT IMPLEMENTED AT LINE";N;"CHR";A1
7140  RETURN 
7150  LET F[1]=1
7160  RETURN 
7170  PRINT #3;N$,Y, END 
7180  FOR I=1 TO 8
7190  LET Y[Y]=F[I]
7192  LET Y=Y+1
7194  NEXT I
7196  RETURN 
7200  LET W$[W1+6,W1+15]=X$
7210  RETURN 
9000  REM READ NEXT LINE
9010  READ #1;N,A$
9020  LET L8=L8+1
9030  LET A1=1
9040  LET A2=LEN(A$)
9050  RETURN 
9100  REM GET NEXT WORD--.X$
9110  IF A$[A1,A1] <> " " THEN 9140
9120  LET A1=A1+1
9130  IF A1 <= A2 THEN 9110
9140  LET A0=A1
9150  IF A1 >= A2 THEN 9240
9160  IF A$[A1,A1]="'" THEN 9270
9161  IF A$[A1,A1]=C$[3,3] THEN 9270
9162  LET A1=A1+1
9164  IF A$[A1,A1] <> " " THEN 9162
9170  LET X$=A$[A0,A1-1]
9180  IF X$ <> "." THEN 9230
9190  IF A1 <> A2 THEN 9230
9200  GOSUB 9000
9210  IF A$[1,3]="   " THEN 9230
9220  LET X$='92
9230  REM
9234  RETURN 
9240  GOSUB 9000
9250  IF A$[1,3]="   " THEN 9110
9260  GOTO 9220
9270  LET A1=A1+1
9290  IF A1>A2 THEN 9170
9300  IF A$[A1,A1] <> A$[A0,A0] THEN 9270
9302  LET A1=A1+1
9310  GOTO 9170
9999  END 
