         DEF      OPNLD:
OPNLD:   EQU      %
MONPROC  SET      1
         SYSTEM   UTS
         DEF      OPNLD
         DEF      COPOPNLD
         DEF      T:LDEV
         PAGE
         REF      LDEVCNT,DBMAX,COPPGS
         REF      DBPOOL
         REF      SCDEVTYP,SCMINR,SCMAXR,SCMISC,SCFPC,SCFORM
         REF      SCFQARGS
         REF      SCFFORM,SCSVDGI
         REF      Y8,Y01,SBSIZE,COPEA00,1STDBI
         REF      SCSEQ,SCFLDA,SCBESTDA,SCCDA
         REF      SCFBUF,SCBLDA,SCDBI,SCCUN,SCRPDA
         REF      COP05
         REF      J:ACCN
         REF      PUF
         REF      Y001,Y002
         REF      OPNX
         REF      OERX
         REF      CC1SET
         REF      JB:PRIV
         REF      Y04
         REF      Y00FF
         REF      HEX
         REF      M3,M16
         REF      M24
         REF      M17
         REF      TB:SZ,TB:MAX,TB:FLGS,CNTXTSET
         REF      J:USCDX,J:JIT
         REF,2    JH:LDCF
         REF      J:DCBLINK
         REF      J:BASE
         REF      SV:RSIZ
         REF      SV:LSIZ,SH:LNM,TYPMNSZ,SB:LTY
         REF      SH:SYMT,SV:TYM
         REF      XFF,DCTSIZ,Y1,Y4
         REF      Y2
         REF      Y00FE
         REF      OH:NM
         REF      OUTOFPGS
         REF      JCOVPA,JCO2VPA
         REF      T:GBUF
         REF      COPGSB,COPGSG
         REF      CBSIZE,SCRCO,SCPCO,SCGCO
         REF      BLNKFIL2
         SREF     HASPIO
         SREF     OCPTYP,OCPHDR,OCPVOL
         REF      Y0008
         REF      COP20B,COP08A
         REF      M8
         PAGE
*                 SYMBOLIC REGISTER DEFINITIONS.
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
*
*
*
C1LDEVX  EQU      1                 INDEX INTO SH:LNM FOR LDEV 'C1'
         PAGE
*
*        ENTRY FROM OPENDEV TO PROCESS OPEN TO A LOGICAL
*        DEVICE.
*
OPNLD    EQU      %
         BAL,SR4  OPNMAIN           OPEN STREAM
         B        OPNX              ALL IS WELL
         B        OERX              ABORT USER...
         SPACE    10
*
*        ENTRY FROM COOP WHEN THE DCB OF A LOGICAL DEVICE POINTS
*        TO A STREAM WHICH EITHER HAS NO CONTEXT BLOCK OR A
*        PARTIALLY INITIALIZED ONE.
*        COOP'S RETURN ADDRESS IS IN R11.
*
COPOPNLD EQU      %
         PUSH     7,R5
         BAL,SR4  OPNMAIN
         LI,SR3   0                 NORMAL RETURN
         LW,D1    SR3               IF ERROR, OPNMAIN RETURNS HERE
         PULL     7,R5
         LW,SR3   D1                ERROR CODE(IF ANY)
         B        *SR4
         PAGE
*
*        MAIN ROUTINE TO OPEN A LOGICAL DEVICE STREAM AND
*        INITIALIZE ITS CONTEXT BLOCK SO IT IS USABLE
*        BY COOP.
*        ENTRY: BAL,SR4 OPNMAIN. EXIT: BAL+1 - NORMAL
*                                      BAL+2 - ERROR
*
OPNMAIN  EQU      %
         PUSH     SR4
         LW,R3    DSI,R6
         AND,R3   XFF               LOGICAL DEVICE INDEX IN DCB
         AI,R3    -(DCTSIZ+1+SV:RSIZ+1)  LDEVX AS COOP KNOWS IT
         LB,R2    SB:LTY,R3         DEFAULT DEV TYP
         STW,R3   CLK,R6            LDEVX IN WORD 12 OF DCB
         BAL,R4   FINDSC            FETCH CONTXT BLOCK ADDR FOR THIS LDEV
         B        %+2
         B        OPNLD0
         BAL,SR2  SCINIT            NEW STREAM; GET CNTXT BLK & INITIALIZE
*
* AT THIS POINT WE HAVE A CONTEXT BLOCK WITH ADDR IN SR3.
*
         LC       J:JIT             IF THIS IS A BATCH COMMAND
         BCS,12   OPNLDDV           PROCESSOR LET HIM OPEN ANY
         LW,R4    S:CUN             THING HE WANTS -- THIS IS
         LH,R4    UH:FLG,R4         BECAUSE CCI NEEDS CR AND
         CI,R4    TIC               LP TO TELL THE GUY HE
         BANZ     OPNLD0            IS ABORTED
OPNLDDV  EQU      %
         BAL,SR4  CHKLDCF           CHECK SYMBIONT DEV AUTH.
         B        OPNLD0            IT'S GOOD
         LI,SR2   X'48'             USER NOT AUTHORIZED
         B        ABORT%HIM         TELL HIM
OPNLD0   LI,D1    0
         LW,D2    Y8                RESET BIT 0 IN STREAM POINTER
         STS,D1   *J:USCDX,R3       TO SIGNAL STREAM IS OPEN
         LW,R3    SR3               CNTXT BLK ADDR
         LW,D1    SCDEVTYP,R3       TAKE FUNCTION FROM CNTXT BLK
         SLS,D1   -14               ADJUST AND MAKE
         AI,D1    X'20000'          IN=1,OUT=2
         LW,D2    Y00FE             PUT IN FUN FIELD
         STS,D1   DSI,R6            OF THIS DCB
         MTW,0    SCBESTDA,R3       IS STREAM OPEN TO A FILE
         BNEZ     OPNLDXIT          YES
*
* WE ASSUME THIS IS THE FIRST OPEN TO THIS STREAM SINCE IT DOES NOT
* HAVE A STARTING DISC ADDRESS.
*
         BAL,SR4  COPDCB            INITIALIZE CNTXT DCBS
         LW,SR4   S:CUN
         STW,SR4  SCCUN,R3          STORE USER NO.
         MTW,0    SCDEVTYP,R3
         BGEZ     GETIF             INPUT STREAM
