***********************************************************************
*M*      PASS3    TO LOAD M:MON AND OTHER PROCESSORS & LIBRARIES
***********************************************************************
*
************************************************************************
         SYSTEM   BPM
         SYSTEM   SIG7FDP
************************************************************************
         DEF      PASS3
         REF      M:SI,M:C
         REF      M:EI
         REF      M:HI
         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 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 LOCCT TABLE IS SAVED FOR THE LOADER IN COMMON
*    STORAGE WITH WORD-0 CONTAINING THE SIZE OF THE LOCCT TABLE
*        THE CC'S SYNTAX APPEARS AS:    :ID  <(PARAMETERS)>
*              WHERE:  ID = M:MON,METASYM,FORTRAN,....ETC.
*              (NOTE THAT THESE REFER TO PREVIOUSLY CREATED LOCCTS
*               OF THE FORM LOCCTM:MON,LOCCTMETASYM,LOCCTFORTRAN..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'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)
         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            NONE OF THE ABOVE SPECIFIED
         LW,D1    CHARS,R7          CHK IF 'MON' OR 'ALL'
         LI,R1    #PROCS
         CW,D1    PROCS,R1
         BE       %+3
         BDR,R1   %-2
         BAL,SR4  BADPROC
         STW,R1   ERRCOND,R7
NOTYPE   EQU      %
**********************************************************************
*FOLLOWING CODE CHECKS FOR A RE-ASSIGNMENT OF THE :SYS-LOADER TO SOME
*OTHER LOADER SPECIFIED ON AN ASSIGN OR SET CARD.
*********************************************************************
         LW,R1    F:LOADER+23       LOOK FOR A FILE NAME ENTRY
         CW,R1    BLNKFNAM          IS IT EMPTY
         BE       RESTOREG          IF EMPTY USE LOADER IN :SYS
         LD,R2    F:LOADER+24       GET REST OF FILE NAME
         LCI      3
         STM,R1   LNKFPT+1,R7       STORE IT IN M:LINK FPT
         LM,R2    F:LOADER+27       GET ACCOUNT
         LB,R1    R1                GET FILE NAME BYTE SIZE
         AI,R1    4                 CONVERT TO # OF WORDS USED TO
         SLS,R1   -2                DETERMINE WHERE TO STORE ACCOUNT #
         CI,R1    3                 ONLY 11 CHARACTERS ALLOWED FOR
         BG       ERRFNAME          FOR THE LOADER FILE NAME
         AI,R1    LNKFPT+1
         AW,R1    R7
         LCI      2
         STM,R2   *R1               THEN STORE IT IN M:LINK FPT
         LD,R2    F:LOADER+30       CHK FOR A PASSWORD SPECIFICATION
         CW,R2    BLNKS             CHK FOR AN EMPTY ENTRY
         BNE      GETPASWD          BR. IF THERE'S A PASSWORD
         CW,R3    BLNKS             NOTE:  8 BLANKS ARE NOT RECOGNIZED
         BE       RESTOREG          AS A PASSWORD
GETPASWD MTW,1    LNKFPT+1,R7       SET THE PASSWORD FLAG IN THE FPT
         AI,R1    2
         LCI      2
         STM,R2   *R1               STORE PASSWORD IN M:LINK FPT
RESTOREG 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   M: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
         LCI      2
         LM,SR3   *D2,R1            GET LMN NAME OUT OF LOCCT
         CD,SR3   M:MON             IS IT M:MON
         BNE      CHKRECOV
         MTW,1    M:MONFLG,R7   YES.SET SPECIAL FLAG
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
         LW,R1    CJOB              OBTAIN CURRENT ACCOUNT FROM JIT
         LCI      2
         LM,SR3   1,R1
         LI,R6    13
         STM,SR3  CURACT,R7
         STM,SR3  *D4,R6            FORCE LMN TO CURRENT ACCOUNT
         MTW,0    M:MONFLG,R7       IF M:MON GO READ SPEC:HAND
         BEZ      %+2           NO..
*                               YES.
         BAL,SR4  GENHANDL ***      GENERATE DESIRED 'HANDLERS' FILE
         B        SAVINCOM
GOTOLOAD EQU      %
         PSW,R7   *R0
         LW,R2    R7             SAVE PLIST PTR
* 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
         CAL1,8   LNKFPT,R2
* 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
         LW,R1    COMMONPG          RELEASE COMMON STORAGE
         OR,R1    XFCPMSK
         CAL1,8   R1
         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'
LOCTERR1 TEXTC    '*** M:MON MUST BE A TREED LOAD MODULE--PASS3',;
                  ' WILL NOT ATTEMPT TO LOAD IT'
CHKRECOV CD,SR3   RECOVER           IS THE LOCCT LMN NAME = RECOVER
         BNE      NOTM:MON          BRANCH IF NOT
         M:OPEN   M:EI,(FILE,'M:MON'),(SAVE),(IN),(KEYED),(DIRECT),;
                      (ERR,NOMON),(ABN,NOMON)
         M:READ   M:EI,(BUF,MONHEAD),(SIZE,48),(ERR,NOMON),;
                      (KEY,KEYHEAD),(ABN,NOMON)
         M:CLOSE  M:EI,(SAVE)
         LW,D1    MONHEAD+1         GET M:MON STARD ADDRESS OUT OF
         AND,D1   =X'1FFFF'
         LW,SR3   D1                THE M:MON HEAD RECORD
         BAL,SR4  CONV+1            CONVERT IT TO EBCDIC
         LW,D3    R4                SAVE IT IN D2
         AI,D1    X'1FF'            NEED TO ROUND START ADDRESS
         AND,D1   =X'1FE00'         TO NEXT HIGHEST PAGE
         AI,D1    X'A00'            ADD 5 PAGES TO ROUNDED ADDRESS
         LI,R1    5                 AND MAKE THIS THE NEW MODULE
         STW,D1   *D2,R1            BIAS FOR RECOVERY
         LW,SR3   D1
         BAL,SR4  CONV+1            CONVERT NEW BIAS TO EBCDIC
         STW,D3   MONRECMG+7        STORE M:MON ST. ADDRESS INTO MSG.
         STW,R4   MONRECMG+15       STORE NEW RECOVERY BIAS INTO MSG
         M:PRINT  (MESS,MONRECMG)
         B        NOTM:MON
NOMON    BAL,SR4  CONV              CONVERT ERR/ABN CODE
         STW,R4   NORECOV+9
         M:PRINT  (MESS,NORECOV)
         LCI      3
         PLM,R2   *R0               CLEAN UP STACK
         B        PASS3NXT
MONRECMG TEXTC    '*** M:MON START ADDRESS =  XXXX.   RECOVER ',;
                  'MODULE BIAS =   YYYY.'
NORECOV  TEXTC    '*** OPEN/READ M:MON FILE ERR/ABN = XXXX',;
                  '.  LOAD OF RECOVER NOT POSSIBLE.'
************************************************************************
         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
*                 (R7) = PTR TO CCPL
*                 (D2) = TOTAL LOCCT SIZE
*
*
*  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
         STW,R2   COMMONPG
         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,R5    D4                R5 = PTR TO START OF LOCCT TABLE
         LW,R2    4,R5              R2 GETS DISP TO ROMT FROM START OF
*                                   LOCCT TABLE
         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,R5              R1 GETS DISP. TO TREE FROM START OF
*                                   LOCCT.
         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
         MTW,0    M:MONFLG,R7       MUCH OF FOLLOWING CODE IS FOR M:MON
         BEZ      MUV2COMM          SKIP FOR NON-M:MON LOCCTS
GRANDLUP LW,R1    MISOVTAB          GET MISOVNM #
         BEZ      MUV2COMM          IF NONE, SKIP DELETING.
         LW,R3    STARTRSZ
         CI,R3    11                M:MON MUST BE A TREED LOAD MOD.
         BG       %+3
         M:PRINT  (MESS,LOCTERR1)   NO TREE FOR M:MON--PRINT THIS.
         B        FREECPGS          DISCONTINUE PROCESSING
         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
FREECPGS LW,R1    COMMONPG
         OR,R1    XFCPMSK
         CAL1,8   R1
         LCI      15
         PLM,R1   *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   X3F               SET SR1 TO MAX. WORD COUNT FOR MBS
         B        %+3
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   4,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    X3F               BEEN ENCOUNTERED. (CB,R3 AGAINST
*                                   BYTE0 OF DATA WORD X3F)
         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    4,R7              R1 GETS ROMT DISP FROM LOCCT
         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   4,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'
XFCPMSK  DATA      X'0D000000'
COMMONPG DATA     0
************************************************************************
         PAGE
**********
*  GENERATE DESIRED 'HANDLERS' FILE FROM INFO IN 'SPEC:HAND'
*    FILE GENERATED BY SYSGEN PASS2.  MERGE WITH DEFAULT FILE 'BASHANDL'
**********
OPNSPCH  GEN,8,24 20,M:TM
         DATA     X'C1000001'
         DATA     CHKAREC           ERR
         DATA     OSPHAB            ABN
         DATA     1                 INPUT
         DATA     X'1010303'        FILENAME
         TEXTC    'SPEC:HAND'
GENHANDL EQU      %
         LCI      15
         PSM,R1   *R0
         M:GP     1        ***      GET WORK AREA
         M:GP     1                 GET WORK AREA
         LW,R5    SR2
*                                   R5  POINTS TO M:TM BUFFER
         STW,D4   R1                SET UP POINTERS TO ROMTABLE
         SLS,D2   -2
         AW,D2    D4
         STW,D2   LOCCTEND
         AW,D4    3,R1              ROM TABLE ADDRESS
         STW,D4   LOCCTAD
         AW,R1    2,R1              TREE ADDRESS
         STW,R1   TREEAD            AND TREE
         AW,R1    -1,R1
         STW,R1   TREEEND
         CAL1,1   OPNSPCH
         LI,R1    0
         STW,R1   H2PRSNT           INITIALIZE HANDLERS2 PRESENCE FLG
         LI,R1    HANDLERS2
READKEYS M:READ   M:TM,(BUF,*R5),(SIZE,1024),(WAIT),;
                  (ERR,RSPHER),(ABN,RSPHAB),(KEY,*R1)
         CI,R1    OVNAMES
         BE       MUSTBOVN
         CI,R1    HANDLERS2         DID WE JUST READ HANDLERS2
         BE       H2EXISTS          BRANCH IF SO
*                                   OTHERWISE IT MUST BE HANDLERS
         MTW,0    H2PRSNT           IF HANDLERS2 REC. EXISTED
         LI,R1    HANDLERS          NOW REPLACE HANDLERS WITH THE HAD
         BAL,SR4  FINDHAND          REST OF THE HANDLERS
*                                   IN HANDLERS FILE. OTHERWISE DO IT
         BAL,SR4  PROSESPC          NOW CONCATENATE FILES NAMED IN
*                                   HANDLERS REC. INTO HANDLERS FILE
         MTW,0    H2PRSNT           IF HANDLERS2 EXISTS,
         BNEZ     CONCFILE       SKIP DOING ROOTHAND AND BASHANDL
*                                FILES. (BASHANDL ALREADY IN HANDLERS2)
         LI,R1    BASHANDL
         BAL,R3   GETHANDL
         LI,R1    ROOTHAND          FIND THE PLACE IN LOCCT FOR ROOTHAND
         BAL,SR4  FINDHAND
         LI,R1    INITRCVR          REPLACE IT WITH INITRCVR AND SSDATU
         BAL,R3   GETHANDL
         LI,R1    XSSDATU
         BAL,R3   GETHANDL
CONCFILE EQU      %
         LI,R1    OVNAMES           GO READ LAST REC. IN SPEC:HAND
         B        READKEYS
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..
         LI,R3    NAMNG             RETURN FROM GETHANDL
         LW,R1    D4                ADDRESS OF NAME
         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
         B        *SR4
CHKAREC  CI,R1    HANDLERS2         IT IS POSSIBLE THAT NO HANDLERS2
*                                   RECORD EXISTS
         BNE      RSPHER            THE OTHER 2 REC.'S IN SPEC:HAND
*                                   MUST BE PRESENT
         LI,R2    X'43'             CHECK FOR 'NO SUCH KEY'
         CB,R2    SR3               IF SO IT'S O.K.
         BE       NOHAN2
         B        RSPHER            OTHERWISE IT'S AN ERROR
MUSTBOVN EQU      %
         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)
         M:CLOSE  M:TM,SAVE
         LCI      15
         PLM,R1   *R0
         LW,D2    LOCCTEND          RECALCULATE LOCCT SIZE
         SW,D2    D4
         SLS,D2   2
         B        *SR4
