 TITLE 'TELEFILE ASSEMBLY PROGRAM - APCCI'
         PCC      0
         SPACE    6
*   %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
*   %%%%%     MODULE NAME:     APCCI                   %%%%%
*   %%%%%     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
XAPD1    DSECT    0                 OVERLAY DATA AREA
CCI1     CSECT    1                 CODE SECTION
         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
*
*        XEROX ASSEMBLY PROGRAM CONTROL CARD INTERPRETER.
*
         REF      AC%FLAG
         REF      PD%FLAG
*
         DEF      CTL%CARD%INTERPRETER     (ENTRY POINT.)
         DEF      STDERROR
         DEF      AP%ABORT          (ENTRY POINT)
*
         REF      CO%SIZE           BYTE SIZE OF CO RECORD
         REF      M:C
         REF      ERR%%X1,ERR%%X3
         REF      ERR%%X2,ERR%%X4
         REF      ABN%%X1,ABN%%X3
         REF      ABN%%X2,ABN%%X4
         REF      ABN%%STD
         REF      ABORT
         REF      ACCOUNTS
         REF      #ACCTS
         REF      CORRESWD          FLAGS INDIC. IDEN. DCB ASSIGNMENTS
         REF      ERR%%STD                                            *D-CCI
         REF      LOWCORE
         REF      ENDCORE
         REF      MAJLINE,SUBLINE   ASSEMBLY LINE NUMBER
         REF      SEGMENT#          AP OVERLAY SEGMENT
*
         DO       SYS=BPMUTS
         REF      INIT%TUNITS
         REF      PAGETBL
         REF      SO%ADJ%FPT
         REF      SO%ADJ%NAME
         REF      SO%KEY
         FIN
*
         REF      SYSLEVEL
         REF      MPX1
         REF      SYSNAME
         REF      CLOSE%FILES
         REF      ROOTRTN
         REF      SAVAREA
         REF      XAPCODE
         REF      X3BUF,WDX3SIZE
         REF      WRITEDO,WRITELO
         REF      LSTBF
         REF      CLRLSTBF
         REF      OPTION%FLAGS
         REF      PGLINES
         REF      SDFCON
         REF      SDFSYS
         REF      SDFSYS%SIZE
         REF      LINE%TYPE
         REF      ASSEMBLE%FLAG
         REF      NUM%PAGE%LINES
         REF      ERR%%BO,ERR%%CI,ERR%%CO,ERR%%DO
         REF      ERR%%GO,ERR%%LO,ERR%%SI,ERR%%SO
         REF      BYX1SIZE,BYX3SIZE
         REF      BO%IDWDS,CO%IDWDS
         DO       SYS=BPMUTS
         REF      DO%ONLINE
         REF      LO%ONLINE
         REF      M:UC
         REF      F:X1,F:X2,F:X3,F:X2KF,F:X5
         FIN
         REF      F:STD,F:SYS
         REF      TRAPLOC
        REF      M:SI,M:SO,M:CI,M:CO
         REF      M:BO,M:DO,M:GO,M:LO
*
         DO       SYS=BPMUTS
         SREF     J:JIT,JOPT
         SREF     TPEXT
         SREF     TPOVT
         SREF     TUEXT
         SREF     TUOVT
         FIN
*
         DO       SYS=RBM
         REF      M:X1,M:X2,M:X3,M:X4,M:X5
         FIN
*
         DEF      CCI1
*
*   EQUATES FOR ABORT
*
ABORT9   EQU      9
ABORT10  EQU      10
ABORT11  EQU      11
ABORT12  EQU      12
*
*        REGISTERS.
*
R0       EQU      0
X1       EQU      1                 TEMP INDEX.
X2       EQU      2                 INDEX TO CURRENT CHARACTER.
X3       EQU      3
X4       EQU      4
X5       EQU      5
X6       EQU      6
X7       EQU      7                 INTERNAL LINK REGISTER.
R8       EQU      8                 OPTION-NAME ACCUMULATOR.
R9       EQU      9                 CURRENT CHARACTER.
R10      EQU      10                TEMP.
R11      EQU      11                TEMP.
R12      EQU      12                TEMP.
R13      EQU      13                TEMP.
R14      EQU      14
R15      EQU      15                EXTERNAL LINK REGISTER.
IOADD    EQU      8
IOSIZE   EQU      9
IORL     EQU      10
SR1      EQU      8
SR2      EQU      9
SR3      EQU      10
SR4      EQU      11
AR       EQU      0                 ABORT REGISTER
AM       EQU      1                 ABORT MESSAGE REGISTER
XW       EQU      2
XT       EQU      4                 TEMP (EVEN)
XT1      EQU      XT+1              TEMP (ODD)
XT2      EQU      XT+2              TEMP
RL       EQU      7                 SUBROUTINE LINK REGISTER
*                                                                     *D-CCI
*  MISCELLANEOUS                                                      *D-CCI
*                                                                     *D-CCI
ADDRFLD  EQU      X'1FFFF'          WORD ADDRESS FIELD MASK           *D-CCI
EADRFLD  EQU      X'1FFFE'          (EVEN) WORD ADDRESS FIELD MASK    *D-CCI
*
*  SALUTE MESSAGE
*
SALUTE%START      TEXT ' TELEFILE ASSEMBLY PROGRAM '
                  DATA,1 X'0D',X'40',C'O',C'P'
                  TEXT 'TIONS '
SALUTE%END        DATA   X'16000000'
*
*  EQUATES FOR LOCATIONS WITHIN RBM
*
CPRABNEO EQU      4                 DCB ABN FIELD OFFSET (CP-R)       *D-CCI
CPRERREO EQU      3                 CPR ERR FIELD OFFSET (CP-R)       *D-CCI
D1       EQU      6                 TYPE CODE FOR 'D1' AREA ON DISK
K:BPEND  EQU      X'153'            FWA OF USABLE BACKGROUND
K:BCKEND EQU      X'141'            LWA OF USABLE BACKGROUND
K:PAGE   EQU      X'174'            BYTE 0 HAS NO. LINES ON PRINT PAGE
K:CCBUF  EQU      X'144'            CONTAINS LOCATION OF CONTROL CARD
* UTS JIT OPTION BITS.  MASKS FOR BITS WITHIN JOPT WORD
LOBIT    EQU      1                 BIT 31. SET BY TEL 'LIST'
GOBIT    EQU      X'80'             BIT 24. SET BY TEL 'OUTPUT'
DOBIT    EQU      X'100'            BIT 23. SET BY TEL 'COMMENT'
*
*        SIMPLE OPTIONS - THOSE REQUIRING ONLY A PRESENCE FLAG.
*        TO ADD A SIMPLE OPTION USE THE 'OPTION' COMMAND WITH LF(1) =
*        FLAG NAME & AF(1) = OPTION-STRING (<= 4 CHARACTERS).  DON'T
*        FORGET TO ADD CORRESPONDING ENTRY TO OPTION%FLAGS TABLE (ROOT).
*
#SIMPLE%OPTIONS   SET 0
*
OPTION   CNAME
         PROC
         REF      LF                (THESE ARE IN THE ROOT)
         DATA     AF(1)
#SIMPLE%OPTIONS   SET #SIMPLE%OPTIONS+1
         PEND
         USECT    CCI1
OPTION%NAMES   RES 0
*
BA%FLAG  OPTION   'BA'
BO%FLAG  OPTION   'BO'
CI%FLAG  OPTION   'CI'
CO%FLAG  OPTION   'CO'
DC%FLAG  OPTION   'DC'
GO%FLAG  OPTION   'GO'
LO%FLAG  OPTION   'LO'
LS%FLAG  OPTION   'LS'
LU%FLAG  OPTION   'LU'
ND%FLAG  OPTION   'ND'
NS%FLAG  OPTION   'NS'
SD%FLAG  OPTION   'SD'              SYMBOLIC DEBUGGING OUTPUT
SI%FLAG  OPTION   'SI'
SO%FLAG  OPTION   'SO'
SU%FLAG  OPTION   'SU'
         PAGE
         LOCAL    %05,%10,%20,%30
CTL%CARD%INTERPRETER EQU %
         STW,R15  ROOTRTN           SAVE RETURN ADDRESS
*
*   SET UP CURRENT TIMER UNIT COUNT FOR STATUS
*        REPORTING BY ON-LINE BREAK RECEIVER.
*
         DO       SYS=BPMUTS
         LW,XT    J:JIT+TPEXT       GET CURRENT CHARGEABLE
         AW,XT    J:JIT+TPOVT         TIME UNITS AND SAVE
         AW,XT    J:JIT+TUEXT         FOR LATER STATUS.
         AW,XT    J:JIT+TUOVT
         STW,XT   INIT%TUNITS
         LI,XT    0
         STW,XT   SO%KEY
         FIN
*
         LW,X1    ='    '
         STW,X1   BLANKS
         STW,X1   BLANKS+1
         LI,X1    0
         STW,X1   LINE%TYPE
         STW,X1   SDFCON            INITIAL SYSTEM NAME TABLE LENGTH
         STW,X1   SYSLEVEL
         STW,X1   #ACCTS
         STW,X1   BLANK%SWITCH      SET TO IGNORE BLANKS
         STW,X1   PRINT%SWITCH
         STW,X1   PGLINES
         STW,X1   SEGMENT#
         BAL,IORL OPENC
         BAL,IORL OPENDO
         BAL,IORL OPENLO
         M:DEVICE M:LO,(VFC)
         DO       SYS=BPMUTS
         MTW,0    *X'4F'            ARE WE ONLINE?
         BGEZ     %05               BRANCH IF NO.
         LW,X1    J:JIT+JOPT
         CI,X1    LOBIT             SET LO%FLAG IF 'LIST' BIT IS ON
         BAZ      %+2               IT'S OFF
         MTW,+1   LO%FLAG
         CI,X1    GOBIT             SET GO%FLAG IF 'OUTPUT' IS ON
         BAZ      %+2               IT'S OFF
         MTW,+1   GO%FLAG
         CAL1,1   =X'2C00006E'      SET '>' AS PROMPT CHARACTER
         M:WRITE  M:UC,(BUF,SALUTE%START),(SIZE,38)
         BAL,X7   READ%CTL%CARD     READ CONTROL CARD.
         B        %20
         ELSE
         LI,X1    0
         LV,XT    D1
         STB,XT   ACCOUNTS          PRESET DEFAULT ACCOUNT AREA
         MTW,+1   #ACCTS            SET DEFAULT # ACCTS TO 1
%30      RES      0
         LW,R8    *K:CCBUF,X1       MOVE CONTROL CARD
         STW,R8   CTL%CARD,X1       TO CTL%CARD AREA
         AI,X1    1
         CI,X1    20
         BL       %30
         B        %10
         FIN
%05      RES      0
         BAL,X7   READ%CTL%CARD     READ CONTROL CARD
%10      RES      0
         LI,X2    0
         BAL,X7   GET%NEXT%NONBLANK SKIP LEADING BLANKS
%12      RES      0
         BAL,X7   GET%NEXT%CHAR     SKIP TO THE
         CI,R9    ' '                 TERMINATOR AFTER
         BE       %20                 THE PROCESSOR NAME
         CI,R9    ','
         BNE      %12
%20      BAL,X7   GET%NEXT%NONBLANK GET 1ST OPTION CHARACTER.
         CI,R9    '.'               IS IT PERIOD?
         BE       SET%DEFAULTS      BRANCH IF YES.
         AI,X2    -1                BACK UP FOR RESCAN OF 1ST CHAR.
         B        COLLECT%OPTION    GO GET OPTIONS.
         PAGE
         LOCAL    %10
