SPL,L,O,M,C 
!     NAME:    RTETG
!     SOURCE:  92101-18008
!     RELOC:   92101-16008
!     PGMR:    B.J.L. 
! 
!  **************************************************************** 
!  * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979.  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 RTETG(3,99) "92101-16008 REV.2013 800129" 
! 
! 
! 
       LET T.ENT(900),                      \ENTRY POINT BUFFER 
           T.BRN(525),                      \BRANCH TABLE BUFFER
           T.COM(75),                       \COMMAND BUFFER 
           T.OVB(96),                       \MNTBL AND OVERLAY BUFFER 
           T.FIL(8),                        \FILE NAME BUFFER 
           T.DCB(144),                      \DCB BUFFER 
           T.BAD,                           \BRANCH TABLE ADDRESS 
           T.SUB(32),                       \SUBROUTINE COUNT BUFFER
           T.ERN,                           \ERROR CODE 
           T.PRI,                           \PRIORITY FOR OVERLAYS
           T.SEC,                           \SCODE FOR OVERLAY DIRECTS. 
           T.CRF,                           \CR REF # FOR OVERLAYS
           T.MAD,                           \MNEMONIC TABLE ADDRESS 
           T.EAD,                           \ENTRY POINT TABLE ADDRESS
           T.LEN,                           \LINE LENGTH, # ENTRIES 
           T.CON,                           \CONTROL WORD 
           T.IDL,                           \ID LETTER
           T.LST                            \ASCII LIST DEVICE
              BE INTEGER,GLOBAL 
! 
       LET CMDCB(16),                       \COMMAND DCB SAVE 
           BRDCB(16),                       \BRANCH TABLE DCB SAVE
           MNDCB(16),                       \MNEMONIC TABLE DCB SAVE
           TRDCB(16),                       \TRANSFER FILE DCB SAVE 
           FMERR(18),                        \FMGR ERROR TABLE
           T.ERR(18),                        \RTETG ERROR TABLE 
\ 
\  THE FOLLOWING DECLARATIONS SHOULD STAY IN THIS ORDER.
\ 
           BRNAM(3),                        \BRANCH FILE NAME 
           BRSEC,                           \BRANCH SECURITY CODE 
           BRICR,                           \BRANCH CARTRIDGE ID
           MNNAM(3),                        \MNEMONIC TABLE NAME
           MNSEC,                           \MNEMONIC SECURITY CODE 
           MNICR,                           \MNEMONIC CARTRIDGE ID
           TRNAM(3),                        \TRANSFER FILE NAME 
           TRSEC,                           \TRANSFER SECURITY CODE 
           TRICR,                           \TRANSFER CARTRIDGE ID
           SAVE,                            \TEMPORARY
           ADDR,                            \TEMPORARY
           MIN1,                            \SAVE FOR SORT
           MIN2,                            \SAVE FOR SORT
           ER(5),                           \END MESSAGE
           RA(7),                           \ABORT MESSAGE
           FLAG,                            \FLAG FOR NO SEGMENT
           NS(13),                          \NO SEGMENT MESSAGE 
           SUBN,                            \SUBROUTINE # 
           OVLAY,                           \OVERLAY #
           CMNAM(3),                        \COMMAND NAME 
           CMSEC,                           \COMMAND SECURITY CODE
           CMICR                            \COMMAND CRN# 
              BE INTEGER
! 
       LET A BE CONSTANT(0) 
! 
       LET .DFER,T.PAR                      \3-WORD TRANSFER
              BE SUBROUTINE,DIRECT,EXTERNAL 
! 
       LET T.LNK BE SUBROUTINE,EXTERNAL 
