 TITLE 'TELEFILE ASSEMBLY PROGRAM - APINIT'
         PCC      0
         SPACE    6
*   %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
*   %%%%%     MODULE NAME:     APINIT                  %%%%%
*   %%%%%     LAST UPDATED:    MAR 07, 1984            %%%%%
*   %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
         SPACE    2
         SPACE    12
*        T E L E F I L E    P R O P R I E T A R Y    P R O D U C T
         SPACE    2
*        THIS DOCUMENT INCLUDES DATA AND INFORMATION WHICH IS CONSIDERED
*        PROPRIETARY TO TELEFILE COMPUTER PRODUCTS, INC. REPRODUCTION,
*        DUPLICATION, DISCLOSURE OR DISSEMINATION, IN WHOLE OR IN PART,
*        TO OTHERS THAN REPRESENTATIVES OF THE UNITED STATES GOVERNMENT
*        SHALL NOT BE MADE WITHOUT PRIOR WRITTEN AUTHORIZATION OF TELEFILE
*        COMPUTER PRODUCTS, INC. NOTWITHSTANDING THE FOREGOING, USE OF
*        THE DATA OR INFORMATION IN WHOLE OR IN PART FOR DESIGN,
*        PROCUREMENT OR MANUFACTURE IS STRICTLY FORBIDDEN.
         PAGE
         SPACE    12
*        T E L E F I L E    P R O P R I E T A R Y    P R O D U C T
         SPACE    2
*        THIS DOCUMENT INCLUDES DATA AND INFORMATION WHICH IS CONSIDERED
*        PROPRIETARY TO TELEFILE COMPUTER PRODUCTS, INC. REPRODUCTION,
*        DUPLICATION, DISCLOSURE OR DISSEMINATION, IN WHOLE OR IN PART,
*        TO OTHERS THAN REPRESENTATIVES OF THE UNITED STATES GOVERNMENT
*        SHALL NOT BE MADE WITHOUT PRIOR WRITTEN AUTHORIZATION OF TELEFILE
*        COMPUTER PRODUCTS, INC. NOTWITHSTANDING THE FOREGOING, USE OF
*        THE DATA OR INFORMATION IN WHOLE OR IN PART FOR DESIGN,
*        PROCUREMENT OR MANUFACTURE IS STRICTLY FORBIDDEN.
         PAGE
BPMUTS   EQU      2
RBM      EQU      3
SYS      EQU      BPMUTS
XAPDATA  DSECT    0
CAR1     RES      0
         CSECT    1
CAR2     RES      0
INITD    EQU      CAR1              ORIGIN OF INIT DATA
INITP    EQU      CAR2              ORIGIN OF INIT PROCEDURE
         DO       SYS=BPMUTS
         SYSTEM   BPM
         M:PT     1                 GENERATE FPT'S IN PROTECT. TYPE 1
         FIN
         DO       SYS=RBM
         SYSTEM   RBM
         FIN
*
         SYSTEM   AP%IL
*
         DEF       IM@INIT             ENTRY POINT
         DEF      INITP,INITD       ORIGIN OF PROCEDURE AND DATA
*
         REF      ABN%%X1
         REF      ABORT
         REF      ADRDCB,LINE%TYPE
         REF      BO%FLAG
         REF      BO%SIZE           BINARY RECORD SIZE
         REF      CORRESWD
         REF      DC%FLAG
         REF      ERR%%C
         REF      ERR%%X1
         REF      LO%FLAG
         REF      LU%FLAG
         REF      PGLINES,PGNUM
         REF      PAGENUM
         REF      POSITIONX1
         REF      RD%STD
         REF      REWX1
         REF      ND%FLAG
         REF      TITLEBUF
         REF       BLANC
         REF      M:SI
         REF      UPDT%ERROR
         REF      ROOTRTN
         REF      SEGMENT#          AP OVERLAY SEGMENT
         REF      SU%FLAG
         REF      WRITEDO,WRITELO
*
         REF      M:C
         REF      M:DO
         REF      M:LO
*
         DO       SYS=RBM
         REF      M:X1
F:X1     EQU      M:X1
         REF      M:X2
F:X2     EQU      M:X2
         REF      M:X4
F:X2KF   EQU      M:X4
         FIN
*
         DO       SYS=BPMUTS
         REF      F:X1
         REF       F:X2,F:X2KF
         REF      REPORT%STATUS
         FIN
         REF      NIVO,FINMAJ
         REF      LOWCORE
         REF      ERR%%SI
         REF      SAVAREA
         REF      EODCNT,EODCNTCI
         REF      ROOTEXIT
         REF      BA%FLAG
         REF      ABN%%X2,ERR%%X2,ABN%%X4,ERR%%X4
