 TITLE 'TELEFILE ASSEMBLY PROGRAM - APCD'
         PCC      0
         SPACE    6
*   %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
*   %%%%%     MODULE NAME:     APCD                    %%%%%
*   %%%%%     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                 OVERLAY DATA AREA
CAR1     RES      0
         CSECT    1
CAR2     RES      0
         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
*
*  EQUATES FOR ABORT
AR       EQU      0                 ABORT REGISTER
ABORT13  EQU      13
ABORT14  EQU      14
ABORT15  EQU      15
ABORT16  EQU      16
ABORT17  EQU      17
ABORT18  EQU      18
ABORT19  EQU      19
ABORT20  EQU      20
ABORT23  EQU      23
ABORT24  EQU      24
         DEF       CAR1,CAR2
         DEF       IM@READ
         DEF      EOF%FLAG          END-OF-FILE FLAG
         DEF      FIN%X1
         DEF      UPDATE%LINE%COUNT
         DEF      IM@SYS
         DEF      IM@END,IM@COPY
         DEF      READC
         DEF      SYSABN            ABNORMAL RETURN ON OPEN F:SYS
         DEF       BUFSI
         DEF      COMPTE%CI
         DEF      LAST%UPDATE,NEXT%UPDATE,PLUS
         DEF      SKIP%COUNT
         DEF      #BLANKS
         DEF      CIRDREGS,CIREC#
         DEF      SYSOPNER
         DEF      CO%REGI,CO%BUF
*
         REF      BYX1SIZE
         REF      CNTERM
         REF      CO%IDWDS,CARDSEQ
         REF      CO%SIZE           BYTE SIZE OF CO RECORD
         REF      CORRESWD          (LO=DO)  (LO=C)  (SI=C)  (----)
         REF      DC%FLAG
         REF      ERR%%C
         REF      ERR%%X1
         REF      M:SI,M:SO,M:CI,M:CO,M:LO
         REF      IM@NAME
         REF      ACCOUNTS,#ACCTS
         REF      MAJLINE,SUBLINE   ASSEMBLY LINE NUMBER
         REF      REWX1
         REF      SAVAREA
         REF      WRITEDO,WRITELO
         REF      CLRLSTBF,LSTBF
         REF      LINK,ABORT,SYSNAME
         REF      CI%DCB
         REF       ADRDCB,LINE%TYPE
         REF       BLANC
         REF      CO%FLAG,SO%FLAG
         REF      LO%FLAG,LU%FLAG
*
         REF      M:C
         DO       SYS=RBM
         REF      M:X1
F:X1     EQU      M:X1
         REF      M:X2,M:X4
         ELSE
         REF      F:X1
         REF       F:X2,F:X2KF
         REF      SO%KEY
         FIN
         REF      F:SYS
         REF      ERR%%CO,ERR%%SO
         REF      NIVO,FINMAJ,1ERLECTURE%LI
         REF      ERR%%SI,ABN%%X2
         REF      ROOTEXIT
         REF      UPDT%ERROR
         REF      EODCNT
         REF      EODCNTCI
         REF      ERR%%CI,BA%FLAG
*
X        EQU      1
SR3      EQU      10
R8       EQU      8
R9       EQU      9
X1       EQU      2
X7       EQU      7
NB       EQU       5
J        EQU       7
RL       EQU      7
R        EQU       8
R1       EQU       9
VAL1     EQU       10
VAL      EQU       11
IOADD    EQU      8
IOSIZE   EQU      9
IORL     EQU      10
LNKR     EQU       12
RETRO    EQU       13
RETOUR   EQU       14
XT       EQU      4                 TEMP - EVEN
XT1      EQU      5                 TEMP - ODD
XT2      EQU      6                 TEMP INDEX
*
ZERO     EQU       0
UN       EQU       1
DEUX     EQU       2
TROIS    EQU       3
MAXSI    EQU      80
*
SO%KEY%INC   EQU  1000              NORMAL 'SO' INCREMENT
SO%KEY%INC1  EQU  2                 TIGHT 'SO' INCREMENT
SO%KEY%LIM   EQU  3**24+9900*SO%KEY%INC   BREAK FOR NORMAL/TIGHT INC.
         PAGE
         USECT    CAR1
ZONECI   RES      4
BUFSI    RES      22
BUFSIEND EQU      BUFSI+(MAXSI/4)
         DO1      SYS=BPMUTS
         RES      8
COMPTE%CI         RES  1            NEXT CI LINE NUMBER
LAST%UPDATE       RES  1            SECOND LINE # FROM + CARD
NEXT%UPDATE       RES  1            FIRST LINE # FROM + CARD
SKIP%COUNT        RES  1            # COMPRESSED LINES TO SKIP
UPDATE%LINE%COUNT RES  1
EOF%FLAG RES      1                 0= EOF NOT YET FOUND
IM@MAJOR EQU      MAJLINE           MAJOR PART OF LINE NUMBER
IM@MINOR EQU      SUBLINE           SUB-LINE PART OF LINE NUMBER
PLUS     RES      1                 '+' CARD READ IS REQUIRED
CI%BSAV  RES      27                SAVE AREA FOR CI%BUFR WHEN IN SYST.
IM@SYS   RES       1
         RES      ABSVAL(%)&1       BOUND 8 WITH NO ZERO'S GENERATED
SYSOPEN  EQU      %
         RES      2
         DO       SYS=BPMUTS
         RES      1                 CODE WORD FOR FILE NAME
SYSFILE  RES      8
         RES      1                 CODE WORD FOR ACCOUNT
SYSACCT  RES      2
         FIN
MAXSYS   EQU      8
STKL     EQU      15-7*(SYS=RBM)
STACK    RES       STKL*MAXSYS
         RES      ABSVAL(%)&1       BOUND 8 WITH NO ZERO'S GENERATED
SYSSTK   RES      2
         PAGE
*
         USECT    CAR2
*
*   S T A T I C   D A T A
*
         BOUND    8
FIVE%SIX DATA     5,6               EOF-EOT CODES
         PAGE
*
IM@READ  EQU       %
         LCI       15               SAVE
         STM,X     SAVAREA          REGS.
         LI,X     M:SI
         STW,X    ADRDCB
