SPL,L,O,M,C 
!     NAME:    BATBL
!     SOURCE:  92076-18017
!     RELOC:   92076-16002
!     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 BATBL(3,99) "92076-16002 REV.2040 800802" 
! 
! CHANGED ENDING MESSAGES IN EXEC TO USE LOGLU INSTEAD OF 
! LU 1 WHICH IN L IS SYSTEM CONSOLE.  800802
! 
! DELETED T.LST EXTERNAL AND ANY REFERENCES TO TRANSFER FILE
! FOR XL AND THEREFORE THE L. 800728
! 
! 
! MADE SO WILL PRINT OUT DUPLICATE FILE NAME ON ERROR IN
! CREATE "CRFIL" ROUTINE.  800322 
! 
       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                            \USED FOR ENDING MESS.
              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),                        \BATBL 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 BATBL"
       INITIALIZE RA TO "$BATBL ABORTED"
       INITIALIZE NS TO "BATBL'S SEGMENT NOT FOUND" 
       INITIALIZE T.SUB TO 32(0)
! 
       LET READF,                           \FMGR READ RECORD 
           WRITF,                           \FMGR WRITE RECORD
           CREAT,                           \FMGR CREAT FILE
           OPENF,                           \FMGR OPEN 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 BATBL 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
!  BATBL'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,T.LST,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 = -2 THEN GOTO CRFL1
       IF T.ERN > 0 THEN T.ERN _ 0
       T.ERC ? [FRETURN]                    !REPORT ANY ERRORS. 
       SAVBF(DCBSV)                         !SAVE DCB BUFFER. 
       RETURN 
CRFL1: EXEC (2,T.CON,FLNAM,3) 
       T.ERC ? [FRETURN]
       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 
! 
BATBL: T.ERN _ 0
       T.MAD _ @CMNAM 
       T.PAR                                !PARSE COMND NAME.
       T.ERC ? [GOTO ABORT]                 !CHECK FOR ERROR
       OPENF(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]
! 
! ***************************REMOVED 800728*****************
! 
!      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.
! *****************************800728***********************
       MOVE(MNDCB,T.DCB)
       WRITF(T.DCB,T.ERN,T.COM,1)           !SAVE SPACE FOR LENGTH. 
       T.ERC ? [GOTO ABRT2]                 !CHECK ERRORS.
       MIN1 _ 1                             !SET UP POINTERS
       T.EAD _ @T.ENT;  I _ 0               !FOR TABLE BUILDER. 
BATB5: T.MAD _ @T.OVB;  SAVBF(MNDCB)        !FOR ALL SPECS . . .
       T.BAD _ @T.BRN;  J _ 0 
! 
BATB2: 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 BATB6        !IF DONE, LEAVE LOOP. 
       IF I = 300 THEN T.ERN _ 7            !CHECK FOR TABLE OVERFLOW.
       T.ERC ? [GOTO ABRT2]                 !REPORT ERRORS. 
       EXEC(100002K,T.CON,T.COM,T.LEN)      !WRITE A LINE.
       GOTO ABRT2                           !ERROR RETURN.
       SUBN_MIN1; OVLAY_0                   !BUILD TABLE ENTRIES. 
       T.LNK(SUBN,OVLAY,FLAG) 
       T.ERC ? [GOTO ABRT2]                 !REPORT ERRORS. 
       MIN1 _ 100001K;                      !SET SEG SWITCH 
! 
! *******************REMOVED 800728***********************
! 
!      MOVE (TRDCB,T.DCB) 
!      WRITF(T.DCB,T.ERN,T.FIL,5)           !SAVE FILE NAME 
! 
!      SAVBF(TRDCB);  T.ERC ? [GOTO ABRT3]  !IN TRANSFER FILE.
! 
! *************************800728*************************
          I _ I + 1;  J _ J + 1             !INCREMENT COUNTERS.
          IF J < 15 THEN GOTO BATB2 
! 
BATB6: 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 ABRT2]                 !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 ABRT2]                 !CHECK ERRORS.
       IF T.LEN >= 0 THEN GOTO BATB5        !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 ABRT2]                 !REPORT ERRORS. 
! 
! 
       T.BAD _ @T.BRN;  K _ 0               !READ IN THE BRANCH 
       MOVE(BRDCB,T.DCB);  RWNDF(T.DCB)     !TABLE, CONDENSING IT 
BATB3: READF(T.DCB,T.ERN,$T.BAD,60,T.LEN)   !TO PAIRS OF ENTRIES. 
       IF T.LEN = -1 THEN GOTO BATB1        !IF EOF, SKIP.
       T.ERC ? [GOTO ABRT2]                 !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 BATB3                           !READ MORE PIECES.
! 
BATB1: 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
BATB4: $[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 BATB4
       SUBN_1; OVLAY_1                      !CREATE OVERLAY DIRS. 
       T.LNK(SUBN,OVLAY,FLAG) 
       T.ERC ? [GOTO ABRT4]                 !REPORT ERRORS. 
! 
! ***********************REMOVED 800728***************************
!      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.
! 
! ***************************800728*******************************
! 
! 
!  NORMAL RETURN FROM MAIN. 
! 
! 
! **************************REMOVED 800728**********************
!      CLOSE(T.DCB,T.ERN)                   !CLOSE TRANSFER FILE. 
!      T.ERC                                !REPORT ERRORS - CONT.
! 
! *****************************800728***************************  
       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,T.LST,ER,5)                       !PRINT END MESSAGE. 
       GOTO TERM                            !TERMINATE. 
! 
!  ABORT SEQUENCE FROM MAIN.
! 
ABRT4: IFNOT T.LEN THEN GOTO ABRT2          !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.
! 
! *********************REMOVED 800728**************************** 
!ABRT3: PRGFL(TRDCB,TRNAM,TRSEC,TRICR)       !PURGE TRANSFER FILE.  
! 
! *****************************800728**************************** 
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,T.LST,RA,7)                       !PRINT ABORT MESS.
TERM:  EXEC(3,((T.CON AND 77K) OR 1100K),-1)!EJECT PAGE.
       EXEC(6)                              !TERMINATE. 
! 
       END BATBL
       END$