*
* FINAL INITIALIZATION OF AN OUTPUT CONTEXT BLOCK
*
         BAL,SR4  COPGSG            GET DISC GRANULE
         STW,R0   SCBESTDA,R3       STARTING DISC ADDR
         STW,R0   SCCDA,R3          CUR DISC ADDR
         BAL,SR4  COPGSB            GET COOP BLKNG BUFFER &MAP WNDW
         LW,D1    SCDEVTYP,R3
         CW,D1    LGLHDR            PUNCH OR LISTING DEVICE
         BAZ      OPNLD1            NOPE
         AND,D1   M8
         CI,D1    OCPTYP            IS  IT THE OCP
         BNE      OPNOF1            NOPE
         PUSH     16,R0             YES
         BAL,SR4  COOPHDOP          BUILD HEADER LABEL
         PULL     16,R0
         BAL,SR4  COPGSG            GET ANOTHER GRANUEL
         LW,R1    SCFBUF,R3         TELL COP20B WHERE BUFF IS
         LI,SR4   -1
         STW,SR4  SCBLDA,R3         FIRST BLOCK SIGNAL
         LI,SR4   0
         STW,SR4  SCDBI,R3          SIGNAL COOP TO EXIT
         LW,R6    R3
         LI,SR4   OPNOF0            SET DBI ON
         PUSH     SR4
         LI,SR4   COP08A
         B        COP20B
OPNOF0   LI,R2    1STDBI
         STW,R2   SCDBI,R3          SET DBI ON
         B        OPNLDXIT          GO
OPNOF1   EQU      %
         LC       J:JIT
         BCS,8    %+3               SKIP TEST IF ON-LINE
         MTW,0    J:ACCN            DON'T ISSUE HEADER 1ST TIME
         BEZ      OPNLD1
         PUSH     16,0
         BAL,SR4  COOPHDR           OUTPUT HEADER FOR NEW FILES
         PULL     16,0
         B        OPNLD1
*
*        GET AN INPUT FILE
*
         REF      GETI,GIFNC,S:CUN,SGC:NCB,E:QA,T:REG,SGCR,SGCQ
GETIF    EQU      %
         LW,R1    CLK,R6
         CI,R1    C1LDEVX           CONTROL INPUT STREAM
         BNE      GETIF1            NO
         LC       J:JIT             ACCESS ALLOWED ONLY
         BCS,12   NONCIF            FOR BATCH USERS
         BAL,SR4  GETI
*        GETI     USES R1,R5,R14,R15, AND RETURNS THE
*                 DISC ADDR IN SR1. IF NONE AVAILABLE, GETI WILL HAVE
*                 TRIGGERED A S. C. BY NOW.
         B        GETIF3
*
*        G I F N C - GET NON-CONTROL INPUT STREAM
*
GETIF1   LI,D1    X'FF'
         AND,D1   SCDEVTYP,R3
         SLS,D1   8
         AI,D1    GIFNC
         LW,D2    SCSVDGI,R3
         SLS,D2   -16
         AND,D2   XFF
         LW,D3    S:CUN
         STB,D3   D2
         LW,D3    SCFORM,R3
         BAL,4    SGCQ
         B        SGC:NCB
         PUSH     R6
GETIF2   LI,R6    E:QA
         BAL,11   T:REG
         AI,1     1                 POINT AT COM WORD 1
         MTB,0    *1                S:CUN STILL THERE
         BEZ      %+2               NO, GHO FILLED IN DISC ADDR
         BDR,R1   GETIF2
         AI,R1    -1                POINT BACK TO COMBUF START
         PULL     R6
         LW,SR1   1,R1              DISC ADDR
         BAL,4    SGCR              RELEASE GHO COM BUF
         CI,SR1   0
         BNE      GETIF3            GOT A GOOD DISC ADDR
*                                   RBBAT UNSUCCESSFUL...
*                                   UNDO THE DAMAGE
*                                   AND EXIT ABNORMALLY
NONCIF   LI,SR2   3
         B        ABORT%HIM         WITH ABN 03.
GETIF3   LW,R3    SR3
         STW,SR1  SCBESTDA,R3       STARTING DISC ADDR
         STW,SR1  SCCDA,R3          CUR DISC ADDR
OPNLD1   LI,SR1   -1
         STW,SR1  SCBLDA,R3         SIGNAL NEW FILE OPEN FOR COOP
OPNLDXIT EQU      %
*
* UPDATE STREAM ACCOUNTING TYPE IN WD 12, BITS 20-23 OF DCB.
*        (R3) = CONTEXT BLK ADDR
*
         LI,R2    0
         BAL,R1   GETDCBN           GET DCB NAME
         CI,14    0                 ZERO IN R14 MEANS
         BE       %+3               NOT 4 CHARS
         CW,14    MDO               CHECK NAME: IF M:DO,
         BE       ACCTDO            SET ACCOUNTING TYPE = 1
         LW,D1    SCDEVTYP,R3
         CW,D1    Y002              PUNCH DEVICE
         BANZ     ACCTPO            YES
         CI,D1    X'4000'           LISTING DEVICE
         BAZ      ACCTNO            NO: MEANS NO ACCT'ING
         LW,D1    J:JIT+PUF
         CW,D1    Y001
         BANZ     ACCTUO
*
*        FALL THROUGH TO LO-TYPE ACCOUNTING...
*
ACCTLO   AI,2     X'100'            ACCT TYP = 4
ACCTUO   AI,2     X'100'            '     '  = 3
ACCTPO   AI,2     X'100'            '     '  = 2
ACCTDO   AI,2     X'100'            '     '  = 1
ACCTNO   LI,3     X'F00'            '     '  = 0
         STS,2    CLK,R6            -,ACCT TYP,LDEVX   20,4,8
         LW,3     Y002              SET FCD FLAG
         STS,3    0,R6              TO INDICATE DCB IS OPEN
         PULL     SR4
         B        *SR4              NORMAL EXIT
MDO      TEXT     'M:DO'
*
*        ABNORMAL EXIT
*        ERROR/ABNORMAL CODE RIGHT-JUSTIFIED IN SR3
*
ABORT%HIM EQU     %
         LW,R3    J:USCDX
         MTW,-1   LDEVCNT,R3        HAVE TO DECREMNT
         LW,R3    CLK,R6
         LI,R0    0
         LW,R1    Y2
         STS,R0   *J:USCDX,R3       MAKE THIS CNTXT BLK AS NOT IN USE
         STW,R0   CLK,R6            ERASE LDEVX IN DCB
         LW,SR3   SR2
         PULL     SR4
         AI,SR4   1                 AND TAKE ABNORMAL
         B        *SR4              EXIT
         PAGE
