$CONTROL MAP,CODE,USLINIT                                               00010000
<<SLPATCH>>                                                             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 MAIN=SLPATCH,PRIVILEGED                                       00028000
$ TITLE "            SL PATCH UTILITY"                                  00030000
BEGIN                                                                   00032000
                                                                        00034000
<<----------------------------------------------------------------------00036000
*                                                                      *00038000
*                           SL FILE PATCHER                            *00040000
*                                                                      *00042000
*                                CU.06                                 *00044000
*                                                                      *00046000
---------------------------------------------------------------------->>00048000
                                                                        00050000
DEFINE                                                         <<01.01>>00052000
PTITLE=("SLPATCH C.00.00 (C) HEWLETT-PACKARD CO., 1976")#;              00054000
                                                                        00056000
INTEGER XREG = X;                                                       00058000
INTEGER S0 = S-0;                                                       00060000
BYTE POINTER BPS0 = S-0;                                                00062000
                                                                        00064000
ARRAY PROMPT (0:0) _ "? ";                                              00066000
ARRAY MSG2 (0:4) _ "SL FILE?  ";                                        00068000
ARRAY MSG3 (0:6) _ "SEGMENT NAME? ";                                    00070000
ARRAY MSG4 (0:7) := "ILLEGAL COMMAND ";                                 00072000
ARRAY MSG5 (0:10) := "SEGMENT NOT SPECIFIED ";                          00074000
ARRAY MSG6 (0:9) _ "ILLEGAL SEGMENT NAME";                              00076000
ARRAY MSG7 (0:7) := "INVALID SL FILE ";                                 00078000
ARRAY MSG8 (0:6) _ "ILLEGAL RANGE ";                                    00080000
ARRAY MSG9 (0:6) _ "ILLEGAL NUMBER";                                    00082000
ARRAY MSG10 (0:9) := "*** END-OF-FILE *** ";                            00084000
ARRAY MSG11 (0:8) := "*** I/O ERROR *** ";                              00086000
ARRAY MSG12 (0:7) := "FILE ERROR =    ";                                00088000
                                                                        00090000
ARRAY TTY (0:35);                                                       00092000
BYTE ARRAY BTTY (*) = TTY;                                              00094000
BYTE ARRAY DELIMS (0:1) _ ",",%15;  <<COMMAND DELIMITERS>>              00096000
INTEGER NRPARMS;                                                        00098000
DOUBLE ARRAY DESCRIP (0:3)=DB;                                          00100000
DOUBLE DESCRIP1 = DESCRIP+0;                                            00102000
BYTE POINTER IDENT1 = DESCRIP1;                                         00104000
INTEGER INFO1 = IDENT1+1;                                               00106000
BYTE LEN1 = INFO1;                                                      00108000
DOUBLE DESCRIP2 = DESCRIP+2;                                            00110000
BYTE POINTER IDENT2 = DESCRIP2;                                         00112000
INTEGER INFO2 = IDENT2+1;                                               00114000
BYTE LEN2 = INFO2;                                                      00116000
DOUBLE DESCRIP3 = DESCRIP+4;                                            00118000
BYTE POINTER IDENT3 = DESCRIP3;                                         00120000
INTEGER INFO3 = IDENT3+1;                                               00122000
BYTE LEN3 = INFO3;                                                      00124000
DOUBLE DESCRIP4 = DESCRIP+6;                                            00126000
BYTE POINTER IDENT4 = DESCRIP4;                                         00128000
INTEGER INFO4 = IDENT4+1;                                               00130000
BYTE LEN4 = INFO4;                                                      00132000
                                                                        00134000
EQUATE SLFILECODE = 1031,  <<FILE CODE>>                                00136000
       SLVERSION = 3;  <<LATEST VERSION NR.>>                           00138000
INTEGER SLFNUM;  <<SL FILE NR.>>                                        00140000
INTEGER ARRAY SLREC0 (0:127);  <<SL FILE RECORD 0>>                     00142000
INTEGER ARRAY SLREC1 (0:127);  <<SL FILE RECORD 1>>                     00144000
INTEGER SLNRT;  <<NR. REFERENCE TABLE ENTRIES>>                         00146000
INTEGER ARRAY RTBUF (0:127);  <<REFERENCE TABLE BUFFER>>                00148000
INTEGER POINTER RTP;  <<REFERENCE TABLE ENTRY POINTER>>                 00150000
DOUBLE DRTRECD := 0D;  <<REFERENCE TABLE REC. NR.>>                     00152000
INTEGER RTRECD = DRTRECD+1;                                             00154000
BYTE ARRAY SEGNAME (0:15);  <<SEGMENT NAME>>                            00156000
INTEGER SEGNR := -1;  <<SEGMENT NR.>>                                   00158000
INTEGER SEGLEN;  <<SEGMENT LENGTH>>                                     00160000
INTEGER SEGRECD;  <<STARTING RECORD NR.>>                               00162000
                                                                        00164000