TEST%NIVO           EQU       %
         MTW,0    NIVO
         BEZ       SUITE%TEST
         LW,X     1ERLECTURE%LI     IS THIS 1ST RECORD IN THE SYSTEM
         BGZ      NIVO%1              NO
         M:READ   *CI%DCB,(BUF,CI%BUFR),(SIZE,120),(WAIT),;
                  (ABN,ERR%%CI),(ERR,ERR%%CI)
         LB,X     CI%BUFR
         CI,X     X'38'
         BE       NIVO%2            THE RECORD IS COMPRESSED
         CI,X     X'18'
         BE       NIVO%2
         MTW,+1   1ERLECTURE%LI     SET LINE TYPE TO SOURCE
         LI,X     20                MOVE THE
         LW,R8    CI%BUFR-1,X         LINE TO THE
         STW,R8   BUFSI-1,X           BUFSI AREA
         BDR,X    %-2
         B        NIVO%3
NIVO%1   RES      0
         CI,X     2                 IS THIS SYSTEM IN COMPRESSED FORMAT
         BE       APPEL%CI%SI         YES
         M:READ  *CI%DCB,(BUF,BUFSI),(SIZE,108-28*(SYS=RBM)),(WAIT),;
                  (ABN,ABN%%SI),(ERR,ABN%%SI)
NIVO%3   RES      0
         MTW,+1   CIREC#            BUMP RECORD NUMBER
         LI,1     8                 GET
         LH,1     *CI%DCB,1         RECORD
         SLS,1    -1                SIZE
         BAL,RETOUR  LECT%MAJ%1     FINISH TESTING SI RECORD
         DO       SYS=RBM
         B        BUMP%MAJOR
         ELSE
         MTW,+1   IM@MAJOR          BUMP MAJOR LINE NUMBER
         LW,5     CI%DCB            DCB ADDRESS
         B        OPT%SO4           BRANCH TO EDIT KEY IF REQUIRED
         FIN
NIVO%2   RES      0
         BAL,7    VALIDATE          VALIDATE CKSUM & BUMP CIREC#
         MTW,+2   1ERLECTURE%LI     SET LINE TYPE TO COMPRESSED
         LI,X     -27               SET WORD COUNT FOR A FULL RECORD
         STW,X    REG6
APPEL%CI%SI  RES   0
         BAL,LNKR  DECODE%CI%SI
         B         BUMP%MAJOR
SUITE%TEST          EQU       %
*
         LW,R      LINE%TYPE
         CI,R     2
         BL       GET%SYMBOLIC%LINE
         BE        GET%COMPRESSED%LINE
         MTW,ZERO  FINMAJ
         BNEZ      GET%COMPRESSED%LINE
*
*
*  PROCESS CI RECORDS UNTIL NEXT UPDATE POINT IS REACHED.
CHOOSE%LINE         EQU       %
         LW,R      NEXT%UPDATE
         CW,R      COMPTE%CI
         BG       GET%COMPRESSED%LINE
         BAL,LNKR  READ%UPDATE
         B         CHOOSE%LINE
*
*
*  READ A COMPRESSED CARD AND DECOMPRESS IT INTO 'BUFSI'.
GET%COMPRESSED%LINE EQU       %
         MTW,UN    COMPTE%CI
         MTW,+1   IM@MAJOR          BUMP MAJOR LINE NUMBER
         LI,LNKR  0                   AND CLEAR MINOR
         STW,LNKR IM@MINOR            LINE NUMBER
         BAL,LNKR  DECODE%CI%SI
         MTW,ZERO  CO%FLAG
         BNEZ      ECRIRE%CO
OPT%SO   EQU       %
*
         DO       SYS=RBM
         MTW,ZERO  SO%FLAG
         BEZ      OPT%SO1
         M:WRITE  M:SO,(BUF,BUFSI),(SIZE,80),(WAIT),;
                  (ERR,ERR%%SO),(ABN,ERR%%SO)
OPT%SO1  RES      0
         FIN
*
         DO       SYS=BPMUTS
*
*  IF THE 'SO' OPTION WAS SPECIFIED, IT IS TIME TO WRITE THE
*     SOURCE RECORD SITTING IN 'BUFSI'.
*
         MTW,0    SO%FLAG
         IF,NE                 -02- DOIF 'SO'
*
*  MUST WRITE SOURCE RECORD -- EITHER SEQUENTIALLY OR KEYED
*
         LW,XT    SO%KEY
         IF,NE                 -04- DOIF 'SO' TO KEYED FILE
*
*  TEST KEY FOR LIMITING VALUE -- USE SMALLER INCREMENT
*     IF OVER LIMIT.
*
         CV,XT    SO%KEY%LIM
         IF,GE                 -06- DOIF AT OR OVER LIMIT
         AV,XT    SO%KEY%INC1       SMALL INCREMENT
         ELS                    06.
         AV,XT    SO%KEY%INC        NORMAL INCREMENT
         FI                    -06-
         STW,XT   SO%KEY            SAVE NEW KEY
         M:WRITE  M:SO,;
                  (ERR,ERR%%SO),;
                  (ABN,ERR%%SO),;
                  (BUF,BUFSI),;
                  (SIZE,80),;
                  (KEY,SO%KEY),;
                  (NEWKEY),;
                  (WAIT)
         ELS                    04.
*
*  WRITE RECORD TO SEQUENTIAL DEVICE/FILE
*
         M:WRITE  M:SO,;
                  (ERR,ERR%%SO),;
                  (ABN,ERR%%SO),;
                  (BUF,BUFSI),;
                  (SIZE,80),;
                  (WAIT)
         FI                    -04-
         FI                    -02-
*
*  EDIT THE KEY INTO THE LISTING IF THIS IS A KEYED FILE
*
         LW,X     LINE%TYPE         EDIT ONLY FOR SI
         CI,X     1
         BNE      LOAD%REG          BRANCH IF NOT SI ONLY
         LI,5     M:SI              DCB ADDRESS
OPT%SO4  RES      0
         LW,X     5,5               ORGANIZATION FIELD
         AND,X    =X'F0'
         CI,X     X'20'             IS ORG KEYED
         BNE      LOAD%REG
         LW,5     10,5              GET THE
         LW,R1    0,5                 3-BYTE KEY
         AND,R1   =X'FFFFFF'        CLEAN IT
         LW,R     BLANC
         STW,R    BUFSI+18          CLEAR COL'S 73-76
         LI,R     '.'               INSERT THE DECIMAL POINT
         STB,R    BUFSI+19
         LI,X     7
OPT%SO2  RES      0
         LI,R     0
         DW,R     =10
         AI,R     X'F0'
         STB,R    BUFSI+18,X
OPT%SO3  RES      0
         AI,X     -1
         CI,X     4                 SKIP DECIMAL POINT POSITION
         BG       OPT%SO2           DON'T TERMINATE BEFORE DEC. POINT
         BE       OPT%SO3           SKIP DEC POINT COLUMN
         CI,R1    0                 TERMINATE AFTER LAST
         BNE      OPT%SO2             SIGNIFICANT DIGIT
         FIN
         B        LOAD%REG