T:LDEV   EQU      %
* ENTERED VIA CAL1,8 BY LDEV PROCESSOR
*(R7)=ADDR PLIST+1
*
         PUSH     11                SAVE RETURN
         LI,R4    1
         LW,D1    *R7,R4            USE STREAM ID IN PLIST
         LI,D2    X'FFFF'           TO FIND CORRESPONDING
         LI,R3    SV:LSIZ           INDEX INTO SH:LNM
LDEV1    LH,D3    SH:LNM,R3         (HEREIN CALLED LDEVX)
         CS,D1    D3
         BE       LDEV2             GOT A MATCH
         BDR,R3   LDEV1
LDEV1A   LI,SR1   BADSID
         B        LDEVERR           BAD STREAM ID
LDEV2    CI,R3    C1LDEVX           CONTROL INPUT STREAM
         BE       LDEV1A            CAN'T BE LDEV'ED
         LW,D4    0,R7
         CW,D4    Y4                IS TYP SPECIFIED
         BAZ      LDEV2C            NO: FETCH DEFAULT
         AI,R4    1                 YES: USE IT TO FIND TYPNME
         CW,D4    Y2                RBID SPECIFIED
         BAZ      LDEV2A            NOPE
         LW,R2    R4                YEP
         AI,R2    1
         LW,D1    *R7,R2            PICK IT UP
         BEZ      LDEV2A            LOCAL - NOTHING SPECIAL
         LW,R2    *R7,R4            REMOTE: USE DEV TYP AS IS
         B        LDEV4             BUT CHECK IF REMOTE OK
LDEV2A   LW,D1    *R7,R4            INDEX  (DEV TYP)
         LI,R2    TYPMNSZ
LDEV2B   LH,D3    OH:NM,R2
         CS,D1    D3
         BE       LDEV3             FOUND DEV TYP
         BDR,R2   LDEV2B
         LI,SR1   BADTYP
         B        LDEVERR           BAD TYP
LDEV2C   LB,R2    SB:LTY,R3         DEFAULT DEV TYP
*
* AT THIS POINT (R2)=DEV TYP, (R3)=LDEVX
*
*        ***LDEV IS DIRECTED TO A CENTRAL SITE DEVICE****
*           CHECK VALIDITY OF DEV & FUNCTION PARAMETERS
*
LDEV3    EQU      %
         BAL,SR4  CHKLDCF           CHECK SYMB. DEVICE AUTH.
         B        LDEV3A            AOK
         LI,SR1   BADFLGS           NOT AUTHORIZED...
         B        LDEVERR           BAD NEWS FOR THIS USER
LDEV3A   CW,D4    Y1                IN/OUT SPECIFIED
         BAZ      LDEV5             NO
*        CHECK FOR LEGAL FCN SPECIFICATION.
         AI,R4    1
         LW,R4    *R7,R4            IN/OUT FCN
         LB,D3    TB:FLGS,R2        DEVICE FLAGS FOR THIS DEV TYP
         EXU      IOCMPR,R4
         BANZ     LDEV5             FCN LEGAL FOR THIS DEVICE
         LI,SR1   BADFCN
         B        LDEVERR
*
*        ***LDEV IS DIRECTED TO A REMOTE SITE***
*           CHECK IF USER HAS REMOTE PRIVILEGE
*
LDEV4    EQU      %
         REF      SV:FTYM
         LI,R4    JH:LDCF           CHECK IF RP IS FATH AND
         LH,12    0,4               CHECK BIT IF IT IS
         LI,13    X'FD9D7'          'RP' SIGN EXTENDED
         LI,R4    SV:FTYM
LDEV4C   CI,R4    SV:TYM
         BLE      LDEV4B
         CH,13    SH:SYMT,R4
         BE       %+2
         BDR,R4   LDEV4C
         SLS,12   0,R4
         CI,12    X'8000'
         BAZ      LDEV4A
LDEV4B   EQU      %
         CI,D4    4                 IS HASP SPECIFIED
         BAZ      %+3               NO
         LI,D2    HASPIO            YES: IS HASP IN CONFIGURATION
         BEZ      LDEV4A            NO: STOP THIS USER FAST
         REF      UH:FLG
         LW,4     S:CUN
         LI,13    SJAC
         CH,13    UH:FLG,4
         BANZ     LDEV5             PROCESSOR RUNNING - OK
         LB,D2    JB:PRIV
         CI,D2    X'C0'
         BGE      LDEV5             PRIV LEVEL HIGH ENOUGH
LDEV4A   LI,SR1   BADWSN
         B        LDEVERR
*
*        VALIDITY & AUTHORIZATION CHECKS COMPLETE...
*        NOW UPDATE THE STREAM ATTRIBUTES WITH THE LDEV VALUES.
*
LDEV5    EQU      %
         BAL,R4   FINDSC            FETCH CNTXT BLK ADDR
         B        LDEV6             NOT THERE
         LW,R1    SR3
         LI,D2    ASAVFLG+DELFLG+ARELFLG
         AND,D2   0,R7              ISOLATE ASAVE & DELETE OPT'S
         CI,D2    ARELFLG           IF AREL SPECIFIED,
         BAZ      %+2
         AND,D2   X40               IGNORE ASAVE OPTION
         SLS,D2   25-1              POSITION TO BITS 1 & 3
         STS,D2   SCDEVTYP,R1       AND PUT AWAY IN CNTXT FOR COP05
         PUSH     2,2               SAVE DEV TYP, LDEVX
         BAL,SR4  COP05             CLOSE CURRENT STREAM
         PULL     2,2
         LW,D2    0,R7
         CI,D2    ARELFLG
         BANZ     LDEVXIT           AREL SPECIFIED: LEAVE
         CI,D2    ASAVFLG
         BAZ      LDEV6             START NEW STREAM FROM SCRATCH
*
*        PROCESS LDEV 'SAVE' OPTION. RESET INTERNAL COOP
*        FIELDS IN CNTXT BLK; LEAVE FIELDS MODIFIED BY LDEV INTACT.
*
         LW,R3    SR3               CNTXT BLK ADDR
         LW,R1    SR3
         AND,R1   M17               HI BYTE CNTNS CNTX-BLK-IN-USE INDTR
         LI,R0    0
         AI,R1    SCFLDA            DEST
         SLS,R1   2
         OR,R1    CNT1BYTES
         MBS,0    0
         STW,0    SCPCO,R3
         STW,0    SCRCO,R3
         STW,R0   SCGCO,R3
         STW,R0   SCRPDA,R3
         LW,R1    DEL%SAV           ERASE DELETE AND ASAVE
         STS,R0   SCDEVTYP,R3       OPTIONS IN CONTXT BLK
         LW,R0    Y00FF
         AND,0    SCSVDGI,R3        SAVE RBID FIELD
         STW,0    SCSVDGI,R3        IN CNTXT BLK
         LI,R2    X'FF'
         AND,R2   SCDEVTYP,R3       RESTORE DEV TYP IN R2
         B        LDEV7
