$CONTROL USLINIT,SOURCE,MAP,CODE                                        00010000
<< PATCH >>                                                             00012000
<< HP32002C MPE SOURCE C.00.00 >>                                       00014000
$COPYRIGHT     "(C) COPYRIGHT HEWLETT-PACKARD CO. 1980. ",            & 00016000
$     "THIS PROGRAM MAY BE USED WITH ONE COMPUTER SYSTEM AT A ",      & 00018000
$     "TIME AND SHALL NOT OTHERWISE BE RECORDED, TRANSMITTED OR ",    & 00020000
$     "STORED IN A RETRIEVAL SYSTEM.  COPYING OR OTHER REPRODUCTION ",& 00022000
$     "OF THIS PROGRAM EXCEPT FOR ARCHIVAL PURPOSES IS PROHIBITED ",  & 00024000
$     "WITHOUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY."   00026000
$CONTROL PRIVILEGED,MAIN=PATCH                                          00028000
  * *  PROGRAM FILE PATCHER  CU.06  * *                                 00030000
BEGIN                                                                   00032000
    DEFINE                                                              00034000
PTITLE=("PROGRAM PATCH C.00.00 (C) HEWLETT-PACKARD CO., 1976")#,        00036000
        TURNOFFTRAPS = PUSH (STATUS);                                   00038000
                       TOS.(2:1):=0;                                    00040000
                       SET (STATUS) #;                                  00042000
   INTEGER NVAL;                                                        00044000
   INTEGER I1;                                                          00046000
   ARRAY OBUF(0:39)_"  FILE=?";                                         00048000
   ARRAY IBUF(0:39);                                                    00050000
   BYTE ARRAY OBUFB(*)=OBUF;                                            00052000
   BYTE ARRAY DPB(0:15);                                                00054000
   BYTE POINTER SP_@OBUFB,SPIB_@SP;                                     00056000
   BYTE POINTER DP_@DPB;                                                00058000
   ARRAY BUF(0:127),ZSEG(0:127);                                        00060000
   INTEGER L,SEG,LL,RC,CNT,PFNUM;                              <<01.01>>00062000
   ARRAY FN(0:16)=DB;                                                   00064000
   BYTE ARRAY FNB(*)=FN;                                                00066000
   LOGICAL DATAFLAG_0;                                                  00068000
   LOGICAL DFLAG,                                                       00070000
       QMCR_%37415;                                                     00072000
   INTEGER X=X;                                                         00074000
   EQUATE PROGMESS = 0;  <<ERROR MESSAGE EQUATES>>             <<00241>>00076000
   EQUATE IN'OUT = 4;  <<INPUT OUT ACCESS TO FILE--AOPT>>      <<00241>>00078000
   LOGICAL AOPTIONS;                                           <<00241>>00080000
   EQUATE VUF'COL=7;  << VUF COLUMN NUMBER >>                  <<04502>>00082000
$INCLUDE INCLVUF                                               <<04502>>00084000
   INTRINSIC QUIT;                                                      00086000
  PROCEDURE TERMINATE; OPTION EXTERNAL;                                 00088000
   INTRINSIC FOPEN,FREAD,FREADDIR,FWRITEDIR,READ,PRINT,FCLOSE;          00090000
INTRINSIC FGETINFO;                                            <<00241>>00092000
PROCEDURE BLANKBUF(N); VALUE N; INTEGER N;                              00094000
BEGIN                                                                   00096000
   OBUF(0)_"  ";                                                        00098000
MOVE OBUF(1)_OBUF(0),(N);                                               00100000
END;                                                                    00102000
PROCEDURE OCTOUT1(BUF,T,N); VALUE T,N;                                  00104000
   BYTE ARRAY BUF; INTEGER T,N;                                         00106000
BEGIN                                                                   00108000
   INTEGER K=X;                                                         00110000
   K_N;                                                                 00112000
   TOS_T;                                                               00114000