*
*  REGISTERS USED TO CONTROL THE SORTING OF PLUS CARDS IN CORE
*
PTR1     EQU      1                 POINTER TO LOWEST KEY
PTR2     EQU      2                 POINTER TO HIGHEST KEY
DEP      EQU      3                 PASS1/PASS2 ADDRESS
PTDEB    EQU      10                INITIAL VALUE OF PTR1
PTFIN    EQU      11                FINAL VALUE OF PTR1
FLAG     EQU      15                RECORD-INVERTED FLAG
*
PAS      EQU      4                 NO. WORDS IN A '+' CARD RECORD
X        EQU      1                 PRIMARY INDEX REGISTER
X1       EQU      2                 SECONDARY INDEX REGISTER
PT       EQU      3                 POINTER FOR NEXT '+' CARD RECORD
I        EQU       4
NB       EQU       5
K        EQU       6
J        EQU       7
R        EQU       8
R1       EQU       9
R8       EQU      8
IOADD    EQU      8
IOSIZE   EQU      9
IORL     EQU      10
VAL1     EQU       10
VAL      EQU       11
LNKR     EQU       12
RETRO    EQU       13
RETOUR   EQU       14
RETURN   EQU       15
T1       EQU      8                 TEMP - EVEN
XT       EQU      4                 TEMP - EVEN
XT1      EQU      5                 TEMP - ODD
*
ZERO     EQU       0
UN       EQU       1
DEUX     EQU       2
TROIS    EQU       3
QUATRE   EQU       4
SEPT     EQU       7
HUIT     EQU       8
DIX      EQU       10
*
SR1      EQU      8
SR2      EQU      9
SR3      EQU      10
*
         USECT    CAR1
PATCH    RES      32                ***** PATCH AREA *****
         BOUND    8
INDICNOTE   RES   2
ZONECI   RES      4
BUFSI    RES      20
MAXSI    EQU      80                MAX BYTES IN SI
         DO1      SYS=BPMUTS
         RES      10
BUFSIEND EQU      BUFSI+(MAXSI/4)
SYS%REGS RES       4
ADRTRI   RES       1
LEC%TEMP RES      1                 TEMP IN LECTURE%MAJ
PRINT%FLAG  RES   1                 0=UPDATE RECORD WAS PRINTED
SAVE%I   RES       1
RES%LINE%COUNT RES 1                X2 FILE RECORD NUMBER
LAST%UPDATE  RES  1
NEXT%UPDATE  RES  1
UPDATE%LINE%COUNT  RES  1
BUF%PRINT   RES   30                TEMP PRINT AREA
*
*  EQUATES FOR THE ABORT PROC
*
AR       EQU      0                 ABORT REGISTER
ABORT25  EQU      25
ABORT27  EQU      27
*
CR       EQU      X'0D'             CARRIAGE RETURN
LF       EQU      X'15'             LINE FEED
TAB      EQU      5                 EBCDIC FOR 'TAB' CHAR
         PAGE
         USECT    CAR2
        BOUND    8
FIVE%SIX DATA     5,6               EOF-EOT CODES
LIMITE%NUMERIQUE    EQU       %
         DATA      '0'
         DATA      '9'
ER3      TEXTC    'OVERLAPPING SEQUENCE NUMBERS.  ',;
                  'LAST UPDATE GROUP IS IGNORED'
ER4      TEXTC    'ILLEGAL UPDATE SYNTAX'
ER5      TEXTC    'ILLEGAL UPDATE SEQUENCE'
CNERR1   TEXTC    ' ** NO ''.'' IN COL 1 - CN SCAN TERMINATED'
DATA%DIX DATA     10
         PAGE
*
*
*
IM@INIT  RES       0
         STW,10   ROOTRTN           SAVE RETURN ADDRESS
         LI,R     1
         STW,R    SEGMENT#
*
         DO       SYS=BPMUTS
         M:INT    REPORT%STATUS     SET BREAK RECEIVER ADDRESS
         FIN
*
         LI,R     0
         STW,R    INDICNOTE
         STW,R    INDICNOTE+1
         STW,R    NIVO              SYSTEM LEVEL INDICATOR
         STW,R    FINMAJ            1=FINISHED WITH UPDATES
         STW,R    UPDATE%LINE%COUNT
         STW,R    UPDT%ERROR        NO. OF '+' CARD ERRORS
         STW,R    RES%LINE%COUNT
         STW,R    PGLINES           CLEAR NUMBER OF LINES PER PAGE
         STW,R    PAGENUM
         STW,R    RD%STD            SET RD%STD
         STW,R    EODCNT            EOD COUNT FOR SI
         STW,R    EODCNTCI          EOD COUNT FOR CI
         STW,R    LAST%UPDATE
         STW,R    SAVE%I            FLAG FOR SKIPPING UPDATES
         LW,R     ND%FLAG           ON IF
         BNEZ     %+2               F:STD IS
         MTW,+1   RD%STD            REQUIRED
         LW,R     BLANC
         STW,R    PGNUM             BLANK PAGE NUMBER IN TITLE BUFFER
*   SET THE VARIABLE PART OF THE TITLE BUFFER TO BLANKS
         LI,X1    18
         STW,R    TITLEBUF+5,X1
         BDR,X1   %-1
         M:TIME   TITLEBUF+2
*
*   INITIALIZE BINARY RECORD SIZE
*
         LI,XT    S:S(SYS=BPMUTS,120,108)   BINARY RECORD SIZE
         MTH,0    BO%FLAG
         IF,NZ                      DOIF 'SB' SPECIFIED
         LI,XT    120               STANDARD RECORD LENGTH
         FI
         STW,XT   BO%SIZE