H2EXISTS MTW,1    H2PRSNT           SET FLAG FOR EXISTANCE OF HANDLERS2
         LI,R2    11                DONT LOOK IN ROOT FOR HANDLERS2
         AWM,R2   TREEAD
         BAL,SR4  FINDHAND
         LI,R1    XSSDATU           PUT SSDATU IN FIRST
         BAL,R3   GETHANDL
         LI,R1    INITRCVR          THEN INITRCVR
         BAL,R3   GETHANDL
         LI,R1    BASHANDL          AND BASHANDL
         BAL,R3   GETHANDL
         BAL,SR4  PROSESPC          GO GET FILES LISTED IN HANDLERS2
*                                   RECORD OF SPEC:HAND
         LI,R1    -11               RESTORE TREE ADDRESS
         AWM,R1   TREEAD
NOHAN2   LI,R1    HANDLERS
         B        READKEYS
**********
FINDHAND RES
         LW,R2    TREEAD            FIND THE HROMNAME AT *R1
         INT,R2   3,R2              IN THE LOCCT ROMTABLES
         AW,R2    LOCCTAD
         LB,D1    *R1               SET UP COMPARE REGS
         ANLZ,R3  %-1
         AI,D1    1                 ADD COUNT BYTE
         STB,D1   R3
         SLS,R3   -2                KEEP R2 AT WORD ADDRESS