WHILE (K_K-1)>=0 DO                                                     00116000
   BEGIN                                                                00118000
     ASSEMBLE(DUP,NOP);                                                 00120000
     BUF(K)_INTEGER((LOGICAL(TOS) LAND 7)+%60);                         00122000
     TOS_TOS&LSR(3);                                                    00124000
   END;                                                                 00126000
END;                                                                    00128000
PROCEDURE ASCI(SP,C,N,M); VALUE N,M;                                    00130000
   BYTE ARRAY SP;                                                       00132000
   INTEGER C,N,M;                                                       00134000
   BEGIN                                                                00136000
     INTEGER K_0,D1_0,D2_0,D3_0,X=X;                                    00138000
     LABEL OVERFLO;                                                     00140000
         WHILE K < N DO                                                 00142000
          BEGIN                                                         00144000
           X _ M;                                                       00146000
           ASSEMBLE(LDXA,LMPY);                                         00148000
           I1 _ TOS;                                                    00150000
           ASSEMBLE(XCH,NOP);                                           00152000
           ASSEMBLE(LDXA,LMPY; DADD,XCH);                               00154000
           IF <> THEN GOTO OVERFLO;                                     00156000
           ASSEMBLE(XCH,NOP);                                           00158000
           TOS _ I1;                                                    00160000
           TOS _ 0;                                                     00162000
           TOS _ SP(K);                                                 00164000
           ASSEMBLE(DUP,NOP);                                           00166000
           IF TOS > "9" THEN TOS _ TOS-7;                               00168000
           TOS _ TOS-"0";                                               00170000
           ASSEMBLE(DADD);                                              00172000
           IF CARRY THEN GOTO OVERFLO;                                  00174000
           K _ K+1;                                                     00176000
          END;                                                          00178000
         ASSEMBLE(STD C,I);                                             00180000
         RETURN;                                                        00182000
OVERFLO :                                                               00184000
   END <<ASCI>>;                                                        00186000
PROCEDURE SCANW(A); VALUE A; INTEGER A;                                 00188000
BEGIN                                                                   00190000
   SCAN SP WHILE A,1;                                                   00192000
    @SP_TOS;                                                            00194000
END;                                                                    00196000
INTEGER PROCEDURE GETNUM;                                               00198000
BEGIN                                                                   00200000
   INTEGER K,K1,N;                                                      00202000
   SCANW(%6440);                                                        00204000
   MOVE DP_SP WHILE N,0;                                                00206000
   @SP_TOS+1;                                                           00208000
   N_TOS-@DP;                                                           00210000
   ASCI(DPB,K,N,8);                                                     00212000
   GETNUM_K1;                                                           00214000
END;                                                                    00216000
PROCEDURE GETREC(SEG,L); VALUE SEG,L; INTEGER SEG,L;                    00218000
BEGIN                                                                   00220000
       INTEGER I,K;                                                     00222000
          TOS := ZSEG(4);                                               00224000
          K := 28+(ZSEG(1)+1)&LSR(1);                                   00226000
          I := -1;                                                      00228000
          WHILE(I:=I+1)<SEG DO TOS:=TOS+(ZSEG(K+I).(2:14)+127)&LSR(7);  00230000
    IF DATAFLAG THEN BEGIN DATAFLAG_0; RC_ZSEG(3) END ELSE              00232000
   RC_TOS;                                                              00234000
   ASSEMBLE(LOAD L; LDI 128; DIV);                                      00236000
   LL_TOS;                                                              00238000
   RC_RC+TOS;                                                           00240000
END;                                                                    00242000
PROCEDURE DISPLAY(N);                                                   00244000
VALUE N; INTEGER N;                                                     00246000
   WHILE N>0 DO                                                         00248000
   BEGIN                                                                00250000
   IF LL>127 THEN                                                       00252000
   BEGIN                                                                00254000
       RC_RC+1;                                                         00256000
       FREADDIR(PFNUM,BUF,128,DOUBLE(RC));                              00258000
   IF <> THEN QUIT(4);                                                  00260000
       LL_0;                                                            00262000
   END;                                                                 00264000
   BLANKBUF(1);                                                         00266000
   OCTOUT1(OBUFB(2),INTEGER (BUF(LL)),6);                               00268000
   PRINT(OBUF,4,0);                                                     00270000
   LL_LL+1;                                                             00272000
   N_N-1;                                                               00274000
   END;                                                                 00276000