! 
       INITIALIZE FMERR TO -1,-2,-3,-4,-5,  \ 
          -6,-7,-8,-11,-12,-13,-14,-15,-16, \ 
          -17,-19,-32,-33 
       INITIALIZE T.ERR TO 10,15,18,19,20,  \ 
          16,14,12,21,22,13,11,9,23,        \ 
          17,24,25,26 
       INITIALIZE T.ERN,BRSEC,BRICR,MNSEC,  \ 
          MNICR,TRSEC,TRICR,CMSEC,CMICR,    \ 
          FLAG TO 10(0) 
       INITIALIZE ER TO "$END RTETG"
       INITIALIZE RA TO "$RTETG ABORTED"
       INITIALIZE NS TO "RTETG'S SEGMENT NOT FOUND" 
       INITIALIZE T.SUB TO 32(0)
! 
       LET READF,                           \FMGR READ RECORD 
           WRITF,                           \FMGR WRITE RECORD
           CREAT,                           \FMGR CREAT FILE
           OPEN,                            \ 
           CLOSE,                           \FMGR CLOSE FILE
           PURGE,                           \FMGR PURGE FILE
           RWNDF,                           \FMGR REWIND
           POST,                            \POST DCB BUFFER
           EXEC                             \RTE SYSTEM CALLS 
              BE SUBROUTINE,EXTERNAL
! 
!  THE FOLLOWING SUBROUTINE MOVES A 16-WORD BLOCK FROM
!  BUFR1 TO BUFR2.
! 
MOVE:  SUBROUTINE(BUFR1,BUFR2)
       LET BUFR1,BUFR2 BE INTEGER 
       SAVE _ @BUFR2;  ADDR _ @BUFR1        !SET BUFFER POINTERS. 
       REPEAT 16 TIMES DO [                 \DO THE MOVE. 
          $SAVE _ $ADDR;  $ADDR _ 0;        \CLEAR OUT ORIGINAL 
          ADDR _ ADDR + 1;                  \BUFFER IN THE
          SAVE _ SAVE + 1]                  !PROCESS. 
       RETURN 
       END
! 
! 
! 
SAVBF: SUBROUTINE(DCBBF) DIRECT 
       LET DCBBF BE INTEGER 
       POST(T.DCB)
       MOVE(T.DCB,DCBBF)
       RETURN 
       END
! 
! 
!  THE FOLLOWING SUBROUTINE CHECKS FOR ERRORS AND 
!  TRANSLATES A FMGR ERROR TO AN RTETG ERROR CODE 
!  IF NECESSARY.  THEN IT PRINTS THE ERROR.  IT ALSO
!  SETUPS FOR PURGING ANY CREATED FILES, CLOSING
!  OTHERS, AND PRINTING AN ERROR MESSAGE IF ONE OF
!  RTETG'S SEGMENTS CANNOT BE FOUND.
! 
T.ERC: SUBROUTINE DIRECT,FEXIT,GLOBAL 
       IF FLAG #0 THEN GOTO NOSEG           !CHECK FOR NO SEG. CONDITION
       IFNOT T.ERN THEN RETURN              !RETURN IF ERROR=0. 
       SAVE _ @FMERR;  ADDR _ @T.ERR        !SET UP POINTERS. 
       IF T.ERN > 0 THEN GOTO T.ER1         !IF FMGR ERROR, 
       REPEAT 18 TIMES DO [                  \SEARCH THE FMGR 
          IF T.ERN = $SAVE THEN [           \ERROR TABLE. 
             T.ERN _ $ADDR;  GOTO T.ER1];   \TRANSLATE A MATCH. 
          SAVE _ SAVE + 1;                  \INCREMENT POINTERS 
          ADDR _ ADDR + 1]                  !AND LOOP.
T.ER1: SUBN_0; OVLAY_1                      !PRINT MESSAGE. 
       T.LNK(SUBN,OVLAY,FLAG) 
       IF FLAG #0 THEN GOTO NOSEG           !CHECK FOR NO SEG.
       T.ERN _ 0
       GOTO FINI
NOSEG: FLAG_0                               !CLEAR FLAG 
       EXEC(2,1,NS,13)                      !PRINT NO SEG. MESS 
FINI:  FRETURN
       END