BUMP%MAJOR   RES  0
         MTW,+1   IM@MAJOR
LOAD%REG RES      0
RESTORE  LCI      +15
         LM,X      SAVAREA
         B         *LINK
*
*
*  READ A SYMBOLIC CARD INTO 'BUFSI' & COMPRESS IT IF CO REQUESTED.
GET%SYMBOLIC%LINE   EQU       %
         BAL,RETOUR LECTURE%MAJ
GSL%1    RES      0
         MTW,+1   IM@MAJOR
GET%SYMBOLIC%LINE1  EQU  %
         MTW,0    CO%FLAG
         BEZ       OPT%SO
*
*
*  WRITE COMPRESSED ITEMS TO CO, STARTING WITH THE CARD IN 'ZONECI'.
ECRIRE%CO           EQU       %
         LCI      3
         LM,1     CO%REGI
         LI,4     -80
         B        PUT%CHAR
BUMP%BLANKS  RES  0
         MTW,+1   #BLANKS
NEXT%OUT RES      0
         BIR,4    PUT%CHAR
         LI,5     X'100'
         B        PUT%CHAR1
LAST%OUT LI,8     2
         BAL,7    PUT6BITS
         LCI      3
         STM,1    CO%REGI
         B        OPT%SO
*
         LOCAL    %10,%20,%30,%40,%50,%60,%70,%80,%90
         LOCAL    %85
PUT%CHAR RES      0
         LB,5     BUFSI+20,4
PUT%CHAR1   RES   0
         CI,5     ' '
         BE       BUMP%BLANKS
         LW,6     #BLANKS
         BEZ      %50
         LI,8     +7
         CI,6     +1
         BE       %40
         LI,8     +5
         CI,6     +64
         BLE      %30
         AI,8     +1
         AI,6     -64
%30      AI,6     -1
         BAL,7    PUT6BITS
         LW,8     6
%40      RES      0
         BAL,7    PUT6BITS
         LI,6     0
         STW,6    #BLANKS
%50      CI,5     X'C0'
         BL       %70
         BAZ      LAST%OUT
         LB,8     ALFNUM-X'C0'/4,5
         BEZ      %85
%20      RES      0
         BAL,7    PUT6BITS
         B        NEXT%OUT
%70      LB,6     SPECIALS
%80      CB,5     SPECIALS,6
         BE       %90
         BDR,6    %80
%85      LI,8     4
         BAL,7    PUT6BITS
         LW,8     5
         BAL,7    PUT8BITS
         B        NEXT%OUT
%90      LI,8     +43
         AW,8     6
         B        %20
*
SPECIALS TEXTC    '.<(+|&%*);~-/,%ž>:''='
*
ALFNUM   DATA,1   0,18,19,20,21,22,23,24,25,26,0,0,0,0,0,0,;
                  0,27,28,29,30,31,32,33,34,35,0,0,0,0,0,0,;
                  0,0,36,37,38,39,40,41,42,43,0,0,0,0,0,0,;
                  8,9,10,11,12,13,14,15,16,17,0,0,0,0,0,0
*  PUT AN 8-BIT ITEM INTO COMPRESSED RECORD.
*  PUT A  6-BIT ITEM INTO COMPRESSED RECORD.
*  REGISTER USAGE:
*    R1= NUMBER OF BITS LEFT AVAILABLE IN CURRENT CO WORD.
*    R3= CURRENT CO WORD RIGHT-JUSTIFIED.
*    R2= CO WORD COUNT LEFT IN CARD (NEGATIBE).
*    R8= THING TO PUT IN CARD.
*    R7= LINK REGISTER.
*    R4= ****    MUST BE PRESERVED    ****
*    R5= ****    MUST BE PRESERVED    ****
*    R6= ****    MUST BE PRESERVED    ****
PUT8BITS AI,1     -8
         BLZ      PUT8BIT2
         SLS,3    +8
         OR,3     8
         B        0,7
PUT8BIT2 SLS,3    8,1
         CI,2     -1
         BNE      PUT8BIT3
         LI,1     24
         B        PUT6BIT4
PUT6BITS AI,1     -6
         BLZ      PUT6BIT2
         SLS,3    +6
         OR,3     8
         B        0,7
PUT6BIT2 SLS,3    6,1
         CI,2     -1
         BE       PUT6BIT3
PUT8BIT3 RES      0
         LW,9     8
         SLS,9    0,1
         OR,3     9
         AI,1     32
         B        PUT6BIT4
PUT6BIT3 LI,1     26
PUT6BIT4 STW,3    CO%BUF+27,2
          LW,3     8
         BIR,2    0,7
*
*  WRITE A CO RECORD OUT.
*
PUT%CO%  EQU      %
*  CALCULATE CHECKSUM & PUT IT IN CO RECORD.
         LI,2     -108
         LI,8     0
         LB,9     CO%BUF+27,2
         AW,8     9
         BIR,2    %-2
         LI,2     2
         STB,8    CO%BUF,2
         MTH,0    CO%FLAG           IS 'SC' OPTION REQUESTED
         BEZ      PUT%CO%1            NO, OUTPUT AS-IS
         LCI      4
         STM,4    ZONECI            SAVE REGISTERS 4-7
         LM,6     CO%IDWDS          3 ID WORDS AND CO SEQUENCE NUMBER
         LCI      3
         STM,6    CO%BUF+27         STORE CO ID WORDS AND ZEROES
         LI,4     HA(CO%BUF)+59     HA OF COLUMN 80
         LB,5     CO%FLAG           NUMBER OF SEQUENCE NUMBER DIGITS
         BEZ      %+2
         BAL,X7   CARDSEQ           CONVERT AND STORE SEQUENCE NUMBER
         LCI      4
         LM,4     ZONECI            RESTORE REGISTERS
         MTW,+1   CO%IDWDS+3        BUMP NEXT CO SEQUENCE NUMBER
PUT%CO%1 RES      0
*  WRITE A CO RECORD.
         M:WRITE  M:CO,;
                  (ERR,ERR%%CO),;
                  (ABN,ERR%%CO),;
                  (BUF,CO%BUF),;
                  (SIZE,*CO%SIZE),;
                  (WAIT)
*  BLANK OUT THE CO CARD TO ALL ZEROS.
         LI,8     0
         LI,2     26
         STW,8    CO%BUF,2
         BDR,2    %-1
*  CLEAR THE CHECKSUM
         LI,2     2
         STB,8    CO%BUF,2