PROCEDURE MODIFY(A); VALUE A; INTEGER A;                                00278000
BEGIN                                                                   00280000
   WHILE A>0 DO                                                         00282000
   BEGIN                                                                00284000
     IF LL>127 THEN                                                     00286000
     BEGIN                                                              00288000
       FWRITEDIR(PFNUM,BUF,128,DOUBLE(RC));                             00290000
   IF <> THEN QUIT(5);                                                  00292000
       FREADDIR(PFNUM,BUF,128,DOUBLE(RC:=RC+1));                        00294000
   IF <> THEN QUIT(5);                                                  00296000
       LL_0;                                                            00298000
     END;                                                               00300000
   BLANKBUF(1);                                                         00302000
   OCTOUT1(OBUFB(2),INTEGER (BUF(LL)),6);                               00304000
   OBUFB(8) := ",";                                                     00306000
   PRINT(OBUF,-9,%320);                                                 00308000
   X := READ(OBUF,-72);                                                 00310000
   OBUFB(X) := %15;                                                     00312000
     @SP_@SPIB;                                                         00314000
     SCANW(%6440);                                                      00316000
     NVAL_GETNUM;                                                       00318000
     BUF(LL)_NVAL;                                                      00320000
     LL_LL+1;                                                           00322000
     A_A-1;                                                             00324000
   END;                                                                 00326000
   FWRITEDIR(PFNUM,BUF,128,DOUBLE(RC));                                 00328000
   IF <> THEN QUIT(6);                                                  00330000
END;                                                                    00332000
PROCEDURE FATALERR(MESSNUM);                                   <<00241>>00334000
   VALUE MESSNUM;                                              <<00241>>00336000
   INTEGER MESSNUM;                                            <<00241>>00338000
BEGIN                                                          <<00241>>00340000
   COMMENT:                                                    <<00241>>00342000
      A FATAL ERROR HAS OCCURED.  PRINT ERROR                  <<00241>>00344000
      MESSAGE AND TERMINATE.                                   <<00241>>00346000
      ;                                                        <<00241>>00348000
                                                               <<00241>>00350000
   INTEGER LEN;                                                <<00241>>00352000
   LOGICAL ARRAY WBUF(0:39);                                   <<00241>>00354000
   BYTE ARRAY BUF(*)=WBUF;                                     <<00241>>00356000
                                                               <<00241>>00358000
   CASE MESSNUM OF                                             <<00241>>00360000
      BEGIN                                                    <<00241>>00362000
      <<0>> MOVE BUF:="*** ERROR *** UNABLE TO OPEN FILE",2;   <<00241>>00364000
      END;                                                     <<00241>>00366000
   LEN:=TOS-LOGICAL(@BUF);                                     <<00241>>00368000
   PRINT(WBUF,-LEN,0);                                         <<00241>>00370000
   TERMINATE;                                                  <<00241>>00372000
                                                               <<00241>>00374000