*
*   CHECK FOR UPDATES
*
         LW,R     LINE%TYPE         IS THERE
         CI,R     3                   AN UPDATE PACKET
         BNE      EXITINIT          NO.  EXIT
         LI,R     M:SI
         STW,R    ADRDCB
         M:REW    F:X2
         M:REW    F:X2KF
         PAGE
*
*
*  READ UPDATE CONTROL CARDS, WRITE THEM ON F:X2, LIST THEM IF LU WAS RE
*  BUILD CONTROL RECORDS & WRITE THEM ON F:X2KF.
         LI,R      -UN
         STW,R     INDICNOTE
         STW,R     INDICNOTE+UN
         LW,NB    LOWCORE
* INITIALIZE 'ADRTRI' AND ADRMAX'.
         STW,NB    PT
         STW,NB    ADRTRI
*  BUILD 1ST POINTER AND INITIALIZE INDEX REGISTERS.
         AI,PT     UN
         STW,PT    *ADRTRI
         LI,I      ZERO
         LI,J      DEUX
         LI,K      UN
         STW,I    *ADRTRI,K         PRESET UPDATE NUMBERS
         STH,K    *ADRTRI,J         IN CASE THE
*                                   FIRST UPDATE CARD IS '+END'
*
*   IF CN CONTROL CARDS ARE IN THE WAY, BUFFER THEM OUT TO X1
*
         MTH,0    DC%FLAG
         IF,NZ                      'CN' SPECIFIED
         LW,RETOUR   CORRESWD
         CV,RETOUR   X'0000FF00'
         IF,ANZ                     SI & C ARE THE SAME DEVICE
         BAL,RETOUR   COPY%CN
         FI
         FI
         BAL,RETOUR  LECTURE%MAJ
BY%FIRST RES      0
*
*  EXAMINE 1ST CHAR OF 'BUFSI' TO DETERMINE IF IT IS AN UPDATE CONTROL C
         LB,R      BUFSI
         CI,R      X'4E'
         BE        APPEL%CONVERT
         LI,VAL    UN
         STH,VAL   *ADRTRI,J
         LI,VAL    ZERO
         AI,J      UN
         STH,VAL   *ADRTRI,J
         B         NOTE%F:X2
APPEL%CONVERT       EQU       %
         LI,X1     ZERO
         BAL,RETOUR CONVERT%DEC%CONSTANT
         CI,X1     UN
         BE        UPDATE%SYNTAX%ERROR
         CI,R      X'6B'     CARACTERE SUIVANT=VIRGULE?
         BE        TEST%VAL
         CI,R      X'40'     CARACTERE SUIVANT=BLANC?
         IF,NE                 -20- NOT COMMA OR BLANK
         CI,R     TAB
         BNE       UPDATE%SYNTAX%ERROR
*
         FI                    -20-
         MTW,+0   SU%FLAG           CHECK SEQUENCE IF SU OPTION
         BEZ      STH%VAL11           IS REQUESTED
         CW,VAL   LAST%UPDATE
         BGE      STH%VAL11         SEQUENCE IS OKAY
         BAL,RETRO SEQNCERR         REPORT A SEQUENCE ERROR
STH%VAL11   RES   0
*  STORE 1ST HALF-WORD INTO TABLE OF CONTROL RECORDS.
         STW,VAL  LAST%UPDATE
         AI,VAL   1
         STH,VAL   *ADRTRI,J
         LI,VAL    ZERO
         B         J%PLUS%UN
*  SYNTAX-CHECK UPDATE CONTROL CARDS & STORE 2ND
*  HALF-WORD INTO TABLE OF CONTROL RECORDS.
TEST%VAL EQU       %
         LW,VAL1   VAL
         BEZ       UPDATE%SYNTAX%ERROR
         MTW,+0   SU%FLAG           CHECK SEQUENCE IF SU OPTION
         BEZ      TEST%VAL1           IS REQUESTED
         CW,VAL1  LAST%UPDATE
         BG       TEST%VAL1         OKAY
         BAL,RETRO SEQNCERR         REPORT A SEQUENCE ERROR
TEST%VAL1   RES   0
         BAL,RETOUR CONVERT%DEC%CONSTANT
         CI,R      X'40'     OCTET SUIVANT=BLANC?
         IF,NE                 -40- NOT BLANK
         CI,R     TAB
         BNE       UPDATE%SYNTAX%ERROR
*
         FI                    -40-
         CW,VAL1   VAL
         BLE       STH%VAL1
         AI,X1     -UN
         B         UPDATE%SYNTAX%ERROR
STH%VAL1 EQU       %
         STH,VAL1  *ADRTRI,J
         STW,VAL  LAST%UPDATE
J%PLUS%UN           EQU       %
         AI,J      UN
         STH,VAL   *ADRTRI,J
         BAL,RETRO PRINT%UPDATE1
         BAL,RETOUR LECTURE%MAJ
*
*  DETERMINE IF 'BUFSI' CONTAINS AN UPDATE CONTROL CARD.
         LB,R      BUFSI
         CI,R      X'4E'     1ER CARACTERE=+?
         BNE       NOTE%F:X2
*  STORE INDEX BLOCK INTO TABLE.
         LW,R      UPDATE%LINE%COUNT
         STH,R     INDICNOTE
         LD,R      INDICNOTE
         STD,R     *ADRTRI,K
         B         ZERO%SUR%INDICNOTE