! 
!  THE FOLLOWING SUBROUTINE CREATES A FILE AND
!  SAVES THE DCB. 
! 
CRFIL: SUBROUTINE(TYPE,DCBSV,FLNAM,FLSEC,FLICR) FEXIT 
       LET TYPE,DCBSV,FLNAM,FLSEC,FLICR BE INTEGER
       CREAT(T.DCB,T.ERN,FLNAM,10,TYPE,     \TRY CREATING THE 
          FLSEC,FLICR)                      !FILE.
       IF T.ERN > 0 THEN T.ERN _ 0
       T.ERC ? [FRETURN]                    !REPORT ANY ERRORS. 
       SAVBF(DCBSV)                         !SAVE DCB BUFFER. 
       RETURN 
       END
! 
! 
! 
CLSFL: SUBROUTINE(SVDCB)
       LET SVDCB BE INTEGER 
       MOVE(SVDCB,T.DCB)                    !RESTORE CORRECT DCB. 
       CLOSE(T.DCB,T.ERN)                   !CLOSE THE FILE.
       T.ERC
       RETURN 
       END
! 
! 
! 
PRGFL: SUBROUTINE(DCBUF,FNAM,FSEC,FICR) 
       LET DCBUF,FNAM,FSEC,FICR BE INTEGER
       CLSFL(DCBUF) 
       PURGE(T.DCB,T.ERN,FNAM,FSEC,FICR)
       IF T.ERN > 0 THEN T.ERN _ 0
       T.ERC
       RETURN 
       END
! 
!  SUBROUTINE TO CLEAR THE READ BUFFER. 
! 
CLBUF: SUBROUTINE DIRECT
       SAVE _ @T.COM
       REPEAT 31 TIMES DO [                 \ 
          $SAVE _ 0;  SAVE _ SAVE + 1]
       RETURN 
       END
! 
! 
!  THE MAIN PROGRAM STARTS HERE 
! 
RTETG: T.ERN _ 0
       T.MAD _ @CMNAM 
       T.PAR                                !PARSE COMND NAME.
       T.ERC ? [GOTO ABORT]                 !CHECK FOR ERROR
       OPEN(T.DCB,T.ERN,CMNAM,0,CMSEC,CMICR)!OPEN COMMAND FILE. 
       IF T.ERN > 0 THEN T.ERN _ 0
       T.ERC ? [GOTO ABORT]                 !NOT FOUND (ONLY TIME ERR=-6) 
! 
       CLBUF                                !CLEAR READ BUFFER. 
       READF(T.DCB,T.ERN,T.COM,40,T.LEN)    !GET FILE NAMES.
       T.ERC ? [GOTO ABRT0]                 !REPORT ANY ERRORS. 
! 
       SAVBF(CMDCB) 
       T.MAD _ @BRNAM;                      !SET UP FOR T.GFI.
       SUBN_0 ; OVLAY_0 
       T.LNK(SUBN,OVLAY,FLAG)               !PARSE THE 1ST COMMAND. 
       T.ERC ? [GOTO ABRT0]                 !CHECK FOR ERRORS.
       CRFIL(7,BRDCB,BRNAM,BRSEC,BRICR) ?   \CREATE BRTBL FILE. 
          [GOTO ABRT0]
! 
       CRFIL(7,MNDCB,MNNAM,MNSEC,MNICR)     \CREATE MNTBL FILE. 
          ? [GOTO ABRT1]
! 
       CRFIL(3,TRDCB,TRNAM,TRSEC,TRICR)    \CREATE TRANSFER FILE. 
          ? [GOTO ABRT2]
! 
       MOVE(TRDCB,T.DCB)                    !PUT TRANSFER FILE
       OPEN(T.DCB,T.ERN,TRNAM,0,TRSEC,TRICR)
       SAVBF(TRDCB)                         !IN NORMAL WRITE MODE.
       MOVE(MNDCB,T.DCB)
       WRITF(T.DCB,T.ERN,T.COM,1)           !SAVE SPACE FOR LENGTH. 
       T.ERC ? [GOTO ABRT3]                 !CHECK ERRORS.
       MIN1 _ 1                             !SET UP POINTERS
       T.EAD _ @T.ENT;  I _ 0               !FOR TABLE BUILDER. 