LDEV6    BAL,SR2  SCINIT            GET NEW CNTXT BLK & ADD DEFAULTS
LDEV7    EQU      %
         LW,R3    *SR3              RETRIEVE LDEVX
         LW,SR4   Y8                AND SET BIT 0 IN STREAM PNTR
         STS,SR4  *J:USCDX,R3       TO SIGNAL UNOPENED STREAM
         BAL,SR4  FPTMRG            ADD NEW LDEV VALUES TO CB
LDEVXIT  EQU      %
         PULL     11                RETURN ADDRESS
         B        T:SELFDESTRUCT    EXIT ERASING THIS OVERLAY
*
LDEVERR  PULL     11
         LW,R4    TSTACK
         SLS,SR1  16                ADJUST ABN CODE
         STW,SR1  -5,R4             STORE IN USER'S SR3
         DESTRUCT CC1SET            SET CC1
*
*
CNT1     EQU      13*4
*
CNT1BYTES GEN,8,24  CNT1,0
*
*
*                          FLAG BITS IN PLIST
ASAVFLG  EQU      X'10'
ARELFLG  EQU      X'20'
DELFLG   EQU      X'40'
*
*
DEL%SAV  DATA     X'50000000'
*
*
IOCMPR   CI,D3    X'20'             CHECK IF INPUT IS LEGAL
         CI,D3    X'10'             ''    '' OUTPUT ''   ''
*
*
*        LDEV ERROR CODES
BADSID   EQU      X'B700'           SUBCODE=00
BADTYP   EQU      X'B702'           ''   ''=01
BADFCN   EQU      X'B704'           ''   ''=02
BADWSN   EQU      X'B706'           ''   ''=03
BADFLGS  EQU      X'B708'           JH:LDCF PERIPHERAL FLG NOT SET
         PAGE
*
* ROUTINE TO CHECK USER'S SYMBIONT DEVICE AUTHORIZATION.
*        ENTRY: BAL,SR4   CHKLDCF
*               (R2) = DEV TYP(TYPMNE INDEX)
*        EXIT : BAL+1 - ALL IS WELL
*               BAL+2 - NOT AUTHORIZED FOR GIVEN DEVICE
*        R1,D1,D2,D3 VOLATILE
*
CHKLDCF  EQU      %
         LH,D3    OH:NM,R2          DEV TYP TEXT MNEUMONIC
         LI,R1    SV:TYM            SIZE OF SH:SYMT TABLE
         LI,D2    X'FFFF'
LDCF1    LH,D1    SH:SYMT,R1        FIND INDEX INTO SYMBIONT
         CS,D1    D3                DEVICE NAME TABLE
         BE       LDCF2             GOT IT
         BDR,R1   LDCF1
         AI,SR4   1                 ERROR: NO SUCH SYMBIONT
         B        *SR4              DEVICE IN THIS SYSTEM