NOTE%F:X2           EQU       %
         MTW,+1   INDICNOTE+1
         LW,R     RES%LINE%COUNT
         STW,R    INDICNOTE
         LW,R      UPDATE%LINE%COUNT
         STH,R     INDICNOTE
         LD,R      INDICNOTE
         STD,R     *ADRTRI,K
*
*  READ UPDATE CARDS, WRITE THEM ON F:X2, & LIST THEM.
ECRIRE%X2           EQU       %
         BAL,RETRO PRINT%UPDATE1
         BAL,RETOUR WRITE%X2
         BAL,RETOUR LECTURE%MAJ
         LB,R      BUFSI
         CI,R      X'4E'     1ER OCTET=+?
         BNE       ECRIRE%X2
         BAL,RETOUR WRITE%X2
ZERO%SUR%INDICNOTE  EQU       %
         LI,R      -UN
         STW,R     INDICNOTE
         STW,R     INDICNOTE+UN
         BAL,RETRO AVINDEX
         B         APPEL%CONVERT
*
*  MOVE%MSG ROUTINE
*        MOVE A TEXTC MESSAGE TO THE BUF%PRINT AREA
*
MOVE%MSG RES      0
         BAL,RETOUR  SP%BLANC
         LB,X     *NB               GET BYTE COUNT OF THE MESSAGE
MV%1     LB,R     *NB,X             MOVE NEXT BYTE
         STB,R    BUF%PRINT,X         TO BUF%PRINT
         BDR,X    MV%1              COUNT & RETURN
         BAL,RETOUR ERR%PRINT       OUTPUT ON 'DO' & 'LO', IF REQ'D
         B        *RETRO            EXIT
*
*  SEQNCERR ROUTINE
*        PRINT A SEQUENCE ERROR MESSAGE
*
SEQNCERR RES      0
         MTW,+1   UPDT%ERROR
         LCI      +15               SAVE REGISTERS
         STM,1    SAVAREA
         BAL,RETRO SP%PRINT         PRINT THE '+' CARD
         MTW,-1   UPDATE%LINE%COUNT    1 WILL BE ADDED BY PRINT%UPDATE1
         LI,NB    ER5               ADDRESS OF ERROR MESSAGE
         BAL,RETRO MOVE%MSG         PRINT THE MESSAGE
         LCI      +15               RESTORE REGISTERS
         LM,1     SAVAREA
         B        *RETRO
         PAGE
*
*
*  INCREMENT INDEX REGS I,J,K
AVINDEX  EQU       %
         AI,PT     QUATRE
         AI,I     QUATRE
         STW,PT    *ADRTRI,I
         AI,J      SEPT
         AI,K      DEUX
         B         *RETRO
*
         PAGE
*
*  HERE MEANS 'COPY%UPDATE%PACKET' HAS FINISHED READING F:SI.
*
FIN1%UPDATE         EQU       %
         LD,R      INDICNOTE
         AND,R     R1
         CI,R      -UN
         BNE       ECRIT%CARTE%END
         LW,R     RES%LINE%COUNT
         LW,X      UPDATE%LINE%COUNT
         STH,X     R
         STD,R     *ADRTRI,K
         B         TRI
ECRIT%CARTE%END     EQU       %
         LI,R     '+E'              WRITE EOF
         STH,R    BUFSI             SENTINEL.
         BAL,RETOUR WRITE%X2
*
*  SORT CONTROL RECORDS USING 1ST HALF-WORD AS KEY.
TRI      EQU       %
         LI,PTDEB  ZERO
         LW,PTFIN  I
         STW,I     SAVE%I   SAUVE I POUR FIN ECRIT X2KF
*  1ST PASS IS FORWARD THRU CONTROL RECORDS.
*  PUT CONTROL RECORD WITH HIGHEST KEY AT END OF TABLE.
         LI,DEP    CROISSANT
PASSE    RES       0
         CW,PTDEB  PTFIN
         BGE       FIN%TRI
         B         %UN,DEP
UNSUITE  EQU       %
         LI,FLAG   ZERO
         LW,I      *ADRTRI,PTR1
         LW,R      *I
%BOUCLE  RES       0
         LW,J      *ADRTRI,PTR2
         CW,R      *J
         B         %TROIS,DEP
* THE COMPARED RECORDS ARE IN SEQUENCE.
TROIS%SUITE         EQU       %
         STW,I     *ADRTRI,PTR1
         LW,I      J
         LW,R      *J
         B         %QUATRE,DEP
*  THE COMPARED RECORDS ARE NOT IN SEQUENCE.
INVERS   STW,J     *ADRTRI,PTR1
         LI,FLAG   UN
         B         %QUATRE,DEP
CROISSANT           RES       0
%UN      EQU       %-CROISSANT
         LW,PTR1   PTDEB
         LW,PTR2   PTR1
         AI,PTR2   PAS
         B         UNSUITE
%TROIS   EQU       %-CROISSANT
         BG        INVERS
         B         TROIS%SUITE
%QUATRE  EQU       %-CROISSANT
         AI,PTR1   PAS
         AI,PTR2   PAS
         CW,PTR1   PTFIN
         BL        %BOUCLE
