
HPAL,L,"CONFG"
BEGIN
INTEGER TR,SECT,J,I,INTN,EQTAB,INTAB,DKSC,CNSC,MASK
        ,M377 := @377
        ,SUBCHNL := 0
       ;
INTEGER ARRAY BUFF [0:260], MAP [1:12]
              ,ULBL [1:3] := "DS","GE","N "
       ;
PROCEDURE UDISC (ULBL,SUBCH);
VALUE SUBCH; INTEGER ULBL, SUBCH;   CODE;
PROCEDURE RDISC (BUFF,SIZE,TR,SECT);
VALUE SIZE,TR,SECT; INTEGER BUFF,SIZE,TR,SECT; CODE;
PROCEDURE WDISC (BUFF,SIZE,TR,SECT);
VALUE SIZE,TR,SECT; INTEGER BUFF,SIZE,TR,SECT; CODE;
PROCEDURE EXEC (BEATIT);
VALUE BEATIT; INTEGER BEATIT; CODE;
&
&     FIND USER DISK
&
     WRITE (1,#(X,"USE ONLY WITH DOS III B REV 1419"));
     WRITE (1,#(X,"ALTER DISK AND CONSOLE SELECT CODES",/,
       "INPUT USER LABEL OF CARTRIDGE YOU WISH TO PATCH"));
     READ (1,#(3A2),FOR I := 1 TO 3 DO ULBL [I]);
     WRITE (1,#(X,"SUBCHANNEL TO SEARCH ?"));
     READ (1,*,SUBCHNL);
     UDISC (ULBL [1], SUBCHNL);
&
& FIND DISC MAP ON BOOTSTRAP IN SECTORS 1,2 TRACK 0
&
     RDISC (BUFF [1], 128, 0, 2);
     FOR I := 1 TO 128 DO
         IF BUFF [I] = 2 THEN J := I;
     FOR I := 1 TO 12 DO MAP [I] := BUFF [J+I-1];
     TR := ROTATE (MAP [3]) AND M377;
     SECT := MAP [3] AND M377;
&
&    GET BASE PAGE (STARTING WITH LOC 2)
&
     RDISC (BUFF [2],128,TR,SECT);
     RDISC (BUFF [130],128,TR,SECT+1);
&
     WRITE (1,#(X,"DISK SELECT CODE =?"));
     READ (1,#(@2),DKSC);
     WRITE (1,#(X,"CONSOLE SELECT CODE =?"));
     READ (1,#(@2),CNSC);
     IF DKSC > CNSC THEN INTN := (DKSC - @4)
                         ELSE INTN := (CNSC - @5);
     BUFF [@202] := INTN;
&
&    REWRITE BASE PAGE WITH ADJUSTED NUMBER OF ENTRIES
&    IN INTERRUPT TABLE
&
     WDISC (BUFF [130],128,TR,SECT+1);
&
&     GET CORE ADDRESS OF EQT AND INT TABLES
&
     EQTAB := BUFF [@117];
     INTAB := BUFF [@201];
&
&     GET DISK ADDRESS OF I/O TABLES
&
     TR := ROTATE (MAP [9]) AND M377;
     SECT := MAP [9] AND M377;
&
&    GET I/O TABLES
&
     RDISC (BUFF [1],128,TR,SECT);
     RDISC (BUFF [120],128,TR,SECT+1);
&
&     FIND ADDR OF INT TABLE IN BUFFER
&
     J := (INTAB -EQTAB+1);
&
&    CLEAR OLD INTERRUPT ENTRIES IN CASE DOING THIS
&    A SECOND TIME
&
     FOR I := 1 TO INTN DO BUFF [J+I-1] := 0;
&
&     SET INT ENTRIES FOR EQT #1 AND #2
&     (CONSOLE AND DISK IN THAT ORDER)
&
     BUFF [J + CNSC - @6] := EQTAB;
     BUFF [J + DKSC - @5] := EQTAB + 17;
&
&     PUT NEW SELECT CODES IN EQT TABLE
&
     BUFF [3] := (BUFF [3] AND @177740) OR CNSC;
     BUFF [30] := (BUFF [20] AND @177740) OR DKSC;
&
&    WRITE I/O TABLES BACK TO DISK
&
     WDISC (BUFF [120],128,TR,SECT+1);
     FOR I := 120 TO 128 DO BUFF [I] := 0;
     WDISC (BUFF [1],128,TR,SECT);
&
&    GET PRE-BOOT PROCESSOR FROM TR = 0, SECT = 0
&    AND MODIFY FOR NEW DISK SELECT CODE
&
     RDISC (BUFF [1],128,0,0);
&
&    FIND CONTROL WORD, WHICH HAS SELECT CODE
&
     FOR I := 1 TO 128 DO
     IF ((BUFF[I] AND @177740) = @120000) THEN J := I;
     BUFF [J-1] := DKSC;
     BUFF [J] := @120000 OR DKSC;
     WDISC (BUFF [1],128,0,0);
&
      EXEC (6);
&
END;
END$


HPAL,L,P,"RDK"
PROCEDURE RDISC (BUFF,SIZE,TR,SECT);
VALUE SIZE,TR,SECT; INTEGER BUFF,SIZE,TR,SECT;
BEGIN
PROCEDURE EXEC (ICODE,UNIT,BUFF,SIZE,TR,SECT);
VALUE ICODE,UNIT,SIZE,TR,SECT;
INTEGER ICODE,UNIT,BUFF,SIZE,TR,SECT;
CODE;
INTEGER ICODE := -1, UNIT := 3;
EXEC (ICODE,UNIT,BUFF,SIZE,TR,SECT);
END;
END$


HPAL,L,P,"WDK"
PROCEDURE WDISC (BUFF,SIZE,TR,SECT);
VALUE SIZE,TR,SECT; INTEGER BUFF,SIZE,TR,SECT;
BEGIN
PROCEDURE EXEC (ICODE,UNIT,BUFF,SIZE,TR,SECT);
INTEGER ICODE,UNIT,BUFF,SIZE,TR,SECT;  CODE;
INTEGER ICODE := -2, UNIT := 3;
EXEC (ICODE,UNIT,BUFF,SIZE,TR,SECT);
END;
END&


HPAL,L,P,"UDK"
PROCEDURE UDISC (ULBL,SUBCH);
VALUE SUBCH; INTEGER ULBL, SUBCH;
BEGIN
PROCEDURE EXEC (ICODE, ULBL, SUBCH);
INTEGER ICODE, ULBL, SUBCH;  CODE;
INTEGER ICODE := 23;
EXEC (ICODE, ULBL, SUBCH);
END;
END$