*  BUMP CO CARD COUNT
         LI,2     1
         MTB,+1   CO%BUF,2
*  SAY THERE'S A FULL CARD LEFT NOW AND RETURN.
         LI,2     -26
         B        0,7
         PAGE
*
*  FINISH UP THE COMPRESSED  FILE.
*
FINSH%CO EQU      %
*        SAVE OUTSIDE REGS; GET INSIDE ONES.
         LCI      3
         STM,1    CO%REGO
         LM,1     CO%REGI
*  PUT AN ENDFILE BYTE INTO LAST ACRD.
         LI,8     3
         BAL,7    PUT6BITS
*  PUT LAST PARTIAL WORD INTO CO CARD BUFFER.
         SLS,3    0,1
         STW,3    CO%BUF+27,2
*  PUT A LAST-CARD CODE INTO CO CTLBYTE.
         LI,2     X'18'
         STB,2    CO%BUF
*  WRITE OUT LAST CO RECORD.
         BAL,7    PUT%CO%
         LCI      3
         LM,1      CO%REGO
         B        *LNKR
         PAGE
         USECT    CAR1
CO%BUF   RES      30
CO%REGO  RES      3                 CO OUTPUT REGISTERS
CO%REGI  RES      3
CIREC#   RES      1                 CI RECORD NUMBER
#BLANKS  RES      1                 # CONSECUTIVE BLANKS FOR DECODE%CI%S
*
         USECT    CAR2
         PAGE
READ%UPDATE         EQU       %
         DO       SYS=RBM
         LI,R     M:X2
         ELSE
         LI,R      F:X2
         FIN
         STW,R     ADRDCB
*  THE CONTROL-RECORDS ARE READ FROM F:X2KF;  THE
*  INFORMATION IN THE CONTROL RECORD IS THEN USED TO PROPERLY
*  POSITION F:X2 IN ORDER TO READ THE UPDATE RECORDS.
         MTW,ZERO  PLUS
         BEZ       LIRE%X2
         MTW,-UN   PLUS      ZERO SUR PLUS
         B         TEST1%SKIP
LIRE%X2  EQU       %
         BAL,RETOUR LECTURE%MAJ
         MTW,+1   UPDATE%LINE%COUNT
         LB,R      BUFSI
         CI,R      X'4E'     CARTE DE CONTROLE?
         BNE      BUMP%MINOR
*  IF THE CARD WHICH WAS READ IS NOT A CONTROL CARD,
*  IT IS PLACED IN 'BUFSI' AND (UPDATE%LINE%COUNT) IS BUMPED.
TEST1%SKIP          EQU       %
         LI,X      GET%COMPRESSED%LINE  SET EOF EXIT
         BAL,RETOUR READ%X2KF
         LH,VAL    ZONECI    APPEL 1ER DEMI-MOT
         LI,X      UN
         LH,VAL1   ZONECI,X  APPEL 2EME DEMI-MOT
         BNE       COMPAR%VAL%LAST
*  RETURN VALUES
*  IN LAST%UPDATE, NEXT%UPDATE, AND SKIP%COUNT.
         STW,VAL   LAST%UPDATE
         STW,VAL   NEXT%UPDATE
         BAL,RETRO SKIP%COMPRESSED
         B         LOAD%DM
BUMP%MINOR  RES   0
         MTW,+0   CO%FLAG           BUMP MINOR LINE NUMBER
         BNE      GSL%1               UNLESS 'CO' IS REQUIRED
         MTW,+1   IM@MINOR
         B        GET%SYMBOLIC%LINE1
*
COMPAR%VAL%LAST     EQU       %
         STW,VAL   NEXT%UPDATE
         STW,VAL1  LAST%UPDATE
         BAL,RETRO SKIP%COMPRESSED
         LW,VAL1   LAST%UPDATE
         SW,VAL1   NEXT%UPDATE
         AI,VAL1   UN
         STW,VAL1  SKIP%COUNT
*  USE INFORMATION IN CONTROL-RECORD DOUBLE-WORD TO POSITION
*  F:X2 FOR THE NEXT READ.
LOAD%DM  EQU       %
         MTW,+0   ZONECI+2          ARE THERE UPDATE CARDS
         BEZ      POINT%X2          BRANCH IF YES
         MTW,UN    PLUS
         B         *LNKR
POINT%X2 EQU       %
         INT,X    ZONECI+1          SAVE X2 RECORD NUMBER IN X
         SW,X     UPDATE%LINE%COUNT
         BEZ      *LNKR
         BLZ      PRECORD%BACK
         AWM,X    UPDATE%LINE%COUNT
         DO       SYS=RBM
         M:PRECORD M:X2,(N,*X),(FWD)
         ELSE
         M:PRECORD F:X2,(N,*X),(FWD)
         FIN
         B        *LNKR
PRECORD%BACK      EQU %
         AWM,X    UPDATE%LINE%COUNT
         LCW,X    X                 GET ABS VALUE OF NO. OF RECORDS
         DO       SYS=RBM
         M:PRECORD M:X2,(N,*X),(REV)
         ELSE
         M:PRECORD F:X2,(N,*X),(REV)
         FIN
         B         *LNKR
*
*
READ%X2KF  EQU    %
         DO1      SYS=BPMUTS
         M:READ   F:X2KF,(BUF,ZONECI),(SIZE,12),(ABN,ABNX2KF)
         DO1      SYS=RBM
         M:READ   M:X4,(BUF,ZONECI),(SIZE,12),(ABN,ABNX2KF)
         B        *RETOUR
*
         PAGE
*
*  HERE MEANS READING OF THE F:X2KF FILE IS FINISHED.
ABNX2KF  EQU       %
         LB,NB    10                GET ABN CODE FROM SR3.
         CI,NB    +5                QUIT
         BE       ABNOK             IF
         CI,NB    +6                NOT
         BNE      SORTIE%ABANDON    EOD OR EOF,
ABNOK    EQU      %                 ELSE OK.
         BAL,RETRO SKIP%COMPRESSED
         MTW,+1   FINMAJ
         B        *X
*
*  PRINT A MESSAGE AND THEN EXIT.
SORTIE%ABANDON  EQU  %
         ABORT    ABORT17           ABNORMAL OR ERROR ON M:X4/F:X2KF
         PAGE
*
*  READ A COMPRESSED CARD AND
*  DECOMPRESS IT INTO BUFSI.
*
DECODE%CI%SI        EQU       %
         LCI      +6
         LM,2     CIRDREGS          LOAD OURS.