*  END OF FORWARD PASS. STORE POINTER OF LARGEST KEY.
*  IF (FLAG) = ZERO, SORT IS FINISHED.
         STW,I     *ADRTRI,PTR1
         CI,FLAG   ZERO
         BE         FIN%TRI
*  THE NEXT PASS GOES BACKWARD THRU THE TABLE.
         AI,PTFIN  -PAS
         LI,DEP    DECROIS
         B         PASSE
*
DECROIS  RES       ZERO
*  %UN FOR BACKWARD PASS.
         LW,PTR1   PTFIN
         LW,PTR2   PTR1
         AI,PTR2   -PAS
         B         UNSUITE
*  %TROIS FOR BACKWARD PASS.
         BL        INVERS
         B         TROIS%SUITE
*  %QUATRE FOR BACKWARD PASS.
         AI,PTR1   -PAS
         AI,PTR2   -PAS
         CW,PTR1   PTDEB
         BG        %BOUCLE
*  END OF BACKWARD PASS.
         STW,I     *ADRTRI,PTR1
         CI,FLAG   ZERO
         BE        FIN%TRI
*  THE NEXT PASS IS FORWARD.
         AI,PTDEB  PAS
         LI,DEP    CROISSANT
         B         PASSE
*
*  WRITE SORTED CONTROL RECORDS ON M:X4 (OR F:X2KF)
*
FIN%TRI  RES      0
         LI,PTR1  0
         LI,DEP   1
         LI,PTR2  4
FIN%T1   RES      0
         LW,I     *ADRTRI,PTR1      GET ADDRESS OF 1ST CONTROL RECORD
         LCI      +3                MOVE RECORD
         LM,R     *I                  TO
         STM,R    ZONECI            PRINT AREA
         CW,PTR2  SAVE%I            TEST FOR LAST CONTROL RECORD
         BLE      FIN%T2            NO.
         BAL,RETRO WRITEX4          WRITE THE LAST CONTROL RECORD
         DO       SYS=RBM
         M:WEOF   F:X2KF
         FIN
*
         M:REW    F:X2KF
         M:WEOF   F:X2
         M:REW    F:X2
EXITINIT RES      0
         LI,R     0
         STW,R    PGLINES
         B        *ROOTRTN          RETURN TO THE ROOT
FIN%T2   RES      0
         LW,J     *ADRTRI,PTR2      ADDRESS OF NEXT CONTROL RECORD
         MTH,0    ZONECI,DEP        WAS 'K' PRESENT ON THE PLUS CARD
         BNEZ     FIN%T3            BRANCH IF YES
         LW,R     *J                COMPARE J AND K
         CW,R     ZONECI
         B        FIN%T4
FIN%T3   RES      0
         LH,R     *J                COMPARE K(2) WITH J(1)
         CH,R     ZONECI,DEP
FIN%T4   RES      0
         BG       FIN%T5            BRANCH IF OKAY
         BAL,RETRO OVERLAP%ERR
         B        FIN%T6
FIN%T5   RES      0
         BAL,RETRO WRITEX4          WRITE THIS CONTROL RECORD
FIN%T6   RES      0
         AI,PTR1  4                 BUMP POINTER ONE
         AI,PTR2  4                 BUMP POINTER TWO
         B        FIN%T1
*
*  WRITE A 12-BYTE CONTROL RECORD ON M:X4 (OR F:X2KF)
*        THE RECORD IS IN ZONECI
WRITEX4  RES      0
*
         M:WRITE  F:X2KF,(BUF,ZONECI),(SIZE,12),(WAIT),;
         (ABN,ABN%%X4),(ERR,ERR%%X4)
         B        *RETRO
*
WRITE%X2 EQU       %
*
         M:WRITE  F:X2,(BUF,BUFSI),(SIZE,80),(WAIT),;
                  (ABN,ABN%%X2),(ERR,ERR%%X2)
         MTW,+1   RES%LINE%COUNT
         B         *RETOUR
*
LECTURE%MAJ         EQU       %
*  CHECK LENGTH OF INPUT RECORD.
         M:READ   M:SI,(BUF,BUFSI),(SIZE,120-40*(SYS=RBM)),;
         (ERR,ERR%%SI),(ABN,ABN%%SI)
LECT%MAJ%1  RES   0
         MTW,+1   PRINT%FLAG        SET FLAG TO 'LINE-NOT-PRINTED'
         LB,1     BUFSI
         AND,1    =X'DB'            TEST FOR A BINARY
         CI,1     X'18'               OR COMPRESSED
         BNE      LECT%MAJ%2          RECORD
         ABORT    ABORT25           UPDATE FILE IN COMPRESSED FORMAT
LECT%MAJ%2  RES   0
         LI,1     8                 GET
         LH,1     *ADRDCB,1         RECORD
         SLS,1    -1                LENGTH
         AI,1     -MAXSI
         BGEZ     CHECK%FOR%PLUS%END
         LI,R1    X'40'             BLANK
         AI,1     -1                LAST
         LB,R     BUFSIEND,1        CHARACTER.
         CI,R     X'15'             IS IT LF?
         BE       ZAP%LF%CR         BRANCH IF YES.
         CI,R     X'0D'             IS IT CR?
         BNE      SUITE%ZAP         BRANCH IF NO.