FINDH1   LD,D1    R2
         SLD,D1   2
         CBS,D1   0
         BE       FINDH2
         AI,R2    7
         LW,D1    -5,2
         CI,D1    X'40'             END OF TABLE
         BANZ     FINDH1            NO
         AI,R2    -7                GO BACK TO PREV
         B        %+4               AND ADD TO END
FINDH2   LI,D2    X'40'             MOVE FLAG TO PREV ENTRY
         LW,D1    2,R2
         STS,D1   -5,R2
         STW,R2   0,R2              CLOBBER NAME SO WE USE THIS SPOT
         LCI      2                 GET ACCOUNT FROM THIS SPOT FOR SEARCH
         LM,D1    3,R2
         STM,D1   HANDACCT
         STW,R2   0,R2              CLOBBER THIS NAME
         B        *SR4
GETHANDL EQU      %
         LB,R4    *R2               IF FIRST NAME, NO MOVE
         BEZ      GETH5
         LW,R4    LOCCTEND          ELSE, MOVE ALL NAMES UP 7 WDS
GETH1    LW,D1    0,R4              TO MAKE ROOM FOR THIS ONE
         STW,D1   7,R4
         AI,R4    -1
         CW,R4    R2
         BGE      GETH1
         AI,R2    7                 POINT TO HOLE
         MTW,7    LOCCTEND          ADJUST SIZE
         LW,R4    TREEAD            AND ROM PTRS FOR FURTHER SEGMENTS
         AI,R4    14
         MTH,7    *R4
         AI,R4    11
         CW,R4    TREEEND
         BL       %-3