INTEGER I;                                                              00166000
LOGICAL MODIFY;                                                         00168000
INTEGER ARRAY BUF (*) = SLREC0;  <<RECORD BUFFER>>                      00170000
INTEGER ADR;  <<SEGMENT ADDRESS>>                                       00172000
INTEGER COUNT;  <<NR. WORDS REQUESTED>>                                 00174000
DOUBLE DRECD _ 0D;                                                      00176000
INTEGER RECD = DRECD+1;                                                 00178000
INTEGER DISP;                                                           00180000
   EQUATE VUF'COL=4;  << VUF COLUMN NUMBER >>                  <<04542>>00182000
$INCLUDE INCLVUF                                               <<04542>>00184000
INTRINSIC QUIT;                                                         00186000
INTRINSIC FOPEN,FCLOSE,FREADDIR,FWRITEDIR,FCHECK,FGETINFO,FLOCK;        00188000
INTRINSIC READ,PRINT,MYCOMMAND,ASCII,BINARY;                            00190000
                                                                        00192000
PROCEDURE IOERROR;                                                      00194000
   BEGIN                                                                00196000
   IF <> THEN  <<ERROR?>>                                               00198000
      BEGIN                                                             00200000
      IF > THEN  <<END OF FILE?>>                                       00202000
         BEGIN                                                          00204000
         TOS := @MSG10;                                                 00206000
         TOS := -19                                                     00208000
         END                                                            00210000
      ELSE  <<I/O ERROR>>                                               00212000
         BEGIN                                                          00214000
         TOS := @MSG11;                                                 00216000
         TOS := -17                                                     00218000
         END;                                                           00220000
      PRINT(*,*,0);                                                     00222000
      QUIT(0)                                                           00224000
      END                                                               00226000
   END;                                                                 00228000
PROCEDURE FERROR;                                                       00230000
   BEGIN                                                                00232000
   IF <> THEN  <<ERROR?>>                                               00234000
      BEGIN                                                             00236000
      TOS := @MSG12;                                                    00238000
      TOS := 0;  <<FOR RESULT OF ASCII>>                                00240000
      TOS := 0; FCHECK(SLFNUM,S0);  <<ERROR NR.>>                       00242000
      TOS := 10;  <<CONVERSION BASE>>                                   00244000
      TOS := @MSG12&LSL(1)+13;                                          00246000
      TOS := ASCII(*,*,*);  <<CONVERT ERROR NR.>>                       00248000
      TOS := -TOS-13;                                                   00250000
      PRINT(*,*,0);                                                     00252000
      IOERROR;  <<ERROR?>>                                              00254000
      QUIT(1);                                                          00256000
      END                                                               00258000
   END;                                                                 00260000
LOGICAL PROCEDURE GETNUM (NUM,STRING,LENGTH);                           00262000
   VALUE LENGTH;                                                        00264000
   INTEGER NUM,LENGTH;                                                  00266000
   BYTE ARRAY STRING;                                                   00268000
   BEGIN                                                                00270000
   INTEGER RESULT = GETNUM;                                             00272000
   @STRING _ @STRING-1;                                                 00274000
   STRING _ "%";  <<FORCE OCTAL CONVERSION>>                            00276000
   LENGTH _ LENGTH+1;                                                   00278000
   NUM _ BINARY(STRING,LENGTH);                                         00280000
   IF <> THEN  <<ERROR?>>                                               00282000
      BEGIN                                                             00284000
      PRINT(MSG9,-14,0);  <<"ILLEGAL NUMBER">>                          00286000
      IOERROR;  <<ERROR?>>                                              00288000
      RETURN                                                            00290000
      END;                                                              00292000
   RESULT := RESULT+1  <<RETURN TRUE>>                                  00294000
   END;                                                                 00296000