NEXT%OPTION       EQU %
         CI,R9    ','               IS CURRENT CHAR A COMMA?
         BE       COLLECT%OPTION    BRANCH IF YES.
         CI,R9    '.'               IS IT A PERIOD?
         BE       OPTIONS%DONE      BRANCH IF YES.  (ALL DONE.)
         B        BAD%SYNTAX        IT'S STRANGE; REPORT ERROR.
COLLECT%OPTION    EQU %
         LI,R8    0                 CLEAR OPTION-NAME ACCUMULATOR.
%10      BAL,X7   GET%NEXT%NONBLANK GET A CHARACTER.
         CI,R9    'A'               IS IT LETTER OR DIGIT?
         BL       SEARCH%OPTIONS    BRANCH IF NO.
         SLS,R8   +8                SHIFT PREVIOUS CHARS OVER.
         OR,R8    R9                MERGE IN NEWEST.
         B        %10               GO GET ANOTHER.
         PAGE
         LOCAL    %10,%20,%30,%40,%50,%60,%70,%80,%90
         LOCAL    %100,%110,%120
         LOCAL    %130,%140,%150,%160,%170,%180
         LOCAL    %200,%210,%220,%125
SEARCH%OPTIONS    EQU %
         LI,X1    #SIMPLE%OPTIONS   SEARCH ALL SIMPLE OPTIONS.
%10      CW,R8    OPTION%NAMES-1,X1 IS IT THIS ONE?
         IF,EQ
         MTW,+1   OPTION%FLAGS-1,X1
         B        NEXT%OPTION
*
         FI
         BDR,X1   %10               TRY ANOTHER.
*
*   NOT A SIMPLE OPTION - IS IT ONE OF THE SPECIAL OR
*      AUGMENTED OPTIONS?
*
         CI,R8    'CN'
         IF,EQ
         MTH,+1   DC%FLAG
         B        NEXT%OPTION
*
         FI
         CI,R8    'PD'
         BE       %40               BRANCH IF YES.
         CI,R8    'AC'              IS IT 'AC'?
         BE       %90               BRANCH IF YES.
         CI,R8    'SB'              IS IT 'SB'?
         BE       %130              BRANCH IF YES.
         CI,R8    'SC'              IS IT 'SC'?
         BE       %140              BRANCH IF YES.
         B        ILLEGAL%OPTION    NOT FOUND; REPORT ERROR.
%40      MTW,+1   PD%FLAG           SET FLAG.
         CI,R9    '('               ARE THERE SYSTEM NAMES?
         BNE      NEXT%OPTION       BRANCH IF NO.
         LI,X6    0                 INITIALIZE NAME-TABLE INDEX.
         STW,X6   SDFCON            CLEAR SDFSYS SIZE & NO. OF ENTRIES
%50      LW,X5    X6                SAVE INDEX FOR STORING LENGTH.
%60      BAL,X7   GET%NEXT%CHAR     GET CHARACTER.
         CI,R9    ')'               ARE WE FINISHED WITH ALL NAMES?
         BE       %70               BRANCH IF YES.
         CI,R9    ','               ARE WE FINISHED WITH THIS NAME?
         BE       %70               BRANCH IF YES.
         AI,X6    +1                BUMP INDEX.
         CI,X6    SDFSYS%SIZE       HAVE WE EXCEEDED TABLE SIZE?
         BG       BAD%SYNTAX        BRANCH IF YES.
         STB,R9   SDFSYS,X6         STORE CHAR IN TABLE.
         B        %60               GO GET ANOTHER CHAR.
%70      MTW,+1   SDFCON            BUMP NAME COUNT.
         LW,R8    X6                CALCULATE NAME
         SW,R8    X5                LENGTH.
         BEZ      BAD%SYNTAX        ZERO LENGTH = ERROR.
         STB,R8   SDFSYS,X5         STORE LENGTH.
         CI,R9    ')'               ARE ALL NAMES FINISHED?
         BE       %80               BRANCH IF YES.
         AI,X6    +1                BUMP INDEX.
         B        %50               GO GET NEXT NAME.
*
%80      RES      0
         AI,X6    +4                CONVERT BYTES
         SAS,X6   -2                TO WORDS.
         STH,X6   SDFCON            STORE COUNT OF BYTES.
         BAL,X7   GET%NEXT%NONBLANK GET CHAR.  (SHOULD BE ',' IF MORE.)
         B        NEXT%OPTION       GO PROCESS NEXT OPTION.
%90      MTW,+1   AC%FLAG           INDICATE OPTION.
         DO       SYS=RBM
         MTW,-1   #ACCTS            DELETE LAST ACCOUNT  (SP AREA)
         FIN
         CI,R9    '('               IF NOT '('
         BNE      BAD%SYNTAX        THEN ERROR.
%100     LD,R12   8BLANKS           INITIALIZE ACCT-NAME ACCUMULATOR.
         LI,X5    0                 INITIALIZE ACCUM. INDEX.
%110     BAL,X7   GET%NEXT%CHAR     GET NEXT CHAR.
         CI,R9    ','               IS IT COMMA?
         BE       %120              BRANCH IF YES.
         CI,R9    ')'               IS IT ')'?
         BE       %120              BRANCH IF YES.
         STB,R9   R12,X5            STORE INTO ACCUM.
         AI,X5    +1                BUMP INDEX.
         CI,X5    +8                MORE THAN 8
         BG       BAD%SYNTAX        CHARS IS ERROR.
         B        %110              GO GET NEXT CHAR.
         DO       SYS=BPMUTS
%120     LW,X5    #ACCTS            GET ACCT-NAME COUNT.
         MTW,+1   #ACCTS            INCREMENT COUNT (IN MEMORY).
         STD,R12  ACCOUNTS,X5       USE FORMER COUNT AS STORE INDEX.
         CI,X5    8
         BL       ACCT%OK
         FIN
         DO       SYS=RBM
%120     RES      0
         CI,X5    2                 ACCOUNTS MUST BE TWO CHARS
         BNE      BAD%SYNTAX
         LI,X5    16                TOTAL NUMBER OF ACCOUNTS
NEXT%AC  RES      0
         CW,R12   AC%TABLE-1,X5     FIND THE ACCOUNT NAME
         BE       AC%FND
         BDR,X5   NEXT%AC
         B        BAD%SYNTAX
AC%FND   RES      0
         LW,X1    #ACCTS
         CI,X1    15                TEST FOR TOO MANY
         BL       ACCT%OK
         FIN
         ABORT    ABORT9            TOO MANY ACCOUNT AREAS SPECIFIED
