1  COM A[25],V[2,10]
2  COM A$[255],A1$[255],B0$[5],D0$[255],F0$[1],F1$[11],S0$[6]
3  COM H0$[94],H1$[94],J0$[3],J1$[3],K1$[15],P0$[184],P1$[4]
4  COM N0$[1],U0$[11],U1$[11],V0$[10],V1$[10],W$[102],W0$[8],W1$[255],Z$[255]
5  COM C0,C1,C2,C3,C4,C5,C6,C7,C8,C9,D0
6  COM D,D1,D2,F9,G,G0,G8,L,S0,V0,V1,V2,V3,V5,V7
7  COM W0,W1,W3,W5,W8,W9
10  COM L[5],M[64,2],N[64,2],P[2]
11  COM B$[94],L$[94],M$[94],N$[94],O$[94],P$[94]
12  COM L1,L2,L3,L4,L7,M1,M2,M3,M4,M5,M7,M8,M9,N1,N2,N3,N4
15  REM (C) COPYRIGHT  HEWLETT-PACKARD CO. 1976
16  REM ALL RIGHTS RESERVED.  NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED,
17  REM REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT THE
18  REM PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD CO.
50  FILES *,*
99  CHAIN "$EDITOR"
100  REM *ENTRY*
110  IF  ERROR  THEN 9998
120  ASSIGN U0$,C1,J, PR 
130  IF J THEN 9998
140  U0=V6=C0
145  D1=D
150  U1=C2
160  GOSUB 1000
165  W1=C0
170  A1$="EDIT00"
175  A1$[C7]=B0$
180  CHAIN J,A1$,100
190  GOTO 9998
900  RESTORE 910
910  DATA 0,1,2,3,4,5,6,7,8,9,10
920  READ C0,C1,C2,C3,C4,C5,C6,C7,C8,C9,D0
1000  REMP >>READ ERROR FILE<<
1005  A1$="EDERRO"
1010  A1$[LEN(A1$)+C1]=B0$
1015  ASSIGN A1$,C2,J
1020  IF  NOT J THEN 1100
1025  PRINT "Error file EDERRO cannot be assigned."
1030  STOP 
1100  REM2 *PROMPT*
1105  PRINT ">";
1110  LINPUT A1$
1115  RESTORE 1120
1120  DATA 5,1,"SCAN",1,"DUMP",1,"CLEAR",4,"//STOP",1,"INITIALIZE"
1125  A1$=UOS$(A1$)
1130  GOSUB 9300
1135  GOTO K2 OF 1150,1150,1800,9999,1900
1140  PRINT "Commands available: SCAN, DUMP, CLEAR, //STOP, and INITIALIZE."
1145  GOTO 1105
1150  B0=K2-C1
1200  REM2 *SCAN/DUMP*
1205  READ #C2,C1
1210  IF  END #C2 THEN 1700
1215  IF  NOT B0 THEN 1250
1220  PRINT "Supply file name for dump:";
1225  LINPUT A1$
1230  ASSIGN A1$,C1,J
1235  IF  NOT J OR J=8 THEN 1250
1240  PRINT A1$" cannot be assigned."
1245  GOTO 1220
1250  READ #C2;A,B
1255  IF B>C2 THEN 1300
1260  PRINT "No errors to report."
1265  STOP 
1300  REM2 *SCAN LOOP*
1305  B1=C2
1310  B2=C1
1315  IF B1>B THEN 1700
1320  READ #C2,B1;H0$,T0,T1,T2,T3,D,D1,D2,M4,N4
1325  IF  NOT B0 THEN 1335
1330  PRINT #C1;CTL(C1)
1335  PRINT #B0;LIN(2),"Error number:"B2
1340  B2=B2+C1
1345  PRINT #B0;LIN(2),"Heading: "H0$
1350  PRINT #B0;"Year:"T3"Day:"T2"Hour:"T1"Minute:"T0
1355  PRINT #B0;"Command number:"D
1360  PRINT #B0;"Program #:"D1"Error #:"M4"Line #:"N4
1365  PRINT #B0;"Number of last //-command:"D2
1370  GOTO TYP(C2) OF 1375,1385,1600
1375  PRINT "Bad format"
1380  STOP 
1385  READ #C2;P0$,P1$,V0,V5,V2,V3,W0,W1,W3
1390  PRINT #B0;"Last prompt (P0$): "P0$
1395  PRINT #B0;"Prompt character was: "P1$
1400  PRINT #B0;"Input type (V0):"V0"Input return (V5):"V5
1405  PRINT #B0;"Input from (1=term, 2=USE file):"V2"Use mode:"W3
1410  GOTO TYP(C2) OF 1375,1415,1600
1415  READ #C2;A$,Z$,A1$,W0$,B0$,D0$,F1$,S0$,U0$,U1$,X$,S0
1420  PRINT #B0;"Working strings:"
1425  PRINT #B0;"  A$=<"A$">"
1430  PRINT #B0;"  Z$=<"Z$">"
1435  PRINT #B0;" A1$=<"A1$">"
1440  PRINT #B0;"Command name: "W0$
1445  PRINT #B0;"Account number: "B0$
1450  PRINT #B0
1455  IF B0 THEN 1475
1460  P0$="Continue? "
1465  GOSUB 3300
1470  IF K2=C2 THEN 1105
1475  PRINT #B0;"Definitions: <"D0$">"
1480  PRINT #B0;"FROM file: "F1$
1485  PRINT #B0;"SCRATCH file: "S0$"  Created (0=no, 1=yes):"S0
1490  PRINT #B0;"WORK file: "U0$
1495  PRINT #B0;"USE file: "U1$
1500  PRINT #B0;"KEEP file: "X$
1505  GOTO TYP(C2) OF 1375,1510,1600
1510  READ #C2;B$,W$,W1$,G,G0,G8,V7
1515  PRINT #B0;"Text handling strings:"
1520  PRINT #B0;"  B$=<"B$">"
1525  PRINT #B0;"  W$=<"W$">"
1530  PRINT #B0;" W1$=<"W1$">"
1535  PRINT #B0
1540  PRINT #B0;"Local increment:"G
1545  PRINT #B0;"Local automargin:"G0
1550  PRINT #B0;"Local line length:"G8
1555  PRINT #B0;"Local display (0=off, 1=on):"V7
1560  PRINT #B0
1565  IF B0 THEN 1600
1570  P0$="Continue? "
1575  GOSUB 3300
1580  IF K2=C2 THEN 1105
1600  REM2 ***END OF ERROR ENTRY**
1605  B1=REC(C2)+C1
1610  GOTO 1315
1700  REM2 **DONE**
1705  IF  NOT B0 THEN 1715
1710  PRINT #B0;LIN(2),'7"End of error file."
1715  PRINT LIN(2),'7"End of error file."
1720  GOTO 1105
1800  REM2 **CLEAR**
1805  READ #C2,C1;A
1810  PRINT #C2,C1;A,C2
1815  FOR I=2 TO A
1820  PRINT #C2,I; END 
1825  NEXT I
1830  STOP 
1900  REM2 **INITIALIZE NEW ERROR FILE**
1905  PRINT "Length of file EDERRO? ";
1910  LINPUT A1$
1915  CONVERT A1$ TO I1,4673
1920  PRINT #C2,C1;I1,C2
1925  GOTO 1105
1930  PRINT "Supply the number of records."
1935  GOTO 1905
3300  REM <YES/NO>
3305  J=SYS(C3)
3310  PRINT P0$;
3315  LINPUT A$
3320  IF SYS(C3) THEN 3370
3322  IF  NOT LEN(A$) THEN 3380
3325  IF LEN(A$)<C4 THEN 3340
3330  PRINT "Response limited to YES (or return) or NO (or break)."
3335  GOTO 3310
3340  A1$=UOS$(A$)
3345  RESTORE 3350
3350  DATA 2,1,"YES",1,"NO"
3355  GOSUB 9300
3360  IF  NOT K2 THEN 3330
3365  RETURN 
3370  K2=C2
3375  RETURN 
3380  K2=C1
3385  RETURN 
9300  REM <KEY>
9310  READ J
9320  FOR K2=C1 TO J
9330  READ J1,K1$
9340  IF LEN(A1$)<J1 THEN 9360
9350  IF A1$=K1$[C1,LEN(A1$)] THEN 9380
9360  NEXT K2
9370  K2=C0
9380  RETURN 
9990  REM <ERR>
9991  M4=SYS(C0)
9992  N4=SYS(C1)
9993  A1$="EDIT31"
9994  A1$[C7]=B0$
9995  CHAIN J,A1$,100
9996  PRINT A1$" is missing.  ERROR"
9997  STOP 
9998  GOTO 9991
9999  END 
