1  COM F$[7],P$[7],L,L8,A$[72],A6,A7,A8,A9,W,W$[64],W0,Y
2  COM M[500],M,M0,M9,Y[150],P[25,2],A[200],C$[72],R$[11]
3  LET Z9=A7=A6=0
4  GOTO 10
5  LET Z9=1
6  LET A6=0
7  REM COBOL, HP 36845A, 6/74
10  FILES *,*,*
15  MAT M=ZER
16  MAT Y=ZER
17  MAT A=ZER
20  DIM N$[10],Z$[72],D$[7]
24  LET D$=""
28  ASSIGN "COSCR",2,A5
30  DIM Y$[72]
32  IF A5=0 THEN 50
33  IF A5=1 THEN 39
34  PRINT "YOU HAVE NOT OPENED A FILE NAMED 'COSCR' BEFORE RUNNING"
36  PRINT "   THE COBOL SYSTEM. PLEASE TYPE 'OPE-COSCR,20' AND"
37  PRINT "   AND THEN TYPE 'RUN' AGAIN."
38  STOP 
39  PRINT "FILE 'COSCR' IS CURRENTLY BEING USED UNDER THIS NUMBER."
40  PRINT "   PLEASE USE ANOTHER USER NUMBER OR TRY AGAIN LATER."
41  PRINT "                THANK YOU"
42  STOP 
50  ASSIGN "$COSC4",1,A5
52  READ #1,1;C$
54  ASSIGN "",1,A5
60  LET A7=0
62  IF TYP(2) <> 1 THEN 80
64  READ #2,1;I
66  IF I <> -1 THEN 80
68  IF TYP(2) <> 2 THEN 80
70  READ #2;D$
72  LET A7=1
74  GOTO 81
80  PRINT #2,1; END 
81  GOSUB 9200
82  IF Z9=1 THEN 95
84  LET F$=D$
85  ASSIGN F$,1,A5
86  IF A5=0 THEN 90
87  LET A6=-1
88  GOTO 95
90  PRINT "CURRENT FILE--";F$
95  LET F=F0=L=A8=A9=B7=0
96  IF A6 <> 0 THEN 100
97  GOTO 9700
100  PRINT "COMON"
102  PRINT 
108  PRINT '10;
110  ENTER #A9,255,A8,A$
120  IF A8 <> -256 THEN 200
130  PRINT '92
140  PRINT "*TIMEOUT-DELETED"
150  LET B7=B7+1
160  IF B7<6 THEN 110
170  PRINT "*YOU HAVE NOT TYPED ANYTHING FOR OVER 20 MINUTES. GOOD BYE."
180  GOTO 1320
200  LET B7=N=0
202  LET A2=LEN(A$)
203  IF A2=0 THEN 108
204  IF A6=-1 OR A6=-3 THEN 1000
205  IF A6=-4 THEN 1190
206  IF A$[1,1]>"9" THEN 214
207  IF A$[1,1]<"0" THEN 214
208  IF A7=0 THEN 210
209  PRINT #2,1; END 
210  LET A7=0
211  PRINT #2;A$, END 
212  LET A6=-2
213  GOTO 108
214  IF A6 <> -2 THEN 820
215  READ #2,1
216  IF  END #2 THEN 800
217  LET Y$=A$
218  READ #2;A$
220  LET B7=N=0
222  LET A2=LEN(A$)
224  FOR I=1 TO 7
230  IF I>A2 THEN 650
240  FOR I0=0 TO 9
250  IF A$[I,I]=N$[I0+1,I0+1] THEN 270
260  NEXT I0
262  GOTO 290
270  LET N=10*N+I0
280  NEXT I
290  LET A0=0
300  LET A$=A$[I,A2]
301  LET A2=A2+2-I
302  LET A$[A2,A2]=" "
312  LET A1=1
320  IF A$[A1,A1] <> " " THEN 325
322  LET A1=A1+1
324  IF A1<A2 THEN 320
325  IF A1<5 THEN 328
326  LET A1=4
327  GOTO 330
328  LET A1=1
330  IF A$[A1,A1] <> " " THEN 420
332  LET A0=1
340  IF A1=A2 THEN 390
350  IF A$[A1+1,A1+1] <> " " THEN 390
352  IF A1+1 <> A2 THEN 360
354  LET A$=A$[1,A2-1]
356  GOTO 370
360  LET Z$=A$[A1+2,A2]
362  LET A$[A1+1,A2-1]=Z$[1,A2-A1-1]
370  LET A2=A2-1
380  GOTO 340
390  LET A1=A1+1
400  IF A1 <= A2 THEN 330
402  LET A$=A$[1,A2]
410  GOTO 660
420  IF A$[A1,A1] >= "A" THEN 510
422  IF A$[A1,A1]="'" THEN 590
424  IF A$[A1,A1]=C$[3,3] THEN 590
430  IF A$[A1,A1+1]="; " THEN 522
432  IF A$[A1,A1+1]=") " THEN 510
440  IF A$[A1,A1+2]="** " THEN 530
450  IF A$[A1+1,A1+1] <> " " THEN 510
460  IF A$[A1,A1]<"0" THEN 530
470  IF A$[A1,A1]>"9" THEN 530
510  LET A0=0
520  GOTO 390
522  LET A$[A1,A1]=","
530  IF A0=1 THEN 510
540  LET Z$=A$[A1,A2]
550  LET A$[A1,A1]=" "
560  LET A$[A1+1,A2+1]=Z$[1,A2-A1+1]
570  LET A2=A2+1
572  LET A1=A1+1
574  IF A$[A1,A1+2] <> "** " THEN 510
576  LET A1=A1+1
580  GOTO 510
590  FOR A3=A1+1 TO A2-1
600  IF A$[A1,A1]=A$[A3,A3] THEN 630
610  NEXT A3
630  LET A1=A3
631  IF A$[A1+1,A1+1]=" " THEN 640
632  LET Z$=A$[A1+1,A2]
634  LET A$[A1+1,A1+1]=" "
636  LET A$[A1+2,A2+1]=Z$[1,A2-A1]
638  LET A2=A2+1
640  GOTO 510
650  LET A$=""
652  LET A2=0
660  PRINT #1;N,A$, END 
662  LET A6=1
730  GOTO 218
800  LET A6=1
810  LET A$=Y$
820  IF A$="" THEN 108
1000  IF A$[1,3]="RUN" THEN 2000
1002  IF A$[1,3]="IGN" THEN 1270
1010  IF A$[1,3]="LIS" THEN 1350
1020  IF A$[1,3]="SCR" THEN 1530
1030  IF A$[1,3]="REN" THEN 1650
1040  IF A$[1,3]="PUN" THEN 1460
1050  IF A$[1,3]="XPU" THEN 1510
1052  IF A$[1,3]="SOR" THEN 3000
1060  IF A$[1,3]="DEL" THEN 1870
1070  IF A$[1,3]="GET" THEN 1200
1072  IF A$[1,3]="BYE" THEN 1320
1074  IF A$[1,3]="EXI" THEN 1320
1076  IF A$[1,3]="PRI" THEN 3200
1080  IF A$[1,3]="CSA" THEN 2250
1081  IF A$[1,3]="CLE" THEN 2600
1082  IF A$[1,3]="STO" THEN 1320
1086  IF A$[1,3]="COM" THEN 2210
1088  IF A$[1,3]="SAV" THEN 2350
1090  PRINT '10"*???"
1100  GOTO 108
1130  PRINT '10"*ILLEGAL FORMAT IN COMMAND"
1140  GOTO 108
1150  PRINT '10"*COULDN'T GET FILE"
1160  GOTO 108
1170  PRINT '10"*NO FILE PRESENT"
1180  GOTO 108
1182  PRINT '10"*PROGRAM MUST BE COMPILED"
1184  GOTO 108
1186  PRINT '10"*PROGRAM PRECOMPILED"
1188  GOTO 108
1190  PRINT '10"*CAN'T MODIFY READ-ONLY PROGRAM"
1192  GOTO 108
1200  IF LEN(A$)<4 THEN 2600
1202  IF A$[4,4] <> "-" THEN 1130
1210  LET F$=A$[5,LEN(A$)]
1212  IF F$ <> "COSCR" THEN 1220
1213  PRINT 
1214  PRINT "   COSCR IS A COMPILER SCRATCH FILE, AND CANNOT BE"
1215  PRINT "USED FOR A USER PROGRAM.  YOU MUST EXIT FROM COMON,"
1216  PRINT "OPEN ANOTHER FILE TO BE USED FOR YOUR PROGRAM, THEN REENTER"
1217  PRINT "COMON AND GET THAT FILE."
1219  GOTO 108
1220  ASSIGN F$,1,A5
1230  IF A5=0 THEN 1260
1232  IF A5<3 THEN 1294
1240  ASSIGN "XXX",1,A5
1242  LET A6=-1
1250  GOTO 1150
1260  LET A6=A7=0
1270  READ #1,1
1271  IF TYP(1)>1 THEN 1540
1272  READ #1;N
1274  IF N=-1 THEN 2420
1276  LET N0=1
1280  GOTO TYP(1) OF 1290,1300,1310
1290  READ #1;N
1292  IF N0 <> 2 THEN 1540
1294  LET N0=1
1296  GOTO 1280
1297  LET A6=-4
1298  GOTO 1270
1300  READ #1;A$
1302  IF N0 <> 1 THEN 1540
1304  LET N0=2
1306  GOTO 1280
1310  IF F$ <> D$ THEN 1316
1312  LET A7=1
1314  GOTO 108
1316  LET D$=""
1317  PRINT #2,1; END 
1318  GOTO 108
1320  PRINT 
1321  IF A6<0 THEN 1330
1322  GOSUB 9000
1330  PRINT 
1340  STOP 
1350  LET A3=1
1351  GOSUB 9000
1352  PRINT 
1354  PRINT F$
1356  PRINT 
1358  IF A6=-3 THEN 1186
1360  READ #1,1
1362  GOSUB 9500
1363  IF B[2]>0 THEN 1370
1364  LET B[2]=1.E+08
1370  IF  END #1 THEN 1430
1372  LET B2=56
1380  READ #1;N,A$
1382  IF N<B[1] THEN 1380
1384  IF N>B[2] THEN 1380
1390  GOSUB 9100
1400  GOSUB 9800
1401  PRINT Z$[1,6];A$;
1402  GOTO A3 OF 1408,1408,1404
1404  PRINT '13'10;
1406  GOTO 1410
1408  PRINT 
1410  LET B2=B2-1
1412  IF B2 <> 0 THEN 1380
1414  IF B1=0 THEN 1380
1416  LET B2=58
1418  PRINT '10'10'10'10'10'10'10'10
1420  GOTO 1380
1430  PRINT 
1450  GOTO A3 OF 108,1490,1490
1460  LET A3=2
1462  GOSUB 9000
1470  PRINT '10'10'10'1'1'1'1'1'1'1'1'1'1'1'1'1'1'1'1'1'1'1;
1480  GOTO 1360
1490  PRINT '1'1'1'1'1'1'1'1'1'1'1'1'1'1'1'1'1'1'1
1500  GOTO 108
1510  LET A3=3
1520  GOTO 1470
1530  IF A6=-1 THEN 1170
1532  IF A6=-4 THEN 1190
1540  PRINT #1,1; END 
1541  PRINT #2,1; END 
1542  LET A6=A7=0
1550  GOTO 108
1650  IF A6=-1 THEN 1170
1651  IF A6=-3 THEN 1186
1652  IF A6=-4 THEN 1190
1653  GOSUB 9000
1654  GOSUB 9500
1656  LET A7=0
1660  READ #1,1
1670  IF B[4]>0 THEN 1682
1680  LET B[4]=1.E+08
1682  IF B[2]>0 THEN 1686
1684  LET B[2]=10
1686  IF B[1]>0 THEN 1690
1688  LET B[1]=100
1690  READ #2,1
1710  IF  END #1 THEN 1790
1720  READ #1;N,A$
1730  IF N<B[3] THEN 1770
1740  IF N>B[4] THEN 1770
1750  LET N=B[1]
1760  LET B[1]=B[1]+B[2]
1770  PRINT #2;N,A$, END 
1780  GOTO 1720
1790  READ #1,1
1800  READ #2,1
1810  IF  END #2 THEN 1850
1820  READ #2;N,A$
1830  PRINT #1;N,A$, END 
1840  GOTO 1820
1850  LET A6=0
1852  PRINT #2,1; END 
1860  IF B0<3 THEN 108
1862  GOSUB 9000
1864  GOTO 108
1870  PRINT #2,1; END 
1871  LET A7=0
1872  IF A6=-3 THEN 1186
1874  IF A6=-4 THEN 1190
1876  GOSUB 9000
1880  GOSUB 9500
1890  IF B[2]>0 THEN 1910
1900  LET B[2]=B[1]
1910  IF B0<1 THEN 1130
1920  READ #1,1
1922  IF  END #1 THEN 1980
1930  IF TYP(1) <> 1 THEN 1980
1932  READ #1;N,A$
1940  IF N<B[1] THEN 1960
1950  IF N <= B[2] THEN 1930
1960  PRINT #2;N,A$, END 
1970  GOTO 1930
1980  GOTO 1790
2000  LET A8=0
2002  IF A7=1 THEN 2140
2004  GOSUB 9000
2010  LET P$="$COMON"
2020  LET L=5
2022  LET A9=A6=0
2030  ASSIGN "COSCR",1,A5
2040  LET B0=0
2050  IF  END #1 THEN 2100
2060  LET B1=1
2070  PRINT #1,B1; END 
2080  LET B1=B1+1
2090  GOTO 2070
2100  CHAIN "$COIDEV"
2140  READ #2,1;I9,D$
2150  READ #2;W$,W0
2160  MAT  READ #2;M,P,Y,A
2180  LET A8=2
2190  LET L8=0
2192  PRINT 
2200  PRINT F$
2201  PRINT 
2202  LET A9=0
2203  ASSIGN "$COSC4",1,A5
2204  READ #1,1;C$,R$
2205  CHAIN "$XCORUN"
2210  REM COMPILE
2220  IF A7=1 THEN 108
2230  LET A8=1
2240  GOTO 2004
2250  REM CSAVE
2252  IF A7=0 THEN 1182
2260  GOSUB 7100
2261  IF A5=9 THEN 108
2262  PRINT #3,1;-1
2270  IF A5 <> 0 THEN 108
2280  LET F1=2
2290  LET F2=3
2292  READ #2,1;I9,D$
2300  GOSUB 7000
2332  ASSIGN "",3,A5
2340  GOTO 108
2350  REM SAVE
2360  GOSUB 7100
2370  IF A5 <> 0 THEN 108
2380  LET F1=1
2390  LET F2=3
2392  READ #1,1
2400  GOSUB 7000
2410  GOTO 2332
2420  REM GET CSAVED FILE
2421  PRINT '10"*WARNING: RUN-ONLY PROGRAM"
2422  LET A7=1
2424  LET A6=-3
2430  READ #1;W$,W0
2440  MAT  READ #1;M,P,Y,A
2460  PRINT #2,1;-1,F$,W$,W0
2470  MAT  PRINT #2;M,P,Y,A
2480  PRINT #2; END 
2490  GOTO 108
2600  REM CLEAR
2610  LET A7=0
2612  LET A6=-1
2620  LET F$=""
2630  LET D$=""
2640  PRINT #2,1; END 
2650  ASSIGN "",1,A5
2660  GOTO 108
3000  REM SORT
3002  IF A6=-1 THEN 1170
3004  IF A6=-3 THEN 1186
3006  LET A6=1
3007  LET A7=0
3008  LET A$="IGN"
3010  GOSUB 9000
3020  GOTO 108
3050  GOTO 108
3100  REM DEBUG
3102  IF A6=-3 THEN 3130
3104  GOSUB 9000
3110  LET A8=3
3112  LET A7=0
3120  GOTO 2010
3130  PRINT '10"CAN'T DEBUG COMPILED FILE"
3140  GOTO 108
3200  REM PRINT
3210  GOSUB 7100
3212  IF A5 <> 0 THEN 108
3220  READ #3,1
3230  PRINT '10'10'10'10'10
3240  IF TYP(3) <> 2 THEN 3280
3250  READ #3;A$
3260  PRINT A$
3270  GOTO 3240
3280  PRINT '10'10'10'10'10
3290  ASSIGN "",3,A5
3292  GOTO 108
7000  REM COPY#F1 TO #F2
7020  GOTO TYP(F1) OF 7030,7040,7050
7030  READ #F1;N
7032  PRINT #F2;N
7034  GOTO 7020
7040  READ #F1;Y$
7042  PRINT #F2;Y$
7044  GOTO 7020
7050  PRINT #F2; END 
7060  RETURN 
7100  REM OPEN FILE
7110  GOSUB 9300
7112  IF A1>A2 THEN 7180
7120  LET Y$=A$[A1+1,A2]
7130  ASSIGN Y$,3,A5
7140  IF A5=0 THEN 7160
7150  PRINT '10"*COULDN'T OPEN FILE"
7160  RETURN 
7180  PRINT '10"*INCORRECT FORMAT--NO NAME SPECIFIED"
7182  LET A5=9
7190  RETURN 
8000  REM ENTRY FROM SUCCESSFUL/RUN/COMP
8010  LET Z9=2
8020  IF A8=2 OR A8=4 THEN 5
8022  IF A8=3 THEN 8130
8030  LET A7=1
8040  ASSIGN "COSCR",2,A5
8050  PRINT #2,1;-1,F$
8052  PRINT #2;W$,W0
8060  MAT  PRINT #2;M,P,Y,A
8080  PRINT #2; END 
8090  IF A8=1 THEN 8110
8092  LET A8=2
8094  LET L8=0
8100  GOTO 2200
8110  PRINT "*SUCCESSFUL COMPILATION"
8120  GOTO 5
8130  LET A8=A7=4
8140  GOTO 8094
9000  REM SORT ROUTINE
9010  IF A6=-4 OR A6=0 THEN 9080
9020  IF A6<0 THEN 1170
9030  LET P$="$COMON"
9040  LET L=9060
9050  CHAIN "$COSORT"
9060  LET A6=B7=0
9062  ASSIGN F$,1,A5
9064  ASSIGN "COSCR",2,A5
9065  GOSUB 9200
9070  GOTO 1000
9080  RETURN 
9100  REM NUMBER ROUTINE (N-Z$)
9102  LET A0=N
9104  LET Z$="000000"
9110  FOR I1=1 TO 6
9120  LET A1=INT(A0/10^(6-I1))
9130  LET Z$[I1,I1]=N$[A1+1,A1+1]
9140  LET A0=A0-A1*10^(6-I1)
9150  NEXT I1
9160  RETURN 
9200  REM INITIALIZE
9210  LET N$="0123456789"
9220  ASSIGN "COSCR",2,A5
9299  RETURN 
9300  REM FIND START OF LIST
9302  LET A2=LEN(A$)
9310  FOR A1=4 TO A2
9320  IF A$[A1,A1]="-" THEN 9350
9330  NEXT A1
9340  LET A1=A2+1
9350  RETURN 
9400  REM GET # TO N0
9410  LET A1=A1+1
9412  LET N0=N2=0
9414  IF A1>A2 THEN 9494
9420  IF A$[A1,A1]="P" THEN 9464
9440  FOR N1=0 TO 9
9450  IF A$[A1,A1]=N$[N1+1,N1+1] THEN 9470
9460  NEXT N1
9462  GOTO 9494
9464  LET N0=-2
9465  LET A1=A1+1
9466  GOTO 9498
9470  LET N0=N0*10+N1
9480  LET N2=1
9490  LET A1=A1+1
9492  IF A1 <= A2 THEN 9440
9494  IF N2=1 THEN 9498
9496  LET N0=-1
9498  RETURN 
9500  REM GET B(10) FROM COMMAND
9502  MAT B=ZER[10]
9510  LET B0=B1=0
9520  GOSUB 9300
9530  IF A1>A2 THEN 9640
9540  GOSUB 9400
9560  LET B0=B0+1
9562  IF B0>10 THEN 1130
9570  LET B[B0]=N0
9580  IF A1>A2 THEN 9610
9590  IF A$[A1,A1]="," THEN 9540
9600  GOTO 1130
9610  IF B[B0] <> -2 THEN 9640
9620  LET B[B0]=0
9630  LET B1=1
9632  LET B0=B0-1
9640  RETURN 
9700  REM RESTART
9710  ASSIGN F$,1,A5
9720  PRINT 
9730  LET A6=0
9740  GOTO 1270
9800  REM-DELETE BLANKS PRECEDING PERIODS AND COMMAS
9810  W7=1
9820  IF A$[W7,W7+2]=" . " THEN 9860
9830  IF A$[W7,W7+2]=" , " THEN 9860
9840  GOTO 9870
9860  A$[W7]=A$[W7+1]
9870  W7=W7+1
9875  IF W7 <= LEN(A$)-1 THEN 9820
9880  IF A$[W7]="." THEN 9895
9885  IF A$[W7]="," THEN 9895
9890  RETURN 
9895  A$[W7-1]=A$[W7]
9899  RETURN 
9999  END 