ZAP%LF%CR                           EQU %
         STB,R1   BUFSIEND,1        CR WITH BLANK
SUITE%ZAP                           EQU %
         BIR,1    ZAP%LF%CR         BLANK BALANCE OF RECORD
CHECK%FOR%PLUS%END                  EQU %
         LW,R     BUFSI             IS CARD A
         CW,R     ='+END'           '+END'?
         BNE      CK%PLUS%AST
         BAL,RETRO PRINT%UPDATE1
         B        FIN1%UPDATE
CK%PLUS%AST  RES  0
         SLS,R    -16
         CI,R     '+*'              TEST FOR AN UPDATE COMMENT
         BNE      *RETOUR           NO.  EXIT
         STW,RETOUR LEC%TEMP        SAVE RETURN ADDRESS
         BAL,RETRO PRINT%UPDATE1
         LW,RETOUR  LEC%TEMP        RESTORE RETURN ADDRESS
         B        LECTURE%MAJ
ABN%%SI  RES      0
         LB,X     SR3
         CI,X     6                 TEST FOR EOF
         BE       ABNSI5            YES
         CI,X     5                 TEST FOR EOD
         BNE      ERR%%SI           NO. IT'S AN ERROR
         MTW,+0   EODCNT            FIRST EOD
         BNEZ     ABNSI5            NO
         MTW,+1   EODCNT            BUMP EOD COUNT
         B        LECTURE%MAJ       GO RE-READ
ABNSI5   RES      0
         MTW,+0   UPDATE%LINE%COUNT TEST FOR FIRST READ
         BNEZ     ABNSI10           NOT FIRST
         MTW,+0   BA%FLAG           BATCH ASSEMBLIES
         BNEZ     ROOTEXIT          YES.  NORMAL TERMINATION
         ABORT    ABORT27           EXPECTED SI MISSING
ABNSI10  RES      0
         LI,1     -ENDMSIZE         - SIZE OF 'END' MESSAGE
         LW,SR3   ENDMSG+ENDMSIZE,1 MOVE THE 'END' MESSAGE
         STW,SR3  BUFSI+ENDMSIZE,1    TO BUFSI
         BIR,1    %-2
         LI,1     ENDMSIZE*4-80     - BYTES REMAINING IN BUFSI
         LI,R1    X'40'
         B        ZAP%LF%CR
ENDMSG   TEXT     '+END  --  SUPPLIED AS THE RESULT OF AN <EOD>'
ENDMSIZE EQU      %-ENDMSG
         PAGE
*  CONVERT TO BINARY THE LINE NUMBERS FROM UPDATE CONTROL
*  CARDS (RESULT IN 'VAL' REG) & LEAVE THE FOLLOWING
*  CHARACTER IN REG 'R'.
CONVERT%DEC%CONSTANT EQU      %
         LI,VAL    ZERO
OCTET%SUIVANT     EQU  %
         AI,X1    UN
         LB,R     BUFSI,X1
         CLM,R     LIMITE%NUMERIQUE
         BCS,9     *RETOUR  RETOUR SI OCTET NON NUMERIQUE
         MI,VAL    DIX
         AI,R      -240
         AW,VAL    R
         B         OCTET%SUIVANT
*
*  CONVERT AN UPDATE LINE NUMBER
*  TO EBCDIC & PUT IT IN THE OUTPUT BUFFER 'BUF%PRINT'.
CONVERT%BIN%DEC     EQU       %
         LI,X      HUIT
CONVERT%ERROR  RES  0
         AI,X     -UN
         LI,VAL1   ZERO
         DW,VAL1   DATA%DIX
         AI,VAL1   X'F0'
         STB,VAL1  BUF%PRINT,X
         CI,VAL   0
         BNEZ     CONVERT%ERROR
         B        *RETOUR
         PAGE
PRINT%UPDATE1       EQU       %
         LW,R     LU%FLAG
         BNEZ     SP%PRINT
         MTW,+1   UPDATE%LINE%COUNT
         B        *RETRO
*
*    ROUTINE UPDATE%SYNTAX%ERROR
*
UPDATE%SYNTAX%ERROR EQU       %
         MTW,+1   UPDT%ERROR
         LCI      +15
         STM,1    SAVAREA           SAVE REGS
         MTW,+1   SAVE%I            SET 'SKIP' FLAG
         BAL,RETRO SP%PRINT
         BAL,RETOUR SP%BLANC
*  (RESTORE X1 CONTENTS.)
         LW,X1    SAVAREA+X1-1
         AI,X1    36
*  PRINT A COLON UNDER THE CHARACTER IN ERROR.
         LI,R      X'7A'     CARACTERE ':'
         STB,R     BUF%PRINT,X1
         BAL,RETOUR ERR%PRINT       OUTPUT ON 'DO' & 'LO', IF REQ'D
         LI,NB    ER4               ADDRESS OF ERROR MESSAGE
         BAL,RETRO MOVE%MSG         PRINT THE MESSAGE
         B        SYN%2
SYN%1    RES      0
         BAL,RETRO SP%PRINT