GETH5    LCI      3                 MOVE NAME TO LOCCT
         LM,D1    0,R1
         STM,D1   0,R2
         STM,D1   OPNH+5,R7         AND TO FIND FPT
         LI,D2    X'FF'             PROPAGATE FLAG BYTE
         LS,D1    -5,R2
         STS,D1   2,R2
         OR,D1    BLNKS             SET NOT LAST BIT
         STS,D1   -5,R2
         LCI      2
         LM,D1    HANDACCT          FIND THE ROM SOMEWHERE
         STM,D1   3,R2
         STM,D1   OPNH+9,R7
         CAL1,1   OPNH,R7
         B        0,R3
*
ONHAB    RES
ONHER    RES
         LB,R4    SR3
         CI,R4    3                 IS IT FILE DOENST EXIST
         BNE      0,R3
         LCI      2                 YES, USE CURRENT ACCOUNT
         LM,D1    CURACT,R7
         STM,D1   3,R2
         B        0,R3
         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    3                 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    3
         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
************************************************************************
*  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)
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)'
********
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'
********
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'
********
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      12                WORDS 2-11 = ACTUAL NAMES
         DATA     0
MISMESS2 TEXTC    '                                               '
MISMESS1 TEXTC    '** THE FOLLOWING OVERLAYS HAVE BEEN REMOVED',;
                  ' FROM THE M:MON LOCCT AS PER PASS2 REQUIREMENTS'