#1       STW,3    CI%CARD+20,2      FILL CARD AREA
         BIR,2    #1                WITH BLANKS.
         LI,2     -81               INITIALIZE CARD INDEX.
#2       BAL,3    GET6BITS          GET CI CTRL CODE
         CI,4     +7                IS IT CHARACTER?
         BL       #4,4              BRANCH IF NO.
         LB,4     XLATETBL,4        TRANSLATE TO EBCDIC
#3       BIR,2    %+2               BUMP CARD INDEX.
         LI,2     0                 RECORD>80 BYTES - IGNORE BEYOND 80
         STB,4    CI%CARD+20,2      & STORE INTO CARD.
#4       B        #2                PADDING.
         B        BADCTRL           ERROR; ILLEGAL CI CTRL CODE
         B        USERRTRN          END-OF-RECORD.
         B        ENDFILE           END-OF-FILE.
         B        #5                8-BIT LITERAL.
         AI,2     -64               N+1 BLANKS
         AI,2     +65               N+65 BLANKS
         BAL,3    GET6BITS          GET COUNT
         AW,2     4                 BUMP OUTPUT INDEX TO SKIP BLANKS
         B        #2
#5       BAL,3    GET8BITS          PUT 8-BIT LITERAL
         B        #3                INTO CARD & CONTINUE.
*
GET6BITS EQU      %
         LI,4     +0                CLEAR ANSWER REG.
         AI,7     -6                ARE 6 BITS AVAILABLE IN REG 5?
         BLZ      #11               BRANCH IF NO.
         SLD,4    +6                SHIFT THEM INTO ANSWER
         B        0,3               REG & RETURN
GET8BITS EQU      %
         LI,4     +0                CLEAR ANSWER REG.
         AI,7     -8                ARE 8 BITS AVAILABLE IN REG 5?
         BLZ      #13               BRANCH IF NO.
         SLD,4    +8                SHIFT THEM INTO ANSWER
         B        0,3               REG & RETURN
#11      BIR,6    #18               BRANCH IF MORE WORDS IN CI BUFFER
         BAL,7    NEXTCI            READ NEW CI RECORD
         LI,4     0
         LI,7     -6                INDICATE STILL 6 BITS TO GET.
         B        #12               GO GET NEW WORD OF BITS.
#18      RES      0
         SLD,4    +6,7              SHIFT REMAINING BITS INTO ANS REG.
#12      LW,5     CI%BUFR+27,6      GET NEXT CI WORD.
         LCW,7    7                 SHIFT REST OF CTRL
         SLD,4    0,7               CODE BITS INTO
         LCW,7    7                 ANSWER REG.
         AI,7     +32               COMPUTE REMAINING BITS.
         B        0,3               RETURN
#13      BIR,6    #14               BRANCH IF MORE WORDS IN CI BUFFER.
         BAL,7    NEXTCI            READ NEW CI RECORD
         LI,4     0
         LI,7     -8                INDICATE STILL 8 BITS  TO GET.
         B        #12               GO GET NEW WORD OF BITS.
#14      SLD,4    +8,7              SHIFT REMAINING BITS INTO ANS REG.
         B        #12               GO GET NEW WORD OF BITS.
*
NEXTCI   EQU      %
         M:READ   *CI%DCB,(BUF,CI%BUFR),(SIZE,120),(ERR,ERR%ABN),;
                  (ABN,ERR%ABN),(WAIT)
         LB,5     CI%BUFR           IS RECORD
         CI,5     X'38'             IN CI FORMAT
         BE       VALIDATE
         CI,5     X'18'             MAYBE LAST CARD FORMAT
         BNE      PRINT%ER1
VALIDATE LI,6     1                 CHECK RECORD SEQUENCE NUMBER
         LW,5     CIREC#
         CB,5     CI%BUFR,6
         BE       VALID%1
         LW,X     CI%BUFR           CI RECORD CONTROL WORD
         ABORT    ABORT18           SEQUENCE ERROR
VALID%1  RES      0
         LB,5     CI%BUFR           I.D. BYTE
         AH,5     CI%BUFR           SEQUENCE NUMBER
         LI,6     X'FF'
         AND,6    CI%BUFR           BYTE COUNT
         AW,5     6
         AI,6     -5                ADJUST FOR BYTES NOT IN THE LOOP
         BEZ      VALID%3           BRANCH IF BYTE COUNT IS 5
*
VALID%2  RES      0
         LB,4     CI%BUFR+1,6       LOOP TO ADD REST OF
         AW,5     4                   RECORD TO CHECKSUM
         BDR,6    VALID%2
VALID%3  RES      0
         LB,4     CI%BUFR+1         BYTE 4 ISN'T IN THE LOOP
         AW,5     4
         LI,6     -26               # WORDS IN THE RECORD - 1
         MTW,+1   CIREC#            BUMP RECORD NUMBER
         LI,4     2                 COMPARE TO RECORD
         CB,5     CI%BUFR,4           CHECKSUM
         BE       0,7               OKAY.  EXIT
         LW,3     CIREC#            NUMBER OF NEXT CI RECORD
         LW,X     CI%BUFR           CI RECORD CONTROL WORD
         ABORT    ABORT19           CHECKSUM ERROR
ENDFILE  EQU      %
         CI,2     -81               IS THIS THE FIRST BYTE
         BNE      BADCTRL           BRANCH IF NO
         CI,LNKR  SKIP%C2           ARE WE IN SKIP MODE
         BE       BADCTRL           BRANCH IF YES
ENDFILE1 RES      0
         LW,X     =' END'
         STW,X    CI%CARD
USERRTRN RES      0
         LCI      +3                SAVE CURRENT REGISTERS FOR
         STM,5    REGS567             THE NEXT CI RECORD
         B        *LNKR
ENDFILE2 RES      0
         CI,2     -81               IS THIS THE FIRST BYTE
         BNE      ERR%%CI           BRANCH IF NO
         CI,LNKR  SKIP%C2           ARE WE IN SKIP MODE
         BE       ERR%%CI           BRANCH IF YES
         B        ENDFILE1
BADCTRL  RES      0
         LW,3     CIREC#            NUMBER OF NEXT CI RECORD
         ABORT    ABORT20           CI CODE ERROR
*
ERR%ABN  EQU      %
         LB,NB    SR3               ERROR OR ABN CODE
         CI,NB    6                 IS IT EOF
         BE       ERR%ABN2          YES
         CI,NB    5                 IS IT EOD
         BNE      ERR%%CI           NO
         MTW,0    EODCNTCI          YES, IS THIS THE 1ST EOD
         BNEZ     ERR%ABN2          NO
         MTW,1    EODCNTCI          YES, COUNT IT
         B        NEXTCI            GO READ AGAIN
