SPL,L,O,M,C 
!     NAME:    T.TRF
!     USE:     PRODUCES TRANSFER FILES USED TO BUILD BASIC OVERLAYS 
!     SYSTEM:  RTE-II AND RTE-III 
!     SOURCE:  92101-18024
!     RELOC:   92101-16024
!     PGMR:    B.J.L. 
!     DATE:    800129 
! 
!  **************************************************************** 
!  * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1975.  ALL RIGHTS      * 
!  * RESERVED.  NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED,       * 
!  * REPRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT* 
!  * THE PRIOR WRITTEN CONSENT OF HEWLETT PACKARD COMPANY.        * 
!  **************************************************************** 
! 
       NAME T.TRF(8) "92101-16024 REV.2013 800129"
! 
! 
       LET T.ENT,                           \ENTRY POINT NAMES
           T.DCB,                           \DCB BUFFER (IN MAIN) 
           T.LEN,                           \# OF OVERLAYS
           T.SUB,                           \SUBROUTINE COUNT BUFFER
           T.OVB,                           \OVERLAY NAMES BUFFER 
           T.SEC,                           \OV.DIR. SEC.CODE 
           T.CRF,                           \OV.DIR. CART.# 
           T.ERN,                           \ERROR NUMBER 
           T.BRN,                           \BRANCH TABLE 
           T.LST                            \ASCII LIST DEVICE
              BE INTEGER,EXTERNAL 
! 
       LET WRITF,                           \FMGR WRITE RECORD
           READF,                           \FMGR READ RECORD 
           RWNDF,                           \FMGR REWIND
           CNUMD                            \CONVERT BINARY TO ASCII
              BE SUBROUTINE,EXTERNAL
! 
       LET .DFER                            \3-WORD TRANSFER
              BE SUBROUTINE,DIRECT,EXTERNAL 
! 
       LET CONVT                            \CONVERT TO ASCII 
              BE SUBROUTINE 
! 
       LET WRTRC,                           \ 
           COMPR BE SUBROUTINE,DIRECT 
! 
       LET IABS                             \GET ABSOLUTE VALUE 
              BE FUNCTION,DIRECT,EXTERNAL 
! 
       LET KCVT                             \BINARY TO ASCII (2-DIG)
              BE FUNCTION,EXTERNAL
! 
       LET OVBUF,                           \OVERLAY NAMES POINTER
           ENBUF,                           \ENTRY POINTS POINTER 
           SEQU(300),                       \SEQUENCE NUMBERS 
           SEQBF,                           \SEQUENCE NUMBER POINTER
           BRBUF,                           \BRANCH TABLE POINTER 
           LGREC(4),                        \":LG,10" 
           LDREC(8),                        \":RU,LOADR,99,6,7" 
           LIST(2),                         \ASCII LIST DEVICE
           LDRC0(3),                        \ 
           LDRC1,                           \ 
           LDRC2(2),                        \ 
           MRREC(3),                        \":MR,FILNAM" 
           FNAME(3),                        \FILE NAME
           FSECS,                           \DELIMITER
           FSEC(3),                         \SECURITY CODE
           FICRS,                           \DELIMITER
           FICR(3),                         \CARTRIDGE REF. # 
           MRCAL(3),                        \":MR,CALSB"
           TRREC(2)                         \"::" 
              BE INTEGER
! 
       INITIALIZE TRREC TO 1,"::" 
       INITIALIZE LGREC TO 3,":LG,10" 
       INITIALIZE LDREC,LIST,LDRC0,LDRC1,LDRC2 TO\
          15,":RU,LOADR,99,    , 007,   000 " 
       INITIALIZE MRREC,FNAME,FSECS,FSEC,   \ 
          FICRS,FICR TO 13,":MR,",11(0) 
       INITIALIZE MRCAL TO "CALSB " 
! 
! 
!  THE FOLLOWING SUBROUTINE CREATES THE TRANSFER
!  FILE FOR LOADING OF THE FOREGROUND DEVICE
!  SUBROUTINE OVERLAYS.  IT WORKS WITH A BUFFER 
!  OF OVERLAY NAMES (WITH NUMBER OF SUBROUTINES IN
!  IN EACH) AND A BUFFER OF SUBROUTINE NAMES. 
! 
! 
T.TRF: SUBROUTINE DIRECT,GLOBAL 
! 
       SEQBF _ @SEQU                        !SET UP POINTERS. 
       ENBUF _ @T.ENT;  BRBUF _ @T.BRN + 1
       SZSUB _ @T.SUB;  RWNDF(T.DCB)        !REWIND FILE. 
! 
       REPEAT 300 TIMES DO                  \MOVE SEQUENCE
          [$SEQBF _ $BRBUF;                 \NUMBERS OUT
          SEQBF _ SEQBF + 1;                \OF BRANCH TABLE. 
          BRBUF _ BRBUF + 2]
! 
       I _ 0
       ALWAYS DO                            \READ IN ALL
          [READF(T.DCB,T.ERN,$ENBUF,5,J);   \THE FILE NAMES.
          IF T.ERN THEN RETURN;             \CHECK ERRORS.
          IF J = -1 THEN GOTO T.TR1;        \FINISHED?
          ENBUF _ ENBUF + 5;  I _ I + 1]    !NO - CONTINUE. 
