SPL,L,O,M,C 
!     NAME:    T.TRF
!     USE:     PRODUCES TRANSFER FILES USED TO BUILD BASIC OVERLAYS 
!     SYSTEM:  RTE-IV 
!     SOURCE:  92101-18023
!     RELOC:   92101-16023
!     PGRM:    B.J.L. 
!     DATE:    800119 
! 
!  **************************************************************** 
!  * (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-16023 REV.2013 800119"
! REV. 1926 CHANGED THE RU,LOADR TO RU,LOADR:IH FOR 
! SESSION MONITOR.
! 
! ADDED NEW LIST CAPABILITY AS IN L  800116 
! 
       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 
           LDREC(12),                       \":RU,LOADR:IH,,##.RTG,"
           LIST(3),                         \ LIST DEVICE FROM RUN STRING 
           OPCOD(3),                        \OPCODE 
           FRMAT(3),                        \FORMAT 
           SIZE,                            \SIZE 
           MRREC(2),                        \" :" 
           DUREC(2),                        \DU, OR ST, 
           FNAME(3),                        \FILE NAME
           FSECS,                           \DELIMITER
           FSEC(3),                         \SECURITY CODE
           FICRS,                           \DELIMITER
           FICR(3),                         \CARTRIDGE REF. # 
           TPREC(8),                        \",##.RTG,BR" 
           PUREC(6),                        \":PU,##.RTG" 
           TRREC(2)                         \"::" 
              BE INTEGER
! 
       INITIALIZE TRREC TO 1,"::" 
       INITIALIZE LDREC,LIST,OPCOD,FRMAT,SIZE  TO\
          21,":RU,LOADR:IH,,##.RTG,     ,     ,     ,,  " 
       INITIALIZE MRREC,DUREC,FNAME,FSECS,FSEC,   \ 
          FICRS,FICR,TPREC TO 22,": ",1(0),", ",11(0),\ 
          ",##.RTG,BR",1(0),",99 "
       INITIALIZE PUREC TO 5,":PU,##.RTG" 
! 
! 
!  THE CONTROL FORMAT FOR THE EACH OVERLAY IS AS FOLLOWS: 
! 
!      +-----------------------------------------------+
!      !15!14!13!12!11!10! 9! 8! 7! 6! 5! 4! 3! 2! 1! 0!
!      +-----------------------------------------------+
!      \OPTION    /\ PAGE  SIZE     /\  SUBROUTINE CT / 
! 
! 
! 
!  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
       WRTRC(PUREC) ? [RETURN]              !WRITE :PU,##.RTG 
T.TR2: 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- 
       DUREC(1)_"ST"                        !SET TO FMGR :ST COMMAND
       TPREC(6),TPREC(7),TPREC(8) _"  "    !CLEAR OUT APPEND
       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. 
             DUREC(1)_"DU";                 \SET TO FMGR :DU COMMAND
             TPREC(6)_",2";                 \SET TO APPEND FILE 
             TPREC(7)_", ";                 \SET TO APPEND FILE 
             TPREC(8)_"99";                 \SET TO APPEND FILE 
             WRTRC(MRREC) ? [RETURN]];      \WRITE RECORD.
          SEQBF _ SEQBF + 1]                !INCREMENT POINTER. 
       SIZE    _ KCVT(($SZSUB -> 6) AND  77K)  !LOADER PAGE SIZE. 
       IF(($SZSUB-<4)AND 7K)=0 THEN[OPCOD(1)_"RT";FRMAT(1)_"PE"] !RT PERM 
       IF(($SZSUB-<4)AND 7K)=1 THEN[OPCOD(1)_"RT";FRMAT(1)_"TE"] !RT TEMP 
       IF(($SZSUB-<4)AND 7K)=2 THEN[OPCOD(1)_"BG";FRMAT(1)_"PE"] !BG PERM 
       IF(($SZSUB-<4)AND 7K)=3 THEN[OPCOD(1)_"BG";FRMAT(1)_"TE"] !BG TEMP 
       IF(($SZSUB-<4)AND 10K)THEN[OPCOD(2)_"SS"]  ! SET SSGA FLAG 
       OVBUF _ OVBUF + 3                    !INCREMENT POINTER. 
       SZSUB _ SZSUB + 1
       LIST(1) _ T.LST
       WRTRC(LDREC) ? [RETURN]              !WRITE RU RECORD. 
       WRTRC(PUREC) ? [RETURN]              !WRITE PURGE RECORD 
       OPCOD(2) _ 0                         ! ZERO SS STRING
       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$ 
                                                                                                                                                                                                                      