END <<FATALERROR>>;                                            <<00241>>00376000
<<**************************M A I N   P R O G  **********************>> 00378000
TURNOFFTRAPS;                                                           00380000
   MOVE IBUF := PTITLE,2;                                   <<01.01>>   00382000
   L := TOS-@IBUF;                                          <<01.01>>   00384000
   MOVE IBUF(VUF'COL):=OFFICIAL'VUUFF;                         <<04502>>00386000
   PRINT(IBUF,L,0);                                         <<01.01>>   00388000
PRINT(OBUF,4,%320);                                                     00390000
   X := READ(FN,-32);                                                   00392000
   IF X=0 THEN TERMINATE;                                      <<00241>>00394000
   FNB(X) := %15;                                                       00396000
PFNUM := FOPEN(FNB,%2001,4);<<OLD,NOFILE'EQ,IN/OUT ACCESS>>    <<00241>>00398000
   IF <> THEN FATALERR(PROGMESS);                              <<00241>>00400000
FGETINFO(PFNUM,<<FILENAME>>,<<FOPT>>,AOPTIONS);                <<00241>>00402000
IF AOPTIONS.(12:4) <> IN'OUT THEN FATALERR(PROGMESS);          <<00241>>00404000
FREAD(PFNUM,ZSEG,128);                                                  00406000
   IF <> THEN QUIT(2);                                                  00408000
WHILE TRUE DO                                                           00410000
BEGIN                                                                   00412000
   PRINT(QMCR,-1,%320);                                                 00414000
   X := READ(OBUF,-72);                                                 00416000
   OBUFB(X) := %15;                                                     00418000
   SCANW(%6440);                                                        00420000
MOVE SP := SP WHILE AS;                                        <<04551>>00422000
    IF SP="DG," THEN                                           <<B0.00>>00424000
     BEGIN                                                     <<B0.00>>00426000
      DFLAG:=1;                                                <<B0.00>>00428000
      DATAFLAG:=1;                                             <<B0.00>>00430000
      @SP:=@SP+3;                                              <<B0.00>>00432000
     END                                                       <<B0.00>>00434000
  ELSE                                                         <<B0.00>>00436000
    IF SP="MG," THEN                                           <<B0.00>>00438000
     BEGIN                                                     <<B0.00>>00440000
      DFLAG:=0;                                                <<B0.00>>00442000
      DATAFLAG:=1;                                             <<B0.00>>00444000
      @SP:=@SP+3;                                              <<B0.00>>00446000
     END                                                       <<B0.00>>00448000
   ELSE                                                        <<B0.00>>00450000
  IF SP="D," THEN                                              <<B0.00>>00452000
   BEGIN                                                       <<B0.00>>00454000
    DFLAG:=1;                                                  <<B0.00>>00456000
    DATAFLAG:=0;                                               <<B0.00>>00458000
    @SP:=@SP+2;                                                <<B0.00>>00460000
    SEG:=GETNUM;                                               <<B0.00>>00462000
   END                                                         <<B0.00>>00464000
   ELSE                                                        <<B0.00>>00466000
   IF SP ="M," THEN                                            <<B0.00>>00468000
    BEGIN                                                      <<B0.00>>00470000
     DFLAG:=0;                                                 <<B0.00>>00472000
     DATAFLAG:=0;                                              <<B0.00>>00474000
     @SP:=@SP+2;                                               <<B0.00>>00476000
     SEG:=GETNUM;                                              <<B0.00>>00478000
    END                                                        <<B0.00>>00480000
   ELSE                                                        <<B0.00>>00482000
    BEGIN                                                      <<B0.00>>00484000
     FCLOSE(PFNUM,0,0);                                        <<B0.00>>00486000
     IF <> THEN QUIT(3);                                       <<B0.00>>00488000
     TERMINATE;                                                <<B0.00>>00490000
    END;                                                       <<B0.00>>00492000
                                                               <<B0.00>>00494000
   L_GETNUM;                                                            00496000
   @SP_@SP-1;                                                           00498000
   IF SP=%15 THEN CNT_1                                                 00500000
     ELSE                                                               00502000
     BEGIN                                                              00504000
       @SP_@SP+1;                                                       00506000
       CNT_GETNUM;                                                      00508000
     END;                                                               00510000
   GETREC(SEG,L);                                                       00512000
   FREADDIR(PFNUM,BUF,128,DOUBLE(RC));                                  00514000
   IF <> THEN QUIT(4);                                                  00516000
   IF DFLAG THEN                                                        00518000
     DISPLAY(CNT)                                                       00520000
   ELSE                                                                 00522000
     MODIFY(CNT);                                                       00524000
     @SP_@SPIB;                                                         00526000
   END;                                                                 00528000
END;                                                                    00530000