ACCT%OK  RES      0
         DO       SYS=RBM
         AI,X5    -1
         LB,X7    AC%CODE,X5        ACCOUNT CODE
         STB,X7   ACCOUNTS,X1
         MTW,+1   #ACCTS            BUMP NUMBER OF ACCTS
         FIN
         CI,R9    ','               IS THERE ANOTHER NAME?
         BE       %100              BRANCH IF YES.
         DO       SYS=RBM
         LI,X7    D1                ADD D1 AREA AS LAST ACCT.  /27062/*D-CCI
         AI,X1    1
         STB,X7   ACCOUNTS,X1
         MTW,+1   #ACCTS            AND BUMP # OF ACCTS
         FIN
%125     RES      0
         BAL,X7   GET%NEXT%NONBLANK GET CHAR.  (SHOULD BE '.' OR ',')
         B        NEXT%OPTION       GO PROCESS NEXT OPTION.
%130     RES      0
         LI,R14   BO%FLAG
         LI,X3    BO%IDWDS
         B        %150
%140     RES      0
         LI,R14   CO%FLAG
         LI,X3    CO%IDWDS
%150     RES      0
         LI,X7    8                 SET NO. OF DIGITS TO 8
         STB,X7   *R14
         MTH,1    *R14              SET SB OR SC FLAG
         LI,X7    0
         STW,X7   0,X3              CLEAR THE 3 ID/SEQ-NO
         STW,X7   1,X3                WORDS
         STW,X7   2,X3
         STW,X7   3,X3              CLEAR THE INITIAL SEQNO. WORD
         STW,X3   SAVEREGS          SAVE FOR ADDRESS OF SEQUENCE NO.
         CI,R9    '('               IS THERE AN IDENT STRING
         BNE      NEXT%OPTION       NO. GO GET NEXT OPTION
         SLS,X3   1                 CONVERT TO HALFWORD ADDRESS
%160     RES      0
         BAL,X7   GET%NEXT%CHAR     NEXT IDENT CHARACTER
         CI,R9    ')'
         BE       %125              END OF IDENT. GO READ TRAILING ','
         CI,R9    '('               IS THERE AN INITIAL SEQUENCE NUMBER
         BE       GETSEQ            YES. GO CONVERT IT
         MTB,-1   *R14              SUBT. 1 FROM BYTE COUNT
         BLZ      BAD%SYNTAX        MORE THAN 8 IDENT. CHARACTERS
         LI,X7    X'3F'             TRIM IDENT CHAR TO 6 BITS
         AND,X7   R9
         LH,R9    IDENTBL,X7        TRANSLATE TO A 12-BIT COLUMN CODE
         LB,X7    SFTBL,X1          GET NEXT SHIFT AMOUNT
         SLS,R9   0,X7              SHIFT 12-BIT CODE TO NEXT FIELD
         CI,X1    3                 IS THIS 1ST OR 5TH CHARACTER
         BAZ      %180                YES, DON'T BUMP HALFWORD ADDRESS
         LH,X7    R9                STORE HIGH ORDER
         AH,X7    0,X3                BITS IN
         STH,X7   0,X3                CURRENT HALFWORD
         AI,X3    1                 BUMP HALFWORD ADDRESS
%180     RES      0
         AH,R9    0,X3              STORE LOW ORDER BITS
         STH,R9   0,X3
         AI,X1    1                 BUMP INDEX TO SHIFT TABLE
         B        %160
GETSEQ   RES      0
         LW,X3    SAVEREGS          GET ADDR (-3) OF SEQUENCE NO.
GETSEQ1  RES      0
         BAL,X7   GET%NEXT%CHAR     NEXT SEQUENCE CHARACTER
         AI,R9    -'0'              IS IT NUMERIC
         BL       SEQEND              NO, TEST FOR RT PAREN
         CI,R9    9                 ERROR IF GREATER THAN 9
         BG       BAD%SYNTAX
         LW,X7    3,X3              PARTIAL SEQUENCE WORD
         MI,X7    10
         AW,X7    R9
         STW,X7   3,X3
         B        GETSEQ1
SEQEND   RES      0
         CI,R9    ')'-'0'           TERMINATOR MUST BE RT PAREN
         BNE      BAD%SYNTAX
         BAL,X7   GET%NEXT%CHAR     GET TERMINATOR FOR IDENT
         CI,R9    ')'               IT MUST ALSO BE RT PAREN
         BE       %125
         B        BAD%SYNTAX
SFTBL    DATA,1   4,8,12,16,4,8,12,16
         BOUND    4
ILLEGAL%OPTION    EQU %
         AI,R8    0                 IGNORE
         BEZ      NEXT%OPTION       NULL OPTION.
         OR,R8    ='    '           INSERT LEADING BLANKS.
         LI,X7    MSGS              SIZE OF MESSAGE
         LW,R10   OPTION%IGNORED-1,X7
         STW,R10  BUF%PRINT-1,X7    MOVE MESSAGE TO PRINT AREA
         BDR,X7   %-2
         STW,R8   BUF%PRINT-1+MSGS  STORE UNKNOWN OPTION
         M:PRINT  (MESS,BUF%PRINT)
         B        NEXT%OPTION       GO GET NEXT OPTION.
         PAGE
         LOCAL    %10
BAD%SYNTAX        EQU %
*        PRINT CONTROL CARD IN ERROR, PRINT ERROR POINTER,
*        PRINT ERROR MESSAGE, EXIT TO MONITOR.
         M:WRITE  M:LL,(BUF,CTL%CARD%DISPLAY),(SIZE,88)
         LD,R12   8BLANKS
         LI,X1    +10
%10      STD,R12  CTL%CARD%DISPLAY,X1
         BDR,X1   %10
         LI,R8    ':'
         STB,R8   CTL%CARD,X2
         M:WRITE  M:LL,(BUF,CTL%CARD%DISPLAY),(SIZE,88)
         ABORT    ABORT10           CONTROL CARD ERROR
         PAGE
         LOCAL    %05,%10,%15,%20
GET%NEXT%CHAR     EQU %
         MTW,+1   BLANK%SWITCH      DON'T IGNORE BLANKS.
GET%NEXT%NONBLANK EQU %
         STW,X7   GET%NEXT%RETURN   SAVE RETURN.
%05      CI,X2    +79               ARE WE AT END OF RECORD?
         BGE      %15               BRANCH IF YES.
         AI,X2    +1                BUMP INDEX TO NEXT CHAR.
         LB,R9    CTL%CARD,X2       GET CHARACTER.
         CI,R9    X'15'             IS IT LINE-FEED?
         BE       %10               BRANCH IF YES.
         CI,R9    X'0D'             IS IT CARRIAGE-RETURN?
         BE       %10               BRANCH IF YES.
         MTW,0    BLANK%SWITCH      SHALL WE IGNORE BLANKS?
         BNEZ     %20               BRANCH IF NO.
         CI,R9    ' '               IS IT A BLANK?
         BE       %05               BRANCH IF YES.
         CI,R9    ';'               IS IT SEMICOLON?
         BNE      %20               BRANCH IF NO.
         BAL,X7   READ%CTL%CARD     READ CONTINUATION RECORD.
         B        %05               GO GET CHARACTER.
%10      LI,R9    ' '               REPLACE LF OR
         STB,R9   CTL%CARD,X2       CR WITH BLANK.
%15      LI,R9    '.'               RETURN FAKE PERIOD.
         LI,X2    +80
%20      LI,X7    0                 INSURE
         STW,X7   BLANK%SWITCH      SWITCH OFF.
         B        *GET%NEXT%RETURN  RETURN.
         PAGE
         LOCAL    %10,%20
READ%CTL%CARD     EQU %
         LI,X1    +10                   CLEAR
         LD,R12   8BLANKS               BUFFER
%10      STD,R12  CTL%CARD%DISPLAY,X1   TO
         BDR,X1   %10                   BLANKS.
         M:READ   M:C,(BUF,CTL%CARD),(SIZE,80)
         LI,X2    -1                INITIALIZE BUFFER INDEX.
         DO       SYS=BPMUTS
         MTW,0    *X'4F'            ARE WE ONLINE?
         BLZ      0,X7              RETURN IF YES.
         MTW,0    PRINT%SWITCH      IS THIS 1ST CTL CARD?
         BEZ      %20
         FIN
         M:WRITE  M:LL,(BUF,CTL%CARD),(SIZE,80)
%20      MTW,+1   PRINT%SWITCH      SET TO PRINT CONTINUATIONS.
         B        0,X7              RETURN.
         PAGE
* EQUATES FOR COLUMN NUMBERS USED IN IDENTBL
#12      EQU      X'800'            COLUMN 12
#11      EQU      X'400'            COLUMN 11
#0       EQU      X'200'            COLUMN 0
#1       EQU      X'100'            COLUMN 1
#2       EQU      X'080'            COLUMN 2
#3       EQU      X'040'            COLUMN 3
#4       EQU      X'020'            COLUMN 4
#5       EQU      X'010'            COLUMN 5
#6       EQU      X'008'            COLUMN 6
#7       EQU      X'004'            COLUMN 7
#8       EQU      X'002'            COLUMN 8
#9       EQU      X'001'            COLUMN 9
IDENTBL  RES      0
         DATA,2   0                 BLANK
         DATA,2   #12+#1            A        12-1
         DATA,2   #12+#2            B        12-2
         DATA,2   #12+#3            C        12-3
         DATA,2   #12+#4            D        12-4
         DATA,2   #12+#5            E        12-5
         DATA,2   #12+#6            F        12-6
         DATA,2   #12+#7            G        12-7
         DATA,2   #12+#8            H        12-8
         DATA,2   #12+#9            I        12-9
         DATA,2   #12+#8+#2         CENT     12-8-2
         DATA,2   #12+#8+#3         DEC PT   12-8-3
         DATA,2   #12+#8+#4         LESS     12-8-4
         DATA,2   0                 LT PAREN
         DATA,2   #12+#8+#6         PLUS     12-8-6
         DATA,2   #12+#8+#7         OR       12-8-7
         DATA,2   #12               AND      12
         DATA,2   #11+#1            J        11-1
         DATA,2   #11+#2            K        11-2
         DATA,2   #11+#3            L        11-3
         DATA,2   #11+#4            M        11-4
         DATA,2   #11+#5            N        11-5
         DATA,2   #11+#6            O        11-6
         DATA,2   #11+#7            P        11-7
         DATA,2   #11+#8            Q        11-8
         DATA,2   #11+#9            R        11-9
         DATA,2   #11+#8+#2         EXCLAM   11-8-2
         DATA,2   #11+#8+#3         DOLLAR   11-8-3
         DATA,2   #11+#8+#4         ASTERISK 11-8-4
         DATA,2   0                 RT PAREN
         DATA,2   #11+#8+#6         SEMICLN  11-8-6
         DATA,2   #11+#8+#7         NOT      11-8-7
         DATA,2   #11               MINUS    11
         DATA,2   #0+#1             SLASH    0-1
         DATA,2   #0+#2             S        0-2
         DATA,2   #0+#3             T        0-3
         DATA,2   #0+#4             U        0-4
         DATA,2   #0+#5             V        0-5
         DATA,2   #0+#6             W        0-6
         DATA,2   #0+#7             X        0-7
         DATA,2   #0+#8             Y        0-8
         DATA,2   #0+#9             Z        0-9
         DATA,2   #12+#11                    12-11
         DATA,2   #0+#8+#3          COMMA    0-8-3
         DATA,2   #0+#8+#4          PERCENT  0-8-4
         DATA,2   #0+#8+#5          UNDSCORE 0-8-5
         DATA,2   #0+#8+#6          GREATER  0-8-6
         DATA,2   #0+#8+#7          QUESTION 0-8-7
         DATA,2   #0                0        0
         DATA,2   #1                1        1
         DATA,2   #2                2        2
         DATA,2   #3                3        3
         DATA,2   #4                4        4
         DATA,2   #5                5        5
         DATA,2   #6                6        6
         DATA,2   #7                7        7
         DATA,2   #8                8        8
         DATA,2   #9                9        9
         DATA,2   #8+#2             COLON    8-2
         DATA,2   #8+#3             NUMBER   8-3
         DATA,2   #8+#4             AT       8-4
         DATA,2   #8+#5             PRIME    8-5
         DATA,2   #8+#6             EQUAL    8-6
         DATA,2   #8+#7             QUOTES   8-7
         BOUND    4
         PAGE
         LOCAL    %05,%10,%20,%30
SET%DEFAULTS      EQU %
         MTW,+1   SI%FLAG           SET
         MTW,+1   LO%FLAG           DEFAULT
         MTW,+1   GO%FLAG           OPTIONS.
OPTIONS%DONE      EQU %
         BAL,RL   IGNORE%TRAPS
*
*   'DC' OVERRIDES 'CN' IF BOTH WERE SPECIFIED
*
         LH,R8    DC%FLAG
         IF,NZ
         LW,R8    DC%FLAG
         CI,R8    X'FFFF'
         IF,ANZ
         LI,R8    1
         STW,R8   DC%FLAG
         FI
         FI
         MTW,0    PD%FLAG           FORCE NO STD DEF FILE READ
         BEZ      %+2                 IF WE'RE PRODUCING ONE
         MTW,1    ND%FLAG
*  SET ASSEMBLE%FLAG TO REFLECT WHETHER THE DEFGEN PASS IS REQUIRED
         LW,R8    GO%FLAG
         OR,R8    LO%FLAG
         OR,R8    BO%FLAG
         STW,R8   ASSEMBLE%FLAG
         DO       SYS=BPMUTS
         BNEZ     %05               IT'S REQUIRED
*  IF ON-LINE, DEFGEN IS REQ'D IF 'LIST','OUTPUT',OR 'COMMENT' IS ON
         LW,R8    *X'4F'
         BGEZ     %05               BRANCH IF NOT ON LINE
         LI,R8    LOBIT+GOBIT+DOBIT
         AND,R8   J:JIT+JOPT
         STW,R8   ASSEMBLE%FLAG
         FIN
%05      RES      0
         DO       SYS=BPMUTS
         MTW,0    *X'4F'            IF ON-LINE, SET SI AS DEFAULT
         BGEZ     %06               BRANCH IF NOT ON-LINE
         LW,R8    CI%FLAG
         BNEZ     %06
         MTW,+1   SI%FLAG
         FIN
%06      RES      0
         MTW,0    SI%FLAG           IS THERE SI?
         BEZ      %10               BRANCH IF NO.
         MTW,+1   LINE%TYPE         INDICATE SI.
%10      MTW,0    CI%FLAG           IS THERE CI?
         BEZ      TEST%SO           BRANCH IF NO.
         MTW,2    LINE%TYPE
TEST%SO  RES      0
         MTW,0    SO%FLAG
         BEZ      TEST%CO
         BAL,IORL OPENSO
TEST%CO  RES      0
         MTW,0    CO%FLAG
         BEZ      TEST%BO
         BAL,IORL OPENCO
TEST%BO  RES      0
         MTW,0    BO%FLAG
         BEZ      TEST%GO
         BAL,IORL OPENBO
TEST%GO  RES      0
         MTW,0    GO%FLAG
         BEZ      TEST%TEMPS
         BAL,IORL OPENGO
TEST%TEMPS  RES   0
         LW,R8    LINE%TYPE
         CI,R8    3
         BNE      OPEN%TEMPS
         BAL,IORL OPENX2KF
         BAL,IORL OPENX2
OPEN%TEMPS  RES   0
         BAL,IORL OPENX1
         BAL,IORL OPENX3
         LW,IORL  LO%FLAG           TURN OFF DO-LO CORRESPONDANCE
         BNEZ     TEST%STD            IF 'LO' IS NOT REQUESTED
*
         STB,IORL CORRESWD
TEST%STD RES      0
         LI,X1    0
         MTW,0    ND%FLAG
         BNEZ     TEST%PD
         BAL,IORL OPENSTD           OPEN F:STD IN USER'S ACCOUNT
         B        TEST%SI           IT'S OPEN
TEST%PD  RES      0
         MTW,0    PD%FLAG
         BEZ      TEST%SI
         BAL,IORL OPENSTDOUT        OPEN F:STD FOR OUTPUT
TEST%SI  RES      0
* DON'T OPEN SI OR CI UNTIL ALL OUTPUT FILES HAVE BEEN OPENED
         MTW,0    SI%FLAG
         BEZ      TEST%CI
         BAL,IORL OPENSI
TEST%CI  RES      0
         MTW,0    CI%FLAG
         BEZ      OPEN%SYS
         BAL,IORL OPENCI
OPEN%SYS RES      0
%20      MTW,0    LINE%TYPE         IS THERE ANYTHING INDICATED?
         BEZ      %30               BRANCH IF NO.
         DO       SYS=BPMUTS
         LW,X7    #ACCTS
         MTW,2    #ACCTS
         LI,X1    1                 INSERT USER'S ACCOUNT
         LW,R8    *X'4F',X1
         AI,X1    1
         LW,R9    *X'4F',X1
         STD,R8   ACCOUNTS,X7
         LD,R8    COLON%SYS         INSERT :SYS ACCOUNT
         STD,R8   ACCOUNTS+2,X7
         M:SETDCB F:STD,;           CHANGE TO ROOT-RESIDENT ROUTINES
                  (ERR,ERR%%STD),;
                  (ABN,ABN%%STD)
         ELSE
         LV,R9    ADDRFLD
         LI,R8    ERR%%STD
         STS,R8   F:STD+CPRERREO
         LI,R8    ABN%%STD
         STS,R8   F:STD+CPRABNEO
         FIN
         B        *ROOTRTN          RETURN TO THE ROOT
%30      RES      0
         ABORT    ABORT11           NO INPUT SPECIFIED
STDERROR RES      0
         LB,R8    SR3               ERROR CODE
         CI,R8    3
         BNE      ABN%%STD
         DO       SYS=BPMUTS
         CI,X1    0                 WAS OPEN IN :SYS ACCOUNT
         BNE      STDERR5             YES
         FIN
*  ABORT IF F:STD WAS RE-ASSIGNED
         LI,R8    X'F'
         AND,R8   F:STD
         CI,R8    1
         BNE      SDFNOTHR
         DO       SYS=BPMUTS
         LW,R8    F:STD+X'17'
         CW,R8    =X'085B7AE2'      COMPARE FOR '%:STDDEF'
         BNE      SDFNOTHR
         LW,R8    F:STD+X'18'
         CW,R8    ='TDDE'
         BNE      SDFNOTHR
         LI,X1    1                 SET FLAG FOR :SYS ACCT
         BAL,IORL OPENSTD%SYS       TRY OPEN IN :SYS ACCOUNT
         B        TEST%SI           IT'S OPEN
         FIN
         DO       SYS=RBM
         LW,XT    F:STD+1
         AND,XT   L(X'3F'**8)
         CV,XT    D1**8
         BNE      SDFNOTHR          REASSIGNED IF NOT IN DEFAULT AREA
*
         LW,R8    F:STD+5           IF NAME ISN'T '%:STDDEF',
         CW,R8    ='%:ST'
         BNE      SDFNOTHR
         LW,R8    F:STD+6
         CW,R8    ='DDEF'
         BNE      SDFNOTHR
         LI,X1    1
         FIN
STDERR5  RES      0
         STW,X1   ND%FLAG
         B        TEST%SI
SDFNOTHR RES      0
         ABORT    ABORT12           STD DEF FILE DOES NOT EXIST
        PAGE
*
*  O P E N X 1
*        OPEN THE X1 (ENCODED TEXT) FILE
*
OPENX1   RES      0
         DO       SYS=BPMUTS
         LI,IOADD  F:X1
         LW,IOSIZE  =X'05C6E7F1'    'FX1'
         B        OPNJOIN
         FIN
         DO       SYS=RBM
         M:OPEN   M:X1,(ERR,ERR%%X1),(ABN,ABN%%X1)
         M:DEVICE M:X1,;
                  (SIZE,BYX1SIZE),;
                  (ORG,UNBLOCK)
         B        *IORL
         FIN
*
*  O P E N X 2
*        OPEN THE X2 FILE
*
OPENX2   RES      0
         DO       SYS=BPMUTS
         LI,IOADD  F:X2
         LW,IOSIZE  =X'05C6E7F2'    'FX2'
         B        OPNJOIN
         FIN
         DO       SYS=RBM
         M:OPEN   M:X2,(ERR,ERR%%X2),(ABN,ABN%%X2)
         M:DEVICE M:X2,;
                  (SIZE,80),;
                  (ORG,BLOCK)
         B        *IORL
         FIN
*
*  O P E N X 3
*        OPEN THE X3 (COMPRESSED SOURCE) FILE
*
OPENX3   RES      0
         DO       SYS=BPMUTS
         LI,IOADD  F:X3
         LW,IOSIZE  =X'05C6E7F3'    'FX3'
         B        OPNJOIN
         FIN
         DO       SYS=RBM
         M:OPEN   M:X3,(ERR,ERR%%X3),(ABN,ABN%%X3)
         M:DEVICE M:X3,;
                  (SIZE,BYX3SIZE),;
                  (ORG,UNBLOCK)
         B        *IORL
         FIN
*
*  O P E N X 2 K F
*        OPEN THE X2KF FILE
*
OPENX2KF RES      0
         DO       SYS=BPMUTS
         LI,IOADD  F:X2KF
         LW,IOSIZE  =X'05F2D2C6'    '2KF'
OPNJOIN  RES      0
         LI,X1    OPENEND-OPENFPT   SIZE OF FPT TO MOVE
OPNJN1   RES      0
         LW,X2    OPENFPT-1,X1      MOVE AN FPT WORD TO TEMP
         STW,X2   SAVAREA-1,X1
         BDR,X1   OPNJN1
         STW,IOSIZE  SAVAREA+4      STORE FILE NAME
         LW,IOSIZE  *X'4F'
         STH,IOSIZE  SAVAREA+5      UNIQUE ACCOUNT I.D.
         M:OPEN,E SAVAREA           OPEN THE TEMP FILE
         B        *IORL
OPENFPT  M:OPEN,L *IOADD,(FILE,'2KF  '),(OUTIN)
OPENEND  RES      0
         FIN
         DO       SYS=RBM
         M:OPEN   M:X4,(ERR,ERR%%X4),(ABN,ABN%%X4)
         M:DEVICE M:X4,;
                  (SIZE,12),;
                  (ORG,BLOCK)
         B        *IORL
         FIN
*
*  O P E N L O
*        OPEN THE LISTING OUTPUT FILE
*
OPENLO   RES      0
         M:OPEN   M:LO,(OUT),(ERR,ERR%%LO),(ABN,ERR%%LO)
         LI,SR1   0
         DO1      SYS=BPMUTS
         STW,SR1  LO%ONLINE
         STW,SR1  NUM%PAGE%LINES
         M:DEVICE M:LO,(CORRES,M:C)
         LI,XT    1                 TO BYTE 1
         STB,SR1  CORRESWD,XT
         M:DEVICE  M:LO,(CORRES,M:DO)
         STB,SR1  CORRESWD          TO BYTE 0
         DO       SYS=BPMUTS
         LW,SR1   M:LO              CHECK FOR
         AND,SR1  =X'F'               DEVICE
         CI,SR1   3                   TYPE ASSIGNMENT
         BNE      OPENLO2           NO,  SET PAGE SIZE VERY LARGE
         LW,SR1   *X'4F'
         BGEZ     *IORL             EXIT IF NOT ON-LINE
         LW,SR1   M:LO+1            CHECK IF NOT OP LABEL
         CI,SR1   X'8000'
         BAZ      *IORL             EXIT IF AN OP LABEL
         SLS,SR1  -8                RT JUSTIFY 'TYPE' ITEM
         AND,SR1  =X'3F'            TEST FOR TYPEWRITER CODE
         CI,SR1   1
         BE       OPENLO3           TYPEWRITER
         CI,SR1   X'10'             TEST FOR USER CONSOLE DEVICE
         BNE      *IORL             NO
OPENLO3  RES      0
         MTW,+1   LO%ONLINE         SET LO-IS-ONLINE FLAG
OPENLO2  RES      0
         LI,SR1   X'7FFFF'          LARGE NUMBER TO PAGE SIZE
         STW,SR1  NUM%PAGE%LINES
         FIN
         DO       SYS=RBM
         LB,SR1   K:PAGE
         AI,SR1   -2
         STW,SR1  NUM%PAGE%LINES
         FIN
         B        *IORL             EXIT
*
*  O P E N B O
*        OPEN THE BINARY OUTPUT FILE
*
OPENBO   RES      0
         M:OPEN   M:BO,(OUT),(ERR,ERR%%BO),(ABN,ERR%%BO)
         M:DEVICE  M:BO,(BIN)
         EXIT     IORL
*
*  O P E N C
*        OPEN THE CONTROL DEVICE
*
OPENC    RES      0
         M:OPEN   M:C,(IN)
         EXIT     IORL
*
*  O P E N D O
*        OPEN THE DO (DIAGNOSTIC OUTPUT) FILE
*
OPENDO   RES      0
         M:OPEN   M:DO,(OUT),(ERR,ERR%%DO),(ABN,ERR%%DO)
         DO       SYS=BPMUTS
         LI,SR1   0
         STW,SR1  DO%ONLINE
         LW,SR1   M:DO
         AND,SR1  =X'F'
         CI,SR1   3
         BNE      *IORL             EXIT IF NOT A DEVICE TYPE ASSIGNMENT
         LW,SR1   *X'4F'
         BGEZ     *IORL             EXIT IF NOT ON-LINE
         LW,SR1   M:DO+1
         CI,SR1   X'8000'
         BAZ      *IORL             EXIT IF AN OP LABEL
         SLS,SR1  -8                RIGHT JUSTIFY 'TYPE' ITEM
         AND,SR1  =X'3F'
         CI,SR1   1
         BE       OPENDO1           BRANCH IF DEVICE IS TYPEWRITER
         CI,SR1   X'10'
         BNE      *IORL             EXIT IF NOT USER CONSOLE DEVICE
OPENDO1  RES      0
         MTW,1    DO%ONLINE         SET DO-IS-ON-LINE FLAG
         FIN
         B        *IORL             EXIT
*
*  O P E N G O
*        OPEN THE GO FILE
*
OPENGO   RES      0
         M:OPEN   M:GO,(OUT),(ERR,ERR%%GO),(ABN,ERR%%GO)
         DO       SYS=RBM
         M:PFIL   M:GO
         FIN
         M:DEVICE  M:GO,(BIN)
         B        *IORL             EXIT
*
*  O P E N S T D
*        OPEN THE F:STD FILE IN THE USER ACCOUNT
*
OPENSTD  RES      0
         M:OPEN   F:STD,(IN)
         B        *IORL
*
*  O P E N S T D % S Y S
*        OPEN THE F:STD FILE IN THE :SYS ACCOUNT
*
         DO       SYS=BPMUTS
OPENSTD%SYS  RES  0
         M:OPEN   F:STD,(FILE,'%:STDDEF',':SYS'),(IN)
         B        *IORL
         FIN
*
*  O P E N S T D O U T
*        OPEN THE F:STD FILE FOR OUTPUT
*
OPENSTDOUT  RES   0
         M:OPEN   F:STD,(OUT)
         DO       SYS=RBM                                      /27493/*D-CCI
         M:DEVICE F:STD,;                                      /27493/*D-CCI
                  (SIZE,BYX1SIZE),;                            /27493/*D-CCI
                  (ORG,UNBLOCK)                                /27493/*D-CCI
         FIN                                                   /27493/*D-CCI
         B        *IORL
*
*  O P E N S I
*        OPEN THE SYMBOLIC INPUT FILE
*
OPENSI   RES      0
         M:OPEN   M:SI,(IN),(ERR,ERR%%SI),(ABN,ERR%%SI)
         M:DEVICE M:SI,(CORRES,M:C)
         LI,XT    2                 TO BYTE 2
         STB,SR1  CORRESWD,XT
         B        *IORL             EXIT
*
*  O P E N C I
*        OPEN THE COMPRESSED INPUT FILE
*
OPENCI   RES      0
         M:OPEN   M:CI,(IN),(ERR,ERR%%CI),(ABN,ERR%%CI)
         B        *IORL             EXIT
*
*  O P E N S O
*        OPEN THE SYMBOLIC OUTPUT FILE
*
         LOCAL    %10
*
OPENSO   RES      0
*
         DO       SYS=BPMUTS
*
*  IF M:SO IS CURRENTLY ASSIGNED TO A FILE, ADJUST ITS DCB
*     FOR KEYED OUTPUT.
*
         LI,XT    M:SO
         LI,XT2   1                 WANT FILE NAME
         CALL     FIND%VARP         RETURNS PTR TO NAME IN XT1 IF FILE
         CI,XT1   0
         IF,NE                 -00- DOIF ASN=FILE
*
*        MOVE THE FILE NAME INTO THE ADJUST FPT.  THIS MESSING ABOUT
*        SHOULD NOT BE NECESSARY WITH CP-V E00, BUT FOR NOW, M:SO
*        IS SUBJECT TO FILE EXTENSION, EVEN THOUGH IT IS A KEYED
*        FILE.  CHANGING THE NAME (SAME NAME, BUT...) DEFEATS FILE
*        EXTENSION, AND THUS THE INOUT MODE WHICH WOULD CAUSE A
*        1600 ABNORMAL (MAYBE) WHEN WE WENT TO WRITE THE KEYED
*        RECORDS.
*
         LI,XT2   2
         LB,XT    *XT1,XT2          JUST MOVE THE WORDS IN USE
         STB,XT   SO%ADJ%NAME,XT2
%10      RES      0
         LW,XT2   *XT1,XT
         STW,XT2  SO%ADJ%NAME,XT
         BDR,XT   %10
*
         CAL1,1   SO%ADJ%FPT
         LI,XT    3
         STB,XT   SO%KEY            SET FLAG (SKELETON KEY)
         FI                    -00-
         FIN
*
         M:OPEN   M:SO,(OUT),(ERR,ERR%%SO),(ABN,ERR%%SO)
         B        *IORL             EXIT
*
*  O P E N C O
*        OPEN THE COMPRESSED OUTPUT FILE
*
OPENCO   RES      0
         M:OPEN   M:CO,(OUT),(ERR,ERR%%CO),(ABN,ERR%%CO)
         M:DEVICE  M:CO,(BIN)
         LI,XT    120               STANDARD RECORD LENGTH
*
         DO       SYS=BPMUTS
         MTH,0    CO%FLAG
         IF,EQ                      DOIF 'SC' NOT SPECIFIED
         LI,XT    108               'SHORT' BINARY RECORDS
         FI
         FIN
*
         STW,XT   CO%SIZE           BYTE SIZE OF CO RECORD
         EXIT     IORL
IGNORE%TRAPS  RES  0
         M:TRAP   TRAPLOC,(IGNORE,FX),(TRAP,NAO)
         DO       SYS=BPMUTS
         M:GDDL                     GET DYNAMIC DATA LIMITS
         STW,SR1  LOWCORE
         CI,SR3   128
         BLE      %+2               BRANCH IF LESS THAN 128 PAGES
         LI,SR3   128               USE 128 PAGES AS MAXIMUM
         SLS,SR3  9                 # PAGES * 512 = AMT OF CORE
         AW,SR3   SR1               ADD AMT OF CORE TO LOWCORE
         STW,SR3  ENDCORE
         FIN
         DO       SYS=RBM
         LW,SR1   K:BPEND           MOVE LOWEST ADDRESS
         AI,SR1   1                 FORCE TO DOUBLEWORD BOUND  /26685/*D-CCI
         AND,SR1  L(EADRFLD)                                   /26685/*D-CCI
         STW,SR1  LOWCORE           USABLE BY THE ASSEMBLER
         LW,SR1   K:BCKEND
         AI,SR1   1
         SW,SR1   LOWCORE           MAKE SURE THAT
         CI,SR1   65536               ENDCORE IS NOT
         BLE      %+2                 MORE THAN 65536
         LI,SR1   65536               WORDS BEYOND
         AW,SR1   LOWCORE             LOWCORE
         STW,SR1  ENDCORE
         FIN
         EXIT     RL
         PAGE
*
*  F I N D % V A R P
*        TESTS A DCB FOR HAVING BEEN ASSIGNED TO A FILE, AND RETURNS
*        A POINTER TO THE VARIABLE PARAMETER OF INTEREST.
*
*        INPUT:   XT IS ADDRESS OF DCB
*                 XT2 IS VARIABLE PARAMETER CODE (1 = NAME, ETC.)
*
*        OUTPUT:  XT  PRESERVED
*                 XT1 IS 0 IF NOT A FILE, OR IS ADDRESS OF
*                     VARIABLE PARAMETER CONTROL WORD.
*
*        USES:    R12
*
         LOCAL    %10
*
FIND%VARP   RES   0
*
         LW,XT1   0,XT              WORD 0 OF DCB TO XT1
         AND,XT1  L(X'F')           ASN FIELD
         CI,XT1   1                 TEST FOR ASSIGNMENT TO FILE
         IF,EQ                 -20-
         LW,XT1   6,XT
         AND,XT1  L(X'1FFFF')       FLP
*
*        SEARCH THE VARP LIST FOR THE DESIRED CONTROL.  IF NOT
*        FOUND, RETURN A 0, AS IF NOT A FILE.
*
%10      RES      0
         CB,XT2   *XT1              TEST TYPE BYTE AGAINST DESIRED
         EXIT,EQ                    GET OUT IF FOUND (XT1 IS SET)
*
*        ADVANCE TO NEXT PARAMETER
*
         LW,R12   0,XT1
         CV,R12   X'00010000'       WAS THIS THE LAST ONE?
         IF,AZ                 -10- DOIF NOT LAST
         AND,R12  L(X'FF')
         AW,XT1   R12               SIZE
         BIR,XT1  %10               ADVANCE TO NEXT CONTROL
*
         FI                    -10-
         FI                    -20-
         LI,XT1   0                 FAIL RETURN
         EXIT
         PAGE
*        DATA AREA.
*
         USECT    XAPDATA
PATCH    RES      32                ***** PATCH AREA *****
GET%NEXT%RETURN   RES 1
ABORT%CODE  RES   1                 SAVED CODE FOR ABORT TYPE
BLANK%SWITCH  RES  1                0=IGNORE BLANKS; 1=DON'T
PRINT%SWITCH  RES  1
         USECT    CCI1
         DO       SYS=RBM
AC%TABLE RES      0
         TEXT     'SP  '
         TEXT     'D1  '
         TEXT     'D2  '
         TEXT     'D3  '
         TEXT     'D4  '
         TEXT     'D5  '
         TEXT     'D6  '
         TEXT     'D7  '
         TEXT     'D8  '
         TEXT     'D9  '
         TEXT     'DA  '
         TEXT     'DB  '
         TEXT     'DC  '
         TEXT     'DD  '
         TEXT     'DE  '
         TEXT     'DF  '
AC%CODE  RES      0
         DATA,1   0,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20
         BOUND    4
         FIN
OPTION%IGNORED    TEXTC 'ILLEGAL OPTION IGNORED:    '
MSGS     EQU      %-OPTION%IGNORED
         BOUND    8
         DO       SYS=BPMUTS
COLON%SYS   RES   0
         TEXT     ':SYS    '
         FIN
         USECT    XAPDATA
         RES      ABSVAL(%)&1       BOUND 8 WITH NO ZERO'S GENERATED
BLANKS   EQU      %
8BLANKS  EQU      %
CTL%CARD%DISPLAY  EQU %
         RES      2
CTL%CARD EQU      %
         RES      20
BUF%PRINT  RES    20                TEMP PRINT AREA
SAVEREGS EQU      X3BUF+WDX3SIZE-16  SAVE AREA FOR REGISTERS 0-15
         USECT    CCI1
         PAGE
*
*   A P % A B O R T
*        THIS ROUTINE PROCESSES ABORT CONDITIONS.
*
*        INPUT:   REGISTER AR CONTAINS AN ABORT NUMBER
*
*        OUTPUT:  AN ABORT MESSAGE IS OUTPUT ON THE 'LO' AND 'DO'
*                   DEVICES; ALL FILES ARE CLOSED; AND, A RETURN TO
*                   MONITOR IS PERFORMED VIA AN M:ERR CALL.
*
AP%ABORT RES      0
         LCI      0
         STM,0    SAVEREGS          SAVE REGISTERS 0-15
         STW,AR   ABORT%CODE        SAVE CODE FOR ABORT TYPE
*
         DO       SYS=BPMUTS
         M:SETDCB M:LO,;            LET MOTHER DIAGNOSE               *D-CCI
                  (ERR,0),;                                           *D-CCI
                  (ABN,0)                                             *D-CCI
         M:SETDCB M:DO,;                                              *D-CCI
                  (ERR,0),;                                           *D-CCI
                  (ABN,0)                                             *D-CCI
         FIN
*
         DO       SYS=RBM
         M:CLOSE  M:LO,SAVE
         M:CLOSE  M:DO,SAVE
         M:OPEN   M:LO,;            LET MOTHER DIAGNOSE               *D-CCI
                  (ERR,0),;                                           *D-CCI
                  (ABN,0)                                             *D-CCI
         M:OPEN   M:DO,;                                              *D-CCI
                  (ERR,0),;                                           *D-CCI
                  (ABN,0)                                             *D-CCI
         FIN
*
         M:DEVICE M:LO,(CORRES,M:DO)   CHANGE DOLOSAME TO IGNORE
         STB,SR1  CORRESWD
         CI,AR    ABSIZE-1
         BG       ABORT%9           ABORT NUMBER IS OUT OF RANGE
         LW,XT    AR
         BLZ      ABORT%9           ABORT NUMBER IS OUT OF RANGE
         LH,XT    ABRTTBL,XT        LOAD INDEX TO ABORT PROCESSOR
         B        ABRTBASE,XT       BRANCH TO SPECIFIED ROUTINE
*
AB       COM,16   AF(1)-ABRTBASE
*
ABRTTBL  RES      0                 TABLE OF INDEXES TO ABORT ROUTINES
         AB       AB%0              SYSTEM                 DG
         AB       AB%1              HILIMIT                DG
         AB       AB%2              SCAN                   DG
         AB       AB%3              OVERFLOW               NCDR
         AB       AB%4              RDSDF                  NCDR
         AB       AB%5              IO%ABORT               ROOT
         AB       AB%6              TRAPLOC                ROOT
         AB       AB%7              CANTHAVE               ROOT
         AB       AB%8              BADTRAP                ROOT
         AB       AB%9              AC%FND                 CCI
         AB       AB%10             BAD%SYNTAX             CCI
         AB       AB%11             OPEN%SYS               CCI
         AB       AB%12             SDFNOTHR               CCI
         AB       AB%13             ERR%ABN2               CD
         AB       AB%14             ABNSI5                 CD
         AB       AB%15             SYSOPNR                CD
         AB       AB%16             2MANYSYS               CD
         AB       AB%17             ABNX2KF                CD
         AB       AB%18             VALIDATE               CD
         AB       AB%19             VALID%2                CD
         AB       AB%20             BADCTRL                CD
         AB       AB%21             WDOUT                  NCD /27493/*D-CCI
         AB       DELETED
         AB       AB%23             PRINT%ER1              CD
         AB       AB%24             PRINT%ER2              CD
         AB       AB%25             LECTURE%MAJ            INIT
         AB       DELETED
         AB       AB%27             ABNSI5                 INIT
ABSIZE   EQU      HA(%)-HA(ABRTTBL) NUMBER OF AB ENTRIES
*
         BOUND    4
*
ABORT%1  RES      0
         BAL,RL   CLR%MOVE          MOVE MESSAGE TO LIST BUFFER
ABORT%2  RES      0
         BAL,RL   PRINT             OUTPUT MESSAGE
ABORT%3  MTW,0    SYSLEVEL
         BLEZ     ABORT%4           NOT WITHIN A SYSTEM FILE
         LI,AM    BA(ABORTSYS)      ADDRESS OF 'PROCESSING SYSTEM- '
         BAL,RL   CLR%MOVE          MOVE MESSAGE TO LIST BUFFER
         LI,AM    BA(SYSNAME)       ADDRESS OF SYSTEM NAME
         BAL,RL   MOVE              APPEND SYSNAME TO MESSAGE IN BUFFER
         BAL,RL   PRINT             OUTPUT MESSAGE
ABORT%4  RES      0
         LI,AM    BA(ABORTAP)       ADDRESS OF 'AP ABORT ERROR'
         BAL,RL   CLR%MOVE          MOVE MESSAGE TO LIST BUFFER
         LW,RL    SEGMENT#
         LW,AM    SEG%MSG,RL
         CALL     MOVE
         LW,XT    SEGMENT#
         IF,NE                 -20- DOIF NOT CCI
         CI,XT    4
         IF,NE                 -21- DOIF NOT END
         LI,AM    BA(LINE#MSG)
         CALL     MOVE
         LW,X3    MAJLINE
         CALL     DECEDIT
         LW,X3    SUBLINE
         IF,NE                 -22- DOIF NO SUB-LINE #
         LI,XT    '.'
         STB,XT   LSTBF,XT1
         AI,XT1   1
         CALL     DECEDIT
         FI                    -22-
         FI                    -21-
         FI                    -20-
         BAL,RL   PRINT             OUTPUT MESSAGE
ABORT%5  RES      0
         LI,AM    BA(D%1)
         BAL,RL   CLR%MOVE
         BAL,RL   SNAPRINT          PRINT A BLANK LINE
         LI,AM    BA(APDATA)
         BAL,RL   CLR%MOVE
         LI,X3    XAPDATA
         SLS,X3   12
         LI,AM    5
         BAL,RL   HEXEDIT
         BAL,RL   SNAPRINT          'XAPDATA = XXXXX'
         LI,AM    BA(APD1)
         BAL,RL   CLR%MOVE
         LI,X3    XAPD1
         SLS,X3   12
         LI,AM    5
         BAL,RL   HEXEDIT
         BAL,RL   SNAPRINT          'XAPD1 = XXXXX'
         LI,AM    BA(APOPTFLG)
         BAL,RL   CLR%MOVE
         LI,X3    OPTION%FLAGS
         SLS,X3   12
         LI,AM    5
         BAL,RL   HEXEDIT
         BAL,RL   SNAPRINT          'OPTION%FLAGS = XXXXX'
         LI,AM    BA(APCODE)
         BAL,RL   CLR%MOVE
         LI,X3    XAPCODE
         SLS,X3   12
         LI,AM    5
         BAL,RL   HEXEDIT
         BAL,RL   SNAPRINT          'XAPCODE = XXXXX'
         LI,AM    BA(APMODULE)
         BAL,RL   CLR%MOVE
         LI,X3    CCI1
         SLS,X3   12
         LI,AM    5
         BAL,RL   HEXEDIT
         BAL,RL   SNAPRINT          'AP OVERLAY MODULE = XXXXX'
         LI,AM    BA(D%1)
         BAL,RL   CLR%MOVE
         BAL,RL   SNAPRINT          PRINT A BLANK LINE
         LI,AM    BA(RO%R7)
         BAL,RL   CLR%MOVE
         LI,X6    SAVEREGS
         STW,X6   R13
         BAL,R15  HEXDUMP1          DUMP REGS 0-7 IN HEX FORMAT
         LI,AM    BA(R8%R15)
         BAL,RL   CLR%MOVE
         LI,X6    SAVEREGS+8
         BAL,R15  HEXDUMP1          DUMP REGS 8-15 IN HEX FORMAT
         LW,XT    ABORT%CODE        GET SAVED CODE
         LB,XT1   DUMP%SW,XT
         BEZ      ABORT%7           BRIF MINI-DUMP REQUIRED
*
         LI,AM    BA(D%1)
         BAL,RL   CLR%MOVE
         BAL,RL   SNAPRINT          PRINT A BLANK LINE
         LI,X6    XAPDATA           START ADDRESS FOR DUMP
         LI,R13   ROOTRTN           END ADDRESS FOR DUMP
         BAL,R15  HEXDUMP           DUMP MEMORY IN HEX FORMAT
         LW,XT    ABORT%CODE        GET SAVED CODE
         LB,XT1   DUMP%SW,XT        GET DUMP FLAG
         CI,XT1   1
         BE       ABORT%7           BRIF MIDI-DUMP IS REQUIRED
*
         DO       SYS=BPMUTS
         LI,X1    -5                INDEX TO PAGETBL
         LI,X2    1                 # BITS REMAINING (+1) IN LAST WORD
         LW,X6    LOWCORE           INITIAL DUMP ADDRESS
FIND%1ST RES      0                 LOOK FOR INIT. DUMP ADDRESS
         CW,X6    ENDCORE
         BGE      ABORT%7           BRIF END-OF-CORE
*
         CALL     NEXT%PG
         B        ABORT%7           END-OF-PAGETBL EXIT
         BNEZ     FIND%LAST         BRIF PAGE USED
*
FIND%L1  RES      0
         AI,X6    512               BUMP TO NEXT CORE PAGE
         B        FIND%1ST
*
FIND%LAST   RES   0                 LOOK FOR END ADDRESS FOR DUMP
         LW,R13   X6                INIT -> FINAL DUMP ADDRESS
FIND%L2  RES      0
         AI,R13   512               BUMP END ADDRESS
         CW,R13   ENDCORE
         BGE      NEXT%PRT          BRIF END OF CORE
*
         CALL     NEXT%PG           GET NEXT 'PAGE-USED' BIT
         B        NEXT%PRT          END-OF-PAGETBL
         BNEZ     FIND%L2           BRIF LAST ADDR. NOT FOUND
*
NEXT%PRT RES      0
         CW,R13   ENDCORE           DECREASE END ADDRESS IF REQ'D
         BLE      %+2
         LW,R13   ENDCORE
         LCI      15
         STM,0    SAVAREA           SAVE REGS
         AI,R13   -1                ADJUST LAST ADDRESS
         BAL,R15  HEXDUMP
         LCI      15
         LM,0     SAVAREA
         LW,X6    R13               LAST ADDRESS -> FIRST
         B        FIND%L1
*
         FIN
*
         DO       SYS=RBM
         LW,X6    LOWCORE
         LW,R13   ENDCORE
         AI,R13   -1
         BAL,R15  HEXDUMP
         FIN
*
ABORT%7  RES      0
         LI,IORL  1                 ABNORMAL CLOSE
         BAL,RL   CLOSE%FILES
         LCI      0
         LM,0     SAVEREGS          RESTORE REGISTERS 0-15
         M:ERR                      RETURN TO MONITOR
*
*   HERE IF ABORT NUMBER IS OUT OF RANGE
ABORT%9  RES      0
DELETED  RES      0
         LI,AM    BA(ABORT%10)
         B        ABORT%1
ABORT%10 TEXTC    'ABORT CALLED WITH ILLEGAL ARGUMENT'
*
SEG%MSG  RES      0
         DATA     BA(CCI%SEG)
         DATA     BA(NCDR%SEG)
         DATA     BA(DEF%SEG)
         DATA     BA(GEN%SEG)
         DATA     BA(END%SEG)
         DATA     BA(CONC%SEG)
CCI%SEG  TEXTC    'CONTROL CARD PROCESSOR'
NCDR%SEG TEXTC    'ENCODER'
DEF%SEG  TEXTC    'ASSEMBLY PASS 1'
GEN%SEG  TEXTC    'ASSEMBLY PASS 2'
END%SEG  TEXTC    'END SUMMARIES'
CONC%SEG TEXTC    'CONCORDANCE'
LINE#MSG TEXTC    '  PROCESSING LINE '
ABORTSYS TEXTC    'PROCESSING SYSTEM- '
ABORTAP  TEXTC    'AP ABORT ERROR IN '
APDATA   TEXTC    'XAPDATA = '
APD1     TEXTC    'XAPD1 = '
APOPTFLG TEXTC    'OPTION%FLAGS = '
APCODE   TEXTC    'XAPCODE = '
APMODULE TEXTC    'AP OVERLAY MODULE = '
RO%R7    TEXTC    ' R0-R7'
R8%R15   TEXTC    ' R8-RF'
*
*  DUMP SWITCHES TABLE.  INDEXED BY ERROR CODE.
*
*        0=MINI DUMP.  1=MIDI DUMP.  2=MAXI DUMP.
*
DUMP%SW  RES      0
         DATA,1   0,2,2,2,1,1,2,2,2,0     CODES 0 THRU 9
         DATA,1   0,0,0,0,0,0,1,1,1,1     CODES 10 THRU 19
         DATA,1   0,1,2,1,1,1,2,0   CODES 20 THRU 27           /27493/*D-CCI
         BOUND    4
         PAGE
*
ABRTBASE RES      0
*   HERE FOR ABORT FROM SYSTEM DIRECTIVE IN AP-DG
*        XT CONTAINS BASE ADDRESS OF ENCODED TEXT AT WORD RESOLUTION
*        XW POINTS TO HALFWORD PRECEEDING SYSTEM NAME
AB%0     RES      0
         LW,XT    SAVEREGS+XT       GET BASE ADDRESS OF ENCODED TEXT
         SLS,XT   2                 CONVERT WORD ADDRESS TO BYTE
         AI,XW    1                 SKIP MULTI-INTEGER HALFWORD
         SLS,XW   1                 CONVERT HALFWORD OFFSET TO BYTE
         AW,XW    XT                SAVE ADDRESS OF SYSTEM NAME
         LI,AM    BA(AB%00)         ADDRESS OF 'UNABLE TO FIND SYSTEM-'
         BAL,RL   CLR%MOVE          MOVE MESSAGE TO LIST BUFFER
         LW,AM    XW                ADDRESS OF SYSTEM NAME
         BAL,RL   MOVE              APPEND NAME TO MESSAGE IN BUFFER
         B        ABORT%2
AB%00    TEXTC    'UNABLE TO FIND SYSTEM- '
*   HERE FOR ABORT FROM HILIMIT ROUTINE IN AP-DG
AB%1     RES      0
         LI,AM    BA(AB%01)         ADDRESS OF 'SPACE OVERFLOW'
         B        ABORT%1
AB%01    TEXTC    'DEF/GEN SPACE OVERFLOW'
*   HERE FOR ABORT FROM SCAN ROUTINE IN AP-DG
AB%2     RES      0
         LI,AM    BA(AB%02)         ADDRESS OF 'BAD ENCODED TEXT'
         B        ABORT%1
AB%02    TEXTC    'BAD ENCODED TEXT'
*   HERE FOR ABORT FROM OVERFLOW IN AP-NCDR
AB%3     RES      0
         LI,AM    BA(AB%03)         ADDRESS OF 'ENCODER SPACE OVERFLOW'
         B        ABORT%1
AB%03    TEXTC    'ENCODER SPACE OVERFLOW'
*   HERE FOR ABORT FROM RDSDF IN AP-NCDR
AB%4     RES      0
         LI,AM    BA(AB%04)         ADDRESS OF MESSAGE
         B        ABORT%1
AB%04    TEXTC    'STD DEF FILE INCOMPATIBLE'
*   HERE FOR ABORT FROM IO%ABORT IN AP-ROOT
*        REGISTER SR3 CONTAINS ERRORCODE (BITS 0-14) AND DCB
*          ADDRESS (BITS 15-31)
AB%5     RES      0
         LI,AM    BA(AB%05)         ADDRESS OF 'ERR OR ABN ON FILE'
         BAL,RL   CLR%MOVE          MOVE MESSAGE TO LIST BUFFER
         LI,SR4   X'1FFFF'          MASK FOR ADDRESS FIELD
         LI,XT    DCBSIZE-1         NUMBER OF DCBT ENTRIES TO SEARCH
         LW,SR3   SAVEREGS+SR3      GET ERRORCODE & DCB ADDRESS
AB%%51   RES      0
         CS,SR3   DCBTABLE,XT       FIND DCB WHICH GAVE
         BE       %+2                 ERROR OR ABNORMAL
         BDR,XT   AB%%51              RETURN
*   XT CONTAINS INDEX TO DCB NAME
         LW,XT    DCBTABLE,XT
         LB,AM    XT                LOAD INDEX TO DCB NAME
         AI,AM    BA(DCBMSG)        AM NOW CONTAINS ADDRESS OF DCB NAME
         BAL,RL   MOVE              MOVE DCB NAME TO LIST BUFFER
         LI,AM    BA(D%1)
         BAL,RL   MOVE              MOVE A BLANK TO LIST BUFFER
         SLD,SR3  -24               RIGHT ADJUST HIGH ORDER 8 BITS
         SLS,SR4  -1                INSERT A ZERO
         SLD,SR3  -8                NOW 16 BITS ARE CONTIGUOUS
         LI,AM    4
         LW,X3    SR4
         BAL,RL   HEXEDIT           EDIT ERROR CODE INTO LIST BUFFER
         B        ABORT%2
AB%05    TEXTC    'ERR OR ABN ON FILE '
*
DCBT     COM,8,24 BA(AF(1))-BA(DCBMSG),AF(2)
*
DCBTABLE RES      0
         DCBT     D%1,0
         DCBT     D%2,M:SI
         DCBT     D%3,M:CI
         DCBT     D%4,M:BO
         DCBT     D%5,M:CO
         DCBT     D%6,M:DO
         DCBT     D%7,M:GO
         DCBT     D%8,M:LO
         DCBT     D%9,M:SO
         DCBT     D%10,F:STD
         DCBT     D%11,F:SYS
         DO       SYS=RBM
         DCBT     D%12,M:X1
         DCBT     D%13,M:X2
         DCBT     D%14,M:X3
         DCBT     D%15,M:X4
         DCBT     D%16,M:X5
         FIN
         DO       SYS=BPMUTS
         DCBT     D%12,F:X1
         DCBT     D%13,F:X2
         DCBT     D%14,F:X3
         DCBT     D%17,F:X2KF
         DCBT     D%16,F:X5
         FIN
DCBSIZE  EQU      %-DCBTABLE        NUMBER OF DCBT ENTRIES
*
DCBMSG   RES      0
D%1      TEXTC    ' '
D%2      TEXTC    'SI'
D%3      TEXTC    'CI'
D%4      TEXTC    'BO'
D%5      TEXTC    'CO'
D%6      TEXTC    'DO'
D%7      TEXTC    'GO'
D%8      TEXTC    'LO'
D%9      TEXTC    'SO'
D%10     TEXTC    'STD'
D%11     TEXTC    'SYS'
D%12     TEXTC    'X1'
D%13     TEXTC    'X2'
D%14     TEXTC    'X3'
D%15     TEXTC    'X4'
D%16     TEXTC    'X5'
D%17     TEXTC    'X2KF'
*
*   HERE FOR ABORT FROM TRAPLOC IN AP-ROOT (RBM VERSION)
*        X1 CONTAINS A POINTER TO A 19 WORD AREA CONTAINING THE
*          PSD, REGS 0-15, AND THE TRAP LOCATION
AB%6     RES      0
         STW,X1   MPX1              SAVE POINTER TO PSD-REG BLOCK
         LI,AM    BA(AB%06)         ADDRESS OF MESSAGE
AB%%61   RES      0
         BAL,RL   CLR%MOVE          MOVE MESSAGE TO LIST BUFFER
         LW,X3    *MPX1             GET PSW1
         LI,AM    8
         BAL,RL   HEXEDIT           HEX OF PSW1 TO LIST BUFFER
         LI,AM    BA(D%1)
         BAL,RL   MOVE              MOVE A BLANK TO LIST BUFFER
         LI,X1    1
         LW,X3    *MPX1,X1          GET PSW2
         LI,AM    8
         BAL,RL   HEXEDIT           HEX OF PSW2 TO LIST BUFFER
         BAL,RL   PRINT             PRINT THE LIST BUFFER
         LW,X1    MPX1
         LCI      0                 MOVE RESIGTES 0-15
         LM,0     2,X1                FROM TRAP ROUTINE'S SAVE AREA
         LCI      0                   TO ABORT ROUTINE'S SAVE AREA
         STM,0    SAVEREGS
         B        ABORT%3
AB%06    TEXTC    'MONITOR TRAP, PSD = '
*   HERE FOR ABORT FROM CANTHAVE IN AP-ROOT (UTS VERSION)
*        MPX1 CONTAINS A POINTER TO A 19 WORD AREA CONTAINING THE
*          PSD, REGS 0-15, AND THE TRAP LOCATION
AB%7     RES      0
         LI,AM    BA(AB%07)         ADDRESS OF MESSAGE
AB%%71   RES      0
         MTW,-2   MPX1              POINTER TO PSD-REG BLOCK
         B        AB%%61
AB%07    TEXTC    'MEMORY PROTECTION TRAP, PSD = '
*   HERE FOR ABORT FROM BADTRAP IN AP-ROOT (UTS VERSION)
AB%8     RES      0
         LI,AM    BA(AB%08)         ADDRESS OF MESSAGE
         B        AB%%71
AB%08    TEXTC    'BAD INSTRUCTION TRAP, PSD = '
*   HERE FOR ABORT FROM AC%FND IN AP-CCI
AB%9     RES      0
         LI,AM    BA(AB%09)         ADDRESS OF MESSAGE
         B        ABORT%1
AB%09    TEXTC    'TOO MANY ACCOUNT AREAS SPECIFIED'
*   HERE FOR ABORT FROM BAD%SYNTAX IN AP-CCI
AB%10    RES      0
         LI,AM    BA(AB%010)        ADDRESS OF MESSAGE
         B        ABORT%1
AB%010   TEXTC    'CONTROL CARD ERROR'
*   HERE FOR ABORT FROM OPEN%SYS IN AP-CCI
AB%11    RES      0
         LI,AM    BA(AB%011)        ADDRESS OF MESSAGE
         B        ABORT%1
AB%011   TEXTC    'NO INPUT SPECIFIED'
*   HERE FOR ABORT FROM SDFNOTHR IN AP-CCI
AB%12    RES      0
         LI,AM    BA(AB%012)        ADDRESS OF MESSAGE
         B        ABORT%1
AB%012   TEXTC    'STD DEF FILE DOES NOT EXIST'
*   HERE FOR ABORT FROM ERR%ABN2 IN AP-CD
AB%13    RES      0
         LI,AM    BA(AB%013)        ADDRESS OF MESSAGE
         B        ABORT%1
AB%013   TEXTC    'EXPECTED CI MISSING'
*   HERE FOR ABORT FROM ABNSIS IN AP-CD
AB%14    RES      0
         LI,AM    BA(AB%014)        ADDRESS OF MESSAGE
         B        ABORT%1
AB%014   TEXTC    'EXPECTED SI MISSING'
*   HERE FOR ABORT FROM SYSOPNR IN AP-CD
AB%15    RES      0
         LI,AM    BA(AB%015)        ADDRESS OF MESSAGE
         B        ABORT%1
AB%015   TEXTC    'ERR OR ABN WHEN OPENING F:SYS'
*   HERE FOR ABORT FROM 2MANYSYS IN AP-CD
AB%16    RES      0
         LI,AM    BA(AB%016)        ADDRESS OF MESSAGE
         B        ABORT%1
AB%016   TEXTC    'SYSTEMS NESTED TOO DEEPLY'
*   HERE FOR ABORT FROM ABNX2KF IN AP-CD
AB%17    EQU      AB%5
*
*   HERE FOR ABORT FROM VALIDATE IN AP-CD
*        X1 CONTAINS THE CONTROL WORD OF THE CURRENT COMPRESSED RECORD
*        XT1 CONTAINS THE EXPECTED RECORD NUMBER
AB%18    RES      0
         STH,XT1  X3                SAVE RECORD NUMBER LEFT ADJUSTED
         LI,AM    BA(AB%018)        ADDRESS OF MESSAGE
AB%18A   BAL,RL   CLR%MOVE          MOVE MESSAGE TO LIST BUFFER
         LI,AM    4
         BAL,RL   HEXEDIT           EDIT RECORD NUMBER INTO LIST BUFFER
         BAL,RL   PRINT             PRINT THE LIST BUFFER
         LI,AM    BA(AB%018A)       ADDRESS OF NEXT MESSAGE
         BAL,RL   CLR%MOVE          MOVE MESSAGE TO LIST BUFFER
         BAL,RL   PRINT             PRINT LIST BUFFER
         LI,AM    BA(AB%018B)       ADDRESS OF NEXT MESSAGE
         BAL,RL   CLR%MOVE          MOVE MESSAGE TO LIST BUFFER
         LI,IOADD 4
         LW,X3    SAVEREGS+X1       GET COMPRESSED RECORD CONTROL WORD
AB%18C   RES      0
         LI,AM    2                 EDIT NEXT 2 DIGITS OF CONTROL WORD
         BAL,RL   HEXEDIT             INTO LIST BUFFER
         LI,AM    '/'
         STB,AM   LSTBF,XT1         STORE A SLASH IN LIST BUFFER
         AI,XT1   1                 INCREMENT LIST BUFFER INDEX
         BDR,IOADD AB%18C           CONTINUE UNTIL CONTROL WORD EDITED
         AI,XT1   -1                REMOVE LAST SLASH
         B        ABORT%2
AB%018   TEXTC    'SEQUENCE ERROR ON CI RECORD # '
AB%018A  TEXTC    'COMPRESSED RECORD  ID/SEQUENCE/CHECKSUM/BYTE COUNT'
AB%018B  TEXTC    '               IS  '
*   HERE FOR ABORT FROM VALID%2 IN AP-CD
*        X1 CONTAINS THE CONTROL WORD OF THE CURRENT COMPRESSED RECORD
*        X3 CONTAINS THE RECORD NUMBER+1
AB%19    RES      0
         AI,X3    -1                DECREMENT RECORD NUMBER
         SLS,X3   16                LEFT ADJUST RECORD NUMBER
         LI,AM    BA(AB%019)        ADDRESS OF MESSAGE
         B        AB%18A
AB%019   TEXTC    'CHECKSUM ERROR ON CI RECORD # '
*   HERE FOR ABORT FROM ENDFILE OR BADCTRL IN AP-CD
*        X3 CONTAINS RECORD NUMBER+1
AB%20    RES      0
         LI,AM    BA(AB%020)        ADDRESS OF MESSAGE
         BAL,RL   CLR%MOVE          MOVE MESSAGE TO LIST BUFFER
         AI,X3    -1                DECREMENT RECORD NUMBER
         SLS,X3   16                LEFT ADJUST RECORD NUMBER
         LI,AM    4
         BAL,RL   HEXEDIT           EDIT RECORD NUMBER INTO LIST BUFFER
         B        ABORT%2
AB%020   TEXTC    'CI CODE ERROR ON RECORD # '
*                                                              /27493/*D-CCI
*   HERE FROM WDOUT IN AP-NCD WHEN STATEMENT CANNOT BE ENCODED /27493/*D-CCI
*        INTO A SINGLE BUFFER.                                 /27493/*D-CCI
AB%21    RES      0                                            /27493/*D-CCI
         LI,AM    BA(AB%021)        ADDRESS OF MESSAGE         /27493/*D-CCI
         B        ABORT%1                                      /27493/*D-CCI
*                                                              /27493/*D-CCI
AB%021   TEXTC    'STATEMENT TOO LONG TO ENCODE'               /27493/*D-CCI
*
*   HERE FOR ABORT FROM PRINT%ER1 IN AP-CD
*        X1 CONTAINS THE CONTROL WORD OF THE CURRENT COMPRESSED RECORD
*        X3 CONTAINS THE RECORD NUMBER
AB%23    RES      0
         SLS,X3   16                LEFT ADJUST RECORD NUMBER
         LI,AM    BA(AB%023)        ADDRESS OF MESSAGE
         B        AB%18A
AB%023   TEXTC    'ID ERROR ON CI RECORD # '
*   HERE FOR ABORT FROM PRINT%ER2 IN AP-CD
AB%24    RES      0
         LI,AM    BA(AB%024)        ADDRESS OF MESSAGE
         B        ABORT%1
AB%024   TEXTC    'COMPRESSED OR BINARY RECORD FOUND IN SI FILE'
*   HERE FOR ABORT FROM LECTURE%MAJ IN AP-INIT
AB%25    RES      0
         LI,AM    BA(AB%025)        ADDRESS OF MESSAGE
         B        ABORT%1
AB%025   TEXTC    'UPDATE FILE IS IN COMPRESSED OR BINARY FORMAT'
*
*   HERE FOR ABORT FROM ABNSI5 IN AP-INIT
AB%27    EQU      AB%14
*
         PAGE
*
*   C L R % M O V E
*        THIS ROUTINE CLEARS THE LIST BUFFER AND THEN STORES A
*          CHARACTER STRING INTO IT.
*
*   M O V E
*        THIS IS AN ALTERNATE ENTRY POINT WHICH STORES A CHARACTER
*          STRING INTO THE LIST BUFFER WITHOUT FIRST CLEARING IT.
*
*        INPUT:   REGISTER AM CONTAINS THE BYTE ADDRESS OF A 'TEXTC'
*                   CHARACTER STRING
*                 REGISTER XT1 CONTAINS THE FIRST CHARACTER POSITION
*                   IN LIST BUFFER TO STORE INTO. (INITIALIZED TO ONE
*                   IF CLR%MOVE IS CALLED)
*
*        OUTPUT:  REGISTER XT1 CONTAINS THE NEXT CHARACTER POSITION
*                   IN LIST BUFFER TO STORE INTO
*
*        USES REGISTER
*                 AM
*                 XT
*                 XT1
*                 XT2
*                 IORL
*
CLR%MOVE RES      0
         STW,RL   IORL
         BAL,RL   CLRLSTBF          CLEAR LIST BUFFER
         LI,XT1   1                 INITIALIZE LIST BUFFER INDEX
         LW,RL    IORL
MOVE     RES      0
         LB,XT2   0,AM              LOAD CHARACTER COUNT
MOVE1    RES      0
         AI,AM    1                 INCREMENT 'FROM' ADDRESS
         LB,XT    0,AM              MOVE NEXT CHARACTER FROM MESSAGE TO
         STB,XT   LSTBF,XT1           NEXT POSITION IN LIST BUFFER
         AI,XT1   1                 INCREMENT 'TO' INDEX
         BDR,XT2  MOVE1             CONTINUE UNTIL ALL CHARS MOVED
         EXIT     RL
         PAGE
*
*   H E X D U M P
*        DUMP A SPECIFIED AREA OF MEMORY IN HEXADECIMAL FORMAT
*
*        INPUT:   REGISTER X6 CONTAINS THE ADDRESS OF THE FIRST
*                   WORD TO BE DUMPED
*                 REGISTER R13 CONTAINS THE ADDRESS OF THE LAST
*                   WORD TO BE DUMPED
*
*        USES REGISTER
*                 X1, X2, X3, X6
*
HEXDUMP  RES      0
         AND,X6   =X'FFFFFFF8'      TRUNCATE START & END ADDRESSES TO
         AND,R13  =X'FFFFFFF8'        AN 8 WORD BOUNDARY
         AI,R13   7
         LI,X2    '  '
NXTLOC   RES      0
         STH,X2   LSTBF             1ST 2 BYTES OF LIST BUFFER
         LW,X3    X6                ADDRESS OF 1ST WORD OF THIS LINE
         SLS,X3   12                LEFT ADJUST ADDRESS
         LI,AM    5                 NUMBER OF HEX DIGITS
         LI,XT1   2                 NEXT POSITION IN LIST BUFFER
         BAL,RL   HEXEDIT           EDIT ADDRESS INTO LIST BUFFER
HEXDUMP1 RES      0                 ENTRY POINT FOR REGISTER DUMP
         LI,R14   8
NXTWORD  RES      0
         LI,X2    ' '
         STB,X2   LSTBF,XT1         STORE A BLANK IN LIST BUFFER
         AI,XT1   1                 INCREMENT INDEX TO LIST BUFFER
         LW,X3    0,X6              LOAD NEXT WORD TO BE CONVERTED
         LI,AM    8                 NUMBER OF HEX DIGITS
         BAL,RL   HEXEDIT           EDIT WORD INTO LIST BUFFER
         AI,X6    1                 ADDRESS OF NEXT WORD TO CONVERT
         BDR,R14  NXTWORD           CONTINUE UNTIL EIGHT WORDS EDITED
         BAL,RL   SNAPRINT          PRINT THE LIST BUFFER
         CW,X6    R13               EXIT WHEN ALL WORDS
         BG       *R15                HAVE BEEN CONVERTED
         LW,X3    X6
         LI,X2    '  '
NXTCMP   RES      0
         LW,AM    0,X3              BRANCH IF THIS WORD DIFFERS FROM
         CW,AM    -8,X3               CORRESPONDING WORD OF LAST LINE
         BNE      NXTLOC              DUMPED
         AI,X3    1
         CI,X3    7                 CONTINUE UNTIL ALL EIGHT WORDS
         BANZ     NXTCMP              HAVE BEEN EXAMINED
         CW,X3    R13
         BG       NXTLOC            FORCE LAST LINE OUT
         STW,X3   X6
         LI,X2    ' *'
         B        NXTCMP
         PAGE
*
*  D E C E D I T
*        CONVERT A BINARY NUMBER TO DECIMAL DIGITS AND STORE
*
*        INPUT:   NUMBER IS IN X3
*                 XT1 HAS BYTE INDEX TO OUTPUT AREA  (LSTBF)
*
DECEDIT  RES      0
         LI,X6    4                 INDEX TO TENS TABLE
DECED1   RES      0                 FIND NUMBER OF SIGNIF. DIGITS
         CW,X3    TENS,X6
         BGE      DECED2            1ST DIGIT FOUND
*
         BDR,X6   DECED1
*
DECED2   RES      0
         LI,X2    0
         DW,X2    TENS,X6           CONVERT AND
         AI,X3    '0'                 STORE NEXT
         STB,X3   LSTBF,XT1           DIGIT
         AI,XT1   1                 BUMP OUTPUT INDEX
         LW,X3    X2                REMAINDER -> DIVIDEND
         AI,X6    -1                BUMP TO NEXT TENS ENTRY
         BGEZ     DECED2            BRIF NOT DONE
*
         EXIT     RL
*
TENS     DATA     1,10,100,1000,10000
         PAGE
*
*  N E X T % P G
*        GET NEXT PAGETBL BIT
*
*        INPUT:   X2 HAS # BITS REMAINING IN CURRENT PAGETBL WORD
*                 X1 HAS INDEX TO CURRENT PAGETBL WORD
*                 X4 HAS PARTIAL PAGETBL WORD
*
*        OUTPUT:  X4 AND COMPARITOR HAVE NEXT PAGETBL BIT
*                 RETURN TO CALL+1 IF END-OF-PAGETBL;  ELSE TO CALL+2
*
         DO       SYS=BPMUTS
NEXT%PG  RES      0
         BDR,X2   NXT%PG1           DEC. PG COUNT.  BRIF MORE PAGES
*
         BIR,X1   NXT%PG2           BUMP PAGETBL INDEX AND BRANCH
*
         EXIT     RL                END-OF-PAGETBL EXIT
*
NXT%PG2  RES      0
         LW,X5    PAGETBL+4,X1      NEXT PAGETBL WORD
         LI,X2    32                PAGE COUNT FOR THIS WORD
NXT%PG1  RES      0
         SLD,X4   1                 NEXT PAGE-USED BIT -> X4
         AND,X4   =1                SET COMPARITOR
         B        1,RL              NORMAL EXIT
*
         FIN
         PAGE
*
*   H E X E D I T
*        THIS ROUTINE CONVERTS A NUMBER TO HEXADECIMAL AND STORES IT
*          IN THE LIST BUFFER
*
*        INPUT:   NUMBER OF DIGITS TO STORE IS IN REGISTER AM
*                 INDEX TO LEFT-MOST CHAR POSITION OF LIST BUFFER IS
*                   IN REGISTER XT1
*                 NUMBER TO CONVERT IS LEFT-ADJUSTED IN REGISTER X3
*
*        OUTPUT:  REGISTER AM IS ZERO
*                 REGISTER XT1 IS INDEX TO NEXT CHAR POSITION OF LIST
*                   BUFFER TO BE STORED
*
HEXEDIT  RES      0
         LI,X2    0                 SHIFT HIGH ORDER HEX DIGIT
         SLD,X2   4                   TO LOW ORDER OF REGISTER X2
         LB,X2    HEXTABLE,X2       CONVERT IT TO A HEX CHARACTER
         STB,X2   LSTBF,XT1           AND STORE IT IN LIST BUFFER
         AI,XT1   1                 INCREMENT INDEX TO LIST BUFFER
         BDR,AM   HEXEDIT           CONTINUE UNTIL ALL DIGITS CONVERTED
         EXIT     RL
*
HEXTABLE TEXT     '0123456789ABCDEF'  TABLE OF HEX CHARACTERS
         PAGE
*
*
*   P R I N T
*        PRINT THE CONTENTS OF LIST BUFFER ON 'LO' AND 'DO' FILES
*
*        INPUT:   REGISTER XT1 CONTAINS THE NUMBER OF BYTES IN LIST
*                   BUFFER
*
*        USES REGISTER
*                 AM, IOADD, IOSIZE, IORL.
*
PRINT    RES      0
         STW,RL   AM
         LI,IOADD LSTBF             ADDRESS OF LIST BUFFER
         LW,IOSIZE XT1              NUMBER OF BYTES TO OUTPUT
         BAL,IORL WRITELO           WRITE ON 'LO' FILE
         BAL,IORL WRITEDO           WRITE ON 'DO' FILE
         EXIT     AM
         PAGE
*
*   S N A P R I N T
*        PRINT THE CONTENTS OF LIST BUFFER ON 'LO' AND/OR 'DO'
*          IF THEY ARE NOT ASSIGNED TO A TERMINAL
*
*        INPUT:   REGISTER XT1 CONTAINS THE NUMBER OF BYTES IN LIST
*                   BUFFER
*
*        USES REGISTER
*                 IOADD, IOSIZE, IORL
*
SNAPRINT RES      0
         LI,IOADD LSTBF             ADDRESS OF LIST BUFFER
         LW,IOSIZE XT1              NUMBER OF BYTES TO OUTPUT
         DO       SYS=BPMUTS
         MTW,0    LO%ONLINE         BRANCH IF 'LO' IS ASSIGNED TO A
         BNEZ     SNAPRT1             TERMINAL
         FIN
         STD,X6   X2
         BAL,IORL WRITELO           WRITE ON 'LO'
         LD,X6    X2
SNAPRT1  RES      0
         DO       SYS=BPMUTS
         MTW,0    DO%ONLINE         EXIT IF 'DO' IS ASSIGNED TO A
         EXIT,NE  RL                  TERMINAL
         FIN
         BAL,IORL WRITEDO           WRITE ON 'DO'
         EXIT     RL
         END