ERRFNAME M:PRINT  (MESS,LNAMERR)
         CAL1,9   1                  EXIT
LNAMERR  TEXTC    'PASS3 ABORTING. F:LOADER FILE NAME MUST BE LESS',;
                  ' THAN OR EQUAL TO 11 CHARS. IN LENGTH'
BALWORDS DATA     0
ELEVEN   DATA     11
LTREEDIP DATA     0
LROMDISP DATA     0
X3F      DATA     X'3F'
SAVTRDISP DATA 0
LOCCTAD  DATA     0
LOCCTEND  DATA 0
TREEAD   DATA     0
TREEEND  DATA     0
HANDACCT RES      2
STARTRSZ DATA     0
STARTRAD DATA     0
STRTRMSZ DATA     0
STRTRMAD DATA     0
D2SAVE   DATA     0
RRCOUNT  DATA     -7
SAVROMD  DATA     0
H2PRSNT  DATA     0
BASHANDL TEXTC    'BASHANDL'
HANDLERS TEXTC    'HANDLERS'
HANDLERS2 TEXTC   'HANDLERS2'       UMOV FILE CONTAINING EF NAMES
ROOTHAND TEXTC    'ROOTHAND'
INITRCVR TEXTC    'INITRCVR'
*                                   FOR APPROPRIATE HANDLERS
OVNAMES  TEXTC    'OVNAMES'         SPECIAL MISSING OVERLAY NAMES
*                                   RECORD
         BOUND    8
RECOVER  TEXTC    'RECOVER'
M:MON    TEXTC    'M:MON'
XSSDATU  TEXTC    'SSDATU'
LOCCTEXT TEXTC    'LOCCT'
DELETEXT TEXTC    'DELETE'
SAVETEXT TEXTC    'SAVE'
BLNKLINE TEXTC    '   '
BLNKFNAM DATA     X'0B404040'       FIRST WORD OF A BLANK FILE NAME
BLNKS    TEXT     '    '
KEYHEAD  TEXTC    'HEAD'
MONHEAD  RES      12
**********
*   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)
PATCH    RES      50                PASS3 PATCH AREA
         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'
*********
M:MONFLG EQU      %-CCPL            SPEC.M:MON LOCCT FLAG
         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',X'80000'+M:HI
         DATA     X'C0000001'
         DATA     ONHAB
         PZE      ONHAB
         DATA     X'1000303'
         RES      3
         DATA     X'2010202'
         RES      2
OPENEI   EQU      %-CCPL
         GEN,8,24  X'14',M:EI
         DATA     X'07400001'
         DATA     1,1,1,2           CONSEC,SEQ,IN,SAVE
         DATA     X'01010303'
         DATA     0,0,0
*********
LNKFPT   EQU      %-CCPL
         GEN,8,8,8,8  2,0,0,2       M:LINK FPT WITH ACCOUNT SPECIFIED
         TEXTC    'LOADER'          INITIALIZED AS SUCH BUT MAY BE
         TEXT     ':SYS'            CHANGED BY AN ASSIGN OR SET COMMAND.
         DO1      3                 RESERVE 2 WORDS FOR PASSWORD &
         TEXT     '     '           FOR A POSSIBLE 3 WORD-LONG LOADER NM
**********
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
         LB,SR3   SR3
         LI,R1    4
         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
*********
         PAGE
*** THE FOLLOWING DCB ALLOWS FOR SPECIFICATION OF A LOADER OTHER
*** THAN THAT IN :SYS.  IT MAY HAVE A 3-WORD FILE NAME, A 2-WORD
*** ACCOANT NAME AND A 2-WORD PASSWORD.
F:LOADER DSECT    1
F:LOADER M:DCB    (FILE,'           ','        '),(PASS,'        ')
************************************************************************
         END      PASS3