ERR%ABN2 RES      0
         MTW,+0   CIREC#            TEST FOR FIRST READ
         BGZ      ENDFILE2          NO
         MTW,0    BA%FLAG           YES, BA SPECIFIED
         BNEZ     ROOTEXIT          YES, NORMAL TERMINATION
         ABORT    ABORT13           NO, ABORT WITH MISSING CI
XLATETBL EQU      %-1
         DATA     '    '            LAST BLANK IS 1ST ENTRY.
         TEXT     '0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ'
         TEXT     '.<(+|&%*);~-/,%ž>:''='
CIREGS   DATA      -20,'    ',0,0,0,0
         USECT    CAR1
CIRDREGS EQU      %
         RES      3
REGS567  RES       1
REG6     RES       1
REG7     RES       1
CI%BUFR  RES,1    120
CI%CARD  EQU      BUFSI
         USECT    CAR2
*
         PAGE
*
*
*  SKIP NUMBER OF COMPRESSED RECORDS INDICATED BY
*  CONTROL RECORD; ALSO INCREMENT CI%LINE%COUNT.
SKIP%COMPRESSED     EQU       %
         LW,R1    SKIP%COUNT        EXIT IF NO COMPRESSED LINES
         BEZ      *RETRO              TO SKIP
         AWM,R1   COMPTE%CI         ADD COUNT TO COMPRESSED LINE COUNT
         STW,LNKR VAL               SAVE LNKR
         MTW,+0   CO%FLAG           BUMP MAJOR LINE NUMBER
         BNEZ     SKIP%C1             UNLESS 'CO' IS REQUESTED
         AWM,R1   IM@MAJOR
SKIP%C1  RES      0
         BAL,LNKR DECODE%CI%SI      SKIP A COMPRESSED LINE
SKIP%C2  RES      0                 LABEL USED AS A FLAG IN DECODE%CI%SI
         MTW,-1   SKIP%COUNT
         BGZ      SKIP%C1
         LW,LNKR  VAL               RESTORE LNKR
         B        *RETRO
         PAGE
*
*  READ A SYMBOLIC RECORD INTO THE 'BUFSI' AREA
*
LECTURE%MAJ         EQU       %
         LW,1     EOF%FLAG          HAS END-OF-FILE BEEN READ
         BNEZ     ABNSI10           BRIF YES
*
         M:READ   *ADRDCB,(BUF,BUFSI),(SIZE,120-40*(SYS=RBM)),;
                  (ABN,LECTURE%MAJ%ABN),(ERR,LECTURE%MAJ%ABN)
         LB,1     BUFSI
         AND,1    =X'DB'            TEST FOR A BINARY
         CI,1     X'18'               OR COMPRESSED RECORD
         BE       PRINT%ER2
         LI,1     8                 GET
         LH,1     *ADRDCB,1         RECORD
         SLS,1    -1                LENGTH
LECT%MAJ%1  RES   0
         AI,1     -MAXSI
         BGEZ     *RETOUR
         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
         B        *RETOUR
*
LECTURE%MAJ%ABN   RES   0
         LW,X     ADRDCB
         CI,X     M:SI              IS ERROR ON 'SI'
         BNE      ABN%%X2           NO
ABN%%SI  RES      0
         LB,X     SR3
         CLM,X    FIVE%SIX          EOD OR EOF ACCEPTABLE             *D-CD
         BOL      ERR%%SI            - ERROR ON ANYTHING ELSE.        *D-CD
*                                                                     *D-CD
         MTW,0    NIVO                                                *D-CD
         IF,EZ                      EITHER TERMINATES SYSTEM          *D-CD
         MTW,0    EODCNT            NEED TWO TO TERMINATE SOURCE,     *D-CD
         IF,EZ                        HOWEVER.                        *D-CD
         MTW,+1   EODCNT            BUMP EOD COUNT
         B        LECTURE%MAJ       GO RE-READ
*                                                                     *D-CD
         FI                                                           *D-CD
         MTW,+1   EOF%FLAG          SET END-OF-FILE FLAG
         LW,X     IM@MAJOR          TEST FOR FIRST CARD READ
         OR,X     IM@MINOR
         BNEZ     ABNSI10           NOT FIRST
         MTW,+0   BA%FLAG           BATCH ASSEMBLIES
         BNEZ     ROOTEXIT          YES, NORMAL TERMINATION       /10770/B-08773
         ABORT    ABORT14           NO, ABORT WITH MISSING SI
         FI                                                           *D-CD
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'
         LI,RETOUR BUMP%MAJOR       SET EXIT FROM LECTURE%MAJOR
         B        ZAP%LF%CR
ENDMSG   TEXT     ' END  * END STATEMENT SUPPLIED BY AP *'
ENDMSIZE EQU      %-ENDMSG
         PAGE
*  PRINT ERROR MESSAGE ER1.
PRINT%ER1           EQU       %
         LW,3     CIREC#            RECORD NUMBER
         LW,X     CI%BUFR           CI RECORD CONTROL WORD
         ABORT    ABORT23           ILLEGAL I.D.
PRINT%ER2   RES   0
         ABORT    ABORT24           COMPRESSED RECORD IN SI FILE
         PAGE
         LOCAL    %10,%20,%30
         LOCAL    %08,X1
X1       EQU      1
X2       EQU      2
IM@COPY  EQU      %
         LCI      +15               SAVE CALLER'S
         STM,1    SAVAREA           REGISTERS
         LI,X1    +1
         STW,X1   IM@SYS
         MTW,+1   NIVO              BUMP LEVEL #.
         LW,X1    NIVO              IF IT'S
         CI,X1    MAXSYS            TOO BIG,
         BG       2MANYSYS          QUIT.
         CI,X1    +1
         BG       %08
         LD,R8    STKINIT           INITIALIZE STACK DBLWORD
         STD,R8   SYSSTK
         LD,R8    SYSINIT           INITIALIZE 'OPEN' FPT
         STD,R8   SYSOPEN
         DO       SYS=BPMUTS
         LD,R8    SYSINIT1
         STW,R8   SYSFILE-1         CONTROL WORD FOR FILE NAME
         STW,R9   SYSACCT-1         CONTROL WORD FOR ACCOUNT NAME
         FIN
         LI,X1    F:SYS
         STW,X1   CI%DCB
         LI,X1    27
         LW,R8    CI%BUFR-1,X1
         STW,R8   CI%BSAV-1,X1
         BDR,X1   %-2
%08      RES      0
         BAL,X1   CLOSESYS          CLOSE F:SYS IF IT'S OPEN