RTET5: T.MAD _ @T.OVB;  SAVBF(MNDCB)        !FOR ALL SPECS . . .
       T.BAD _ @T.BRN;  J _ 0 
! 
RTET2: CLBUF;  MOVE(CMDCB,T.DCB)            !CLEAR READ BUFFER
       READF(T.DCB,T.ERN,T.COM,75,T.LEN)    !READ A RECORD. 
       SAVBF(CMDCB) 
       IF T.LEN = -1 THEN GOTO RTET6        !IF DONE, LEAVE LOOP. 
       IF I = 300 THEN T.ERN _ 7            !CHECK FOR TABLE OVERFLOW.
       T.ERC ? [GOTO ABRT3]                 !REPORT ERRORS. 
       EXEC(100002K,T.CON,T.COM,T.LEN)      !WRITE A LINE.
       GOTO ABRT3                           !ERROR RETURN.
       SUBN_MIN1; OVLAY_0                   !BUILD TABLE ENTRIES. 
       T.LNK(SUBN,OVLAY,FLAG) 
       T.ERC ? [GOTO ABRT3]                 !REPORT ERRORS. 
       MIN1 _ 100001K;  MOVE(TRDCB,T.DCB)   !SET SEG SWITCH 
       WRITF(T.DCB,T.ERN,T.FIL,5)           !SAVE FILE NAME 
       SAVBF(TRDCB);  T.ERC ? [GOTO ABRT3]  !IN TRANSFER FILE.
          I _ I + 1;  J _ J + 1             !INCREMENT COUNTERS.
          IF J < 15 THEN GOTO RTET2 
! 
RTET6: MOVE(BRDCB,T.DCB)                    !RESTORE BRANCH DCB.
       WRITF(T.DCB,T.ERN,T.BRN,             \ 
          (T.BAD-@T.BRN))                   ! 
       SAVBF(BRDCB)                         !SAVE BRTBL DCB.
       T.ERC ? [GOTO ABRT3]                 !REPORT ANY ERRORS. 
! 
       MOVE(MNDCB,T.DCB)
       WRITF(T.DCB,T.ERN,T.OVB,             \WRITE THIS SEGMENT 
          (T.MAD-@T.OVB))                   !OF MNTBL.
       T.ERC ? [GOTO ABRT3]                 !CHECK ERRORS.
       IF T.LEN >= 0 THEN GOTO RTET5        !CHECK FOR DONE.
! 
       T.OVB(1) _ -I                        !PUT IN SUB. COUNT. 
       RWNDF(T.DCB)                         !GO BACK TO BEGINNING.
       WRITF(T.DCB,T.ERN,T.OVB,1)           !WRITE MNTBL. 
       SAVBF(MNDCB)                         !SAVE MNTBL DCB.
       T.ERC ? [GOTO ABRT3]                 !REPORT ERRORS. 
! 
! 
       T.BAD _ @T.BRN;  K _ 0               !READ IN THE BRANCH 
       MOVE(BRDCB,T.DCB);  RWNDF(T.DCB)     !TABLE, CONDENSING IT 
RTET3: READF(T.DCB,T.ERN,$T.BAD,60,T.LEN)   !TO PAIRS OF ENTRIES. 
       IF T.LEN = -1 THEN GOTO RTET1        !IF EOF, SKIP.
       T.ERC ? [GOTO ABRT3]                 !REPORT ANY ERRORS. 
       T.LEN _ T.LEN >-1
       FOR I _ 2 TO (T.LEN-2) BY 2 DO       \CONDENSE THIS PIECE
          [$(T.BAD+I) _ $(T.BAD+(I<-1))]    !OF THE TABLE.
       K _ K + T.LEN                        !UPDATE POINTERS. 
       T.BAD _ T.BAD + T.LEN
       GOTO RTET3                           !READ MORE PIECES.
