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$