%10      LW,R8    CIREC#            SAVE CURRENT
         LW,R9    1ERLECTURE%LI     LINE TYPE
         STB,R9   R8
         PSW,R8   SYSSTK            CI POSITION.
         LW,R8    IM@MAJOR          SAVE
         PSW,R8   SYSSTK            LINE #.
         LI,R8    0
         STW,R8   1ERLECTURE%LI     CLEAR LINE TYPE
         STW,R8   CIREC#            CLEAR RECORD NUMBER
         STW,R8   IM@MAJOR
         LCI       +3                  SAVE CURRENT
         LM,X1     REGS567             CI REGS.
         PSM,X1   SYSSTK
         DO       SYS=RBM
         LW,X1    F:SYS+5           SAVE CURRENT FILE NAME
         LW,X1+1  F:SYS+6             AND AREA
         LI,X1+2  X'3F00'
         AND,X1+2 F:SYS+1
         LCI      3
         PSM,X1   SYSSTK
         LW,R8    BLANC             BLANK OUT FILE NAME IN
         STW,R8   F:SYS+5
         STW,R8   F:SYS+6
         LB,X1    IM@NAME           MOVE FILE NAME INTO DCB
         CI,X1    8                   AND IN SYS NAME FOR 'ABORT'
         BLE      %+2
         LI,X1    8                 TRUNCATE FILE NAME TO 8 CHARS
         STB,X1   IM@NAME
         LW,X2    IM@NAME
         AND,X2   L(X'FFFFFF')
         AW,X2    X1
%20      AI,X2    -1
         LB,R8    0,X2
         AI,X1    -1
         STB,R8   F:SYS+5,X1
         BGZ      %20
         ELSE
         LCI      +8                SAVE CURRENT
         LM,X1    SYSFILE           FILE NAME.
         PSM,X1   SYSSTK
         LCI      +2                SAVE
         LM,X1    SYSACCT           CURRENT
         PSM,X1   SYSSTK            ACCT.
         LI,X1    +8                BLANK OUT
         LW,R8    BLANC             FILE
         STW,R8   SYSFILE-1,X1      NAME
         BDR,X1   %-2               AREA
         LB,X1    IM@NAME           MOVE
         CI,X1    31
         BLE      %+2               LIMIT SYSTEM NAME TO 31 CHARS
         LI,X1    31
         STB,X1   IM@NAME
         STB,X1   SYSFILE           FILE
         LW,X2    IM@NAME           NAME
         AND,X2   =X'FFFFFF'        INTO
         AW,X2    X1                FPT
%20      AI,X2    -1                FILE
         LB,R8    0,X2              NAME
         STB,R8   SYSFILE,X1        AREA.
         BDR,X1   %20
         FIN
         LW,R8    NIVO              MOVE SYSTEM NAME IF ON LEVEL ONE
         CI,R8    1
         BNE      ENDMOVE
MOVESYSNAME  RES  0
         AI,X1    1
         LB,R8    0,X2
         STB,R8   SYSNAME,X1
         AI,X2    1
         CB,X1    IM@NAME
         BL       MOVESYSNAME
         STB,X1   SYSNAME
ENDMOVE  RES      0
         LI,X1    0
         DO       SYS=RBM
%30      LB,R8    ACCOUNTS,X1
         SLS,R8   8
         LW,R9    L(X'3F00')
         STS,R8   F:SYS+1
         ELSE