SYN%2    RES      0
         BAL,RETOUR LECTURE%MAJ     FIND THE NEXT '+' CARD
         LB,R     BUFSI
         CI,R     '+'
         BNE      SYN%1
         MTW,-1   SAVE%I            RESET 'SKIP' FLAG
         LCI      +15
         LM,1     SAVAREA
         B        APPEL%CONVERT
*
*
*  PRINT THE UPDATE CARD IN ERROR.
*
SP%PRINT EQU       %
         STW,RETRO ZONECI
         MTW,+1   UPDATE%LINE%COUNT
         LI,R     0
         XW,R     PRINT%FLAG        SET TO 'LINE-PRINTED'
         BEZ      *ZONECI
         BAL,RETOUR  SP%BLANC
         LW,VAL   UPDATE%LINE%COUNT
         BAL,RETOUR CONVERT%BIN%DEC
         LI,X     -20
SP%PRINT1  RES    0
         LW,R     BUFSIEND,X
         STW,R    BUF%PRINT+29,X
         BIR,X    SP%PRINT1
         DO       SYS=BPMUTS
*
*  INSERT THE KEY IF SI IS FROM A KEYED FILE
*
         LW,X     M:SI+5            FILE ORGANIZATION
         AND,X    =X'F0'
         CI,X     X'20'             TEST FOR ORG=KEYED
         BNE      SP%PRINT4         NO
         LW,VAL   *M:SI+10          GET 3-BYTE KEY
         AND,VAL  =X'FFFFFF'        CLEAN IT
         LI,X     33                RIGHT-MOST COLUMN FOR KEY
SP%PRINT5   RES   0
         LI,VAL1  0
         DW,VAL1  DATA%DIX          CONVERT NEXT DIGIT
         AI,VAL1  X'F0'
SP%PRINT6   RES   0
         STB,VAL1 BUF%PRINT,X
         AI,X     -1
         LI,VAL1  '.'
         CI,X     30                IS THIS THE COLUMN FOR DEC. PT.
         BE       SP%PRINT6         YES
         BG       SP%PRINT5           NOT YET
         CI,VAL   0                 TERMINATE AFTER LAST DIGIT
         BNE      SP%PRINT5         MORE DIGITS
SP%PRINT4   RES   0
         FIN
         MTW,0    SAVE%I
         BEZ      SP%PRINT2
         LI,X     -4
SP%PRINT3   RES   0
         LW,R     IGNORE+4,X        MOVE IGNORED MESSAGE TO BUF%PRINT
         STW,R    BUF%PRINT+6,X
         BIR,X    SP%PRINT3
         BAL,RETOUR ERR%PRINT       OUTPUT ON 'DO' & 'LO', IF REQ'D
         B        *ZONECI
SP%PRINT2   RES   0
         BAL,RETOUR PRINT
         B        *ZONECI           EXIT
IGNORE   TEXT     ' *** IGNORED ***'
         PAGE
SP%OVERLAP          EQU       %
         BAL,RETOUR SP%BLANC
         LH,VAL    ZONECI
         LI,X      UN
         LH,VAL1   ZONECI,X
         LH,R      ZONECI+UN
         STW,R     RES%LINE%COUNT
         CI,VAL1   ZERO
         BNE       CARTE%2
*  RE-BUILD +J-TYPE CONTROL CARDS.
         STW,VAL   LAST%UPDATE
         BAL,LNKR  CARTE%J
         B         *RETURN
CARTE%2  EQU       %
         STW,VAL   NEXT%UPDATE
         STW,VAL1  LAST%UPDATE
         BAL,LNKR  CARTE%JK
         B         *RETURN
*
*  RE-BUILD AND PRINT +J,K-TYPE CONTROL CARDS.
CARTE%JK EQU       %
         LI,X     50
         LW,VAL   LAST%UPDATE
         BAL,RETOUR CONVERT%ERROR
         LI,R      X'6B'       'VIRGULE'
         AI,X      -UN
         STB,R    BUF%PRINT,X
         LW,VAL   NEXT%UPDATE
SUITE%ERROR         EQU       %
         BAL,RETOUR CONVERT%ERROR
         LI,R      X'4E'      CARACTERE 'PLUS'
         AI,X      -UN
         STB,R    BUF%PRINT,X
*  CONVERT CARD NUMBER.
         LW,VAL   RES%LINE%COUNT
         BAL,RETOUR CONVERT%BIN%DEC
         BAL,RETOUR ERR%PRINT       OUTPUT ON 'DO' & 'LO', IF REQ'D
         B         *LNKR
*
*  RE-BUILD +J CARD.
CARTE%J  EQU       %
         MTW,-UN   LAST%UPDATE
         LW,VAL   LAST%UPDATE
         LI,X     50
         B         SUITE%ERROR
*
         PAGE
OVERLAP%ERR  RES  0
         MTW,+1   UPDT%ERROR
         LCI      +15
         STM,1    SAVAREA
         CW,I     J                 SET TO IGNORE THE SECOND
         BG       OVRLAP1             UPDATE RECORD
         STW,I    *ADRTRI,PTR2      REPLACE ADDRESS POINTER
         XW,I     J