PROCEDURE GETREFTABENTRY (SEGNR);                                       00298000
   VALUE SEGNR;                                                         00300000
   INTEGER SEGNR;                                                       00302000
   BEGIN                                                                00304000
   TOS := SEGNR; TOS := 4;                                              00306000
   ASSEMBLE(DIV,STBX);                                                  00308000
   @RTP := (TOS&LSL(5))+@RTBUF;                                         00310000
   TOS := SLREC1(XREG);  <<REC. NR.>>                                   00312000
   IF S0 <> RTRECD THEN  <<DIFFERENT RECORD?>>                          00314000
      BEGIN                                                             00316000
      RTRECD := TOS;                                                    00318000
      FREADDIR(SLFNUM,RTBUF,128,DRTRECD);                               00320000
      FERROR  <<ERROR?>>                                                00322000
      END;                                                              00324000
   SEGLEN _ RTP.(2:14);  <<SEGMENT LENGTH>>                             00326000
   SEGRECD _ RTP(1)  <<STARTING RECORD NR.>>                            00328000
   END;                                                                 00330000
INTEGER PROCEDURE SEARCHSEGNAME;                                        00332000
   BEGIN                                                                00334000
   TOS := SLNRT-1;                                                      00336000
   WHILE >= DO                                                          00338000
      BEGIN                                                             00340000
      GETREFTABENTRY(S0);                                               00342000
      IF NOT LOGICAL(RTP(3).(0:1)) THEN  <<NOT DELETED?>>               00344000
         BEGIN                                                          00346000
         TOS := @RTP(8)&LSL(1);                                         00348000
         IF * = SEGNAME,(16) THEN GO GETOUT                             00350000
         END;                                                           00352000
      TOS := TOS-1                                                      00354000
      END;                                                              00356000
   GETOUT:                                                              00358000
   SEARCHSEGNAME := TOS  <<SEG. NR.>>                                   00360000
   END;                                                                 00362000
PROCEDURE LOADBUFFER;                                                   00364000
   BEGIN                                                                00366000
   FREADDIR(SLFNUM,BUF,128,DRECD);  <<READ FIRST RECORD>>               00368000
   FERROR  <<ERROR?>>                                                   00370000
   END;                                                                 00372000
PROCEDURE STOREBUFFER;                                                  00374000
   BEGIN                                                                00376000
   IF MODIFY THEN  <<BUFFER MODIFIED?>>                                 00378000
      BEGIN                                                             00380000
      FWRITEDIR(SLFNUM,BUF,128,DRECD);                                  00382000
      FERROR  <<ERROR?>>                                                00384000
      END                                                               00386000
   END;                                                                 00388000
                                                                        00390000
<<* * * PRIMARY ENTRY POINT * * *>>                                     00392000
                                                                        00394000
GO OB1;                                                                 00396000
                                                                        00398000
<<* * * SECONDARY ENTRY POINT * * *>>                                   00400000
                                                                        00402000
                                                                        00404000