%30      LD,R8    ACCOUNTS,X1       TRY TO
         STW,R8   SYSACCT           FIND
         STW,R9   SYSACCT+1         THE
         FIN
         CAL1,1   SYSOPEN           FILE
         DO       SYS=RBM                                      /27492/*D-CD
         M:REW    F:SYS,(WAIT)                                 /27492/*D-CD
         FIN                                                   /27492/*D-CD
         B        FOUNDIT           BY
SYSABN   LB,SR3   SR3               OPENING
         CI,SR3   X'03'             WITH EACH
         BNE      SYSOPNER          POTENTIAL ACCOUNT
         AI,X1    1
         CW,X1    #ACCTS
         BL       %30
         LI,X1    0
         STW,X1   IM@SYS
         B       IM@END1            CAN'T FIND.  RECOVER & RETURN
*
FOUNDIT  LCI       +6                  START CI
         LM,X1    CIREGS            ROUTINE WITH
         STM,X1   CIRDREGS          FRESH REGS.
         B        RESTORE           RESTORE REGS AND EXIT
*
FCDBIT   EQU      X'00200000'       'OPEN' BIT IN THE DCB
CLOSESYS RES      0                 CLOSE F:SYS DBC IF IT'S OPEN
         LW,R8    F:SYS
         CW,R8    =FCDBIT           TEST FOR DCB OPEN
         BAZ      0,X1              IT'S ALREADY CLOSED
         M:CLOSE  F:SYS
         B        0,X1
         BOUND    8
STKINIT  DATA     STACK-1
         DATA,2   STKL*MAXSYS,0
SYSINIT  GEN,8,24 X'14',F:SYS
         DATA     SYS=BPMUTS
*  DATA WORDS TO INITIALIZE FPT FOR BPMUTS
SYSINIT1 DATA     X'01000808'       FILE-NAME,NOT-LAST,SIG.,SIZE
         DATA     X'02010202'       ACCOUNT,LAST,SIG.,SIZE
         PAGE
         LOCAL    %08,%10,X1
X1       EQU      1
IM@END   LCI      15
         STM,1    SAVAREA
IM@END1  RES      0
         MTW,-1   NIVO
         BGZ      %08
         BLZ      ENDITALL
         LI,X1    27
         LW,R8    CI%BSAV-1,X1
         STW,R8   CI%BUFR-1,X1
         BDR,X1   %-2
         LI,X1    M:CI
         STW,X1   CI%DCB
%08      RES      0
         BAL,X1   CLOSESYS          CLOSE F:SYS IF IT'S OPEN
         DO       SYS=RBM
%10      LCI      3                 RECOVER PREVIOUS FILE NAME
         PLM,X1   SYSSTK              AND AREA
         STW,X1   F:SYS+5
         STW,X1+1 F:SYS+6
         LW,R8    X1+2
         LW,R9    L(X'3F00')
         STS,R8   F:SYS+1
         ELSE
%10      LCI      +2                RECOVER PREVIOUS
         PLM,X1   SYSSTK
         STW,X1   SYSACCT           ACCT
         STW,X2   SYSACCT+1         NUMBER.
         LCI      +8                RECOVER
         PLM,X1   SYSSTK            PREVIOUS
         LCI      +8                FILE
         STM,X1   SYSFILE           NAME.
         FIN
         LCI       +3                  RECOVER
         PLM,X1   SYSSTK            PREVIOUS
         LCI       +3                  CI
         STM,X1    REGS567             REGS.
         PLW,X1   SYSSTK            RECOVER
         STW,X1   IM@MAJOR          LINE #.
         PLW,X1   SYSSTK            RECOVER
         LB,R8    X1                PREVIOUS
         STW,R8   1ERLECTURE%LI     LINE TYPE
         AND,X1   =X'FFFFFF'        AND
         STW,X1   CIREC#            PREVIOUS RECORD #.
         MTW,0    NIVO
         BEZ      RESTORE
         CAL1,1   SYSOPEN           OPEN PREVIOUS FILE.
         AI,X1    -1                POSITION
         BEZ      IM@END3
         M:PRECORD *CI%DCB,(N,*X1),(FWD)
IM@END3  RES      0
         M:READ   *CI%DCB,(BUF,CI%BUFR),(SIZE,120)
         B        RESTORE           RESTORE REGS AND EXIT
*
ENDITALL   RES    0
         LW,X1    LINE%TYPE         IS SI,CI REQUESTED
         CI,X1    2
         BAZ      ENDITALL1         BRANCH IF ONLY SI
         BAL,RETRO SKIP%COMPRESSED
         LB,R8    CI%BUFR           IS LAST RECORD ALREADY READ
         CI,R8    X'18'
         BE       ENDITALL2         YES, NO PROBLEM
         LCI      +6
         LM,2     CIRDREGS          THE NEXT BYTE MUST BE END-FILE
         BAL,3    GET6BITS          GET THE NEXT CONTROL BYTE
         CI,4     3                 TEST FOR END-FILE
         BNE      BADCTRL
ENDITALL2   RES   0
         LW,X1    LINE%TYPE
         CI,X1    3
         BNE      ENDITALL1         NOT SI,CI
         LW,X     FINMAJ            BRANCH IF EOF WAS FOUND
         BGZ      ENDITALL1           ON X2KF FILE
         LI,X     ENDITALL4         SET EOF EXIT
         BAL,RETOUR READ%X2KF
         B        ENDITALL6         NO EOF ON X2KF
ENDITALL4   RES   0
         M:READ   *ADRDCB,(BUF,BUFSI),(SIZE,108-28*(SYS=RBM)),;
                  (ABN,ENDITALL5),(ERR,ENDITALL5)
         LB,X     BUFSI             MAKE SURE CURRENT UPDATE GROUP
         CI,X     '+'                 IS FINISHED
         BE       ENDITALL1         YES, IT'S FINISHED
ENDITALL6   RES   0
         BAL,RL   CLRLSTBF          CLEAR LSTBF AREA
         LB,X1    UPDATE%LINE%ERR   BYTE COUNT
ENDITALL3   RES   0
         LB,IOADD UPDATE%LINE%ERR,X1
         STB,IOADD LSTBF,X1         MOVE NEXT BYTE OF MESSAGE
         BDR,X1   ENDITALL3
         MTW,+1   UPDT%ERROR
         LI,IOADD LSTBF
         LB,IOSIZE UPDATE%LINE%ERR
         BAL,IORL WRITEDO
         LW,X1    LO%FLAG
         OR,X1    LU%FLAG
         BEZ      ENDITALL1
         BAL,IORL WRITELO
ENDITALL1   RES   0
         MTW,0    CO%FLAG
         BEZ      RESTORE
         BAL,LNKR FINSH%CO
         B        RESTORE           RESTORE REGS AND EXIT
ENDITALL5   RES   0
         LB,NB    10                MAKE SURE ABN OR ERR CODE
         CI,NB    5                   IS EOD OR EOF
         BE       ENDITALL1
         CI,NB    6                 TEST FOR EOF
         BE       ENDITALL1
         B        ENDITALL6
SYSOPNER EQU      %
         ABORT    ABORT15           ERROR OR ABN WHEN OPENING F:SYS
2MANYSYS RES      0
         ABORT    ABORT16           SYSTEMS NESTED TOO DEEPLY
UPDATE%LINE%ERR RES 0
         TEXTC    'UPDATE LINE NUMBERS EXCEED COMPRESSED FILE '
         PAGE
*
*   R E A D C
*        PERFORM READ OF CN CONTROL COMMAND
*
READC    RES      0
         LCI      15
         STM,1    SAVAREA           SAVE REGISTERS
         LH,XT2   DC%FLAG
         CI,XT2   2
         IF,NE                      NORMAL - READ FROM C DEVICE
         M:READ   M:C,;
                  (ERR,ERR%%C),;
                  (ABN,ABN%%C),;
                  (BUF,BUFSI),;
                  (SIZE,80),;
                  (WAIT)
         LI,XT    8
         LH,X     M:C,XT
         SLS,X    -1                ARS
         BAL,RETOUR   LECT%MAJ%1    FILL RECORD & STRIP CR OR LF
         LI,XT    1
         MTB,0    CORRESWD,XT
         IF,EZ                      DON'T ECHO ON SAME DEVICE
         LCI      10
         LM,1     BUFSI
         STM,1    LSTBF+1
         LM,1     BUFSI+10
         STM,1    LSTBF+11
         LW,XT    BLANC
         STW,XT   LSTBF
         LI,IOADD LSTBF
         LI,IOSIZE   84
         BAL,IORL WRITELO
         FI
         ELS                        INIT HAD TO GET THEM OUT OF THE WAY
         M:READ   F:X1,;
                  (ERR,ERR%%X1),;
                  (ABN,ABN%%X1),;
                  (BUF,BUFSI),;
                  (SIZE,80),;
                  (WAIT)
         FI
         LCI      15
         LM,1     SAVAREA           RESTORE REGISTERS
         EXIT     IORL
*
*   A B N % % X 1
*
ABN%%X1  RES      0
         LB,XT    SR3
         CLM,XT   FIVE%SIX          CHECK FOR EOF OR EOT ON X1
         BOL      ERR%%X1           OTHER ERROR - STD. HANDLING
*
         CALL     FIN%X1
         B        CNTERM
*
*   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
*
         B        CNTERM
*
*
*   F I N % X 1
*
FIN%X1   RES      0
         BAL,IORL REWX1
*
         DO       SYS=RBM
         M:DEVICE F:X1,;            CHANGE BACK FOR ENCODED TEXT
                  (SIZE,BYX1SIZE),;
                  (ORG,UNBLOCK)
         FIN
*
         EXIT
*
         END