OVRLAP1  RES      0
         LCI       TROIS
         LM,R     *J
         STM,R     ZONECI
         BAL,RETURN SP%OVERLAP
         LCI       TROIS
         LM,R     *I
         STM,R     ZONECI
         BAL,RETURN SP%OVERLAP
         LI,NB    ER3               ADDRESS OF ERROR MESSAGE
         BAL,RETRO MOVE%MSG         PRINT THE MESSAGE
         LCI      +15
         LM,1     SAVAREA
         B        *RETRO
*
*  OUTPUT AN ERROR LINE ON 'DO', AND ON 'LO' IF REQUIRED
*
ERR%PRINT   RES   0
         LI,IOADD BUF%PRINT
         LI,IOSIZE 120
         BAL,IORL WRITEDO
         LW,R     LO%FLAG           OUTPUT ON 'LO' IF EITHER
         OR,R     LU%FLAG             LU OR LO IS REQUESTED
         BEZ      *RETOUR
*
*  PRINT THE LINE ON 'LO'
*
PRINT    EQU       %
         LCI      +4
         STM,I    SYS%REGS
         LI,IOADD  BUF%PRINT
         LI,IOSIZE  120
         BAL,IORL WRITELO
         LCI      +4
         LM,I     SYS%REGS
         B         *RETOUR
*
*  CLEAR 'BUF%PRINT' TO BLANKS.
SP%BLANC EQU       %
         LW,R      BLANC
         LI,X     30
         STW,R     BUF%PRINT-UN,X
         BDR,X     %-UN
         B         *RETOUR
         PAGE
*
*   C O P Y % C N
*        COPY CN CONTROLS FROM M:C, WRITING THEM TO LO & X1.
*
         LOCAL    %10,%20,%30,%40
*
COPY%CN  RES      0
         LCI      15
         STM,1    SAVAREA           SAVE REGISTERS 1 - 15
         LI,XT    2
         STH,XT   DC%FLAG           TELL ENCODER TO READ X1, NOT C
*
         DO       SYS=RBM
         M:DEVICE F:X1,;            CHANGE TEMPORARILY TO NEW FORMAT
                  (SIZE,80),;
                  (ORG,BLOCK)
         FIN
*
         M:REW F:X1
%10      RES      0
         M:READ   M:C,;             NEXT CN CONTROL
                  (ERR,ERR%%C),;
                  (ABN,ABN%%C),;
                  (BUF,BUFSI),;
                  (SIZE,120-40*(SYS=RBM)),;
                  (WAIT)
*
*   FILL RECORD WITH BLANKS, STRIPPING OFF A POSSIBLE
*        TRAILING CR OR LF.
*
         LI,XT    8
         LH,XT    M:C,XT
         SLS,XT   -1                ARS
         AI,XT    -MAXSI
         IF,L                       DOIF PADDING NEEDED
         LI,T1    ' '               FILL CHARACTER
         AI,XT    -1
         LB,XT1   BUFSIEND,XT
         IF,NE    LF,XT1
         CV,XT1   CR
         BNE      %30               SKIP INITIAL REPLACEMENT
*
         FI
%20      RES      0
         STB,T1   BUFSIEND,XT
%30      RES      0
         BIR,XT   %20
*
         FI
*   NOW LOG THE RECORD READ, UNLESS WE WOULD BE ECHOING
*        IT BACK TO THE SAME DEVICE THAT IT CAME FROM.
*
         LI,XT    1
         MTB,0    CORRESWD,XT       TEST LO=C FLAG
         IF,EZ
         LCI      10
         LM,1     BUFSI
         STM,1    BUF%PRINT+1
         LM,1     BUFSI+10
         STM,1    BUF%PRINT+11
         LW,XT    BLANC
         STW,XT   BUF%PRINT
         LI,IOADD BUF%PRINT
         LI,IOSIZE   84
         BAL,IORL WRITELO
         FI
%40      RES      0
         M:WRITE  F:X1,;            AND SAVE IT
                  (ERR,ERR%%X1),;
                  (ABN,ABN%%X1),;
                  (BUF,BUFSI),;
                  (SIZE,80),;
                  (WAIT)
         LB,XT    BUFSI
         CV,XT    '.'               CHECK FOR CN CONTROL COMMAND
         IF,EQ
         LW,XT    BUFSI
         CV,XT    '.END'
         BNE      %10               WAS '.' COMMAND, BUT NOT END
*
         ELS
         LI,NB    CNERR1
         BAL,RETRO   MOVE%MSG       DIAGNOSE
         LI,IOSIZE   -1
         BAL,IORL POSITIONX1        BACK UP OVER BAD RECORD
         LV,XT    '.END'            FAKE GOOD END
         STW,XT   BUFSI
         LV,XT    '    '
         STW,XT   BUFSI+1
         B        %40
*
         FI
         BAL,IORL REWX1
         LCI      15
         LM,1     SAVAREA           RESTORE REGS
         EXIT     RETOUR
*
*   A B N % % C
*
ABN%%C   RES      0
         LB,XT    SR3
         CLM,XT   FIVE%SIX          CHECK FOR EOF OR EOT ON C
         BOL      ERR%%C            OTHER ERROR - STD. HANDLING
*
         BAL,IORL REWX1
         LCI      15
         LM,1     SAVAREA           RESTORE REGS
         EXIT     RETOUR
*
         END