! 
T.TR1: ENBUF _ @T.ENT;  L _ 0               !RESET POINTER. 
       SEQBF _ @SEQU
       REPEAT T.LEN TIMES DO [              \FOR EACH OVERLAY 
T.TR4:    IFNOT $SZSUB THEN [               \BYPASS UNUSED
          SZSUB _ SZSUB + 1;  GOTO T.TR4];  \OVERLAY NUMBERS. 
          IF [I _ $SZSUB AND  77K] > 1 THEN[\DO THE FOLLOWING:
             FOR J _ (L+1) TO (L+I-1) DO    \CHECK FOR DUPLICATE
                [FOR K _ L TO (J-1) DO      \FILE NAMES AND 
                   [COMPR]]];               \MARK THEM. 
          SZSUB _ SZSUB + 1;  L _ L + I]    !ADVANCE TO NEXT OVERLAY. 
! 
       RWNDF(T.DCB);  SZSUB _ @T.SUB        !REWIND FILE. 
! 
       I _ 0;  OVBUF _ @T.OVB               !FIX UP RECORDS TO
T.TR2: WRTRC(LGREC) ? [RETURN]              !LOAD EACH OVERLAY. 
       CONVT(T.SEC,T.CRF)                   !CONVERT CODES. 
T.TR3: IFNOT $SZSUB THEN [                  \BYPASS UNUSED
          SZSUB _ SZSUB + 1;  GOTO T.TR3]   !OVERLAY NUMBERS. 
       .DFER(FNAME,$OVBUF)                  !CREATE MR OF OVER- 
       WRTRC(MRREC) ? [RETURN]              !LAY DIRECTORY. 
       REPEAT ($SZSUB AND  77K) TIMES DO [  \CREATE MR RECORDS. 
          BRBUF _ 5 * $SEQBF + @T.ENT;      \GET RIGHT NAME.
          IF $BRBUF THEN [                  \IF NAME UNIQUE,
             .DFER(FNAME,$BRBUF);           \MOVE IN NAME.
             CONVT($(BRBUF+3),$(BRBUF+4));  \CONVERT CODES. 
             WRTRC(MRREC) ? [RETURN]];      \WRITE RECORD.
          SEQBF _ SEQBF + 1]                !INCREMENT POINTER. 
       LDRC1 _ KCVT(($SZSUB -> 6) AND  77K)  !LOADER PAGE SIZE. 
! SET LOADER OPTION 
       IF(($SZSUB -<4)AND 7K)=0 THEN[LDRC0(2)_(KCVT(6)AND 77K)OR 30000K]
       IF(($SZSUB -<4)AND 7K)=1 THEN[LDRC0(2)_(KCVT(5)AND 77K)OR 30000K]
       IF(($SZSUB -<4)AND 7K)=2 THEN[LDRC0(2)_(KCVT(8)AND 77K)OR 30000K]
       IF(($SZSUB -<4)AND 7K)=3 THEN[LDRC0(2)_(KCVT(0)AND 77K)OR 30000K]
       IF(($SZSUB -<4)AND 10K) THEN[LDRC0(1)_(KCVT(1)AND 77K)OR 20000K] 
       OVBUF _ OVBUF + 3                    !INCREMENT POINTER. 
       SZSUB _ SZSUB + 1
       LIST(1) _ T.LST                      !LIST DEVICE 800119 
       WRTRC(LDREC) ? [RETURN]              !WRITE RU RECORD. 
       LDRC0(1) _ 0                         ! ADDED 800119
       I _ I + 1
       IF I < T.LEN THEN GOTO T.TR2 
! 
       WRTRC(TRREC)                         !WRITE "::" 
       RETURN 
       END
! 
! 
WRTRC: SUBROUTINE(BUF) DIRECT,FEXIT 
       LET BUF BE INTEGER 
       WRITF(T.DCB,T.ERN,$(@BUF+1),BUF) 
       IF T.ERN THEN FRETURN
       RETURN 
       END
! 
! 
CONVT: SUBROUTINE(NUM1,NUM2)
       LET NUM1,NUM2 BE INTEGER 
       .A. _ NUM1 
       CNUMD(IABS,FSEC)                     !CONVERT SECURITY CODE. 
       IF NUM1 < 0 THEN FSECS _ ":-",       \COMPENSATE FOR 
          ELSE FSECS _ ": "                 !NEGATIVE NUMBER. 
       .A. _ NUM2 
       CNUMD(IABS,FICR)                     !CONVERT CART. #. 
       IF NUM2 < 0 THEN FICRS _ ":-",       \COMPENSATE FOR 
          ELSE FICRS _ ": "                 !NEGATIVE NUMBER. 
       RETURN 
       END
! 
! 
COMPR: SUBROUTINE DIRECT,FEXIT
       BRBUF _ ENBUF + 5 * $(SEQBF+J) 
       OVBUF _ ENBUF + 5 * $(SEQBF+K)       !COMPARE TWO FIVE-
       REPEAT 5 TIMES DO [                  \WORD ARRAYS AND
          IF $BRBUF # $OVBUF THEN RETURN;   \MARK ONE OF THEM 
          BRBUF _ BRBUF + 1;                \WITH A ZERO IF 
          OVBUF _ OVBUF + 1]                !THEY MATCH.
       $(OVBUF-5) _ 0 
       RETURN 
       END
! 
! 
       END
       END$