! 
RTET1: SAVBF(BRDCB) 
       ADDR _ @T.BRN;  T.EAD _ @T.ENT       !SET UP FOR SORT
       FOR I _ 1 TO (K-1) BY 2 DO           \NUMBER ENTRIES WITH
          [$(ADDR+I) _ (I-1) >-1]           !RECORD POSITION. 
       I _ 0                                !SORT ACCORDING TO
RTET4: $[REAL]@MIN1 _ $[REAL](ADDR+I)       !OVERLAY AND SUB- 
       SAVE _ I                             !ROUTINE NUMBER.
       FOR J _ I+2 TO (K-2) BY 2 DO         \DO THE SORT. 
          [IF $(ADDR+J) < MIN1 THEN [       \ 
             $[REAL]@MIN1_$[REAL](ADDR+J);  \ 
             SAVE _ J]]                     ! 
       $[REAL](ADDR+SAVE) _ $[REAL](ADDR+I) 
       $[REAL](ADDR+I) _ $[REAL]@MIN1 
       MIN1 _ (I >-1)*3 + T.EAD             !SET UP ADDRESS PTRS. 
       MIN2 _ (SAVE >-1)*3 + T.EAD          !TO ENT. PT. NAMES. 
       .DFER(T.COM,$MIN1)                   !EXCHANGE THE ENTRY 
       .DFER($MIN1,$MIN2)                   !POINT NAMES CORRES.
       .DFER($MIN2,T.COM)                   !TO BRTBL ENTRIES.
       I _ I + 2
       IF I <= (K-4) THEN GOTO RTET4
       SUBN_1; OVLAY_1                      !CREATE OVERLAY DIRS. 
       T.LNK(SUBN,OVLAY,FLAG) 
       T.ERC ? [GOTO ABRT4]                 !REPORT ERRORS. 
! 
       MOVE(TRDCB,T.DCB)
       IF T.LEN THEN [                      \IF ANY OVERLAYS
          OVLAY_2; T.LNK(SUBN,OVLAY,FLAG);  \WERE CREATED, THEN 
          T.ERC ? [GOTO ABRT4]]             !CREATE TRANSFER FILE.
! 
! 
!  NORMAL RETURN FROM MAIN. 
! 
       CLOSE(T.DCB,T.ERN)                   !CLOSE TRANSFER FILE. 
       T.ERC                                !REPORT ERRORS - CONT.
       CLSFL(MNDCB)                         !CLOSE MNTBL FILE.
       CLSFL(BRDCB)                         !CLOSE BRTBL FILE.
       CLSFL(CMDCB)                         !CLOSE COMMAND FILE.
       IF T.ERN THEN GOTO ABORT             !IF T.ERN, IND. ABORT.
! 
       EXEC(2,1,ER,5)                       !PRINT END MESSAGE. 
       GOTO TERM                            !TERMINATE. 
! 
!  ABORT SEQUENCE FROM MAIN.
! 
ABRT4: IFNOT T.LEN THEN GOTO ABRT3          !ERROR FROM T.OVL.
       ADDR _ @T.OVB
       REPEAT T.LEN TIMES DO [              \ATTEMPT TO PURGE 
          PURGE(T.DCB,T.ERN,$ADDR,T.SEC,    \CREATED OVERLAYS, IF 
             T.CRF);                        \ 
          T.ERC;  ADDR _ ADDR + 4]          !ANY.  PRINT MESSAGES.
ABRT3: PRGFL(TRDCB,TRNAM,TRSEC,TRICR)       !PURGE TRANSFER FILE. 
ABRT2: PRGFL(MNDCB,MNNAM,MNSEC,MNICR)       !PURGE MNTBL FILE.
ABRT1: PRGFL(BRDCB,BRNAM,BRSEC,BRICR)       !PURGE BRTBL FILE.
ABRT0: CLSFL(CMDCB)                         !CLOSE COMMAND FILE.
ABORT: EXEC(2,1,RA,7)                       !PRINT ABORT MESS.
TERM:  EXEC(3,((T.CON AND 77K) OR 1100K),-1)!EJECT PAGE.
       EXEC(6)                              !TERMINATE. 
! 
       END RTETG
       END$ 
                                                                                                                                                                                