         TITLE    'SYSGEN PASS3 - LOAD SYSTEM AUTOMATICALLY'
*        CATALOG NO. 705539 - M:PASS3ROM
************************************************************************
         SYSTEM   BPM
         SYSTEM   SIG7FDP
************************************************************************
         DEF      PASS3
         REF      M:SI,M:C
         REF      M:EI
         REF      M:EO
         REF      M:TM
         PAGE
************************************************************************
*  THIS PROCESSOR WILL PROCESS ':' TYPE CONTROL COMMANDS WHICH DEFINE
*    A PROCESSOR, SUBROUTINE, OR A MONITOR WHICH IS TO BE LOADED. THE
*    NAME ON THE CC IS USED TO OBTAIN A LOCCT (LOADER-OVERLAY-CONTROL-
*    TABLE) TABLE WHICH DEFINES TO THE LOADER THE LOAD/TREE STRUCTURE
*    FOR THE NAME DEFINED. THE LOCCT TABLES ARE ASSUMED TO BE IN THE RUN
*    ACCOUNT UNLESS, A PREVIOUS ASSIGN SPECIFIES THAT THE M:EI DCB IS
*    TO REFERENCE SOME OTHER ACCOUNT, (E.G. :ACCNT1).
*        THE CC MAY DEFINE A BIAS (>BKGRDLL) FOR LOADING THE
*    ELEMENT. IF NONE IS GIVEN, THE BIAS WILL BE OBTAINED FROM THE
*    M:MON LOAD-MODULE IN THE CURRENT ACCOUNT. THIS IS ACCOMPLISHED
*    BY DETERMINING THE BACKGROUND-LOWER-LIMIT FOR THE M:MON MODULE.
*    IF M:MON DOES NOT EXIST, THE BIAS IN THE ORIGINAL LOCCT TABLE IS
*    NOT MODIFIED. THE LOCCT TABLE IS THEN PUT INTO THE ABS/READ/WRITE
*    AREA OF RAD FOR USE BY THE LOADER. (R6)=LOCCT SIZE UPON EXITING
*    TO THE LOADER. THE LOADER IS ENTERED VIA AN 'M:LINK' CALL, AND
*    THE LOADER WILL RETURN VIA AN 'M:LDTRC' RETURN CALL. IF THE CC
*    CONTAINS THE KEYWORD 'DELETE', ALL ROM'S WHICH MAKE UP THE
*    CURRENT ELEMENT WILL BE RELEASED, UNLESS THE LOADER RETURNED
*    BECAUSE OF AN ERROR IN LOADING.
*  THE ENTIRE PROCESS OF BIASING IS BYPASSED IF THE TARGET SYSTEM IS
*    UTS.  ALSO, THE LOCCT TABLE IS SAVED FOR THE LOADER IN COMMON
*    STORAGE IF PASS3 IS BEING EXECUTED UNDER AN UTS SYSTEM,
*    (WORD-0 = SIZE OF LOCCT TABLE).
*        THE CC'S SYNTAX APPEARS AS:    :ID  <(PARAMETERS)>
*         WHERE :   ID = METASYM, FORTRAN, FMGE, ETC.
*           PARAMETERS = DELETE; SAVE (SAVE(N1,N2,...))
*               WHERE DELETE DELETES ALL ELEMENT FILES EXCEPT THOSE ON SAVE
*                      N1,N2,...= NAMES OF ELEMENT FILES WHICH ARE
*                                   NOT TO BE DELETED
************************************************************************
PASS3    EQU      %      <<->> ENTRY
         LW,SR4   *R0               SET UP TSTACK
         PSW,SR4  *R0                 FOR ERROR RECOVERY
         M:GP     NOPAGES  ***      OBTAIN WORK AREA
         SLS,SR1  9                 # WORDS
         LW,D1    SR2               BASE ADDR.OF BUFFER (CC'S)
         LW,R2    SR1
         AI,D1    -1
         LI,R1    0
         STW,R1   *D1,R2            SET WORK AREA = 0
         BDR,R2   %-1            ---
         AI,D1    1
         LW,D2    SR2
         AI,D2    CARDSIZ           BASE ADDR. OF LOCCT BUFFER
         LC       X'2B'
         BCR,2    READFRST
         LC       *X'4F'
         BCR,8    READFRST
         LI,6     37
         CAL1,1   PROMPT
         M:TYPE   (MESS,TYPEIS)
         B        %+2
READFRST EQU      %
         LI,R6    0
********
*   READ MONITOR SYSTEM CONTROL COMMAND 'PASS3   TYPE'
********
         M:READ   M:C,(BUF,*D1),(SIZE,80),(WAIT)
         LI,D3    X'80'
         STW,D3   RECSIZE
         M:PRINT  (MESS,P3CONT)
         M:SETDCB M:EI,(ERR,EIE),(ABN,EIA)
         M:SETDCB M:EO,(ERR,EOE),(ABN,EOA)
         PSW,SR1  *R0
         M:TRAP   (IGNORE,FX)
         PLW,SR1  *R0
         LW,D3    SR1               END OF
         AW,D3    D1                  WORK AREA +1
         LI,R2    CCPL-ENDYN
         LW,R7    *R0
         AI,R7    1                 CCPL TABLE ADDRESS
         LW,R3    ENDYN,R2          MOVE PLIST (CCPL)
         PSW,R3   *R0                 INFO TO TSTACK
         BIR,R2   %-2            ---
         STW,D1   FLGS,R7           SET CC BUFFER ADDR IN CCPL
         PSW,SR1  *R0
*   PROCESS PASS3 'TYPE' FIELD
         LCI      0
         PSM,R0   *R0
         LI,SR1   0
         CI,R6  0
         BNE      %+3
         BAL,SR4  NAMSCAN  ***      GET RID OF 'PASS3'
         NOP      0
         BAL,SR4  NAMSCAN  ***      GET OPTION 'MON' OR 'ALL'
 BCS,8 NOTYPE
 LW,D1 CHARS,R7
         LI,R1    #PROCS
         CW,D1    PROCS,R1
         BE       %+3
         BDR,R1   %-2
         BAL,SR4  BADPROC
         STW,R1   ERRCOND,R7
NOTYPE   EQU      %
         LCI      0
         PLM,R0   *R0
PASS3NXT EQU      %
         PLW,SR1  *R0
         PSW,SR1  *R0
         AI,D1    -1
         LI,R2    0
         LW,R3    SR1               SET WORK AREA
         STW,R2   *D1,R3              TO ZERO
         BDR,R3   %-1            ---
         STW,R3   SAVE,R7
         STW,R3   DELETE,R7
         STW,R3   MONFLG,R7
         STW,R3   CURACT,R7
         STW,R3   CURACT+1,R7
         AI,D1    1
         LI,R2    1                 START CC
         STW,R2   CCP,R7              SCAN AT COLUMN-2
         M:PRINT  (MESS,BLNKLINE)
         BAL,SR4  READCC   ***      GET NEXT CC
*********
         BAL,SR4  LISTCC   ***
*********
         CW,SR3   L(X'06000000')    READCC O.K.
         BNE      PASS3NXT      NO..
         LI,SR1   0             YES.
         BAL,SR4  NAMSCAN  ***      GET CC ID
         BCS,8    IDERR    EEE      ID BAD
         LCI      2
         PSM,SR1  *R0
         LW,R1    CSL,R7
         CI,R1    15-5              MAXIMUM ID SIZE = 10 CHAR.
         BG       IDSIZE   EEE      ID TOO LONG
         CI,R1    0                 THERE MUST BE
         BE       IDSIZE   EEE        AN ID
         AI,R1    5                 SIZE OF 'LOCCT'
         LW,R2    LOCCTEXT          BUILD TEXTC FORM OF:
         STB,R1   R2                  'LOCCTXXX---XX'
         LW,R3    LOCCTEXT+1          AND PUT IN OPEN
         STW,R2   OPNP+8,R7           CALL ON MONITOR
         STW,R3   OPNP+9,R7             WHERE: 'XX---XX' = ID
         LI,R4    6                 APPEND
         LI,R5    0                   NAME
         LW,SR4   CSL,R7              TO 'LOCCT'
         LW,SR2   R7                  IN OPEN PLIST
         AI,SR2   CHARS
         LW,R1    R7
         AI,R1    OPNP+8
         LB,R3    *SR2,R5
         STB,R3   *R1,R4
         AI,R4    1
         AI,R5    1
         BDR,SR4  %-4            ---
         AI,R4    3
         SLS,R4   -2
         AI,R1    -1
         LI,R3    2                 SET #
         STB,R4   *R1,R3              WORDS USED
         CAL1,1   OPNP,R7  ***      OPEN TO INPUT FILE (M:EI)
         LI,SR4   0                 TOTAL SIZE OF IMAGE(S)
         LI,D4    -1                CARD SEQUENCE # CHECK
         PSW,D2   *R0
PASS3LCT EQU      %
         LW,R1    *D2               LAST WORD OF PREV. CARD SAVED
         M:READ   M:EI,(BUF,*D2),(SIZE,120),(ERR,RE),(ABN,RA),(WAIT)
         AI,D4    1                 TO NEXT SEQUENCE #
         LB,SR2   *D2               CHECK
         CI,SR2   X'3E'               IMAGE FOR
         BE       %+3            ---  CODE TYPE
         CI,SR2   X'1E'               OK
         BNE      TYP      EEE  NO..CODE OK
         LI,R3    1             YES.
         LB,R2    *D2,R3            GET IMAGE SEQ.#
         CW,R2    D4
         BNE      SEQ      EEE  YES.IMAGE SEQUENCE # BAD
         LI,R3    2             NO..
         LB,R2    *D2,R3            GET BYTE CHECKSUM
         LI,R4    0
         STB,R4   *D2,R3            SET CHECKSUM IN IMAGE =0
         LI,R3    3
         LB,R3    *D2,R3            GET BYTE COUNT FROM IMAGE
         AW,SR4   R3                ACCUMULATE TOTAL
         AI,SR4   -4                  RECORD SIZE (BYTES)
         SLS,R3   -2                MAKE # WORDS
         PSW,R3   *R0
         AI,D2    -1
         AW,R4    *D2,R3            FORM A WORD
         BDR,R3   %-1            ---  CHECKSUM OF IMAGE
         LH,R5    R4
         AND,R4   L(X'0000FFFF')
         CI,R5    0
         BEZ      %+3            ---TAKE CARE OF OVERFLOW
         AW,R4    R5
         B        %-5            ---
         SLD,R4   -8                FORM A BYTE
         SLS,R5   -8                  CHECKSUM OF IMAGE
         CI,R4    0
         BEZ      %+3            ---TAKE CARE OF OVERFLOW
         AH,R4    R5
         B        %-5            ---
         SLD,R4   16
         CW,R4    R2                CHECKSUM OK
         BNE      SUM      EEE  NO..
         PLW,R3   *R0           YES.
         AI,D2    1
         STW,R1   *D2               RESTORE LAST WORD OF PREV.IMAGE
         AW,D2    R3                TO NEXT IMAGE AREA
         AI,D2    -1
         CI,SR2   X'1E'              BINARY END IMAGE
         BNE      PASS3LCT      NO..
         PLW,D2   *R0           YES.
         M:CLOSE  M:EI,(SAVE)
         LCI      2
         PLM,SR1  *R0
         LCI      3
         PSM,SR4  *R0
         LI,SR2   '('
         BAL,SR4  CHARSCAN ***      CHECK FOR PARAMETERS FIELD
         BCR,8    PASS3PAR      YES.GO PROCESS PARAMETERS
         CI,SR1   KCRET
         BE       PASS3CHK
         CI,SR1   KNL
         BE       PASS3CHK       ---
         CI,SR1   EOB
         BNE      DEL      EEE      CC IN ERROR
PASS3CHK EQU      %
         LI,R1    RELLMN            DETERMINE
         LW,SR4   *D2,R1              IF THIS LOCCT
         CW,SR4   M:MON               IS FOR M:MON
         BNE      NOTM:MON      NO..
         LI,R1    RELLMN+1      YES.POSSIBLY
         LW,SR4   *D2,R1
         CW,SR4   M:MON+1
         BNE      NOTM:MON      NO..NOT = M:MON
         MTW,1    M:MONFLG,R7   YES.SET SPECIAL FLAG
         MTW,1    MONFLG,R7         SET M:MON FLAG
         LI,R1    0
         STW,R1   BKGRDLL,R7        RESET BKGRDLL
NOTM:MON EQU      %
         LCI      4                 (D1)=WORK AREA SIZE (WORDS)
         PLM,D1   *R0               (D2)=LOCCT SIZE (BYTES)
         LCI      4
         PSM,D1   *R0               (D3)=CC BUF.BASE   (D4)=LOCCT BASE
         AI,D4    1                 TRUE BUFFER ADDRESS FOR ABS WRITE
         LW,R6    *D4               MAKE SURE SEVERITY LEVEL
         OR,R6    L(X'000F0000')      IN LOCCT IS 'F'
         STW,R6   *D4
         LCI      3
         PSM,D1   *R0
         LW,D1    M:EI+22           OBTAIN CURRENT ACCOUNT
         AND,D1   L(X'FF')            FROM M:EI DCB
         AI,D1    M:EI+22+1           WHERE DCB MAY BE LARGE
         LCI      3                   OR SMALL BUT ACCOUNT ENTRY IN DCB
         LM,D1    *D1                 MUST FOLLOW FILE-NAME ENTRY IN DCB
         LI,R6    13
         LCI      2
         STM,D2   *D4,R6            FORCE LOCCT TABLE TO CURRENT ACCOUNT
         STW,D2   CURACT,R7
         STW,D3   CURACT+1,R7
         LCI      3
         PLM,D1   *R0
         MTW,0    MONFLG,R7         M:MON LOCCT
         BEZ      %+2           NO..
*                               YES.
         BAL,SR4  GENHANDL ***      GENERATE DESIRED 'HANDLERS' FILE
         B        SAVINCOM
GOTOLOAD EQU      %
         PSW,R7   *R0
* SETUP AND CALL LOADER VIA M:LINK CALL
         LW,R6    D2                LOCCT
         SLS,R6   -2                  SIZE (WORDS)
         LW,7     =X'200000'
         CW,7     M:LL              CLOSED?
         BAZ      %+2               YES
         M:CLOSE  M:LL,(SAVE)       NO,CLOSE IT
         LW,R7    *CJOB             OBTAIN SYSID FROM MONITORS JIT
         AND,R7   L(X'0000FFFF')
         OR,R7    L(X'00FF0000')
         LCI      15
         PSM,R1   *R0
         M:LINK   'LOADER',':SYS' ** G O - T O - L O A D E R
* LOADER RETURNS  HERE VIA M:LDTRC RETURN CALL
*    LOADER SENDS FLAG BACK IN REG. FOR INDICATION OF WHETHER OR NOT
*      THE LOAD WAS SUCCESSFULL OR NOT.  FLAG =0 IF O.K. ; =1 IF BAD
         SPACE    5
         STW,D4   LOADFLG           FLAG TO DELETE OR NOT TO DELETE
         M:FCP    2        ***      RELEASE COMMON STORAGE
         LCI      15
         PLM,R1   *R0
         PLW,R7   *R0
         MTW,0    DELETE,R7         IF DELETE PARAMETER,
         BEZ      %+2            ---  DELETE ALL ROM'S IN THIS LOCCT
         BAL,SR4  ROMDELET ***      DELETE ALL ROM'S
MAYBERR  LCI      3
         PLM,SR4  *R0
         M:DEVICE M:LL,(PAGE)
         MTW,0    LOADFLG           CHK FOR A LOAD ERROR
         BEZ      PASS3NXT
         LW,SR1   ERRCOND,R7
         CI,SR1   1
         BL       PASS3NXT
         BG       LOADERR
         MTW,0    M:MONFLG,R7
         BEZ      PASS3NXT
         M:PRINT  (MESS,MERRMSG)
         CAL1,9   3
LOADERR  M:PRINT  (MESS,LERRMSG)
         CAL1,9   3
MERRMSG  TEXTC    'M:MON NOT SUCCESSFULLY LOADED'
LERRMSG  TEXTC    'MODULE NOT SUCCESSFULLY LOADED'
BADPROC  EQU      %
         M:PRINT  (MESS,BPRMSG)
         LI,R1    0
         B        *SR4
BPRMSG   TEXTC    'OPTION NOT ''MON'' OR ''ALL'' - NONE ASSUMED'
LOCTERR  TEXTC    '** PROBLEM WITH LOCCT - NO MATCH WITH MISSING',;
                  ' OVERLAY NAMES RECORD PRODUCED BY PASS2'
************************************************************************
         PAGE
********
* PROCESS CC PARAMETERS             :ID (BIAS=NNNN,><DELETE>)
********
PASS3PAR EQU      %                 PROCESS PARAMETERS
         LI,SR2   DELETEXT      NO..
         BAL,SR4  QUOTSCAN ***      CHECK FOR 'DELETE'
         BCR,8    PASS3DEL      YES.
         LI,SR2   SAVETEXT      NO..
         BAL,SR4  QUOTSCAN ***       CHECK FOR 'SAVE'
         BCS,8    KEYWRD   EEE  NO..
         MTW,0    SAVE,R7       YES.PREVIOUS 'SAVE' OPTION
         BNEZ     DUPKEYWD EEE  YES.
         STW,SR4  DELETE,R7     YES.ASSUME DELETE OPTION WHEN SAVE OPT.
         LCI      2
         PSM,SR1  *R0
         M:GP     1        ***      GET SOME WORK AREA
         STW,SR2  SAVE,R7           SAVE BASE ADDRESS
         SLS,SR1  9
         AW,SR1   SR2               END OF WORK AREA +1
         SLS,SR1  2                 BYTE ADDRESS
         STW,SR1  *SR2              SET WORD 1 = BA(LAST WORD +1)
         AI,SR2   1
         LW,SR1   SR2
         SLS,SR1  2
         AI,SR1   4
         STW,SR1  *SR2              SET WORD 2 = BA(NEXT AVAIL.BYTE)
         LCI      2
         PLM,SR1  *R0
         LI,SR2   '('
         BAL,SR4  CHARSCAN ***      CHECK FOR '('
         BCS,8    DEL      EEE
NXTNAM   EQU      %
         BAL,SR4  NAMSCAN  ***      GET NEXT NAME
         BCS,8    NAM      EEE
         LCI      15
         PSM,R1   *R0
         LW,R1    SAVE,R7           GET WORK AREA BASE ADDRESS
         LW,R2    1,R1              (R2) = NEXT AVAIL.BYTE IN AREA
         LW,R3    0,R1              (R3) = LAST AVAIL.BYTE IN AREA +1
         LW,R4    CSL,R7            NAME SIZE
         LI,R5    CHARS             NAME BUFFER ADDRESS
         AW,R5    R7
         SLS,R5   2
         STW,R4   R6
         AI,R4    1
         B        SETNO          ---START WITH BYTE COUNT
NXTCHAR  EQU      %
         LB,R6    0,R5              GET NEXT BYTE OF NAME
         AI,R5    1
SETNO    EQU      %
         CW,R2    R3
         BGE      GETPAGE        ---NEED MORE WORK AREA
CONTNAM  EQU      %
         STB,R6   0,R2              MOVE NAME TO WORK AREA
         AI,R2    1
         BDR,R4   NXTCHAR        ---
         STW,R2   1,R1              UPDATE NEXT AVAIL.BYTE ADDRESS
         LCI      15
         PLM,R1   *R0
         LI,SR2   ','
         BAL,SR4  CHARSCAN ***      CHECK FOR ','
         BCR,8    NXTNAM        ---GO GET NEXT NAME
         CI,SR1   ')'
         BNE      DEL      EEE      CC IN ERROR
         LI,SR1   0
         B        PASS3FLD       ---ALL DONE WITH NAMES
GETPAGE  EQU      %                 GET MORE WORK AREA
         LCI      2
         PSM,SR1  *R0
         M:GP     1        ***      GET WORK AREA
         AI,SR2   512               END OF WORK AREA +1
         SLS,SR2  2                 BYTE ADDRESS OF END +1
         STW,SR2  0,R1              UPDATE WORD 1 IN WORK AREA
         STW,SR2  R3
         LCI      2
         PLM,SR1  *R0
         B        CONTNAM        ---
PASS3DEL EQU      %
         STW,SR4  DELETE,R7         SET FLAG FOR DELETE FILES
PASS3FLD EQU      %
         LI,SR2   ','
         BAL,SR4  CHARSCAN ***      CHECK FOR ANOTHER FIELD
         BCR,8    PASS3PAR      YES.
         CI,SR1   ')'           NO..END OF FIELD
         BNE      DEL      EEE  NO..
EOCC     EQU      %             YES.
         LI,SR1   0
         BAL,SR4  NXACTCHR ***      SEARCH FOR END OF CC
         CI,SR1   KCRET
         BE       PASS3CHK
         CI,SR1   KNL
         BE       PASS3CHK       ---
         CI,SR1   EOB
         BNE      EOCC           ---
         B        PASS3CHK       ---
         PAGE
************************************************************************
*  GET COMMON STORAGE & SAVE LOCCT TABLE FOR LOADER IN COMMON
*     ENTER :     (D4) = BUFFER ADDRESS
*                 (D2) = LOCCT TABLE SIZE (BYTES)
*
*
*  THIS ROUTINE ALSO ADJUSTS THE LOCCT TABLE FOR M:MON SO AS TO DELETE
*  THE MISSING OVERLAYS FROM THE TREE AND TO REMOVE
*  THEIR ASSOCIATED ROMS FROM THE ROM TABLE PORTION.
*  THE RESULTING LOCCT IS THEN PLACED IN COMMON STORAGE FOR
*  PROCESSING BY THE LOADER.
*
*  NOTE   THAT PASS2 SUPPLIES THE RECORD WITH THE NAMES OF THE
*  OVERLAYS TO BE DELETED IN THE SPEC:HAND FILE AND THAT AT LEAST
*  1 SUCH NAME WILL BE CONTAINED IN THE 'OVNAMES' RECORD.
*
************************************************************************
SAVINCOM EQU      %
         LCI      15
         PSM,R1   *R0
         LW,R1    D2
         SLS,R1   -2
         LW,R2    R1
         AI,R2    X'1FF'
         SLS,R2   -9
         OR,R2    XGCPMSK
         CAL1,8   R2
         STW,R1   *SR2              WORD-0 OF COMMON = LOCCT SIZE(WORDS)
         AI,D4    -1
         STW,D4   LOCCTAD
         LW,R2    R1
         AW,R2    D4
         STW,R2   LOCCTEND
         LW,R7    D4
         LW,R2    2,R7              GET DISP TO ROMT
         STW,R2   LROMDISP
         SW,R1    R2
         AI,R1    1
         STW,R1   STRTRMSZ          INITIAL ROM TABLE SIZE
         LW,R3    R2
         AW,R3    D4
         AI,R3    1
         STW,R3   STRTRMAD          INITIAL ROM TABLE ADDRESS IN
*                                   WORK AREA LOCCT
         LW,R1    3,R7
         STW,R1   LTREEDIP
         AW,R1    D4
         STW,R1   STARTRAD          INITIAL TREE TABLE ADDRESS (POINTING
*                                   TO SIZE WORD
         LW,R3    *R1
         STW,R3   STARTRSZ          SAVE TREE SIZE
         AI,R1    1                 PT TO FIRST NAME IN TREE
         STW,R1   TREEAD
         LW,R1    *R0               * BACK UP A MINUTE...
         LW,R1    R7-14,R1          *
         MTW,0    M:MONFLG,R1       * IF IT ISNT M:MON,  D O N ' T
         BEZ      MUV2COMM          * DELETE ANY OVERLAYS.
GRANDLUP LW,R1    MISOVTAB          GET MISOVNM #
         BEZ      MUV2COMM          IF NONE, SKIP DELETING.
         LW,R3    STARTRSZ
         LI,R4    0
LOOP     LCI      2
         LM,SR3   *TREEAD,R4
         CD,SR3   MISOVTAB,R1
         BE       PURGEIT
         BDR,R1   %-2
         LW,R1    MISOVTAB          RESTORE # MISS OV TO R1
         AI,R4    11                PT TO NEXT ENTRY IN TREE
         CW,R4    R3                ALL THRU WITH TREE
         BL       LOOP              BRANCH IF NOT
         M:PRINT  (MESS,LOCTERR)     PROBLEM WITH LOCCT
         M:FCP    2
         LCI      15
         PLM,R1   *R0
         PLW,R7   *R0
         B        MAYBERR
PURGEIT  CW,R1    MISOVTAB          IS IT LAST ENTRY
         BE       ADUSTREE
         LW,R7    MISOVTAB          GET # OF MISOV NAMES IN TABLE
         SW,R7    R1                # TO MOVE
         LW,R5    R1
         AI,R5    1
MUVLOOP  LD,SR3    MISOVTAB,R5      MOVE REMAINING NAMES DOWN
         STD,SR3  MISOVTAB,R1
         AI,R1    1
         AI,R5    1
         BDR,R7   MUVLOOP
ADUSTREE MTW,-1   MISOVTAB          DECRMENT # OF MISSING NAMES IN TABLE
         STW,R4   SAVTRDISP
         AI,R4    11
         CW,R4    STARTRSZ
         BGE      MUVTREE
         LW,R4    SAVTRDISP
         BAL,SR4  FIG#RENT          CALCULATE # OF ROM ENTRIES TO
*                                   ELIMINATE
         LW,R7    SAVROMD
         LCW,R6   RRCOUNT
         AW,R6    R7                R6 = 'FROM' ADDRESS
         LW,SR1   LOCCTEND
         SW,SR1   R6                # OF WORDS TO MOVE OVER ROM
         AI,SR1   1                 ENTRY TO BE ELIMINATED
         CW,SR1   X3F               SEE IF WORD COUNT > 63
         BL       OK
         SW,SR1   X3F
         STW,SR1  BALWORDS
         LW,SR1   X3F
OK       SCS,SR1  -8                PUT COUNT IN BYTE0
         AW,R7    SR1
         SLD,R6   2                 CONVERT EVERYTHING TO BYTES
MBSROM   MBS,R6   0                 MOVE REST OF ROM TABLE DOWN
         MTW,0    BALWORDS          ANYMORE BYTES TO MOVE
         BEZ      MUVTREE
         LW,SR1   BALWORDS
         CW,SR1   X3F
         BL       OK1
         SW,SR1   X3F
         STW,SR1  BALWORDS
         LW,SR1   XFC
         B        %+4
OK1      LI,R5    0
         STW,R5   BALWORDS
         SLS,SR1  2
         STB,SR1  R7                STORE COUNT IN BYTE0
         B        MBSROM
MUVTREE  EQU      %
         LW,R7    SAVTRDISP         GET MISSING TREE ENTRY DISP
         LW,R4    R7
         LW,R6    R7
         AI,R6    11                R6 NOW = DISP. TO NEXT ENTRY IN TREE
         CW,R6    STARTRSZ          IS R6 BEYOND TREE TABLE END
         BGE      JUSTMOD           BR. IF SO
         LW,R3    STARTRSZ          CALCULATE # OF ENTRIES TO MOVE
         SW,R3    R6
         DW,R3    ELEVEN            R3 NOW = # OF ENTRIES TO MOE
         AW,R6    TREEAD
         AW,R7    TREEAD
MUVTRNAM LCI      4                 ONLY MOVE THE TREE ENTRY NAME
         LM,SR3   *R6               OVERLAY LINK REMAINS UNDISTURBED
         LW,R4    RRCOUNT           NEED TO UPDATE ROM TABLE PTR
         AH,R4    D2                D2 HAS OLD ROM PTR IN LEFT HALF
         STH,R4   D2
         LCI      4
         STM,SR3  *R7
         AI,R6    11
         AI,R7    11
         BDR,R3   MUVTRNAM
         STW,R6   SAVTRDISP
CHK4MORE EQU      %
         LW,R3    RRCOUNT           ADJUST LOCCTEND ADDRESS
         AWM,R3   LOCCTEND
         LI,R3    -7                RESTORE RRCOUNT TO INITIAL VALUE
         STW,R3   RRCOUNT
         AI,R3    -4
         AWM,R3   STARTRSZ          DECREMENT TREE SIZE BY -11
         MTW,0    MISOVTAB
         BGZ      GRANDLUP          BRANCH IF MORE MISSING OVERLAYS
*                                   ARE TO BE DELETED
         SW,R7    TREEAD
         STW,R7   SAVTRDISP
CLEANUP  LW,R4    SAVTRDISP         NOW WE NEED TO ZERO
         AI,R4    -7                OUT OVERLAY WORD DISP IN LAST
         AW,R4    TREEAD            TREE ENTRY
         LI,R3    0
         STW,R3   *R4
         B        MUV2COMM
JUSTMOD  LI,R3    -11
         AWM,R3   STARTRSZ
         LI,SR4   CLEANUP
         B        FIG#RENT
DECRRL   EQU      %
         LI,R3    -11
         LW,R7    D4
         AWM,R3   2,R7              ALTER ROMT DISP BY 1 TREE ENT. SIZE
         AW,R3    RRCOUNT
         AWM,R3   *SR2              ALTER LOCCT SIZE IN COMMON AREA
         LW,R3    RRCOUNT           REDUCE BY -1 TREE ENTRY AND -N
*                                   ROM ENTRIES
         AWM,R3   STRTRMSZ
         B        *SR4
FIG#RENT AW,R4    TREEAD            THIS ROUTINE CHECKS FOR  TOTALL
         AI,R4    3                 # OF ROMS BELONGING TO THE
         LH,R4    *R4               SEGMENT TO BE ELIMINATED
         AW,R4    STRTRMAD          PT TO START OF THE GROUP
         STW,R4   SAVROMD           SAVE PTR. TEMPORARILY
         AI,R4    2                 LAST BYTE OF WORD 3 OF THIS ENTRY
CHK4LAST LW,R3    *R4               WILL = 0 WHEN THE LAST OF GROUP HAS
         CB,R3    XFC               BEEN ENCOUNTERED
         BE       DECRRL            BR. IF LAST
         MTW,-7   RRCOUNT           RRCOUNT = -7*#OF ROMS TO BE DELETED
         AI,R4    7
         B        CHK4LAST          CONTINUE TO CHECK FOR LAST
MUV2COMM LW,R1    STARTRSZ          PUT CURRENT SIZE OF TREE IN
         STW,R1   *STARTRAD         TREE SIZE WORD IN TREE TABLE
         LW,R7    D4
         LW,R1    2,R7
         LW,D2    *SR2
         SLS,D2   2                 ADJUST D2 FOR NEW SIZE & SAVE IT
         STW,D2   D2SAVE
         LI,R2    X'80'             SET UP FLAG FOR LOADER
         STB,R2   *SR2                FLAG IS BIT-0 = 1
         LW,R2    *D4,R1            MOVE LOCCT TABLE
         STW,R2   *SR2,R1             TO COMMON STORAGE
         BDR,R1   %-2             ---
         LW,R1    STRTRMSZ          GET CURRENT ROM TABLE SIZE
         AW,SR2   2,R7              PT SR2 TO WHERE ROM TABLE WILL
         MTW,-1   STRTRMAD
         LW,R2    *STRTRMAD,R1      BE PLACED IN COMMON AREA
         STW,R2   *SR2,R1
         BDR,R1   %-2
         LCI      15
         PLM,R1   *R0
         LW,D2    D2SAVE
         B        GOTOLOAD
XGCPMSK  DATA     X'0C000000'
************************************************************************
         PAGE
**********
*  GENERATE DESIRED 'HANDLERS' FILE FROM INFO IN 'SPEC:HAND'
*    FILE GENERATED BY SYSGEN PASS2.  MERGE WITH DEFAULT FILE 'BASHANDL'
**********
GENHANDL EQU      %
         LCI      15
         PSM,R1   *R0
         M:GP     1        ***      GET WORK AREA
         LW,R5    SR2
         M:GP     1                 GET 2ND PAGE FOR M:EI DCB BUF
         M:OPEN   M:TM,(FILE,'SPEC:HAND'),(KEYED),(IN),(SAVE),;
                  (ERR,OSPHER),(ABN,OSPHAB)
READKEYS M:READ   M:TM,(BUF,*R5),(SIZE,1024),(WAIT),;
                  (ERR,RSPHER),(ABN,CHKEND)
         LW,R2    M:TM+10
         LCI      3
         LM,D1    *R2               GET KEY FROM KBUF AREA OF DCB
         STM,D1   OPENEO+7,R7
         CW,D1    HANDLERS
         BNE      MAYBEPRO
         M:OPEN   M:EI,(FILE,'BASHANDL'),(IN),(SAVE),;
                  (ERR,OBSHER),(ABN,OBSHAB)
         M:SETDCB M:EO,(ERR,0),(ABN,0)
         M:OPEN   M:EO,(FILE,'HANDLERS'),(OUT),(SAVE),(CONSEC),(SEQUEN)
         BAL,R2   CPYHNDL  ***      COPY BASIC HANDLERS TO MERGED FILE
PROSESPC LW,R6    *R5               # ENTRIES IN EA. SPEC:HAND RECORD
         LW,D4    R5                TO 1-ST ENTRY
NXTHANDL EQU      %
         AI,D4    2
         LD,D1    *D4               GET HANDLER NAME
         LB,R1    D1                CHECK FOR POSSIBLE BAD NAME
         BEZ      NAMNG             YES.ERROR
         CI,R1    7                 HANDLER NAME MUST = OR BE LESS THAN 7
*                                   CHARACTERS LONG
         BG       NAMNG             YES.ERROR
         LI,R1    #SPECHND          NAME O.K.
         CD,D1    SPECHAND-2,R1     IS NAME ONE OF DEFAULTS
         BE       NAMNG             YES.IGNORE IT
         BDR,R1   %-2               NO..
         LW,D3    R5                NO..NAME IS UNIQUE
SRCHTBL  EQU      %
         AI,D3    2
         CW,D3    D4                HAS NAME ALREADY BEEN IN TABLE
         BGE      GETHANDL          NO..GO GET NEW FILE
         CD,D1    *D3               CHECK FOR LIKE NAME
         BNE      SRCHTBL           NO..NOT THIS ONE
NAMNG    EQU      %                 YES.NAME ALREADY OBTAINED
         BDR,R6   NXTHANDL          NO..END OF HANDLER NAME TABLE
         M:CLOSE  M:EO,(SAVE)
         B        READKEYS          SEE IF THERE ARE MORE KEYED RECORDS
CHKEND   LB,R1    SR3
         CI,R1    6
         BNE      RSPHAB
         M:CLOSE  M:TM,(SAVE)
         M:FP     2        ***      FREE WORK AREA
         LCI      15
         PLM,R1   *R0
         B        *SR4     <->      EXIT
MAYBEPRO CW,D1    OVNAMES           IS IT MISSING OPTIONAL OVERLAY
*                                   NAMES RECORD.
         BNE      MUSTBPRO          BR. IF NOT
         LD,R2    *R5               MOVE TABLE TO MISOVTAB.
         STD,R2   MISOVTAB          TABLE IS L.E. 10 WORDS IN LNGTH.
MISNMLUP LD,D1    *R5,R2
         STD,D1   MISOVTAB,R2
         SLD,D1   8                 REMOVE BYTE COUNT FROM OV. NAMES
         AI,D2    X'40'             ADD TRAILING BLANK
         STD,D1   MISMESS2,R2       INFORM USERS OF REMOVED NAMES
         BDR,R2   MISNMLUP
         M:PRINT  (MESS,MISMESS1)
         M:PRINT  (MESS,MISMESS2)
         B        READKEYS
MUSTBPRO CW,D1    HANDLERS2
         BNE      ERRHAND
         CAL1,1   OPENEO,R7
         B        PROSESPC
**********
GETHANDL EQU      %
         LCI      2
         STM,D1   OPNH+8,R7
         SLD,D1   8                 SET UP OPEN/READ ERROR MESSAGES
         AI,D2    X'40'
         LCI      2
         STM,D1   BSHNDM+4
         STM,D1   SPHM+4
         LW,R2    SPHM+3
         SLS,R2   -8
         SLS,R2   8
         AI,R2    X'40'
         STW,R2   SPHM+3
         CAL1,1   OPNH,R7  ***      OPEN NEW NAMED FILE
         BAL,R2   CPYHNDL  ***      MERGE WITH OTHER FILES
         B        NAMNG             TO NEXT ENTRY
**********
         SPACE    2
**********
*   MERGE THIS FILE WITH NEW HANDLERS FILE
**********
CPYHNDL  EQU      %
         M:READ   M:EI,(BUF,*SR2),(SIZE,120),(WAIT),(ERR,RBSHER),;
                  (ABN,RBSHAB)
          LW,R1    M:EI+4
         SLS,R1   -17
         M:WRITE  M:EO,(BUF,*SR2),(SIZE,*R1),(WAIT)
         B        CPYHNDL
RBSHER   EQU      %                 I/O ERROR
RBSHAB   EQU      %                 I/O ABN
         LB,R1    SR3               GET ERR/ABN
         CI,R1    6                 EOF
         BNE      HNDLER   EEE      ERROR
         M:CLOSE  M:EI,(SAVE)
         B        *R2      <->      EXIT
**********
         PAGE
************************************************************************
*  THIS ROUTINE WILL DELETE FROM THIS ACCOUNT ALL ROM'S WHICH MAKE
*    UP THE LM JUST FORMED. THE ROM NAMES APPEAR IN THE LOCCT.
*        ENTRY :  (D4) = BASE ADDRESS OF LOCCT
*                 (D2) = LOCCT SIZE (BYTES)
************************************************************************
ROMDELET EQU      %                ENTER
         MTW,0    LOADFLG           LOADER LOADED O.K.
         BNEZ     *SR4     <<->>NO..EXIT  --  DO NOT DELETE ANYTHING
*                               YES.
         LCI      15
         PSM,R1   *R0
         LW,R4    SAVE,R7           (R4) = BASE OF WORK AREA IF THERE
         BEZ      DELIT          ---NO SAVE OPTION SPECIFIED
         LI,R1    OPNP+8            DETERMINE FILE NAME ADDRESS
         AW,R1    R7
         BAL,SR4  CHKNAM   ***      CHECK IF FILE NAME IN SAVE TABLE
         BCS,8    DELNXT        YES.SAVE LOCCT TABLE
DELIT    EQU      %             NO..DELETE LOCCT TABLE
         CAL1,1   OPNP,R7  ***      RELEASE
         M:CLOSE  M:EI,(REL)           LOCCT TABLE
DELNXT   EQU      %
         SLS,D2   -2
         AW,D2    D4
         LI,R1    1                 OBTAIN FROM LOCCT
         LW,R1    *D4,R1              THE REL.ENTRY OF ROM TABLE
         BEZ      ROMDEL1       NO..ANY ROM TABLE
         LI,R2    2             YES.
         LW,R2    *D4,R2
         AW,R2    D4                POSITION TO TREE TABLE
         LW,D3    -1,R2
         AW,D3    R2                END TREE +1
         STW,R2   SR2
         M:SETDCB M:EI,(ERR,DE),(ABN,DA)
ROMDELA  EQU      %
         LI,R2    3
         LW,R1    *SR2,R2           OBTAIN NEXT ROM TABLE ADDRESS
         SLS,R1   -16                 FROM TREE
         LI,R2    1
         AW,R1    *D4,R2
         AW,R1    D4                RELOCATE IT
ROMDEL0  EQU      %
         LCI      3                 PICK UP
         LM,R2    0,R1                ROM NAME (R2,R3,R4)
         STM,R2   OPN+8,R7          PUT NAME IN OPEN PLIST
         LB,R5    R2                DETERMINE # EFFECTIVE
         AI,R5    4                   WORDS IN NAME
         SLS,R5   -2
         LI,R6    2
         LI,D1    OPN+7
         AW,D1    R7
         STB,R5   *D1,R6
         PSW,R1   *R0
         PSW,R4   *R0
         LCI      2
         PSM,R2   *R0
         LCI      2
         LM,R2    3,R1              GET CURRENT ACCT
         CW,R2    CURACT,R7         IS IT CURRENT ACCT
         BNE      ROMDEL01          NO
         CW,R3    CURACT+1,R7
         BNE      ROMDEL01          NO
         LW,R4    SAVE,R7           GET WORK AREA BASE ADDRESS
         BEZ      DELROM         ---NO SAVE NAMES SPECIFIED
         LI,R1    OPN+8             DETERMINE FILE NAME ADDRESS
         AW,R1    R7
         BAL,SR4  CHKNAM   ***      CHECK IF NAME IN SAVE TABLE
         BCS,8    ROMDEL01      YES.SAVE FILE
DELROM   EQU      %             NO..DELETE FILE
         CAL1,1   OPN,R7   ***      OPEN THE ROMFILE
         M:CLOSE  M:EI,(REL)        CLOSE AND RELEASE
ROMDEL01 EQU      %
         LCI      2
         PLM,R2   *R0
         PLW,R4   *R0
         PLW,R1   *R0
         CI,R4    X'40'             AT END OF
         BANZ     ROMDEL2       NO..  ROM TABLE
ROMDEL02 EQU      %             YES.
         AI,SR2   11                TO NEXT TREE ENTRY
         CW,SR2   D3                AT END OF TREE
         BL       ROMDELA       NO..
ROMDEL1  EQU      %             YES.
         MTW,0    SAVE,R7
         BEZ      ROMDEL1X       ---NO SAVE NAMES IN TABLE
         LW,R1    SAVE,R7           SAVE TABLE BASE ADDRESS
         LW,R2    0,R1              (R2) = BA(END OF NAME TABLE +1)
         SLS,R2   -2
         SW,R2    R1                DETERMINE # PAGES IN WORK AREA
         SLS,R2   -9
         OR,R2    L(X'09000000')
         CAL1,8   R2       ***      RELEASE WORK AREA
ROMDEL1X EQU      %
         LCI      15
         PLM,R1   *R0
         B        *SR4   <<->>     EXIT
ROMDEL2  EQU      %
         AI,R1    7                 TO NEXT ROM TABLE ENTRY
         CW,R1    D2
         BGE      ROMDEL02      YES.END OF ROM TABLE
         B        ROMDEL0       NO..
************************************************************************
         PAGE
************************************************************************
*  CHKNAM CHECKS NAME POINTED TO BY (R1) = TEXTC TYPE NAME
*        AGAINST NAMES IN TABLE POINTED TO BY (R4)
*    TABLE FORMAT IS :
*        WORD-0 = BA(LAST BYTE AVAILABLE +1)
*        WORD-1 = BA(NEXT AVAILABLE BYTE IN TABLE)
*        WORD-2 THRU N = BYTE TABLE OF CHARACTERS (TEXTC TYPE NAME)
*          EXIT :
*                 NAME FOUND , CC1 = 1
*                 NAME NOT FOUND , CC1 = 0
************************************************************************
CHKNAM   EQU      %
         LCI      15
         PSM,R1   *R0
         STW,R1   R2
         LW,R3    R4
         SLS,R3   2
         AI,R3    8                 1-ST BYTE IN TABLE ADDRESS
CHKNAM1  EQU      %
         SLS,R1   2
         LB,R6    0,R3              NAME SIZE FROM TABLE
         CW,R3    1,R4              SEE IF AT END OF TABLE
         BGE      NONAM         YES.
         LB,R5    0,R1          NO..NAME SIZE
         CW,R5    R6                NAME SIZES EQUAL
         BNE      TONXTNM1      NO..GET NEXT NAME
         AI,R3    1             YES.
         AI,R1    1
         CW,R3    1,R4              AT END OF TABLE
         BGE      NONAM         YES.
NXTCHR   EQU      %             NO..
         LB,R5    0,R1              CHECK CHARACTER IN NAME
         CB,R5    0,R3
         BNE      TONXTNM        ---NAMES NOT EQUAL
         BDR,R6   %+2            ---
         B        NAMFND         ---
         AI,R1    1
         AI,R3    1
         CW,R3    1,R4              AT END OF TABLE
         BGE      NONAM         YES.
         B        NXTCHR        NO..
NAMFND   EQU      %
         LCI      15                NAME IS FOUND
         PLM,R1   *R0
         LCI      8
         B        *SR4     <-->     RETURN
TONXTNM1 EQU      %
         AI,R6    1
TONXTNM  EQU      %
         AW,R3    R6                POSITION TO NEXT NAME
         LW,R1    R2
         CW,R3    1,R4              SEE IF AT END OF TABLE
         BL       CHKNAM1       NO..
NONAM    EQU      %             YES.NAME NOT FOUND
         LCI      15
         PLM,R1   *R0
         LCI      0
         B        *SR4     <-->     RETURN
************************************************************************
         PAGE
************************************************************************
*  THIS ROUTINE WILL DISPLAY PREVIOUS CC IF NOT ALREADY DISPLAYED, AND
*    WILL THEN READ A CC. ALSO USED FOR CONTINUATION CC LIST/READ.
************************************************************************
READCC   EQU      %                ENTER
         PSW,R1   *R0
         PSW,SR4  *R0
         BAL,SR4  LISTCC   ***      LIST PREVIOUS CC IF NOT LISTED
         PLW,SR4  *R0
READNXTC EQU      %
         M:READ   M:SI,(BUF,*D1),(SIZE,80),(WAIT),(ERR,CE),(ABN,CA)
         LH,R1    M:SI+4
         SLS,R1   -1
         STW,R1   RECSIZE
         LI,R1    LISTCONT          SET TO
         STW,R1   CCP-1,R7            LIST THIS CC
         LI,SR3   0
         LH,R1    *D1
         CH,R1    XEND
         BNE      %+4
         LI,SR3   6
         SLS,SR3  24
         B        CA
         LB,R1    *D1
         CI,R1    ':'               CC MUST BEGIN WITH ':'
         BNE      NO:      EEE  NO..
         LI,R1    X'1FFFF'
         AND,R1   FLGS,R7
         STW,R1   FLGS,R7
         LW,SR3   L(X'06000000') OK.SET UP FOR CHAR.S.R.CONT.CARD READ
         PLW,R1   *R0
         B        *SR4   <<->>     EXIT
READCONT EQU      %                 CONTINUATION CARD READ S.R.
         LW,D1    FLGS,R7
         B        READCC         ---
LISTCONT EQU      %                 CONTINUATION CARD LIST S.R.
         LW,D1    FLGS,R7
         B        LISTCC         ---
********
LISTCC   EQU      %                ENTER
         PSW,R1   *R0
         LW,R1    CCP-1,R7
         AND,R1   L(X'1FFFF')
         BEZ      LISTCC1        ---CC HAS ALREADY BEEN LISTED
         LW,R1    CCP-1,R7          SET TO
         AND,R1   L(X'FFFE0000')      NOT LIST
         STW,R1   CCP-1,R7          NEXT TIME
         LH,R1    M:SI+4
         SLS,R1   -1
         PSW,R2   *R0
         LW,R2    R1
         AI,R2    -1
         LB,R2    *D1,R2            GET LAST BYTE
         CI,R2    X'15'             IS IT CARRIAGE RETURN
         BNE      %+2               NO
         AI,R1    -1                YES
         PLW,R2   *R0
         M:WRITE  M:LL,(BUF,*D1),(SIZE,*R1),(WAIT)
LISTCC1  EQU      %
         PLW,R1   *R0
         B        *SR4   <<->>     EXIT
************************************************************************
*  EOCCSCAN IS USED TO FIND THE END OF THE CURRENT LOGICAL
*    CONTROL COMMAND
********
EOCCSCAN EQU      %                ENTER
         PSW,SR4  *R0
         LW,SR1   FLGS,R7           RESET BUFFER FULL FLAGS IN CCPL
         AND,SR1  L(X'1FFFF')
         STW,SR1  FLGS,R7
EOCCSCN1 EQU      %
         LI,SR1   0
         BAL,SR4  NXACTCHR ***      GET NEXT CHAR.
         CI,SR1   KCRET
         BE       %+2
         CI,SR1   KNL
         BE       %+3            ---
         CI,SR1   EOB
         BNE      EOCCSCN1       ---TO NEXT CHAR.
         PLW,SR4  *R0
         B        *SR4   <<->>     EXIT
************************************************************************
         PAGE
************************************************************************
*  GENROOT WILL GENERATE A 'ROOT' LM FOR M:MON FROM CURRENT LOCCT TREE
*     ENTRY: (D2) = ADDR.OF LOCCT -1
************************************************************************
GENROOT  EQU      %           ENTER.
         LCI      15
         PSM,R1   *R0
         LI,SR3   0
         STW,SR3  BKGRDLL,R7        DON'T USE PREVIOUS BKGRDLL
         STW,SR3  M:MONFLG,R7       RESET 'M:MON' LOCCT FLAG
         LCI      15                NO..BYPASS GENERATION OF 'ROOT'
         PLM,R1   *R0
         B        *SR4     <->      EXIT
************************************************************************
         PAGE
************************************************************************
*  ERROR ROUTINES AND MESSAGES
************************************************************************
P3CONT   EQU      %
         TEXTC    '#### P A S S 3 -- IN -- C O N T R O L ####'
********
********
CE       EQU      %                ENTER
CA       EQU      %                ENTER
         LB,R1    SR3
         CI,R1    6                 M:C = EOF
         BNE      CEA1          NO..
CEA0     EQU      %             YES.
         M:DEVICE M:LL,(PAGE)
         LW,D4    BKGRDLL,R7
         BEZ      CEA0X          ---NO BKGRDLL DETERMINED
         LCI      MSIZ1
         LM,R2    BKGRDLLB
         SLS,D4   12
         LI,R1    3                 CONVERT BKGRDLL FOR DISPLAYING
CNVBKLL  EQU      %
         LI,D3    0
         SLD,D3   4
         CI,D3    9
         BG       %+3            ---
         AI,D3    X'F0'
         B        %+2            ---
         AI,D3    X'B7'
         STB,D3   R7,R1             STORE ADDRESS IN MESSAGE
         AI,R1    1
         CI,R1    8
         BL       CNVBKLL        --
         LW,R1    *R0
         AI,R1    1
         LCI      MSIZ1
         PSM,R2   *R0
         M:PRINT  (MESS,*R1)        DISPLAY BKGRDLL
         LI,R1    -MSIZ1
         MSP,R1   *R0
CEA0X    EQU      %
         M:PRINT  (MESS,CEAM)
         CAL1,9   1                 EXIT
CEA1     EQU      %
         BAL,SR4  CONV     ***      CONVERT ERROR CODE
         STW,R4   CEAM1+6
         M:PRINT  (MESS,CEAM1)
         B        CEA0           ---
********
CEAM     EQU      %
         TEXTC    '#### P A S S 3 -- C O M P L E T E D ####'
********
CEAM1    EQU      %
         TEXTC    '** I/0 ERR/ABN ON M:SI=XXXX'
********
EIA      EQU      %                ENTER
EIE      EQU      %                ENTER
         BAL,SR4  CONV     ***      CONVERT ERROR CODE
         STW,R4   EIAEM+6
         BAL,SR4  EOCCSCAN ***      FIND END OF CURRENT CC
         M:PRINT  (MESS,EIAEM)
EIAE     EQU      %
         LCI      2
         PLM,SR1  *R0
         B        PASS3NXT       --EXIT
********
EIAEM    EQU      %
         TEXTC    '** OPEN M:EI ERR/ABN = XXXX (LOCCT)'
********
EOA      EQU      %                ENTER
EOE      EQU      %                ENTER
         BAL,SR4  CONV     ***      CONVERT ERROR CODE
         STW,R4   EOAEM+6
         BAL,SR4  EOCCSCAN ***      FIND END OF CURRENT CC
         M:PRINT  (MESS,EOAEM)
         LCI      3
         PLM,SR4  *R0
         B        PASS3NXT       --EXIT
********
EOAEM    EQU      %
         TEXTC    '** WRITE ABS ERR/ABN = XXXX (LOCCT)'
********
RE       EQU      %                ENTER
RA       EQU      %                ENTER
         BAL,SR4  CONV     ***      CONVERT ERROR CODE
         STW,R4   REAM+6
         BAL,SR4  EOCCSCAN ***      FIND END OF CURRENT CC
         M:PRINT  (MESS,REAM)
         M:CLOSE  M:EI,(SAVE)
         PLW,D2   *R0
         B        EIAE           --EXIT
********
REAM     EQU      %
         TEXTC    '** READ M:EI ERR/ABN = XXXX (LOCCT)'
********
DE       EQU      %                ENTER
DA       EQU      %                ENTER
         PSW,R1   *R0
         M:PRINT  (MESS,DEAM)
         LI,R1    OPN+8
         AW,R1    R7
         M:PRINT  (MESS,*R1)
         PLW,R1   *R0
         B        ROMDEL01       --EXIT
********
DEAM     EQU      %
         TEXTC    '** CANNOT OPEN/RELEASE'
********
NO:      EQU      %                ENTER
         M:WRITE  M:LL,(BUF,*D1),(SIZE,80),(WAIT)
         CI,R1    '*'               COMMENT CC IF COLUMN-1 = '*'
         BE       READNXTC          YES.
         M:PRINT  (MESS,NO:M)
         LW,R1    CCP-1,R7
         AND,R1   L(X'FFFE0000')    SET TO CC LISTED
         STW,R1   CCP-1,R7
         PLW,R1   *R0
         B        *SR4   <<->>     EXIT (TO CALLER OF READCC)
********
NO:M     EQU      %
         TEXTC    '** CC ERROR,NO '':'' IN COLUMN-1'
********
IDERR    EQU      %                ENTER
         BAL,SR4  LISTCC   ***
         M:PRINT  (MESS,IDERRM)
         BAL,SR4  EOCCSCAN ***      FIND END OF CC
         B        PASS3NXT       --EXIT
********
IDERRM   EQU      %
         TEXTC    '** CC ID INVALID'
********
IDSIZE   EQU      %                ENTER
         BAL,SR4  LISTCC   ***
         M:PRINT  (MESS,IDSIZEM)
         BAL,SR4  EOCCSCAN ***      FIND END OF CC
         LCI      2
         PLM,SR1  *R0
         B        PASS3NXT       --EXIT
********
IDSIZEM  EQU      %
         TEXTC    '** ID SIZE >10 OR =0 CHARACTERS'
********
DEL      EQU      %                ENTER
         BAL,SR4  LISTCC   ***
         M:PRINT  (MESS,DELMES)
         BAL,SR4  EOCCSCAN ***      FIND END OF CC
COMEXIT  EQU      %
         LCI      3
         PLM,SR4  *R0
         B        PASS3NXT       --EXIT
********
DELMES   EQU      %
         TEXTC    '** DELIMETER NOT (),= OR SYNTAX BAD'
********
KEYWRD   EQU      %                ENTER
         BAL,SR4  LISTCC   ***
         M:PRINT  (MESS,KEYWRDM)
KEYWRDX  EQU      %
         BAL,SR4  EOCCSCAN ***      FIND END OF CC
         B        COMEXIT        --EXIT
********
KEYWRDM  EQU      %
         TEXTC    'KEYWORD NOT DELETE OR SAVE'
********
DUPKEYWD EQU      %
         BAL,SR4  LISTCC   ***
         M:PRINT  (MESS,KEYWRDM1)
         B        KEYWRDX        ---
********
KEYWRDM1 EQU      %
         TEXTC    '** KEYWORD SAVE ALREADY USED'
********
NAM      EQU      %
         BAL,SR4  LISTCC   ***
         M:PRINT  (MESS,NAMERR)
         LW,SR1   FLGS,R7
         AND,SR1  L(X'1FFFF')
         STW,SR1  FLGS,R7
         LI,SR2   ','
         BAL,SR4  CHARSCAN ***
         BCR,8    NXTNAM         ---GO PROCESS ANOTHER NAME
         CI,SR1   ')'               END OF SAVE NAMES
         BNE      DEL            ---CC IN ERROR
         LI,SR1   0
         B        PASS3FLD       ---EXIT
********
NAMERR   EQU      %
         TEXTC    '** NAME INVALID'
********
TYP      EQU      %                ENTER
         M:CLOSE  M:EI,(SAVE)
         BAL,SR4  EOCCSCAN ***      FIND END OF CC
         STB,D4   SR3
         BAL,SR4  CONV     ***      CONVERT SEQ.#
         STW,R4   TYPM+8
         M:PRINT  (MESS,TYPM)
COMERR   EQU      %
         PLW,D2   *R0
         LCI      2
         PLM,SR1  *R0
         B        PASS3NXT       --EXIT
********
TYPM     EQU      %
         TEXTC    '** BIN.CARD INVALID TYPE, SEQ.#XXXX'
********
SEQ      EQU      %                ENTER
         M:CLOSE  M:EI,(SAVE)
         BAL,SR4  EOCCSCAN ***      FIND END OF CC
         STB,D4   SR3
         BAL,SR4  CONV     ***      CONVERT SEQ.#
         STW,R4   SEQM+8
         M:PRINT  (MESS,SEQM)
         B        COMERR         --EXIT
********
SEQM     EQU      %
         TEXTC    '** BIN.CARD SEQUENCE ERR, SEQ.#XXXX'
********
SUM      EQU      %                ENTER
         M:CLOSE  M:EI,(SAVE)
         BAL,SR4  EOCCSCAN ***      FIND END OF CC
         STB,D4   SR3
         BAL,SR4  CONV     ***      CONVERT SEQ.#
         STW,R4   SUMM+7
         M:PRINT  (MESS,SUMM)
         PLW,R3   *R0
         B        COMERR         --EXIT
********
SUMM     EQU      %
         TEXTC    '** CHECKSUM ERROR,  SEQ. # XXXX'
********
BKGRDLLB EQU      %
         TEXTC    '**** M:MON BKGRDLL IS XXXXX'
MSIZ1    EQU      %-BKGRDLLB
********
TYPEIS   TEXTC    'OPTION (ALL,MON) '
********
RSPHER   EQU      %
RSPHAB   EQU      %
         PSW,SR3  *R0
         M:CLOSE  M:TM,(SAVE)
         PLW,SR3  *R0
OSPHER   EQU      %
OSPHAB   EQU      %
         BAL,SR4  CONV     ***CONVERT ERR/ABN NO.
         STW,R4   SPHM+10
         BAL,SR4  EOCCSCAN ***      FIND END OF CC
         M:PRINT  (MESS,SPHM)
FREEPGS  M:FP     2                 RELEASE WORK AREA
COMNER   EQU      %
         LCI      15
         PLM,R1   *R0
         LCI      3
         PLM,SR4  *R0
         B        PASS3NXT <->      EXIT
********
SPHM     EQU      %
         TEXTC    '*** OPEN/READ SPEC:HAND FILE ERR/ABN = XXXX'
ERRHAND  EQU      %                 SHIFT OFF BYTE COUNT OF
         LW,R2    D2
         LW,R3    D3
         SLD,D1   8                 SHIFT OFF BYTE COUNT OF
         SLD,R2   8                 UNRECOGNIZED KEY
         AI,R3    X'40'             ADD A BLANK AT END
         STW,D1   HANDMESS+9
         STD,R2   HANDMESS+10       STORE IT IN MESSAGE
         M:PRINT  (MESS,HANDMESS)
         B        FREEPGS
         BOUND    8
HANDMESS TEXTC    '*** UNRECOGNIZED KEY IN SPECHAND = XXXXXXXXXXXX'
********
HNDLER   EQU      %
         PSW,SR3  *R0
         M:CLOSE  M:EI,(SAVE)
         PLW,SR3  *R0
ONHER    EQU      %
ONHAB    EQU      %
         PSW,SR3  *R0
         M:CLOSE  M:EO,(REL)        RELEASE THE NEWLY CREATED HANDLERS
*                                   FILE--UNABLE TO GET AN ELEMENT
         PLW,SR3  *R0
OBSHER   EQU      %
OBSHAB   EQU      %
         BAL,SR4  CONV     ***      CONVERT ERR/ABN NO.
         STW,R4   BSHNDM+10
         BAL,SR4  EOCCSCAN ***      FIND END OF CC
         M:PRINT  (MESS,BSHNDM)
         M:FP     2        ***      FREE WORK AREA
         B        COMNER   <->      EXIT
********
BSHNDM   EQU      %
         TEXTC    '**** OPEN/READ BASHANDL FILE ERR/ABN = XXXX'
********
         PAGE     REGISTER
************************************************************************
R0       EQU      0
R1       EQU      1
R2       EQU      2
R3       EQU      3
R4       EQU      4
R5       EQU      5
R6       EQU      6
R7       EQU      7
SR1      EQU      8
SR2      EQU      9
SR3      EQU      10
SR4      EQU      11
D1       EQU      12
D2       EQU      13
D3       EQU      14
D4       EQU      15
************************************************************************
NOPAGES  EQU      4
CARDSIZ  EQU      30
RELLMN   EQU      11
KNL      EQU      X'15'
EOB      EQU      X'26'
CJOB     EQU      X'4F'             ADDRESS IN MONITOR TO FIND JIT
************************************************************************
         BOUND    8
MISOVTAB EQU      %                 WORD0 = # OF MISSING OVERLAYS
         DO1      10                WORDS 2-9 = ACTUAL NAMES
         DATA     0
MISMESS2 TEXTC    '                                        '
MISMESS1 TEXTC    '** THE FOLLOWING OVERLAYS HAVE BEEN REMOVED',;
                  ' FROM THE M:MON LOCCT AS PER PASS2 REQUIREMENTS'
BALWORDS DATA     0
ELEVEN   DATA     11
LTREEDIP DATA     0
LROMDISP DATA     0
XFC      DATA     X'FC'
X3F      DATA     X'3F'
SAVTRDISP DATA 0
LOCCTAD  DATA     0
LOCCTEND  DATA 0
TREEAD   DATA     0
STARTRSZ DATA     0
STARTRAD DATA     0
STRTRMSZ DATA     0
STRTRMAD DATA     0
D2SAVE   DATA     0
RRCOUNT  DATA     -7
SAVROMD  DATA     0
HANDLERS TEXTC    'HANDLERS'
HANDLERS2 TEXTC   'HANDLERS2'       UMOV FILE CONTAINING EF NAMES
*                                   FOR APPROPRIATE HANDLERS
OVNAMES  TEXTC    'OVNAMES'         SPECIAL MISSING OVERLAY NAMES
*                                   RECORD
M:MON    TEXTC    'M:MON'
LOCCTEXT TEXTC    'LOCCT'
DELETEXT TEXTC    'DELETE'
SAVETEXT TEXTC    'SAVE'
BLNKLINE TEXTC    '   '
**********
*   PASS3 TYPE TABLES
**********
**********
PROCS    DATA     0,'MON ','ALL '
#PROCS   EQU      %-PROCS-1
**********
         BOUND    8
SPECHAND EQU      %
         TEXTC    'KBTIO'
         TEXTC    'CRDIN'
         TEXTC    'PRTOUT'
         TEXTC    'PRTOUTL'
         TEXTC    'DISCIO'
         TEXTC    'DPAK'
         TEXTC    'DISKAB'
#SPECHND EQU      (%-SPECHAND)/2
**********
LOADFLG  DATA     0                 LOADER RETURN FLAG(=0 O.K. ; =1 BAD)
         PAGE
************************************************************************
CCPL     EQU      %
         GEN,8,24 NODELM,BA(DELM)   # DELIMITERS,BA(DELIMITERS)
         GEN,8,24 CNTCOL,READCONT   CONTINUE COL.,CONTINUE READ S.R.
         PZE      NULL              LIST OUTPUT S.R.
CCP      EQU      %-CCPL
         DATA     0                 CURRENT CHAR.POSITION
FLGS     EQU      %-CCPL
         GEN,8,24 0,BUFFER          FLAGS,CC BUFFER (SUPPLIED)
CSL      EQU      %-CCPL
         DATA     0                 CHAR.STRING LENGTH
         DATA     0                 CHAR.POSITION OF 1-ST CHAR.OF FIELD
CHARS    EQU      %-CCPL
         RES      9                 CHAR.STRING BUFFER
*********
OPNP     EQU      %-CCPL
         GEN,8,24 X'14',M:EI
         DATA     X'C1480001'
         PZE      EIE
         PZE      EIA
         DATA     1
         DATA     2
         DATA     63
         DATA     X'01010808'
         TEXTC    'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX'
*********
MONFLG   EQU      %-CCPL            M:MON LOCCT FLAG
         DATA     0
M:MONFLG EQU      %-CCPL            SPEC.M:MON LOCCT FLAG
         DATA     0
BKGRDLL  EQU      %-CCPL            TEMP CELL FOR M:MON'S BKGRDLL
         DATA     0
DELETE   EQU      %-CCPL            FLAG FOR DELETING ROM'S
         DATA     0
SAVE     EQU      %-CCPL
         DATA     0
ERRCOND  EQU      %-CCPL
         DATA     0
CURACT   EQU      %-CCPL
         DATA     0,0
*********
OPN      EQU      %-CCPL            OPEN PLIST FOR DELETE ROM'S
         GEN,8,24 X'14',M:EI
         DATA     X'C1480001'
         PZE      DE
         PZE      DA
         DATA     1
         DATA     2
         DATA     63
         DATA     X'01010808'
         TEXTC    'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX'
*********
OPNH     EQU      %-CCPL
         GEN,8,24 X'14',M:EI
         DATA     X'C1480001'
         PZE      ONHER
         PZE      ONHAB
         DATA     1
         DATA     2
         DATA     63
         DATA     X'01010202'
         TEXTC    'XXXXXXX'
OPENEO   EQU      %-CCPL
         GEN,8,24 X'14',M:EO
         DATA     X'07400001'
         DATA     1,1,2,2
         DATA     X'1010303'
         DATA     0,0,0
**********
ENDYN    EQU      %
********
NULL     EQU      0                 NO AUTO.CONTINUE/LIST
BUFFER   EQU      0                 BUFFER ADDRESS TO BE SUPPLIED
DELM     EQU      %
         DATA,1   '.',',',' ',' ','
',' ','(',')','='
NODELM   EQU      BA(%)-BA(DELM)
CNTCOL   EQU      1
         BOUND    4
         PAGE
************************************************************************
*  CONVERT HEXADECIMAL ERROR/ABNORMAL CODE IN REG. SR3 OR SR1
*    TO EBCDIC - EXIT WITH EBCDIC VALUE IN REG. R4
************************************************************************
CONV     EQU      %                ENTER
         LI,R1    4
         LB,SR3   SR3
         STW,SR3  R3
         SLS,R3   16
         LI,R5    0
CONV1    EQU      %
         LI,R2    0
         SLD,R2   4
         LB,SR1   CONVTBL,R2
         STB,SR1  R4,R5
         AI,R5    1
         BDR,R1   CONV1
         B        *SR4   <<->>     EXIT
********
CONVTBL  EQU      %
         DATA,1   '0','1','2','3'
         DATA,1   '4','5','6','7'
         DATA,1   '8','9','A','B'
         DATA,1   'C','D','E','F'
*                 PUSH OR PULL N WORDS SPECIFIED BY 1ST ARGUMENT INTO
*                 REG'S STARTING AT 2ND ARGUMENT.
PUSH     CNAME    X'9',X'B'
PULL     CNAME    X'8',X'A'
         PROC
         DO       NUM(AF)=1
LF       GEN,1,7,4,3,17 1,NAME(1),AF(1),0,R0
         ELSE
         DO       AF(1)=1
LF       GEN,1,7,4,3,17 1,NAME(1),AF(2),0,R0
         ELSE
         DO       AF(1)=16
LF       LCI      0
         ELSE
LF       LCI      AF(1)
         FIN
         GEN,1,7,4,3,17 1,NAME(2),AF(2),0,R0
         FIN
         FIN
         PEND
         PAGE
K0       EQU      X'0'
K1       EQU      X'1'
K2       EQU      X'2'
K6       EQU      X'6'
K8       EQU      X'8'
K24      EQU      X'24'
K40      EQU      X'40'
KFF      EQU      X'FF'
KN1      EQU      -X'1'
KBLANK   EQU      ' '
KCRET    EQU      X'0D'
KEOB     EQU      X'26'
KSCOLON  EQU      ';'
Y2       DATA     X'20000000'
Y4       DATA     X'40000000'
Y8       DATA     X'80000000'
YDFFFFFFF DATA    X'DFFFFFFF'
PROMPT   GEN,8,24 X'2C','%'
XEND     DATA     'END '
RECSIZE  DATA     80
         PAGE
*        NXACTCHR-NEXT ACTIVE CHARACTER ROUTINE GETS THE NEXT ACTIVE
*        CHARACTER FROM THE INPUT RECORD. IF A SEMICOLON IS ENCOUNTERED,
*        THE OUTR ROUTINE IS CALLED IF SPECIFIED. THEN THE NEXT
*        RECORD IS OBTAINED BY CALLING THE SPECIFIED CONTINUATION
*        ROUTINE IF A LEGAL CONTINUATION RECORD IS NOT OBTAINABLE.
*        ENTER WITH ADR OF CHAR PARAM LIST IN R7,
*        JIT POINTER IN R5 AND CUR CHAR OR ZERO IN SR1.
NXACTCHR EQU      %
         CI,SR1   K0                CHECK IF CUR CHAR = 0
         BNE      NXACH3            BRANCH IF NOT
NXACH1   EQU      %
         LW,R2    CCP,R7
         CW,R2    RECSIZE
         BE       NXACH5            BRACH IF YES
         LW,R3    CBUF,R7
         LB,SR1   *R3,R2            PICK UP NEXT CHAR
         CI,SR1   KSCOLON           CHECK IF CUR CHAR IS A ;
         BE       NXACH6            BRANCH IF YES
         CI,SR1   KCRET             CHECK IF CARRIAGE RETURN
         BE       NXACH51
         CI,SR1   KNL
         BE     NXACH51
         CI,SR1   KEOB
         BE       NXACH51
         CI,SR1   '.'               IF CHAR. = '.', THEN END OF IMAGE
         BNE      NXACH1A           NO..
         LW,R1    RECSIZE
         STW,R1   CCP,R7
         LI,SR1   KCRET             SET CHAR. TO NL
         B        NXACH51
NXACH1A  EQU      %
         LW,R1    FLAGS,R7
         CW,R1    Y4                CHECK IF IN BLANK-OUT MODE
         BAZ      NXACH2            BRACH IF NOT
         LI,R4    K40
         STB,R4   *R3,R2            BLANK OUT CUR CHAR IN RECORD
NXACH2   EQU      %
         MTW,1    CCP,R7            SET CCP = CCP+1
NXACH3   EQU      %
         LW,R1    FLAGS,R7          (R1) = FLAGS
         CI,SR1   K40               CHECK IF CUR CHAR IS A BLANK
         BNE      NXACH4            BRANCH IF NOT
         CW,R1    Y8                CHECK IF BLANK IS ACTIVE
         BAZ      NXACH1            BRANCH IF NOT
NXACH4   EQU      %
         CI,SR1   KCRET             CHECK IF CARRIAGE RETURN
         BE       NXACH51
         CI,SR1   KNL
         BE       NXACH51
         CI,SR1   KEOB
         BE       NXACH51
         CI,SR1   '.'               END OF CC IF CHAR. = '.'
         BE       NXACH51           YES.
         LW,R1    CLD,R7            (R1) = # OF DELIM, BYTE ADR OF DLM
         LB,R2    R1                (R2) = # OF DELIM
NXACH8   EQU      %
         CB,SR1   0,R1              CHECK IF CUR CHAR IS A DELIM
         BE       NXACH9            BRANCH IF YES
         AI,R1    K1
         BDR,R2   NXACH8
         LCI      K0                SET  CC1 = 0
         B        *SR4              EXIT
NXACH9   EQU      %
         LCI      K8                SET CC1 TO INDICATE CUR CHAR IS DLM
         B        *SR4
*
NXACH5   EQU      %
         LI,SR1   KEOB              SET CUR CHAR  = EOB
NXACH51  EQU      %
         PUSH     SR4
         LW,R1    OUTR,R7
         BEZ      NXACH52
         BAL,SR4  *R1               LIST LAST RECORD
NXACH52  EQU      %
         PULL     SR4
         B        NXACH9
*
NXACH6   EQU      %
         PUSH     2,SR3
         LW,R1    OUTR,R7
         BEZ      NXACH7
         BAL,SR4  *R1               GO TO OUTR ROUTINE
NXACH7   EQU      %
         LW,R1    CONTR,R7
         LB,R2    R1
         STW,R2   CCP,R7            SET CCP = CP (CONTINUATION POS)
         BAL,SR4  *R1               GET CONTINUATION RECORD
         LB,R2    SR3               (R2) = I/O COMPLETE CODE
         PULL     2,SR3
         CI,R2    K6                CHECK IF CONT. RECORD OBTAINED
         BE       NXACH1            BRANCH IF YES
         LI,SR1   KFF               SET CUR CHAR = FF
         LCI      K8                SET CC1 =1, ERR IN GETTING CONT
         B        *SR4                                            RECORD
         PAGE
*        NAMSCAN-SCANS FOR LEGAL ALPHA NUMERIC NAME.
*        IF LEGAL CC1 =0, IF NOT CC1 = 1
*        ENTER WITH ADR OF CCPL IN R7, CUR CHAR OR ZERO IN SR1
*
*
*
NAMSCAN  EQU      %
         PUSH     13,SR4
         LW,R5    R3
         BAL,SR4  GETCHST           GET CHARACTER STRING
         BCS,8    COMEXIT2          BRANCH IF ILLEGAL STRING
         LI,R4    K0
NAMS1    EQU      %
         LB,R3    *R7,R2            SET (R3) = ITH CHAR
         LB,R3    CHTBL,R3          CHECK IF CHAR LEGAL ALPHANUMERIC
         BEZ      COMEXIT2            BRANCH IF NOT
         OR,R4    R3                   MERGE TYPE
         AI,R2    K1
         BDR,R1   NAMS1             SET N# N-1
         CI,R4    K2                CHECK IF AT LEAST ONE ALPHABETIC
         BL       COMEXIT2
         B        COMEXIT1
         PAGE
*        CHARSCAN-COMPARES CUR CHAR WITH CHAR IN SR2. IF =, CC1 =0.
*        IF NOT CC1 = 1.
*        ENTER WITH PARAMETER LIST ADR IN R7, CUR CHAR OR ZERO IN SR1,
*        AND COMPARISON CHAR IN SR2.
*
CHARSCAN EQU      %
         PUSH     13,SR4
         LW,R5    R3
         BAL,SR4  NXACTCHR          GET NEXT ACTIVE CHAR
         CW,SR1   SR2
         BNE      CHRS3             BRANCH IF NOT
         LI,SR1   K0                SET CUR CHAR = 0
         PULL     13,SR4
         LCI      K0                SET CC1 =  0
         B        *SR4
CHRS3    EQU      %
         PULL     13,SR4
         LCI      K8
         B        *SR4              EXIT
COMEXIT1 EQU      %
         LW,R3    YDFFFFFFF         RESET BUFFER
         AND,R3   FLAGS,R7                   EMPTY
         STW,R3   FLAGS,R7                        FLAG
         PULL     13,SR4
         LCI      K0                SET CC1 = 0
         B        *SR4              EXIT
         PAGE
*        QUOTSCAN-COMPARE QUOTE CONSTANT WITH CHAR STRING AND IF = SETS
*        CC1= 0 ,OTHERWISE SETS CC1 = 1.
*        QUOTE CONSTANT AND CHAR STRING CAN BE = ONLY IF THEY ARE
*        OF THE SAME LENGTH
*        ENTER WITH ADR OF PARAM LIST IN R7, CUR CHAR OR 0 IN SR1,
*        AND WORD ADR OF QUOTE CONSTANT IN SR2.
QUOTSCAN EQU      %
         PUSH     13,SR4
         LW,R5    R3
         BAL,SR4  GETCHST           GET CHAR STRING
         BCS,8    COMEXIT2          BRANCH IF ILLEGAL STRING
         LW,R4    SR2               (R4) = QUOTE CONSTANT ADR
         SLS,R4   2                 CONVERT TO BYTE ADR
         CB,R1    QC0,R4            COMPARE LENGTHS
         BNE      COMEXIT2
QUTS1    EQU      %
         AI,R4    K1
         LB,R3    *R7,R2
         CB,R3    QC0,R4            COMPARE CHARS
         BNE      COMEXIT2
         AI,R2    K1
         BDR,R1   QUTS1
         B        COMEXIT1
*
*
COMEXIT2 EQU      %
         PULL     13,SR4
         LCI      K8                SET CC1 = 1
         B        *SR4              EXIT
         PAGE
*        CHSTSCAN-CHARACTER STRING SCAN- GETS THE NEXT CHARACTER
*                 STRING UP TO THE NEXT DELIMITER AND MOVES THE
*                 STRING TO THE PARAMETER LIST BUFFER.
*        ENTER WITH JOB POINTER IN R5, PARAM LIST POINTER IN R7,
*        CUR CHAR OR ZERO IN SR1
*        IF  N= 0  OR N > 31 CC1 IS SET  TO 1 . IF CHAR STRING IS NOT
*        OBTAINABLE BECAUSE OF ERROR IN TRYING TO OBTAIN A CONT. RECORD,
*        CC1 AND CC2 ARE BOTH SET TO ONE
CHSTSCAN EQU      %
         PUSH     13,SR4
         LW,R5    R3
         LI,R1    KBLANK
         LI,R2    BAPLB             (R2) = BYTE ADR OF PARAM LIST BUF
         LI,R3    K24
CHSTS1   EQU      %
         STB,R1   *R7,R2            FILL PARAM LIST BUFFER
         AI,R2    K1                            WITH BLANKS
         BDR,R3   CHSTS1
*
         LI,R2    K0                SET
         LW,R3    Y8                   BLANK
         STS,R2   FLAGS,R7                   NOT ACTIVE
*
         LI,R1    K0
         LI,R2    PLB
         AW,R2    R7
         LI,R3    K24
CHSTS2   EQU      %
         PUSH     3,R1
         BAL,SR4  NXACTCHR          GET NEXT ACTIVE CHAR
         BCS,8    CHSTS4            CHECK IF CHAR IS A DELIMITER
         LW,R3    Y8                SET
         STS,R3   FLAGS,R7              BLANK ACTIVE
         PULL     3,R1
         CI,R1    K0                CHECK IF FIRST CHAR OF FIELD
         BNE      CHSTS22
         LW,D1    CCP,R7            SET PCCP = CHAR POSITION OF 1ST
         AI,D1    KN1
         STW,D1   PCCP,R7                         CHAR OF FIELD
CHSTS22  EQU      %
         STB,SR1  *R2,R1            STORE CHAR IN BUFFER
         LI,SR1   K0                SET CUR CHAR =0
         AI,R1    K1                SET  N= N+1
         BDR,R3   CHSTS2
CHSTS21  EQU      %
         STW,R1   CSL,R7
         LI,R2    K0
         LW,R3    Y8
         STS,R2   FLAGS,R7
         PULL     13,SR4
         LC       Y8
         B        *SR4
CHSTS3   EQU      %
         STW,R1   CSL,R7            STORE N IN PARAM LIST
         LI,R2    K0                SET
         LW,R3    Y8                   BLANK
         STS,R2   FLAGS,R7                   NOT
         PULL     13,SR4
         LCI      K0
         B        *SR4              EXIT
CHSTS4   EQU      %
         PULL     3,R1
         CI,R1    K0                CHECK IF  N= 0
         BNE      CHSTS3
         B        CHSTS21
*        GETCHST-GETS THE NEXT CHAR STRING IF THE PARAM LIST BUFFER
*        IS EMPTY AND MARKS THE PARAM LIST BUFFER AS FULL. SETS
*        (R0) = (R1) = N, (R2) = BYTE ADR OF PARAM LIST BUFFER.
*        ENTER WITH ADR OF PARAM LIST IN R7, CUR CHAR OR 0 IN SR1.
*
*
GETCHST  EQU      %
         LI,R4    K0                FOR CONTINUATION
         LW,R3    Y2                CHECK
         AND,R3   FLAGS,R7               IF PARAM LIST BUF IS FULL
         BNEZ     GCHST1            BRANCH IF FULL
         PUSH     1,SR4
         STW,R5   R3
         BAL,SR4  CHSTSCAN          SCAN FOR CHAR STRING
         STCF     R4
         PULL     1,SR4
GCHST1   EQU      %
         LW,R1    CSL,R7
         LI,R2    BAPLB             (R2) = BYTE ADR OF PARAM LIST BUF
         LW,R3    Y2                SET
         STS,R3   FLAGS,R7               PARAM LIST BUF NOT EMPTY FLAG
         LC       R4
         B        *SR4              EXIT
         PAGE
C300     EQU      X'00030000'
C3000    EQU      X'03000000'
C33      EQU      X'00000303'
C3300    EQU      X'03030000'
C333     EQU      X'00030303'
C3333    EQU      X'03030303'
C222     EQU      X'00020202'
C2223    EQU      X'02020203'
C1100    EQU      X'01010000'
C1111    EQU      X'01010101'
CHTBL    DATA     0,0,0,0               0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
         DATA     0,0,0,0               0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
         DATA     0,0,0,0               0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
         DATA     0,0,0,0               0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
         DATA     0,0,0,3               0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 3
         DATA     0,0,3,0               0 0 0 0 0 0 0 0 0 0 0 3 0 0 0 0
         DATA     0,0,0,C300            0 0 0 0 0 0 0 0 0 0 0 0 0 3 0 0
         DATA     0,0,C33,C3000         0 0 0 0 0 0 0 0 0 0 3 3 3 0 0 0
         DATA     C222,C2223,C3300,0    0 2 2 2 2 2 2 3 3 3 0 0 0 0 0 0
         DATA     C333,C3333,C3300,0    0 3 3 3 3 3 3 3 3 3 0 0 0 0 0 0
         DATA     C33,C3333,C3300,0     0 0 3 3 3 3 3 3 3 3 0 0 0 0 0 0
         DATA     0,0,0,0               0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
         DATA     C222,C2223,C3300,0    0 2 2 2 2 2 2 3 3 3 0 0 0 0 0 0
         DATA     C333,C3333,C3300,0    0 3 3 3 3 3 3 3 3 3 0 0 0 0 0 0
         DATA     C33,C3333,C3300,0     0 0 3 3 3 3 3 3 3 3 0 0 0 0 0 0
         DATA     C1111,C1111,C1100,0   1 1 1 1 1 1 1 1 1 1 0 0 0 0 0 0
QC0      EQU      0
CLD      EQU      0
CONTR    EQU      1
OUTR     EQU      2
FLAGS    EQU      4
CBUF     EQU      4
PCCP     EQU      6
PLB      EQU      7
BAPLB    EQU      4*PLB
************************************************************************
         END      PASS3