LDCF2    LI,D1    X'8000'           COMPUTE JH:LDCF BIT FOR
         SLS,D1   -1                THIS SYMBIONT DEVICE...
         BDR,R1   %-1
         LI,R1    JH:LDCF           HA(USER'S PERIPHERAL DEV FLGS)
         CH,D1    0,R1              CHECK FLAG FOR THIS DEVICE
         BANZ     *SR4              AUTHORIZED
         AI,SR4   1
         B        *SR4              NOT AUTHORIZED
         PAGE
*ROUTINE TO FETCH THE CONTEXT BLOCK ADDR FOR A GIVEN LDEV
*        ENTRY : BAL,R4 FINDSC
*        INPUT : (R3)=LDEVX
*        EXIT :: BAL+1  IF NEW STRM(NEEDS INITIALIZATION)
*                BAL+2  NOT A NEW STRM--CNTXT BLK ADDR RETNED IN R10
*
FINDSC   EQU      %
         LW,D1    J:USCDX           POINTER TO CB0
         BEZ      FINDSC1           N0 MEANS USERS HAS NO COOP CNTXT AT ALL
         LW,SR3   *D1,R3
         CW,SR3   Y2
         BAZ      0,R4              STREAM NEEDS INIT.
         B        1,R4              OK
FINDSC1  EQU      %
         PULL     SR4
         PUSH     16,0
         LI,D3    JCOVPA            MAP THE COOP CNTXT WINDOW #1
         BAL,R2   T:GBUF            (AND STAY MAPPED THROUGHOUT)
*THAT BUFFER SHOULD ALWAY BE AVAILBLE
*        MTW,0    SR3
*        BEZ      %-3
         STW,D3   J:USCDX           NOW,AT LEAST HAVE 1 PG FOR CNTXT
         LI,D1    0                 CLR CB0 LIKE MON BUFF
         BAL,SR4  BLNKFIL2          NO CONFLICT EVNTHGH CB0 IS 32 WDS
*NOW SET UP CB0 TO CONTAIN PNTRS TO ALL CNTXT BLKS WITHIN THE
*  SAME PAGE
         LW,R7    J:USCDX
         LI,R1    1
         STW,R1   COPPGS,R7         INDICATE # OF COOP PGS
ALLCBS   EQU      %
         AI,R7    CBSIZE
         STW,R7   *D3,R1
         AI,R1    1
         CI,R1    SV:LSIZ           THOUGH HAVE RM FOR 15 STRMS
         BLE      ALLCBS
         PULL     16,0
         PUSH     SR4
         B        0,R4
         PAGE
* ROUTINE TO INITIALIZE A COOP CONTEXT BLOCK AND FILL IN DEFAULTS.
*        RETURN WITH (SR3)=CONTEXT BLOCK ADDRESS
* (R2)=DEVICE TYPE(TYPNME INDEX)
* (R3)=LDEVX
*(SR2)=RETURN ADDR
SCINIT   EQU      %
         PULL     SR4
         PUSH     16,0
         LW,R1    J:USCDX           SINCE THIS IS A NEW STREAM,
         MTW,1    LDEVCNT,R1        INCREMENT CURRENT STREAM COUNT
SC1      LW,D3    *J:USCDX,R3
         LW,R3    TSTACK            OVERWRITE D3 IN STACK
         STW,D3   *M24,R3           WITH CNTXT BLK ADDR
         LW,R1    J:USCDX
         LW,D1    LDEVCNT,R1        DOES CURRENT # OF STRMS
         CW,D1    DBMAX,R1          EXCEED AVALBLE DATA BUFFS
         BLE      SC0               NO
*NO. OF BLKNG BUFFS ALLOCATED SHOULD AT LEAST BE EQUAL TO THE
*  NO. OF OPEN STRMS SO COOP CAN BE ASSURED OF SUCH A FACT
         BAL,R0   ALLSBSB
*NOW GO ABOUT INITIALIZING THAT PRTCLR CNTXT BLK
SC0      EQU      %
         PULL     2,D3              RETRIEVE CNTXT BLK ADDR
         BAL,SR4  CNTXTSET          START CLEAN(ALL 0S)
         PULL     14,0
         PUSH     SR4
         LW,R1    Y2
         STS,R1   *J:USCDX,R3       MARK THI CNTXT BLK IN USE
         LW,R1    D3
         STW,R3   0,R1              SAVE LDEVX IN CNTXT BLK
         LB,D1    TB:SZ,2           DEFAULT LINES OR MINIMUM
         STW,D1   SCMINR,1          RECORD LENGTH
         LI,D1    1
         STW,D1   SCMISC,1          1 COPY
         LB,D1    TB:MAX,2          MAX RECORD LENGTH
         STW,D1   SCMAXR,1
         LB,D1    TB:FLGS,2         DEVICE FLAGS
         CI,R2    5
         BNE      %+2
         AI,D1    X'2000'           X'20' IN FLAG1 IF CP
         SLS,D1   8
         CI,D1    X'2000'           IS THIS AN INPUT DEVICE
         BANZ     %+2               YES
         OR,D1    Y8                OUTPUT: SET OUT FLAG
         CI,R2    OCPTYP            IS THIS THE OCP
         BNE      %+2               NOPE
         OR,D1    Y0008             YES-SET OCP FLAG
*
*        ONLY ONE FUNCTION IS POSSIBLE FOR LOCAL DEVICES. REMOTE
*        DEVICES HAVE THE IN/OUT PARAMETER SET IN THE LDEV FPT
*        WHICH NULLIFIES WHAT IS DONE HERE.
*
         OR,D1    R2                DEVICE TYPE
         STW,D1   SCDEVTYP,1        FCN,FLAG1,FLAG2,DEVTYP 1,15,8,8
         LW,SR3   R1
         B        *SR2
*COOP DATA BUFFER ALLOCATION
*  ADDS 2 DATA BUFFERS TO DATA BUFFER POOL IN CB0
*        ENTRY : BAL,R0  ALLSBSB
*           (R1)=ADDR OF COOP WNDW #1
*        OUTPUT : 2 POOL SLOTS FILLD IN CB0 AND INFO. UPDTD
ALLSBSB  EQU      %
         LI,D3    JCO2VPA           COOP WINDOW #2
         PUSH     2,R0
         BAL,R2   T:GBUF            GET A SPARE BUFFER
         PULL     2,R0
         LW,SR3   SR3               IS BUFFER AVAIL.
         BEZ      OUTOFPGS          NO(CNTXT AREA OVERFLOW)
*PUT THE ACQUIRED BUFFERS IN FREE DATA BUFF POOL IN CB0
*  FORMAT(BYTE)   BIT 2--LOWER/UPPER HALF INDTR
*                    BIT 3 TO 7--SPARE BUFFER INDEX
*
         MTW,1    COPPGS,R1         UPDATE PG COUNT
         LW,D3    J:USCDX
         AI,D3    DBPOOL            PT TO DATA BUFFER POOL
         LI,R2    1
ALS1     LB,R3    *D3,R2
         BEZ      ALS3
ALS2     AI,R2    1
         CI,R2    SV:LSIZ
         BG       *R0
         B        ALS1              FIND FREE SLOT
ALS3     MTW,1    DBMAX,R1          ONE MORE ALLTD DATA BUFF
         STB,SR3  *D3,R2            STORE INTO FREE SLOT
         CW,SR3   X20               FLIP THE UPPER HLF INDICATOR
         BANZ     *R0               ALL DONE
         OR,SR3   X20
         B        ALS2              ONE MORE
         PAGE
* ROUTINE TO MERGE LDEV FPT FIELDS INTO A COOP CONTEXT BLOCK.
*  (SR3)=CONTEXT BLOCK ADDR
*  (R2)=DEV TYP
*  (R7)=ADDR OF FPT+1
*  (SR4)=RETURN ADDR
*
FPTMRG   EQU      %
         LW,R1    SR3
         LW,R0    SCDEVTYP,R1       FETCH DFLT DEV FLGS IN CNTXT BLK
* HOLD SCDEVTYP STUFF IN R0 & UPDATE AS PARAMETERS ARE ENCOUNTERED.
         LW,SR1   R2                SAVE DEV TYP
         LI,SR2   X'FF'             MASK FOR DEV TYP
         BAL,R2   CHKBIT1
         STS,SR1  R0                PUT AWAY NEW DEV TYP
         BAL,R2   CHKBIT
         BAL,R3   SETRBID           STORE RBID
         BAL,R2   CHKBIT
         BAL,R3   SETFCN            SET IN/OUT FLAG AS SPECIFIED
         BAL,R2   CHKBIT
         STW,D1   SCMINR,1          LINES OR MIN RECORD LENGTH
         LI,R3    4
         LW,SR1   SCMISC,1          FETCH DEFAULT VALUES
         BAL,R2   CHKBIT
         STB,D1   SR1               OVERWRITE WITH FPT PARAMETER IF ITS THERE
         SCS,SR1  8                 POSITION FOR NEXT
         BDR,R3   %-3
         STW,SR1  SCMISC,1
         BAL,R2   CHKBIT%
         STW,D1   SCSEQ,1           SEQ ID
         BAL,R2   CHKBIT%
         STW,D1   SCFPC,1           FPC
         BAL,R2   CHKBIT%
         STW,D1   SCFORM,1          FORM
         BAL,R2   CHKBIT%
         STW,D1   SCFFORM,1         FFORM
         LW,D2    Y00FF
         CW,D2    SCSVDGI,1         ZERO WSN
         BAZ      RBSKIP            YES: SKIP OVER FLG1&2,MAXR
         SCS,R0   8                 (DEFAULT FLAGS FROM SCDEVTYP IN R0)
         BAL,R2   CHKBIT
         STB,D1   R0                UPDATE FLAG1(IF SPECIFIED)
         SCS,R0   8
         BAL,R2   CHKBIT
         STB,D1   R0                UPDATE FLAG2
         SCS,R0   16                0,FLAG1,FLAG2,DEV TYP 8,8,8,8
         BAL,R2   CHKBIT            TIME OUT FOR
         STW,D1   SCMAXR,1          MAX RECORD LENGTH
*        NOW GATHER BIT FLAGS AND VFC FLAG AND POSITION IN R0
FPTMRG1  LI,SR1   7                 ISOLATE  HASP,DIRECT,DRC    BITS
         AND,SR1  0,R7              IN WORD 1 OF FPT
         LI,D1    0
         BAL,R2   CHKBIT
         SLS,D1   3                 POSITION VFC-NOVFC BIT
         OR,SR1   D1
         SCS,SR1  -8                VFC,HASP,DIRECT,DRC IN BITS 4-7
         OR,R0    SR1
         STW,R0   SCDEVTYP,1
         LW,D1    Y00FF
         AND,D1   SCSVDGI,1         ISOLATE RBID
         BNEZ     *SR4
         LW,D2    HASPBIT           ZERO: CLEAR HASPBIT
         STS,D1   SCDEVTYP,1        IN CNTXT BLK
         B        *SR4
*
SETFCN   SCS,D1   -1                MOVE IN-OUT FLG TO BIT 0
         LW,D2    Y8
         STS,D1   R0
         B        *R3
*
SETRBID  SLS,D1   16                POSITION RBID TO BYTE 1
         LW,D2    Y00FF
         STS,D1   SCSVDGI,1         AND PUT AWAY IN CNTXT
         B        *R3
         SPACE      5
CHKBIT1  LW,D3    0,R7
         SLS,D3   1                 SKIP STREAM ID
         LI,R4    X'80002'
CHKBIT   SLS,D3   1                 GET PARAMETER, INDIRECT OK
         BEV      1,R2
         LW,D1    *R7,R4
         BGEZ     CHKBIT2           NOT INDIRECT
         CI,D1    X'1FFF0'
         BANZ     %+2
         AW,D1    J:BASE            REGISTER: COMPUTE LOCATION
         LW,D1    *D1
CHKBIT2  EQU      %
         BIR,R4   0,R2
*
*
*
CHKBIT%  EQU      %                 GET PARAMETER, INDIRECT ILLEGAL
         SLS,D3   1
         BEV      1,R2
         LW,D1    *R7,R4
         BIR,R4   0,R2
*
*
*
RBSKIP   LI,R3    3
RBSKIP1  SLS,D3   1
         BEV      %+2
         BIR,R4   %+1
         BDR,R3   RBSKIP1
         B        FPTMRG1
*
*
HASPBIT  EQU      Y04
         PAGE
*
*        THIS ROUTINE RESETS COOP'S NEWQ ARGS
*        ENTER WITH (R3) = CNTXT BLK ADDR
*
COPDCB   EQU      %
         LI,D1    DCBSKEL
         ANLZ,D2  SETRD             DEST.
         SLD,D1   2                 BA
         OR,D2    DCBRNG
         MBS,D1   0
         MTW,0    SCDEVTYP,R3
         BGEZ     *SR4              DONE IF INPUT
         LW,D2    Y01
SETRD    STS,D2   SCFQARGS,R3       OUTPUT: FCN CODE=WRITE
         B        *SR4
*
DCBSKEL  GEN,8,8,8,8  0,X'FF',3,0   DISC WRITE ARGS
         DATA     0                 BUF ADDR
         DATA     SBSIZE+SBSIZE+SBSIZE+SBSIZE   BUFF SIZE
         DATA     0                 DISC ADDR
         DATA     COPEA00           FILE END ACTION
         DATA     0                 DEV ARGS
         DATA     1STDBI            INITIAL BLOCK INDEX
         DATA     0,0,0             REST OF DEV ARGS
DCBCNT   EQU      BA(%)-BA(DCBSKEL)
DCBRNG   GEN,8,24  DCBCNT,0
         PAGE
*
* WRITE THE HDR LABEL FOR THE OCP
*
COOPHDOP LW,R3    SCFBUF,R3         BUFFER ADDRESS
         LW,R4    RCCNTL
         STW,R4   1,R3              STORE CONTROL CHAR
         AI,R3    2                 BUMP TO RECORD
         SLS,R3   2                 BYTE ADDRESS
         LI,R2    BA(OCPVOL)
         LI,R1    80
         BAL,0    MOVER             PUT VOL LABEL IN
         LI,R2    BA(RCCNTL)
         LI,R1    4
         BAL,0    MOVER             PUT CONTROL CHAR IN
         LI,R2    BA(OCPHDR)
         LI,R1    80                PUT HDR IN
         BAL,0    MOVER
         SLS,R3   -2                WORD ADDRESS
         LW,R1    OCPTM
         STW,R1   0,R3              PUT TAPE MARK IN
         LI,R1    X'4000'
         STW,R1   1,R3              PUT END OF BLOCK IN
         B        *SR4              RETURN
*
RCCNTL   DATA     X'00500601'
OCPTM    DATA     X'00000601'
*
*
*        ENTRY: BAL,11  COOPHDR
*               (R3)= CNTXT BLK ADDR
*
COOPHDR  EQU      %                 BUILD COOP BANNER RECORD
         LW,5     SCDEVTYP,3        ONLY IF THIS IS LISTING OR
         CW,5     LGLHDR            PUNCH DEVICE
         BAZ      *11
         PSW,11   TSTACK
         PSW,3    TSTACK
         LW,7     3
         LW,3     SCFBUF,3
         AND,R3   M17               HI BYTE IS THE SPARE BUFFER INDXX
         AI,3     100
         BAL,15   CNVTINDX
         STW,4    *3                 MOVE THE FOLLOWING INTO THE BUFFER
         LW,0     :BLNK             ------
         STW,0    1,3               SYSID
         AI,3     2                 NAME
         SLS,3    2                 ACCOUNT
         LC       J:JIT
         BCR,4    CPHDNG
         LW,1     S:CUN
         LI,2     MAXG
         CB,1     SB:GJOBUN,2
         BE       %+3
         BDR,2    %-2
         B        CPHDNG
         SLS,2    3
         AI,2     BA(S:GJOBTBL)
         LB,1     0,2
         AI,2     1
         B        CPHDG
CPHDNG   EQU      %
         LI,1     12                DATE
         LI,2     BA(J:UNAME)       TIME
CPHDG    BAL,0    MOVER
         BAL,0    DLTBLNK
         LI,0     ','
         STB,0    0,3
         AI,3     1
         LI,1     8
         LI,2     BA(J:ACCN)
         BAL,0    MOVER
         BAL,0    DLTBLNK
         LI,1     4
         LI,2     BA(BLNKS)
         BAL,0    MOVER
         LI,1     2
         LI,2     BA(DATE)
         BAL,0    MOVER
         LI,0     '/'
         STB,0    0,3
         AI,3     1
         LI,1     2
         BAL,0    MOVER
         LI,0     '/'
         STB,0    0,3
         AI,3     1
         LI,1     2
         LI,2     BA(DATE)+6
         BAL,0    MOVER
         LI,1     4
         LI,2     BA(BLNKS)
         BAL,0    MOVER
         LI,1     2
         LI,2     BA(TIME)
         BAL,0    MOVER
         LI,0     ':'
         STB,0    0,3
         AI,3     1
         BAL,0    MOVER             THIS CODE IS HURRIEDLY (SIC) WRITTEN
         LW,1     3                 AND WOULD BEAR IMPROVMENT WHEN ANYONE
         LW,6     SCFBUF,7          HAS TIME -- SMK
         AND,R6   M17               CLAR HI BYTE
         LI,3     8
         CI,5     X'4000'           PUNCH GET ONE LINE BANNER WITH 5 WORDS
         BANZ     CPHDP             OF -1.  LISTING GETS 2 PAGES OF BANNER
         LI,0     X'2401'
         STW,0    1,6
         AI,6     93
         LW,0     BLNKS
         STW,0    6,6
         LI,4     5
         LI,0     -1
         STW,0    *6,4
         BDR,4    %-1
         PSW,6    TSTACK
         AI,6     1
         SLS,6    2
         SW,6     1
         AW,6     SCMINR,7          BE SURE BANNER IS EXTENDED TO MIN
         BLEZ     %+3               RECORD LENGTH
         STB,6    1
         MBS,0    BA(BLNKS)
         PLW,6    TSTACK
         AI,6     -93
         LI,4     94**2
         B        CPMHD
CPHDP    EQU      %
         LI,0     X'601'            FIRST BATCH BANNER IS ONE LINE SINCE
         STW,0    1,6               SPECIAL BANNER IS SUPLIED BY CCI
         LI,0     X'F1'             FOR ONLINE,GHOST, AND NON-
         STW,0    99,6              FIRST BATCH TWO PAGE BANNER
         LI,4     3+99**2           FORMAT OF HEADER IS 0,BC,FC=86,SK=3
         LC       J:JIT             NUMBER OF TIMES TO PRINT,SECONDARY
         BCS,12   %+3               VFC,PRIMARY VFC,MESSAGE
         LH,8     J:CPPO
         BEZ      CPMHD             PAGES FOR NORMAL,ONE FOR FORMS
         LI,0     X'8603'           IF THE MESSAGE IS TO A HASP COMLINE
         STW,0    1,6               HASP VFC IS USED.
         LI,3     10
         LI,13    X'C1'
         CW,5     Y04
         BAZ      CPHDP1
         LI,13    X'81'
         CI,R5    X'10000'
         BAZ      CPHDP1
         LI,13    X'A2'
         CI,R5    X'20000'
         BAZ      CPHDP1
         LI,13    X'82'
CPHDP1   EQU      %
         LW,0     SCMINR,7
         CI,0     100               MAX BANNER LINES
         BLE      %+3               IF MORE USE 'LP'
         LI,2     6                 DEFAULT
         LB,0     TB:SZ,2
         AI,0     2
         LW,8     SCFORM,7
         BEZ      %+3
         AI,13    -1
         AI,0     -1
         SLS,13   16
         STB,0    13
         STW,13   2,6
CPMHD    EQU      %
         LW,8     1,6
         SLS,8    16
         SLS,6    2
         AW,6     4
         SW,1     6
         CW,1     SCMAXR,7
         BLE      %+2
         LW,1     SCMAXR,7
         LI,2     X'10000'          HERE:
         LW,14    SCFBUF,7          R1=BYTE COUNT TO MOVE
         LW,15    SCFBUF,7          R2=DUMMY MAX TO MOVE
         LI,11    CPHDD             R3=DESTINATION BTD
         CW,5     Y04               R4=SOURCE BTD
         BAZ      CPHHDDO
         CI,R5    CMPP
         BAZ      H%CMP1
         AND,R5   NCMPC
         B        H%CMP1
CPHHDDO  EQU      %
         PSW,1    TSTACK            R5=COOP FLAGS (SCDEVTYP)
         AW,1     4                 R14=DEST. BUF. WA
         BAL,11   RECTRAN           R15=SOURCE BUF WA
         PLW,2    TSTACK            ---
CPHDD    EQU      %                 EITHER THE HASP COMPRESSOR OR RECTRAN IS
         LW,4     14                CALLED TO MOVE THE RECORD INTO PLACE
         SLS,2    16
         AWM,2    1,4
         PLW,7    TSTACK
         STW,3    SCDBI,7
***** FOR EACH PUNCH FILE PRODUCED
*********   GENERATE A FREE LACE CARD IN-ADDITION TO THE BANNER
*
         LW,R5    SCDEVTYP,R7
         CI,R5    X'4000'           SEE IF PUNCH
         BANZ     ALLDONE
         CI,R5    X'800'            IS BIN LEGAL???
         BAZ      ALLDONE           NO DONT PUCH BIN BANNER
         PSW,R7   TSTACK
         CW,R5    Y04               IS IT HASP
         BAZ      LACEMV0
         LW,R3    SCFBUF,7          FOR COMPRESSION
         AI,R3    100               SAFE BUFFERING AREA
         SLS,R3   2
         B        LACEMV1
LACEMV0  EQU      %
         SLS,R4   2                 BYTE ADDRESS OF BUFFER
         AW,R3    R4                (R3)=WHERE THE LACE IMGE WILL BE F DMD
         LI,R1    4
         LI,R2    BA(LACECON)
         BAL,R0   MOVER             INSERT CNTL STRNG FOR THE LACE RECD
LACEMV1  LW,R1    R3                CUURRENT
         LI,R2    120
         STB,R2   R1
         MBS,0    BA(LACECLR)       CLEAR THE 120 BYTES WITH 0
         LW,R1    R3
         LI,R2    6
         STB,R2   R1
         MBS,0    BA(LACEFF)        START WITH 4 ALL PUNCHED CLMS
         AI,R1    6                  THEN FLLWD BY 4 NON-PUNCH ONES
         STW,R1   R3
         BAL,D4   CNVTINDX          RATHER GET THE SYSID AGAIN(EBCDIC)
*
         LI,SR4   4
LACE0    LB,D4    R4
         LI,R5    15
LACE1    CB,D4    LACETAB,R5
         BE       LACE2
         AI,R5    -1
         BGEZ     LACE1
         B        LACE3             ERROR,BUT COULD'NT CARE LESS
LACE2    EQU      %
         MI,R5    20
         AI,R5    BA(LACEBIN)
         LW,R2    R5
         LI,R1    20
         BAL,R0   MOVER             GOT IT
         AI,R3    4                 ROOM IN BETWEEN(MADE TO BE 5)
LACE3    SLS,R4   8                 GET NEXT ONE
         BDR,SR4  LACE0
         LW,R1    R3
         LI,R2    9
         STB,R2   R1
         MBS,0    BA(LACEFF)        THROW IN 6 PUNCHED COLUMNS
*
         PLW,R7   TSTACK
         LW,R5    SCDEVTYP,R7       R5=COOP FLGS
         CW,R5    Y04               IS IT HASP
         BAZ      ALLSET            IF NOT ALMOST DONE
         PSW,R7   TSTACK
         LI,R1    120               BYTE COUNT TO MOVE
         LI,R2    X'10000'          DUMMY
         LW,R3    SCDBI,R7          DESTINATION BTD
         AI,R3    4                 ALLOW FOR CONTROL STRING
         LI,R4    100**2            SOURCE BTD
         LW,D3    SCFBUF,R7         DEST. BUF. WA.
         AND,D3   M17
         LW,D4    D3                SOURCE BUF. WA.
         REF      Y02
         LW,8     Y02
         LI,R5    CMPC
         BAL,SR4  H%CMP1            **GO COMPRESS**
*
         PLW,R7   TSTACK
         LW,R4    LACECON
         STH,R2   R4                R2 RETURNED AS CPMRESSION LENGTH
         LI,D3    R4**2
         LW,D4    SCFBUF,R7
         AND,D4   M17
         SLS,D4   2                 BYTE ADDR. OF BUFFER
         AW,D4    SCDBI,R7          THATS WHERE THE CONTROL STRING GOES
         LI,R1    4
         STB,R1   D4
         MBS,D3   0                 CONTROL STRING SETUP
         STW,R3   SCDBI,R7          POSITION SETUP(R3 FROM H%CMP1)
         B        ALLDONE
ALLSET   EQU      %
         LI,R1    120+4
         AWM,R1   SCDBI,R7          NON-HASP,SIZE FIXED
ALLDONE  EQU      %
*
         PLW,11   TSTACK
         B        *11
*
*
MOVER    EQU      %
         STB,1    3
         MBS,2    0
         B        *0
*
*
DLTBLNK  EQU      %
         AI,3     -1
         LI,4     ' '
         CB,4     0,3
         BNE      %+2
         BDR,3    %-2
         AI,3     1
         B        *0
*
*
         SREF     H%CMP1
         REF      J:UNAME,DATE,TIME,RECTRAN,J:CPPO
         REF      MAXG,S:GJOBTBL,SB:GJOBUN
LGLHDR   DATA     X'00204000'
:BLNK    TEXT     ':   '
BLNKS    TEXT     ' '
*
CMPP     EQU      X'10000'
CMPC     EQU      X'20000'
NCMPC    DATA     -1-CMPC
*
LACECON  DATA     X'00782601'       120 BYTES,BIN,SKP=1
LACECLR  DATA,1   0
LACEFF   DATA,1   X'FF'
         BOUND    4
*     LACE CONVERSION TABLE
LACEBIN  EQU      %
0B       DATA     X'3FC20420',X'42042042',X'4204204',X'2042043F',;
                  X'C0000000'
1B       DATA     0,X'841841',X'843FC004',X'400400',0
2B       DATA     X'30420420',X'C2042042',X'14204204',X'2242043C',;
                  X'40000000'
3B       DATA     X'30C20420',X'42042042',X'04204264',X'2642643F';
                  ,X'C0000000'
4B       DATA     X'3C004004',X'400400',X'40040040',X'3FC04004',0
5B       DATA     X'3CC24424',X'42442442',X'44244244',X'24424427',;
                  X'C0000000'
6B       DATA     X'3FC22422',X'42242242',X'24224224',X'22422423',;
                  X'C0000000'
7B       DATA     X'30020020',X'2002042',X'8210220',X'24028030',0
8B       DATA     X'3FC24424',X'42442442',X'44244244',X'2442443F',;
                  X'C0000000'
9B       DATA     X'3C424424',X'42442442',X'44244244',X'2442443F',;
                  X'C0000000'
AB       DATA     X'7C0C014',X'2402402',X'40240240',X'1400C007',;
                  X'C0000000'
BB       DATA     X'3FC24424',X'42442442',X'44244244',X'2441480B',0
CB       DATA     X'1F820420',X'42042042',X'4204204',X'20420410',;
                  X'80000000'
DB       DATA     X'3FC20420',X'42042042',X'4204204',X'2041080F',0
EB       DATA     X'3FC24424',X'42442442',X'44244204',X'20420420',;
                  X'40000000'
FB       DATA     X'3FC24024',X'2402402',X'40240200',X'20020020',0
LACETAB  TEXT     '0123456789ABCDEF'
*
*
CNVTINDX EQU      %
         PUSH     2,6
         INT,6    J:JIT             GET SYSTEM ID
*                                   AND CONVERT IF
         SLS,7    16
         LI,1     4
CVX10    EQU      %
         LI,6     0
         SLD,6    4
         LB,0     HEX,6
         STB,0    4
         SCS,4    8
         BDR,1    CVX10
*
         PULL     2,6
         B        *15
         PAGE
*
*
*
GETDCBN  EQU      %
         LW,5     J:DCBLINK
DOT2     AI,5     1
         CW,6     0,5               FIND DCB ADDRESS
         BNE      DOT0
         LCI      2
         LM,14    -2,5              PICK UP NAME
         LB,D1    14
         SLD,14   8
         AI,D1    -4
         BEZ      0,1
         B        DOT0+2
DOT0     CW,5     *J:DCBLINK
         BNE      DOT2
         LI,14    0                 NOT FOUND
         B        0,1
         END