OB1: MOVE TTY := PTITLE,2;                                     <<01.01>>00406000
   MOVE TTY(VUF'COL):=OFFICIAL'VUUFF;                          <<04542>>00408000
   PRINT(TTY,(S0 := S0-@TTY),0);                               <<01.01>>00410000
IOERROR;  <<ERROR?>>                                                    00412000
                                                                        00414000
<<* * * GET SL FILE NAME * * *>>                                        00416000
                                                                        00418000
OB2:                                                                    00420000
PRINT(MSG2,-9,%320);  <<"SL FILE?">>                                    00422000
IOERROR;  <<ERROR?>>                                                    00424000
TOS _ READ(TTY,-72);  <<READ SL FILE NAME>>                             00426000
IOERROR;  <<ERROR?>>                                                    00428000
XREG := TOS; IF = THEN GO OB2;  <<ZERO CHAR. COUNT?>>                   00430000
BTTY(XREG) := %15;  <<INSERT CR STOPPER>>                               00432000
MYCOMMAND(BTTY,DELIMS(1),1,NRPARMS,DESCRIP);                            00434000
IF > THEN  <<ERROR?>>                                                   00436000
   BEGIN                                                                00438000
   PRINT(MSG4,-16,0);  <<"ILLEGAL COMMAND">>                            00440000
   GO OB2                                                               00442000
   END;                                                                 00444000
                                                                        00446000
<<* * * OPEN SL FILE * * *>>                                            00448000
                                                                        00450000
SLFNUM := FOPEN(IDENT1,%(2)00000000011,%(2)111110110);                  00452000
FERROR;  <<ERROR?>>                                                     00454000
FLOCK(SLFNUM,TRUE);  <<GET FILE EXCLUSIVELY>>                           00456000
FREADDIR(SLFNUM,SLREC0,256,0D);  <<READ RECORDS 0,1>>                   00458000
FERROR;  <<ERROR?>>                                                     00460000
TOS := 0;                                                               00462000
FGETINFO(SLFNUM,,,,,,,,S0);                                             00464000
IF TOS <> SLFILECODE OR SLREC0 <> SLVERSION THEN                        00466000
   BEGIN                                                                00468000
   PRINT(MSG7,-15,0);  <<"INVALID SL FILE">>                            00470000
   IOERROR;  <<ERROR?>>                                                 00472000
   GO OB2                                                               00474000
   END;                                                                 00476000
SLNRT _ SLREC0(9);  <<NR. REFERENCE TABLE ENTRIES>>                     00478000
                                                                        00480000
<<* * * PROCESS COMMAND * * *>>                                         00482000
                                                                        00484000
OB3:                                                                    00486000
PRINT(PROMPT,-1,%320);  <<PROMPT = "?">>                                00488000
IOERROR;  <<ERROR?>>                                                    00490000
TOS := READ(TTY,-72);  <<READ COMMAND>>                                 00492000
IOERROR;  <<ERROR?>>                                                    00494000
XREG := TOS; IF = THEN GO OB3;  <<ZERO CHAR. COUNT?>>                   00496000
BTTY(XREG) := %15;  <<INSERT CR STOPPER>>                               00498000
MYCOMMAND(BTTY,DELIMS,4,NRPARMS,DESCRIP);                               00500000
IF > THEN  <<ERROR?>>                                                   00502000
   BEGIN                                                                00504000
   ERROR4:                                                              00506000
   PRINT(MSG4,-16,0);  <<"ILLEGAL COMMAND">>                            00508000
   GO OB3                                                               00510000
   END;                                                                 00512000
                                                                        00514000
IF IDENT1 = "EXIT" AND INTEGER(LEN1) = 4 AND NRPARMS = 1 THEN           00516000
   GO FINISHED;                                                         00518000
IF NOT (2 <= NRPARMS <= 4) THEN GO ERROR4;                              00520000
                                                                        00522000
<< * * * GET SEGMENT NAME * * *>>                                       00524000
                                                                        00526000
IF IDENT2 = ALPHA AND NRPARMS >= 3 THEN  <<NEW SEGMENT?>>               00528000
   BEGIN                                                                00530000
   IF LEN1 > 15 THEN GO ERROR1;  <<TOO LONG?>>                          00532000
   MOVE SEGNAME := IDENT1,(INTEGER(LEN1)),2;  <<SEGMENT NAME>>          00534000
   BPS0 := " "; ASSEMBLE(DUP,INCB);                                     00536000
   MOVE * := *,(15-INTEGER(LEN1));  <<TRAILING BLANKS>>                 00538000
   TOS := SEARCHSEGNAME;                                                00540000
   ASSEMBLE(TEST);                                                      00542000
   IF < THEN  <<CAN'T FIND SEGMENT?>>                                   00544000
      BEGIN                                                             00546000
      DEL;                                                              00548000
      ERROR1:                                                           00550000
      PRINT(MSG6,-20,0);  <<"ILLEGAL SEGMENT NAME">>                    00552000
      IOERROR;  <<ERROR?>>                                              00554000
      IF SEGNR <> -1 THEN GETREFTABENTRY(SEGNR);  <<RESTORE OLD SEG.>>  00556000
      GO OB3                                                            00558000
      END;                                                              00560000
   SEGNR := TOS;  <<SEGMENT NR.>>                                       00562000
   TOS := @DESCRIP1; TOS := @DESCRIP2; TOS := 6;                        00564000
   ASSEMBLE(MOVE 3);                                                    00566000
   NRPARMS := NRPARMS-1                                                 00568000
   END;                                                                 00570000
IF SEGNR = -1 THEN  <<SEGMENT NOT SPECIFIED?>>                          00572000
   BEGIN                                                                00574000
   PRINT(MSG5,-21,0);  <<"SEGMENT NOT SPECIFIED">>                      00576000
   IOERROR;  <<ERROR?>>                                                 00578000
   GO OB3                                                               00580000
   END;                                                                 00582000
                                                                        00584000
IF INTEGER(LEN1) <> 1 THEN GO ERROR4;                                   00586000
IF IDENT1 = "D" THEN  <<DUMP CELLS?>>                                   00588000
   BEGIN                                                                00590000
   TOS := FALSE;  <<CLEAR MODIFY FLAG>>                                 00592000
   LOOP:                                                                00594000
   MODIFY := TOS;  <<MODIFY FLAG>>                                      00596000
   IF NOT GETNUM(ADR,IDENT2,INTEGER(LEN2)) THEN GO OB3;                 00598000
   IF NRPARMS = 3 THEN  <<OPTIONAL COUNT?>>                             00600000
      IF NOT GETNUM(COUNT,IDENT3,INTEGER(LEN3)) THEN GO OB3             00602000
      ELSE                                                              00604000
   ELSE COUNT _ 1;  <<DEFAULT COUNT = 1>>                               00606000
   IF ADR >= SEGLEN OR ADR+COUNT-1 >= SEGLEN THEN                       00608000
      BEGIN                                                             00610000
      ERROR8:                                                           00612000
      PRINT(MSG8,-13,0);  <<"ILLEGAL RANGE">>                           00614000
      IOERROR;  <<ERROR?>>                                              00616000
      GO OB3                                                            00618000
      END;                                                              00620000
   RECD _ SEGRECD+ADR.(0:9);  <<STARTING RECORD NR.>>                   00622000
   DISP _ ADR.(9:7);  <<STARTING RECORD DISPLACEMENT>>                  00624000
   LOADBUFFER;  <<READ FIRST RECORD>>                                   00626000
   TOS _ COUNT;  <<WORD COUNTER>>                                       00628000
   WHILE <> DO                                                          00630000
      BEGIN                                                             00632000
      TRYAGAIN:                                                         00634000
      ASCII(BUF(DISP),8,BTTY);  <<CURRENT CONTENTS>>                    00636000
      IF MODIFY THEN  <<MODIFY CONTENTS?>>                              00638000
         BEGIN                                                          00640000
         MOVE BTTY(6) _ " _ ";                                          00642000
         PRINT(TTY,-9,%320);                                            00644000
         IOERROR;  <<ERROR?>>                                           00646000
         TOS := READ(TTY,-72);                                          00648000
         IOERROR;  <<ERROR?>>                                           00650000
         XREG := TOS; IF = THEN GO TRYAGAIN;  <<ZERO CHAR. COUNT?>>     00652000
         BTTY(XREG) := %15;  <<INSERT CR STOPPER>>                      00654000
         MYCOMMAND(BTTY,DELIMS(1),1,NRPARMS,DESCRIP);                   00656000
         IF > THEN  <<ERROR?>>                                          00658000
            BEGIN                                                       00660000
            PRINT(MSG9,-14,0);  <<"ILLEGAL NUMBER">>                    00662000
            IOERROR;  <<ERROR?>>                                        00664000
            GO TRYAGAIN                                                 00666000
            END;                                                        00668000
         IF IDENT1 <> "*" OR INTEGER(LEN1) <> 1 THEN                    00670000
            BEGIN                                                       00672000
            IF NOT GETNUM(I,IDENT1,INTEGER(LEN1)) THEN GO TRYAGAIN;     00674000
            BUF(DISP) _ I  <<MODIFY CONTENTS>>                          00676000
            END                                                         00678000
         END                                                            00680000
      ELSE  <<PRINT CONTENTS>>                                          00682000
         BEGIN                                                          00684000
         PRINT(TTY,-6,0);  <<PRINT NUMBER>>                             00686000
         IOERROR  <<ERROR?>>                                            00688000
         END;                                                           00690000
      DISP _ (DISP+1).(9:7);                                            00692000
      IF = THEN  <<REFIL BUFFER?>>                                      00694000
         BEGIN                                                          00696000
         STOREBUFFER;  <<SAVE RECORD>>                                  00698000
         RECD _ RECD+1;                                                 00700000
         LOADBUFFER  <<READ NEXT RECORD>>                               00702000
         END;                                                           00704000
      TOS := TOS-1                                                      00706000
      END;                                                              00708000
   DEL;                                                                 00710000
   STOREBUFFER;  <<SAVE LAST RECORD>>                                   00712000
   GO OB3                                                               00714000
   END;                                                                 00716000
                                                                        00718000
IF IDENT1 = "M" THEN  <<MODIFY CELLS?>>                                 00720000
   BEGIN                                                                00722000
   TOS := TRUE;  <<SET MODIFY FLAG>>                                    00724000
   GO LOOP                                                              00726000
   END;                                                                 00728000
                                                                        00730000
GO ERROR4;  <<ILLEGAL COMMAND?>>                                        00732000
                                                                        00734000
FINISHED:                                                               00736000
END;                                                                    00738000
