*     UBCHAN  (SYSGEN PASS2  :CHAN/:DEVICE)
*************************************************************************
*M*      UBCHAN   DECODES CHAN/DEV CC. BUILDS IOTABLE,M:HGP & M:DCTMOD
*************************************************************************
*
         SYSTEM   BPM
         SYSTEM   SIG7FDP
*
*
* * * * * SYSGEN, PASS2 * * * * * FOR SIGMA 5|7 BATCH MONITOR
*
*
*
*                 SYMBOLIC REGISTER DEF'S.
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
         PAGE
*                 CHANGE STACK POINTER AMOUNT SPEC. BY 1ST ARGUMENT.
*                 SECOND ARGUMENT SPEC. AVAILABLE REGISTER.
BUMP     CNAME
         PROC
LF       LI,AF(2) AF(1)
         MSP,AF(2)  *R0
         PEND
*                 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
         DEF      CHAN,UBCHAN,CHDVEND
*********
         REF      M:TM
         REF      M:EI
         REF      MODGEN
         REF      MODIFY
         REF      READCONT,RDINCFCH
         REF      ABNMOD
         REF      OUTLLERR,READSTRG,GETPGS
         REF      PRINTMSG
         REF      NAMSCAN,CHARSCAN,CHSTSCAN,HEXSCAN
         REF      COREALLOC,WRITELM
         REF      EXPHWRT
         REF      M17
         REF      RBSIZ
         REF      LOGIT
         REF      CONVTBL
         PAGE
************************************************************************
*  PASS2 STACK ALLOCATION -- POINTED TO VIA (R3).
************************************************************************
BASESTAC EQU      0      REL.DISPLACEMENT TO STACK BASE
********                          ****
SSIZE    EQU      BASESTAC+1        1ST DISC SECTOR SIZE (PSA DEVICE)
CORE     EQU      BASESTAC+2          CORE SIZE(FROM :MONITOR)
SDGANSG  EQU      BASESTAC+3        #SECT/GRAN FOR 1ST DISC (PSA DEV)
#GRANPER EQU      BASESTAC+4        #GRAN PER
CCBUFRS  EQU      BASESTAC+5        BASE OF BUFFERS
********                          ****
BUFFADDR EQU      CCBUFRS+0           POINTER TO CC BUFFER(=BUFFER)
BUFFER   EQU      CCBUFRS+1           CONTROL COMMAND BUFFER(20 WORDS)
BUFFADDR1 EQU     CCBUFRS+21        EXTRA WORD FOR LONG READ
FETCHLST EQU      CCBUFRS+22        CC PROCESSOR PARAM.LIST (7 WORDS)
FETCHCCP EQU      CCBUFRS+25        CURNT.CHAR.POS.PROCESSED IN CC
FETCHCSL EQU      CCBUFRS+27        CHAR.STRING LENGTH OF FIELD IN CC
FETCHBUF EQU      CCBUFRS+29        CC CHAR.STRING BUFFER (9 WORDS)
FETCHADR EQU      CCBUFRS+38        POINTER TO FETCHLST (=FETCHLST)
XBUFADDR EQU      CCBUFRS+39        POINTER TO XBUFFER (=XBUFFER)
XBUFFER  EQU      CCBUFRS+40        ERROR BUFFER FOR % CHAR.
SCPUFLG  EQU      CCBUFRS+60        SLAVE CPU'S PRESENCE FLAG
********
         PAGE
CHANFLG  EQU      SCPUFLG+1         CHAN CC ENCOUNTERED
P2OVLOP  EQU      SCPUFLG+2         FLGS FOR OPTION MON. OVERLAYS
P2OVLOP1 EQU      SCPUFLG+3         FLGS (CONT) FOR OPTIONAL MON OVERLAYS
P2ERR    EQU      SCPUFLG+4         COUNT OF # OF ERROR MESSAGES
P2ABRT   EQU      SCPUFLG+5         PASS2 DELAYED ABORT FLAG
MINCOCFL EQU      SCPUFLG+6         MINICOC PRESENCE FLAG
****
RCHAN    EQU      SCPUFLG+7         #CHAN CMNDS FOR UBCHAN
CHCTR    EQU      RCHAN+1           CTR OF CHAN BY ROOT
DVCTR    EQU      RCHAN+2           CTR OF DEVICE BY ROOT
CCPTR    EQU      RCHAN+3           PTR TO CMND PROCESSING
****
DYSTORND EQU      CCPTR+1           END AVAILABLE CORE
SAVEPAGE EQU      CCPTR+2           LAST ADRESS OF PAGE GOTTEN
GETPGPTR EQU      CCPTR+3           LAST ADRESS OF PAGE GOTTEN
#PAGES   EQU      CCPTR+4           # PAGES GOTTEN FOR PERM AREA
ENDUSED  EQU      CCPTR+5           END OF CURRENT USED AREA
****
DPAK3275 EQU      ENDUSED+1         # OF 3275 DP'S AND CHANNEL SYMBOL
*                                   (MAX = 36 CHANNEL SYMBOLS IN TBL)
COCS     EQU      DPAK3275+10
COCFEX#  EQU      COCS+5            8-BYTE COC ASSOCIATED FEX # TBL
AVTBLGTH EQU      COCFEX#+3         # OF TAPE ENTRIES
LORBIN   EQU      COCFEX#+4         LOW RBT DCT INDEX
HIRBIN   EQU      COCFEX#+5         HIGH RBT DCT INDEX
#RBTS    EQU      COCFEX#+6         # OF RBTS DEFINED ON :DEVICE CC
DUALFLG  EQU      COCFEX#+7         DUALFLG FOR :CHAN CC
BIGLOC   EQU      COCFEX#+8         BIG FLAG SET IN XMONITOR MODULE
****
SCYLPSA  EQU      BIGLOC+1          #GRAN/PHY CYLIN IN LEFT HALF
*                                   AND # PHY CYLIN IN RIGHT HALF
SWAPUTS  EQU      SCYLPSA+1         DP SWAPPER
HAND2FLG EQU      SCYLPSA+2         HANDLERS2 PRESENCE FLAG
PRIVDEV  EQU      SCYLPSA+3         TOT # OF PRIVATE PACKS
****
DCTSIZE  EQU      PRIVDEV+1         #DCTS+1 (AFTER UBCHAN)
TYPMNEAD EQU      DCTSIZE+1         PTR TO TYPMNE TABLE IN PERM AREA
TYPMNESZ EQU      DCTSIZE+2         #TYPMNE ENTRIES
TBSZPTR  EQU      DCTSIZE+3      PTR TO TB:SZ (MIN REC LNGTH)  :MUST
TBMAXPTR EQU      DCTSIZE+4      PTR TO TB:MAX (MAX REC LNGTH) :BE
TBFLGSPTR EQU     DCTSIZE+5      PTR TO TB:FLGS                :IN
TBFLGS1PTR EQU    DCTSIZE+6      PTR TO TB:FLGS1               :ORDER
TYCOUNT  EQU      DCTSIZE+7         PTR TO COUNT OF OCCUR. OF TYPE
BTXPTR   EQU      DCTSIZE+8         PTR TO BTX TBL   : MUST
OTXPTR   EQU      DCTSIZE+9         PTR TO OTX TBL   :BE
GTXPTR   EQU      DCTSIZE+10        PTR TO GTX TBL   :IN ORDER
DCT1TEMP EQU      DCTSIZE+11        PTR TO DCT1 TEMP
DCT4TEMP EQU      DCTSIZE+12        PTR TO DCT4 TEMP
DCT16TEMP EQU     DCTSIZE+13        PTR TO DCT16TEMP
****
SYMBPTR  EQU      DCT16TEMP+1       PTR TO SYMB DEV TYPE TABLE
SYMBDEV  EQU      SYMBPTR+1         #SYMB DEVICE TYPES
SYMBTYPE EQU      SYMBPTR+2         PTR TO SYMB TYPE INDEX TBL
SYMBCOUNT EQU     SYMBPTR+3         # SYMB DEVICES
SYMBVAL  EQU      SYMBPTR+4         #ENTRIES IN SYMBACT
SYMBACT  EQU      SYMBPTR+5         DW TEXT OF SYMB DEVICES
FAUTPTR  EQU      SYMBPTR+6         FAUTH ENTRIES
#MXSTRM  EQU      SYMBPTR+7         #MXSTRM ENTRIES
****
#RATS    EQU      #MXSTRM+1         #RAT ENTRIES
RATPTR   EQU      #RATS+1           PTR TO RAT TABLE
RATBMAXPTR EQU    #RATS+2           PTR TO BMAX TABLE
LDVPTR   EQU      #RATS+3           PTR TO LDEV TABLE
#LDV     EQU      #RATS+4           #LDEV ENTRIES
SBLTYPTR EQU      #RATS+5           PTR TO SB:LTY TALBE
LDVCONST EQU      #RATS+6           CONSTANT FOR LDEV INDEX
SVDFDK  EQU       #RATS+7           1ST DISK TYPE INDEX
SVDFTP   EQU      #RATS+8           1ST TAPE TYPE INDEX
LPART#   EQU      #RATS+9
MCDEV    EQU      #RATS+10          MC DEVICE DCTX
TCLSIZES EQU      #RATS+11          PTR TO CLIST SIZE BYTE TABLE
TPSZWID  EQU      #RATS+12          PTR TO PAPER WIDTH & SIZE TBL
FDB:DCT  EQU      #RATS+13          PTR TO DCTX TABLE FOR FECP DEVICES
FDB:FEX  EQU      #RATS+14          PTR TO FDB:FEX FEX # TBL
FEB:CDX  EQU      #RATS+15          PTR TO FEB:CDX FE DCTX TBL
FEDX#    EQU      #RATS+16          CONTAINS  0 OR NUMBER OF FECP DEVICES
*                                   IN RT H.W. & HIGHEST FEX# IN LT H.W.
INT#     EQU      #RATS+17          SINCE FEX RANGES FROM 1 TO 4
*                                    A MAXIMUM OF 3 WORDS USED FOR
*                                   FOR SAVING CORRESPONDING INTERRUPTS
FIRSTDP  EQU      #RATS+20             FIRST BYTE = DEVICE TYPE INDEX (+1)
*                                      RIGHT HALF = DEVICE NAME FOR FIRST
*                                      DP (YY PART OF YYNDD)
P2DYNEND EQU      #RATS+21             END OF PERM DYNAM STACK AREA
         PAGE
*********************************************************
*    UBCHAN STACK POINTED TO BY R3,CONTAINS MOSTLY
*        POINTERS TO LOCATIONS IN DYNAMICALLY ALLOCATED
*       PAGES
**********************************************************
         SPACE    2
CHANPTR EQU       P2DYNEND+1        PTR TO NXT CHANTBL ENTRY
CHANADDR EQU      P2DYNEND+2        PTR TO START OF CHAN TBL
         SPACE    2
DEVICDPT EQU      P2DYNEND+3        PTR TO NXT DEVICD1 ENTRY
DEVIADDR EQU      P2DYNEND+4        PTR TO START OF DEVICD1
         SPACE    2
HANDTADR EQU      P2DYNEND+5        PTR TO HANDLER TBLE
RHANDTAD EQU      P2DYNEND+6        PTR TO USER ROOT HANDLER ENTRIES
         SPACE    2
DCINPNTR EQU      P2DYNEND+7        PTR TO NXT DCINTBL
DCINADDR EQU      P2DYNEND+8        PTR TO START OF DCINTBL
DCINEND  EQU      P2DYNEND+9        LAST ADDR USED IN GOTTEN AREA
         SPACE    6
DCT1PTR  EQU      DCINEND+1         PTR TO DCT1 TABLE
DCT2PTR  EQU      DCINEND+2         PTR TO DCT2 TABLE
DCT3PTR  EQU      DCINEND+3         PTR TO DCT3 TABLE
DCT4PTR  EQU      DCINEND+4         PTR TO DCT4 TABLE
DCT5PTR  EQU      DCINEND+5         PTR TO DCT5 TABLE
DCT6PTR  EQU      DCINEND+6         PTR TO DCT6 TABLE
DCT7PTR  EQU      DCINEND+7         PTR TO DCT7 TABLE
DCT8PTR  EQU      DCINEND+8         PTR TO DCT8 TABLE
DCT9PTR  EQU      DCINEND+9         PTR TO DCT9 TABLE
DCT10PTR EQU      DCINEND+10        PTR TO DCT10 TABLE
DCT11PTR EQU      DCINEND+11        PTR TO DCT11 TABLE
DCT12PTR EQU      DCINEND+12        PTR TO DCT12 TABLE
DCT13PTR EQU      DCINEND+13        PTR TO DCT13 TABLE
DCT14PTR EQU      DCINEND+14        PTR TO DCT14 TABLE
DCT15PTR EQU      DCINEND+15        PTR TO DCT15 TABLE
DCT16PTR EQU      DCINEND+16        PTR TO DCT16 TABLE
DCT17PTR EQU      DCINEND+17        PTR TO DCT17 TABLE
DCT18PTR EQU      DCINEND+18        PTR TO DCT18 TABLE
DCT19PTR EQU      DCINEND+19        PTR TO DCT19 TABLE
DCT20PTR EQU      DCINEND+20        PTR TO DCT20 TABLE
DCT21PTR EQU      DCINEND+21        PTR TO DCT21 TABLE
DCT22PTR EQU      DCINEND+22        PTR TO DCT22 TABLE
DCT23PTR EQU      DCINEND+23        PTR TO DCT23 TABLE
DCT24PTR EQU      DCINEND+24        PTR TO DCT24 TABLE
DCT25PTR EQU      DCINEND+25        PTR TO DCT25 TABLE
DCT26PTR EQU      DCINEND+26        PTR TO DCT26 TABLE
DCT27PTR EQU      DCINEND+27        PTR TO DCT27 TABLE
DCT28PTR EQU      DCINEND+28        PTR TO DCT28 TABLE
DCT29PTR EQU      DCINEND+29        PTR TO DCT29 TABLE
DCT1PPTR EQU      DCT29PTR+1        PTR TO DCT1P TABLE
DCT1APTR EQU      DCT1PPTR+1        PTR TO DCT1A TABLE
DCTLAST  EQU      DCT1PPTR+2
NDCTS    EQU      DCTLAST-DCT1PTR   #DCT TABLES
********                          ****
         SPACE    2
CIT1PTR  EQU      DCTLAST+1           POINTER TO CIT1 TABLE
CIT2PTR  EQU      DCTLAST+2           POINTER TO CIT2 TABLE
CIT3PTR  EQU      DCTLAST+3           POINTER TO CIT3 TABLE
CIT4PTR  EQU      DCTLAST+4           POINTER TO CIT4 TABLE
CIT5PTR  EQU      DCTLAST+5           POINTER TO CIT5 TABLE
CIT6PTR  EQU      DCTLAST+6         POINTER TO CIT6 TABLE
CITLAST  EQU      DCTLAST+7         END OF CIT TABLES
NCITS    EQU      CITLAST-CIT1PTR     # CIT TABLES
********                          ****
         SPACE    2
TYPINDX  EQU      CITLAST+1         TYPE INDEX TO REORDER DCTS
PACKRPTR EQU      CITLAST+2         END OF TABLES TO BE PACKED
********                          ****
         SPACE    6
HEADADDR EQU      PACKRPTR+1          POINTER TO HEADER
TREEADDR EQU      PACKRPTR+2          POINTER TO TREE
RDEFADDR EQU      PACKRPTR+3          POINTER TO REF/DEF STACK
EXPRADDR EQU      PACKRPTR+4          POINTER TO EXPR.STACK
RDICADDR EQU      PACKRPTR+5          POINTER TO REL.DICT.0
CLISTADR EQU      PACKRPTR+6          POINTER TO SECT.0
HEADLNG  EQU      PACKRPTR+7          HEADER        SIZE
TREELNG  EQU      PACKRPTR+8          TREE          SIZE
RDEFLNG  EQU      PACKRPTR+9          REF/DEF STACK SIZE
EXPRLNG  EQU      PACKRPTR+10         EXPR.STACK    SIZE
RDICLNG  EQU      PACKRPTR+11         REL.DICT.0    SIZE
SECT0LNG EQU      PACKRPTR+12         SECT.0        SIZE
********                          ****
         SPACE    2
CLISWDCT EQU      SECT0LNG+1        UNUSED
HGP1PTR  EQU      SECT0LNG+2          POINTER TO NEXT HGP TABLE ENTRY
HGP1ADDR EQU      SECT0LNG+3          POINTER TO HGP TABLE BASE
LASTHGP1 EQU      SECT0LNG+4          POINTER TO BASE OF LAST HGP TABLE
********
         SPACE    2               ****
AVRFLGAD EQU      LASTHGP1+1        PTR TO AVRFLGS ADDRESS IN IOTABLE
NUMTAPES EQU      AVRFLGAD+1        # OF TAPES SPECIFIED
FEDXBYTT EQU      NUMTAPES+1        PTR TO FEDX NDX BYTE TABLES
FEXBYTT  EQU      NUMTAPES+2         PTR TO FEX NDX BYTE TABLES
FEDXHWT  EQU      NUMTAPES+3        PTR TO FEDX NDX H.W. TABLES
FEXHWT   EQU      NUMTAPES+4         PTR TO FEX NDX H.W. TABLES
FEXWT    EQU      NUMTAPES+5         PTR TO FEX NDX WORD TABLES
AVRTBLAD EQU      NUMTAPES+6           PTR TO AVR TABLE
AVRTBLSZ EQU      AVRTBLAD+1     AVRTBLNE IN LEFT HALF AND AVRTBLSIZ
*                                IN RIGHT HALF
#SWAPDEVS EQU     AVRTBLAD+2        #RADS WITH PSA
SWAPPTR   EQU     AVRTBLAD+3        PTR TO SWAPPER
SOLICIT  EQU      AVRTBLAD+4        PTR TO SOLICIT TABLE
AVRIDARA  EQU     AVRTBLAD+5        PTR TO AVRID
OCDCTVAL  EQU     AVRTBLAD+8        DCT INDEX OF OC
GETINTERPTR EQU   AVRTBLAD+9        ADDR OF INTERMEDIATE PGS
#INTPAGES  EQU    AVRTBLAD+10       #PAGES
ENDINTER EQU      AVRTBLAD+11       LAST USED ADD OF INTER.AREA
WSNAMES  EQU      AVRTBLAD+12       RB WSN NAME ENTRIES
MH2NDSK  EQU      AVRTBLAD+13          LOCATION FOR MH2NDSK ADDRESS
DKSTYPES EQU      AVRTBLAD+14       PTR TO DISK TYPE TABLE
MPCTABAD EQU      AVRTBLAD+15       PTR TO MPC TABLE ADDRESS
**********
         SPACE    2
DCN      EQU      MPCTABAD+1        DCT1 INDEX OF 1ST DC/DP/SP
BATAPE   EQU      DCN+1             INDEX INTO DCT1 OF 1ST 9T/7T
NBATAPE EQU       DCN+2             COMPLIMENT OF BATAPE
PSA%AD   EQU      NBATAPE+1         ADDR OF PSA DEF
PSA      EQU      PSA%AD+1          HI SECT# OF 1ST PSA HGP
********                          ****
         SPACE    6
LMODPLIS EQU      PSA+1             MASTER PLIST
EXPRCALL EQU      PSA+9             EXPRESSION (AND MODGEN) PLIST
HEAD     EQU      PSA+19            LOAD MODULE HEAD
TREE     EQU      PSA+31            LOAD MODULE TREE
MAX00    EQU      PSA+43            END OF SECT.00
RDEFCALL EQU      PSA+44            REF PLIST
DEFCALL  EQU      RDEFCALL          DEF PLIST
DICTCALL EQU      PSA+52            RELOCATION DICTIONARY PLIST
TREETOP  EQU      PSA+57            END OF PLISTS
********                          ****
         SPACE    2
**********
RBLIMSPTR  EQU    TREETOP+1         PTR TO RBLIMS TABLE
RBFLAGPTR  EQU    TREETOP+2         PTR TO RB:FLAG
RBBSPCPTR EQU     TREETOP+3         PTR TO RBB:SPC
RBBSFCPTR EQU     TREETOP+4         PTR TO RBB:SFC
RBBCPZPTR EQU     TREETOP+5         PTR TO RBB:CPZ
RBBLPZPTR EQU     TREETOP+6         PTR TO RBB:LPZ
RBBCRCPTR EQU     TREETOP+7         PRT TO RBB:CRC
RBDWSNPTR EQU     TREETOP+8         PTR TO RBD:WSN
DISCLIMSPTR EQU   TREETOP+9         PTR TO DISCLIMS
NCYLPTR  EQU      TREETOP+10        PTR TOO NCYL
NTPCPTR  EQU      TREETOP+11        PTR TO NTPC
NSPTPTR  EQU      TREETOP+12        PTR TO NSPT
CYLSPTR  EQU      TREETOP+13        PTR TO CYL%SHFT
TRKSPTR  EQU      TREETOP+14        PTR TO TRK%SHFT
NSPCPTR  EQU      TREETOP+15        PTR TO NSPC
SECSPTR  EQU      TREETOP+16        PTR TO SEC%SHFT
**********
         SPACE    6
MODTABPTR EQU     SECSPTR+1         POINTER TO M:MODNUM FILE
MODNUMPTR   EQU   SECSPTR+2         POINTER TO TEMP M:MODNUM
MODEL2   EQU      SECSPTR+3
CHARSAVE EQU      SECSPTR+4
REMEMBER EQU      SECSPTR+5
NOCONT   EQU      SECSPTR+6
DISCFLG  EQU      NOCONT+1
STACKEND EQU      NOCONT+5
************************************************************************
         PAGE
UBCHAN   EQU      %
CHAN     EQU      %                 MAIN ** E N T R Y **
*
* TRANSFER HEAD, TREE, MODIFY CALLS, AND PLISTS TO DYN. STORAGE
*
        BUMP     STACKEND-P2DYNEND,D4
         PUSH     7,R2
         LI,R1    STACKEND-P2DYNEND
         LI,R4    P2DYNEND
         AW,R4    R3
         LI,R2    K0
         STW,R2   *R4,R1
         BDR,R1   %-1
         STW,R2   RCHAN,R3
*
         LI,R1    LMODPLIS
         AW,R1    R3
         LI,R2    K0
         LI,R4    PLISTDAT
         LW,SR1   *R4,R2
         STW,SR1  *R1,R2
         AI,R2    K1
         CI,R2    TREETOP-LMODPLIS
         BL       %-4
*
         LI,R2    GETPGPTR+1
         BAL,R1   GETPGS            GET ONE PAGE
         LW,SR2   GETPGPTR,R3       GET LAST ADDR OF PAGE
         AI,SR2   -511
         STW,SR2  TYPMNEAD,R3
         LW,SR1   DVCTR,R3          GET #DEVICE CMNDS
         AI,SR1   TYCHEND           ADD STD #TYPMNE
         AW,SR2   SR1
         STW,SR2  TBSZPTR,R3        ALLOW TOO MUCH SPACE
         SAS,SR1  -2                /4 FOR OTHER TABLES
         AW,SR2   SR1
         STW,SR2  TBMAXPTR,R3
         AW,SR2   SR1
         STW,SR2  TBFLGSPTR,R3
         AW,SR2   SR1
         STW,SR2  TBFLGS1PTR,R3
         AW,SR2   SR1
         STW,SR2  BTXPTR,R3
         AW,SR2   SR1
         STW,SR2  OTXPTR,R3
         AW,SR2   SR1
         STW,SR2  GTXPTR,R3
         AW,SR2   SR1
         STW,SR2  TYCOUNT,R3
         SAS,SR1  1
         AW,SR2   SR1
         BAL,SR4  ENOUGHP
         STW,SR2  DCT1TEMP,R3
         LW,SR1   DVCTR,R3
         AI,SR1   1+1
         SLS,SR1  -1
         AW,SR2   SR1
         BAL,SR4  ENOUGHP
         STW,SR2  DCT4TEMP,R3
         SLS,SR1  -1
         AW,SR2   SR1
         AI,SR2   1
         SLS,SR2  -1
         SLS,SR2  1
         BAL,SR4  ENOUGHP
         STW,SR2  DCT16TEMP,R3
         LW,SR1   DVCTR,R3
         AI,SR1   1
         SLS,SR1  1
         AW,SR2   SR1
         AI,SR2   2                 ROUND UP
         STW,SR2  TPSZWID,R3
         SLS,SR1  -1                CONVERT BACK TO #WORDS
         AW,SR2   SR1
         STW,SR2  TCLSIZES,R3
         AI,SR1   2                 ROUND UP
         SLS,SR1  -2                CONVERT TO BYTES
         AW,SR2   SR1
         BAL,SR4  ENOUGHP
         STW,SR2  FDB:DCT,R3
         AW,SR2   SR1
         STW,SR2  FDB:FEX,R3
         AW,SR2   SR1
         STW,SR2  FEB:CDX,R3        ALLOW MAX OF 2 WORDS FOR FEB:CDX
         AI,SR2   1
         LI,SR4   ENDPERM
ENOUGHP  EQU      %
         CW,SR2   GETPGPTR,R3
         BLE      *SR4
         LI,R2    GETPGPTR+1
         BAL,R1   GETPGS
         B        %-4
ENDPERM  EQU      %
         STW,SR2  ENDUSED,R3        SAVE LAST USED PERM AREA+1
         LI,R2    GETINTERPTR+1
         BAL,R1   GETPGS
         LW,SR2   GETINTERPTR,R3
         AI,SR2   -511
         STW,SR2  MODTABPTR,R3
         M:OPEN   M:EI,(KEYED),(IN),;
                  (SAVE),(ERR,ABNMOD),(ABN,ABNMOD),(DIRECT)
         M:READ   M:EI,(BUF,*SR2),(SIZE,2040),(ERR,ABNMOD),(ABN,ABNMOD);
                  ,(KEY,KEY)
         M:CLOSE  M:EI,(SAVE)
         LI,R2    GETINTERPTR+1
         BAL,R1   GETPGS
         LW,SR2   GETINTERPTR,3
         AI,SR2   -511
         STW,SR2  CHANADDR,R3       START OF CHAN TABLES
         STW,SR2  CHANPTR,R3        CURRENT TABLE
         MTW,-5   CHANPTR,R3        MOVE BACK FOR FIRST CHAN
         LW,R1    CHCTR,R3          #CHAN CMNDS
         MI,R1    5                 *5 WORDS/ENTRY
         AW,SR2   R1
         STW,SR2  DEVIADDR,R3       START OF DEVICD1 TBLS
         STW,SR2  DEVICDPT,R3       CURRENT DEVICD1 TBLE
         LW,R1    DVCTR,R3          #DEVICE CMNDS
         MI,R1    DEVDCIN           # OF WORDS IN DEVICD1 AND DCIN
*                                   TABLES
         AW,SR2   R1
         AI,SR2   1
         SLS,SR2  -1
         SLS,SR2  1
         LI,R4    ALLOHAND
CHKSIZ   CW,SR2   GETINTERPTR,R3
         BLE      0,R4
         LI,R2    GETINTERPTR+1
         BAL,R1   GETPGS
         CW,SR2   GETINTERPTR,R3
         BG       %-3
         B        0,R4
ALLOHAND  STW,SR2 HANDTADR,R3
         LW,R7    DVCTR,R3
         AI,R7    1
         MI,R7    4
         AW,SR2   R7
         BAL,R4   CHKSIZ
         MTW,0    HAND2FLG,R3       IF NON-0 RHANDTAD ALLOCATION
         BEZ      %+6               IS NEEDED
         AI,SR2   1                 INSURE DW BOUND
         AND,SR2  M16X2
         STW,SR2  RHANDTAD,R3
         AW,SR2   R7
         BAL,R4   CHKSIZ
         STW,SR2  MODNUMPTR,R3
         LW,R1    DVCTR,R3
         AI,R1    4
         SLS,R1   -2
         AW,SR2   R1
         BAL,R4   CHKSIZ
         STW,SR2  DCINADDR,R3
         STW,SR2  DCINPNTR,R3
         LW,R1    DVCTR,R3
         MI,R1    DCINSZ            # OF WORDS IN DCIN TABLE
         AW,SR2   R1
         BAL,R4   CHKSIZ
         STW,SR2  DCINEND,R3
         LW,R1    DVCTR,R3
         SLS,R1   1
         AI,SR2   1
         SLS,SR2  -1
         SLS,SR2  1
         STW,SR2  WSNAMES,R3
         AW,SR2   R1
         BAL,R4   CHKSIZ
         STW,SR2  DKSTYPES,R3
         AW,SR2   DVCTR,R3
         BAL,R4   CHKSIZ
         STW,SR2  ENDINTER,R3
*
*****     SPACE NOW ALLOCATED
*****     STORE STD TYPCHARS IN TABLE
*
         LI,R1    TYCHEND
         STW,R1   TYPMNESZ,R3
         LW,SR1   TYPMNEAD,R3
         LH,R2    TYPCHARS,R1
         STH,R2   *SR1,R1
         BDR,R1   %-2
*
         PULL     7,R2
CHANCC   EQU      %
         BAL,D4   CHANNEL
         STW,D4   CHANFLG,R3        SET CHAN SUCCESS FLG
IODEFRD  EQU      %
         MTW,0    CHANFLG,R3        HERE AFTER CHAN/DEVICE CC
         BEZ      IODDEVIC          NO PREVIOUS CHAN CC
         LW,R4    CHANFLG,R3
         CI,R4    1
         BNE      TRY02             CHECK IF PREVIOUS CHAN WAS IN ERR
TRY01    EQU      %                 YES
         LI,R4    0
         STW,R4   CHANFLG,R3
         B        NXTCC
TRY02    CI,R4    2
         BE       TRY01             DEVICE CC WITH NO PREVIOUS CHAN CC
         PAGE
NXTCC    EQU      %
         BAL,R4   RDINCFCH ***      GET NEXT CC
*
UBIODEF EQU       %
         CW,R1    XDEV              DEVICE
         BE       IODDEVIC
         CW,R1    XCHAN
         BE       CHANCC            CHAN CC
*
* * * IF NONE OF THE ABOVE, END OF DEV|LABEL CARD INPUT
*
CHDVEND  LW,R2    DEVICDPT,R3       SET LAST CHAN/DEVICE CC
         LW,R1    CHANPTR,R3
         STW,R2   4,R1              COMPLETE SETTING OF CHANTBL
         B        ENDITALL
         PAGE
CHANNEL  EQU      %
* CARD FORMAT :CHAN <(DUAL,(ND0,ND0)>
*      ENTRY IN CHANTBL
*        WORD 1, BYTES 0,1 USED FOR DUAL
*        BYTE 0 - ND WITH BIT 0 SET IF N DIFFERENT
*        BYTE 1 IS THE SECOND ND
*        WORD 4
*          DEVICD1 START ADDRESS
*        WORD 5
*          DEVICD1 END ADDRESS
*
         LI,R1    0
         LI,SR2   KLPAREN
         BAL,SR4  CHARSCAN    ***
         BCS,8    CHANCR            NO KEYWORDS
         BAL,SR4  NAMSCAN     ***  GET KEYWORD
         BCS,8    CHANNG            KEY BAD
         LW,SR4   FETCHBUF,R3
         CW,SR4   XDUAL
         BE       CHANDU
         CW,SR4   NOPA              CHECK FO NOPART
         BE       NOPART
CHANNG   EQU      %
         BAL,R7   ERRBORT3   ***
         BAL,SR4  ERRBOR21    ***
CHANNG1  EQU      %
         LI,SR4   1
         STW,SR4  CHANFLG,R3        FLAG SET TO CHAN CC ERROR
         LW,R2    DEVICDPT,R3
         MTW,0    RCHAN,R3
         BEZ      DVCYNXT           NO PREV. CHAN
         LW,R1    CHANPTR,R3        SET PREV CHANTABLE ENTRY
         STW,R2   4,R1              DEVICD1 END ADD.
         B        DVCYNXT           EVEN ON ERROR
CHANCR   EQU      %
         CI,SR1   KEOB
         BE       CHANENT
         CI,SR1   KCRET
         BE       CHANENT
         CI,SR1   KNL
         BE       CHANENT
         B        CHANNG
CHANDU   EQU      %
         LW,R4    CHANPTR,R3
         AI,R4    5
         LI,SR2   KCOMMA
         BAL,SR4  CHARSCAN
         BCS,8    CHANNG
         LI,SR2   KLPAREN
         BAL,SR4  CHARSCAN
         BCS,8    CHANNG
DUSEC    EQU      %
         BAL,SR4  CHSTSCAN          'ND0'
         LW,R6    FETCHBUF,R3       GET NDD
         SLS,R6   -16               GET ND OF NDD
         STB,R6   SR4               D TO SR4
         SLS,R6   -8                JUSTIFY N
         SLS,R6   4                 POSITION
         SLS,SR4  -24               JUSTIFY D
         AI,SR4   -'0'              CONVERT D TO BIN
         BGEZ     %+3               CONVERSION DONE
         AI,SR4   '0'-'A'+10        CONVERT
         BLEZ     CHANNG            TOO SMALL
         CI,SR4   15
         BG       CHANNG            TOO BIG
         AW,R6    SR4
         STH,R6   *R4,R1         STORE NDD IN CHANTBL ENTRY
         AI,R1    1
         CI,R1    1
         BG       DUCHK
         SLS,R6   -4
         STW,R6   D1
         LI,SR2   KCOMMA
         BAL,SR4  CHARSCAN
         BCS,8    CHANNG
         B        DUSEC
DUCHK    EQU      %
         MTW,1    DUALFLG,R3        SET DUAL FLAG
         SLS,R6   -4
         CW,R6    D1                ARE N AND N THE SAME?
         BE       %+3               YES
         LW,R1    L(X'80000000')    NO
         STS,R1   *R4               SET BIT 0 TO 1
         LI,R1    CHANOK
CKDUNE   EQU      %
         LI,SR2   KRPAREN
         BAL,SR4  CHARSCAN
         BCR,8    %+3
         BAL,R7   ERRBORT3  ***
         BAL,SR4  ERRBOR2X   ***
         B        *R1
CHANOK   EQU      %
         LI,R1    CHAN1
         B        CKDUNE
CHANENT  EQU      %
         LW,R2    DEVICDPT,R3
         MTW,0    RCHAN,R3
         BEZ      CHANENT1          1ST CHAN CC
         LW,R1    CHANPTR,R3
         STW,R2   4,R1
CHANENT1 EQU      %
         MTW,5    CHANPTR,R3
         MTW,1    RCHAN,R3
         LW,R1    CHANPTR,R3        SET NEW CHANTBLE ENTRY
         STW,R2   3,R1              START DEVICD1 ADD
         B        *D4               RETURN
CHAN1    LI,SR2   KCOMMA
         BAL,SR4  CHARSCAN
         BCS,8    CHANCR
         B        CHANNEL
NOPART   LW,R4    CHANPTR,R3
         MTW,1    6,R4
         LI,SR2   KRPAREN
         BAL,SR4  CHARSCAN
         BCS,8    CHANNG
         B        CHAN1
********
         PAGE
IODDEVIC EQU      %                 DEVICE CARD PROCESSOR
         MTW,0    CHANFLG,R3
         BNEZ     IODDEVX           DEVICE CC OK, PREVIOUS CHAN CC
         BAL,R7   ERRBORT3 ***
         BAL,SR4  ERRBOR20 ***
         LI,SR4   2                 SET
         STW,SR4  CHANFLG,R3          DEVICE CC WITH NO PREVIOUS  CHAN C
         B        DVCYNXT
IODDEVX  EQU      %
* CARD FORMAT:DEVICE YYNDD<,(KEYWORD,VALUE)....>
*                                   ENTRY IN DEVICD1
*        GEN,24,8                   'NDD',PAPERSIZE
*        GEN,8,8,16                 TYPE+1,PAPERWIDTH,'N' X'DD'
*        GEN,5,3,8,16   FLAGS,FLOW,HAND INDX,'YY'
*                       FLAGS = BIT 0 DEDICATE
*                       FOR RBTS BIT1 = 1 IRBT, = 0 7670
*                                BIT2 = 1 FOR RBX, =0 RBS
*                               BIT3 = 1 FOR FULL, = 0 HALF
*                       FOR DISKS BIT1 = 1 FOR KNOWN DEVICES
*                                             = 0 FOR NEW
*                    BIT2 = 0 MOVEABLE
*                          = 1 FIXED HEAD
*        GEN,8,8,8,8                NEW FLAGS, WSN NDX/DEVICE NDX+1 FOR
*                                   NON-STAND/0,MOD # NDX,DISCLIMS NDX/
*                                   CC & DD FLAGS
*                           FLAGS=L,T,D,PUB,BIN,R,COMP,VFC
*        GEN,8,8,8,8                MXREC,MREC,MORFLGS,CLIST
*                                MORFLGS = 1 IF RHANDLER SPECIFIED
*        GEN,8,8,16                 FEDX,FEX,INT
*        GEN,16,1,1,6,8             DEVICD DISP,CYL,PRIV,TYPE,NGC->FLINK
*        GEN,16,16                  SS,NSPT
*        GEN,16,8,8                 SIZE,CYLS,TRKS
*        GEN,8,8,16                 SECS,0,NCYL
*        GEN,8,8,16                 0,NTPC,PSA
*        GEN,16,16                  PFA,PER
*
* * * R7 IS DEVOTED TO PLIST ADDRESS FOR SCAN ROUTINES (EXCEPT ABORT)
* *  SR1 IS DEVOTED TO CCHAR IMAGE OR ZERO (IF READY TO MOVE ON)
*
         LI,SR1   K0
         BAL,SR4  NAMSCAN
         BCS,8    IODDEV02          BR,IF UNSUCCESS
         LW,R1    FETCHBUF,R3       GET 1ST 4BYTES (LEFT JUSTIFIED)
         LW,R2    FETCHCSL,R3        NO. BYTES
         CI,R2    K5                5 BYTES YYNDD AND 1DELIM ,
         BE       IODDEV03          YYNDD=5 BYTES,READ SUCCESSFULLY
IODDEV02 EQU      %
         BAL,R7   ERRBRT3           OTHERWISE, ERROR
         B        DVCYNXT           TRY ANOTHER CARD
IODDEV03 LW,R2    TYPMNESZ,R3       SIZE
         LW,D4    TYPMNEAD,R3       ADDRESS
         LH,D3    R1                GET ONLY 1ST 2 BYTES
         CH,D3    YD5D6
         BNE      IODDEV3A          CANNOT BE 'NO' TYPMNE YY
IODDEV3X EQU      %
         BAL,R7   ERRBORT3
         BAL,SR4  ERRBOR18
         B        DVCYNXT
IODDEV3A EQU      %
         CH,D3    YD4E3             CANNOT BE 'MT' TYPMNE YY
         BE       IODDEV3X
         CH,D3    YE2D7             IS IT SP
         BE       IODDEV3X          YES,ILLEGAL TO DEFINE
*                                   SP AS DEVICE THO IN TYPMNE TBLE
         CH,D3   *D4,R2             COMPARE WITH TYPMNE
         BE       TYPFOUND          THROUGHOUT
         BDR,R2   %-2
*                                   NOT FOUND--NEW ENTRY FOR TYPMNE
         MTW,1    TYPMNESZ,R3
         LW,R2    TYPMNESZ,R3
         STH,D3   *D4,R2            INSERT NEW TYPMNE
TYPFOUND EQU      %
         LW,D1    R2                GET TYPE INDEX
*
         SLS,R1   16                LEFT JUSTIFY CHANNEL DESIGNATOR
         LB,D2    R1
         B        AOK
POSBAD   EQU      %
         CI,R4    2
         BNE      PROBBAD
         LI,R4    0                 THIS IS PROBABLY AN FECP DEVICE
         SLS,D1   -8                ARBITRARILY CHANGE CHAN & UNIT
         LI,D2    X'C11E'           LETS ASSUME THIS FOR NOW.
         SLS,D2   16
         SLD,D1   16
         B        AOK2A
PROBBAD  EQU      %
         BAL,R7   ERRBRT3
         LW,D2    FETCHBUF,R3                                           897
         STW,D2   MSG13+5                                               897
         LW,D2    FETCHBUF+1,R3                                         897
         LB,D2    D2
         STB,D2   MSG13+6
         MTB,-7   MSG13
         BAL,SR4  ERBOR13A                                              897
         MTB,7    MSG13
         B        DVCYNXT           NEXT CARD
AOK      EQU      %                                                     897
         SLS,D1   8
         CH,D3    YD9C2             IS IT RBT
         BNE      %+2
         MTW,1    #RBTS,R3          KEEP COUNT OF RBTS
         OR,D1    X84               2ND BYTE = PAPER WIDTH = 132
         SLS,D1   8
         OR,D1    D2
         SLS,R1   8
         LW,SR3   FETCHBUF+1,R3
         SLS,SR3  -8
         OR,SR3   R1
         LI,R4    K2
         LI,SR4   K0
GETDD    OR,SR4   YFF               GET BOTH DIGITS (EACH MUST BE 0-F)
         CS,SR3   YF
         BGE      AOK2           IF 0-9 OR
         AW,SR3   Y39               A-F  O.K. OTHERWISE IT'S N.G.
         CS,SR3   YF                                                    897
         BL       POSBAD            MAY BE A VALID FECP UNIT #
AOK2     EQU      %                                                     897
         SLS,SR3  4
         SCD,SR3  4
         BDR,R4   GETDD             R4 = ZERO
         STB,SR4  D2
         SLD,D1   8                 COMBINE WITH PREVIOUS
AOK2A    LW,D2    DEVICDPT,R3       CLEAR DEVICDC1 AND DCIN PORTIONS
         LI,R2    DEVDCIN-1
         STW,R4   *D2,R2
         BDR,R2   %-1
         STW,R4   *D2
*
         PUSH     D3
         LW,D3    FETCHBUF,R3
         LW,D4    FETCHBUF+1,R3
         SLD,D3   8                 PUT TEXT
         SLS,D3   8                   NDD IN DEVICD1 TABLE
         AI,D3    38                PAPER SIZE DEFAULT = 38
         STW,D3   *D2               STORE INTO DEVICD1(0)
         PULL     D3
         AI,D2    K1
         STW,D1   *D2               STORE INTO DEVICD1 (1)
         AI,D2    1
         AND,D3   M16
         STW,D3   *D2               PUT AWAY YY
         AI,D2    1
         CI,D3    'LP'
         BNE      NOLISTDV
LISTDV   EQU      %
         LW,D4    =X'80000000'
         STW,D4   *D2               SET LISTING TYPE IN NEWFLGS
NOLISTDV EQU      %
         LW,D2    DEVICDPT,R3
         AI,D2    DEVICDSZ          D2 PTS TO START OF DCINTBL AREA
         LB,R2    D1                GET TYPMNE INDEX
         CI,R2    X'C'
         BE       CLSTCHK
         LW,D4    TYCOUNT,R3
         MTH,1    *D4,R2
         CI,D3    'TY'              IS IT TY
         BNE      %+5
         MTW,0    OCDCTVAL,R3       YES,HAS ANY BEEN FOUND
         BNEZ     %+3               YES
         STW,R2   OCDCTVAL,R3       NO, SAVE AS OC INDEX
         MTW,-1   OCDCTVAL,R3
CLSTCHK  EQU      %
         LW,D4    CLISTDAT          GET STD DEFAULT FOR CLIST
         CI,R2    TYCHEND           WITHIN RANGE
         BG       %+2               NO
         LW,D4    CLISTDAT,R2       YES GET SIZE OF CLIST
         LW,D1    DEVICDPT,R3       GET CURRENT DEVICD1
         LI,R4    CLSTBYT
         STB,D4   *D1,R4            STORE CLIST VALUE IN
*                                   DEVICD1 MAY BE OVERRIDDEN
         LW,D4    DEVICDPT,R3       RESTORE DEVICD1 PTR
         CI,R2    X'C'              IS IT DISK TYPE
         BNE      %+3               NO
         LI,R4    13
         STB,R2   *D1,R4            SET TYPE IN EXTRA BYTE
         SW,D1    DEVIADDR,R3
         SLS,D1   16                STORE DEVICD1 DISP INTO
         STW,D1   *D2               WHAT'S TO BECOME START OF DCINTBL
         LW,D2    DEVICDPT,R3       BACK TO START
****
*  MOVE DEFAULT HANDLER NAMES TO HANDLER TABLE
****
        LW,SR2   HANDTADR,R3        HANDLER TABLE ADDR.(DEFAULT)
       MTW,1    *SR2               # ENTRIES IN HANDLER NAME TABLE
        LW,R4    *SR2               GET HANDLER NAME TABLE INDEX
HAND1   EQU      %
         LI,R2    HANDNDX           DISP TO HAND. NDX BYTE IN DEVVICD1
       STB,R4   *D2,R2             SET INDEX INTO DEVCD1 TABLE
         LI,R2    DEVNDX            GET TYPMNE
       LB,R1    *D2,R2               INDEX
       CI,R1    TYCHEND            MUST BE STANDARD
       BG       DEVOPTPA           NOT--IF DEFAULT IS USED
       SLS,R4   2
       AW,SR2   R4                 AREA IN HANDLER NAME TABLE
         AI,R1    -1
       SLS,R1   2                  AREA IN DEFAULT HANDLER NAME TABLE
        AI,R1    HANDNAME
       LD,SR3   *R1                MOVE DEFALUT
       STD,SR3  *SR2                 NAME TO HANDLER TABLE
         CW,SR3   7TAP
         BNE      %+2
         STW,SR3  7TAPFL
       AI,SR2   2
         AI,R1    2
         LD,SR3   *R1
       STD,SR3  *SR2
         PAGE
DEVOPTPA EQU      %
DEVOPTQA LI,SR2   KCOMMA            START IN HERE FOR CURRENT CHAR.
         BAL,SR4  CHARSCAN
         BCR,8    DEVOPTPB          BR.IF FOUND COMMA
         BAL,SR4  DVCDFINI          END CHECK
         CI,SR1   KLPAREN           DON'T LOOSE OPTION
         BNE      %+3               IF THERE IS NO COMMA
         BAL,R7   ERRBRT3           BETWEEN THEM
         B        DEVOPTPB
         LI,SR1   K0                                                    897
         B        DEVOPTPA           TRY AGAIN
DEVOPTPB EQU      %
         LI,SR2   KLPAREN             LEFT PAREN
         BAL,SR4  CHARSCAN
         BCR,8    DEVOPTNA            BR.IF YES
DEVOPTPC BAL,SR4  DVCDFINI            NO FOLLOWING OPTION--CK.EOB, ERROR
         BAL,R7   ERRBRT3
         LI,SR1   K0                                                    897
         B        DEVOPTPB
DEVOPTNA EQU      %
         BAL,SR4  CHSTSCAN          CH.STRING FOR OPTION NAME
         BCR,8    %+2
         BAL,R7   ERRBRT3
         LW,R1    FETCHBUF,R3       GET 1ST 4BYTES
         LW,D2    DEVICDPT,R3
         AI,D2    2
         LW,D3    *D2
         AND,D3   M16
         CW,R1    MODE
         BE       MODEL
         CW,R1    NOPA
         BNE      REGUL
         LW,D2    DEVICDPT,R3
         LI,R2    FLAGS/4
         LW,R1    NOPABIT
         STS,R1   *D2,2
         B        RPRENDPA
REGUL    EQU      %
         CI,D3    'RB'              IS IT REMOTE BATCH
         BE       TRYMOD            YES
*********
TRYPRIV  EQU      %
         CW,R1    XPRIV
         BNE      TRYCYL
         LI,SR4   PRIVBIT|CYLBIT    SET FLAG
PRIVCYLEND EQU    %
         LI,R2    DEVICDSZ
         STS,SR4  *D4,R2
         B        RPRENDPA
TRYCYL   EQU      %
         CW,R1    XCYLI
         BNE      TRYSIZE
         LI,SR4   CYLBIT
         LI,2     DEVICDSZ
         STS,SR4  *D4,R2            SET CYLIN BIT
         LI,R2    TNGCD             MAY HAVE OPTIONAL NGC
         B        DEVOPVAL
*********
TRYSIZE  CW,R1    XSIZE
         BNE      TRYNSPT
         LI,R2    SIZED*2+BYTDISP+1   DISP TO 2ND BYTE OF SIZE SLOT
         B        DEVOPVAL
TRYTYPE  EQU      %
         LW,R1    MODEL2,R3
         LW,SR3   DKSTYPES,R3
         LW,R2    *SR3
         BEZ      ADDIT
         CW,R1    *SR3,R2
         BE       STODL
         BDR,R2   %-2
ADDIT    MTW,1    *SR3
         LW,R2    *SR3
         STW,R1   *SR3,R2           STORE MODEL #
STODL    LI,R4    15
         STB,R2   *D4,R4            SET UP DISK TYPE ENTRY
*                                   ((DISCLIMS NDX WORD 3 OF DEVICD1 TBL
         LI,R2    #DCDPCM
         CW,R1    DCDPCM-1,R2       SEE IF SPECIAL DC,DP, OR DP TYPE
         BE       %+3
         BDR,R2   %-2
         B        MODELDONE
         CI,R2    DPAKTYP           IS IT AMONGST PACK GROUP IN
*                                   DCDPCM TABLE
         BGE      %+3               YES
         LW,SR4   =X'20000000'      SET FIXED HEAD BIT
         B        SETKNOWN
         LI,R1    4
         LB,SR4   *D4,R1            GET TRUE TYPE BYTE
         CI,SR4   X'D'              ALREADY DUMMY
         BLE      CLDEF
         LI,R4    13
         STB,SR4  *D4,R4            STORE TRUE NDX+1 IN DEVICD1(3)
         LI,SR4   X'D'              THIS IS A DUMMY NDX+1
         STB,SR4  *D4,R1            STORE DUMMY INTO DEVICD1(1)
         LI,R1    3
         LW,SR4   =X'20000000'      SET D BIT
         STS,SR4  *D4,R1
CLDEF    EQU      %
         LI,R1    CLSTBYT
         LB,SR4   *D4,R1            GET CLIST VALUE
         CI,SR4   6
         BNE      SETKNOWN-1        NOT DEFAULT LEAVE AS IS
         MTB,2    *D4,R1            CHANGE CLIST TO THE VALUE 8
         LI,SR4   0
SETKNOWN EQU      %
         OR,SR4   =X'40000000'
         LI,R1    2                 SET BIT 1 = 1
         STS,SR4  *D4,R1            FOR KNOWN DEVICE
         LD,SR3   DEFAULTS-2,R2
         LI,R1    SSD/2+DEVICDSZ    DISP TO SS WORD IN DEVICD1
         AW,D4    R1
         LI,R5    X'FFFF'
         LW,R4    *D4               SEE IF USER ALREADY GAVE NSPT
         CH,R4    DFBYTES           BY CHECKING AGAINST ZERO
         BNE      LFTHLF            BRANCH IF SO
         LS,R4    SR3            NO. THEN DEFAULT NSPT.
LFTHLF   SLS,R5   16
         MTH,0    *D4               SEE IF USER ALREADY GAVE SS
         BNE      NXTOPT
         LS,R4    SR3               NO. THEN DEFAULT SS.
         STW,R4   *D4
NXTOPT   AI,D4    1                 SEE IF USER ALREADY GAVE SIZE
         MTH,0    *D4
         BNEZ     %+3
         LS,R4    SR4               NO. THEN DEFAULT SIZE
         STS,R4   *D4
         AI,D4    -2                MOVE BACK TO WORD (1) PORTION
*                                   OF DCIN TABLE AREA
         LB,R5    R5                SET R5 TO MASK FOR BYTE
         LW,R4    *D4
         CB,R4    DFBYTES           SEE IF USER ALREADY GAVE CYLIN SIZE
         BNE      %+2
         LS,R4    SR4               NO. THEN DEFAULT NGC
         LW,R5    =X'3F00'          SET R5 TO MASK TO DISK TYPE
         LS,R4    SR4
         STW,R4   *D4               RE-STORE WORD (1) OF DCIN PORTION
         LW,R5    R3                RESET R5 TO INITIAL STATUS
         AI,D4    -DEVICDSZ         SET D4 TO PT. TO BEGIN OF DEVCD1
*                                   TABLE ENTRY
         LI,R1    CYLSD+BYTDISP     DISP TO CYLS BYTE IN DEVICD1
         LW,SR3   DFBYTES,R2        DEFAULT  THE CYLS,
         STB,SR3  *D4,R1            TRKS,SECS
         AI,R1    1
         SLS,SR3  -8
         STB,SR3  *D4,R1
         AI,R1    1
         SLS,SR3  -8
         STB,SR3  *D4,R1
         LI,R1    NCYLD+DEVICDSZ*2  PTR TO NCYL H.W. IN DEVICD1
         LW,SR3   DFHLFS,R2
         STH,SR3  *D4,R1
         AI,R1    1
         SLS,SR3  -16
         STH,SR3  *D4,R1
         LI,SR4   DCIND+4
         CI,R2    DPAKTYP
         BL       CHKHAND
         CI,R2    DPAKTYP+1         IT'S A PACK. IS IT A 7261,7275,
*                                   3275 OR 3282? IF SO CHANGE DPAK
*                                   HANDLER TO DISKAB
*                                   IS IT AN MPC DP, IF SO CHANGE
*                                   HANDLER NAME TO MPCDIO
         BG       CHK4DPS
         LI,SR4   DPIND+4
CHKHAND  LW,SR2   HANDTADR,R3
         LI,R2    HANDNDX           DISP TO HAND. NDX BYTE IN DEVVICD1
         LB,R2    *D4,R2
         SLS,R2   2
         AW,SR2   R2
         LB,R4    *SR2
         BNE      MODELDONE
HANDSIN  LI,R4    -4
         AI,SR2   4
         LW,R2    *SR4,R4
         STW,R2   *SR2,R4
         BIR,R4   %-2
         B        MODELDONE
CHK4DPS  CI,R2    #DCDPCM           IS IT AN MPC DP? NOTE MPC DP IS
         BNE      OTHERS            ASSUMED TO BE LAST ONE IN GROUP OF
*                                   STANDARD PACKS
         LI,R1    DEVUNNDX          NEED TO LOOK AT LOW ORDER D IN DD
         LB,SR4   *D4,R1            OF DEVICE UNIT NUMBER
         SCS,SR4  -4                TO SEE IF IT'S A ZERO
         MTB,0    SR4
         BNEZ     NYMPCHD2          BRANCH IF IT IS NON-ZERO
         LI,D3    ERR4MPCU          PUT OUT A WARNING MESSAGE
         BAL,SR4  LOGIT
NYMPCHD2 EQU      %
         LI,R1    MORFLGS           GET BYTE DISP OF MORFLGS IN DEVICD1
         LB,SR4   *D4,R1            GET CONTENTS OF MORFLGS
         EOR,SR4  X80               SET BIT 0 OF BYTE
         STB,SR4  *D4,R1            STORE BACK INTO MORFLGS BYTE
*
*                                        CONTENTS OF P2OVLOP1
*
*                                     MPC                      MPC
*                                     DP                       MT
         LW,R4    Y01               ********************************
         OR,R4    P2OVLOP1,R3       *       *       *       *      *
         STW,R4   P2OVLOP1,R3       *  01   *       *       *  XX  *
*                                   *       *       *       *      *
*                                   ********************************
         LI,R1    CLSTBYT           DISP TO CLIST BYTE IN DEVICD1 TBL
         LI,SR4   18
         STB,SR4  *D4,R1            18 IS DEFAULT VALUE FOR MPC DP
         LI,SR4   MPCHAND+4         YES IT'S AN MPC DP
         B        %+2               MAKE HANDLER MPCDIO/MPCDCUOTHER-
OTHERS   LI,SR4   DISHAND+4         WISE MAKE HANDLER DISKAB/DISKABCU
         LI,R1    -5
         EXU      CHKHAND+5,R1
         BIR,R1   %-1
         B        HANDSIN
MODEL    STW,R1   MODGIVEN           SET FLAG INDICATING MOD # SPECIFIED
MODELA   LI,SR2   KCOMMA
         BAL,SR4  CHARSCAN
         BCS,8    RONGMODC
         BAL,SR4  CHSTSCAN
         BCS,8    ABORT
         LW,R1    FETCHCSL,R3
         CI,R1    1
         BNE      NOTDISC
         LW,R1    FETCHBUF,R3
         STW,R1   REMEMBER,R3
         MTW,1    DISCFLG,R3
         B        MODELA
NOTDISC  LW,1     FETCHBUF,R3
         STW,1    MODEL2,R3
         SAS,R1   -16               NEED TO KNOW IF IT'S A 93XX DEVICE
         CH,R1    MPCOVNMT+1        IF SO, IT'S AN MPC TAPE TYPE
         BNE      CHKCOMMA          IF NOT SKIP THE FOLLOWING
         LI,R1    DEVUNNDX          NEED TO LOOK AT LOW ORDER D IN DD
         LB,SR4   *D4,R1            OF DEVICE UNIT NUMBER
         SCS,SR4  -4                TO SEE IF IT'S A ZERO
         MTB,0    SR4
         BNEZ     NONZDD            BRANCH IF IT IS NON-ZERO
         LI,D3    ERR4MPCU          PUT OUT A WARNING MESSAGE
         BAL,SR4  LOGIT
NONZDD   LI,R1    1
*                                         CONTENTS OF P2OVLOP1
*                                      MPC                    MPC
*                                      DP                     MT
*
*                                   ********************************
*                                   *      *       *       *       *
*                                   *  XX  *  00   *  00   *  01   *
*                                   *      *       *       *       *
*                                   ********************************
*
         OR,R1    P2OVLOP1,R3       SET MPC TAPE FLAG
         STW,R1   P2OVLOP1,R3
         LI,R1    MORFLGS           BYTE LOCATION FOR MPC FLAG IN
         LB,D2    *D4,R1            DEVICD1 TABLE POINTED TO BY D4
         OR,D2    X80               SET ZEROTH BIT OF MORFLGS BYTE
         STB,D2   *D4,R1            INDICATING THIS IS AN MPC DEVICE
         LI,R1    CCDDBYT           BYTE LOCATION FOR DD FLAG IN
         LB,D2    *D4,R1
         OR,D2    X80               SET DD FLAG BIT IN DEVICD1 BYTE
         STB,D2   *D4,R1
         LI,R1    FLAGS             BYTE LOCATION FOR I/O FLAGS IN
         LB,D2    *D4,R1            DEVICED1 DEVICE TABLE
         OR,D2    X3                SET INOUT FLAGS
         STB,D2   *D4,R1            AND STORE BACK IN DEVICD1 TABLE
         LI,R1    NEWFLGS           BYTE LOCATION FOR REMOVE & T FLAGS
         LB,D2    *D4,R1
         OR,D2    X44               SETTING FOR REMOVE & T FLAGS IN
         STB,D2   *D4,R1            DEVICED1 TABLE.
         LI,R1    CLSTBYT           BYTE LOCATION FOR CLIST DATA IN
         LI,D2    18                CLIST SIZE FOR MPC TAPES IS 18
         STB,D2   *D4,R1            GOES INTO DEVICED1 TABLE
CHKCOMMA LI,SR2   KCOMMA
         BAL,SR4  CHARSCAN
         BCR,8    %+5
         STW,8    CHARSAVE,R3
         LI,1     0
         STW,1    NOCONT,R3
         B        FIND
         BAL,SR4  CHSTSCAN
         BCS,8    ABORT
         STW,8    CHARSAVE,R3
         LW,1     FETCHBUF,R3
         STW,1    NOCONT,R3
FIND     LW,R1    MODTABPTR,R3
         LW,R2    *R1
         BEZ      ABORT
         LD,8     *R1,R2            GET DEV/MOD
         CW,8     MODEL2,R3         MOD RIGHT
         BNE      LOOPIT
         MTW,0    NOCONT,R3         WAS A CONT SPECIFIED
         BNE      FIND1
         STW,SR2  NOCONT,R3         NO - USE THE ONE IN M:MODNUM FILE
         B        %+3
FIND1    CW,9     NOCONT,R3         YES
         BNE      LOOPIT            ISNT THIS ONE
         LW,D1    DEVICDPT,R3
         LI,R1    MOD#NDX           DISP TO MOD# BYTE IN DEVICD1
         STB,R2   *D1,R1            SAVE THE INDEX
         MTW,0    DISCFLG,R3
         BE       MODELDONE
         LW,R1    REMEMBER,R3       RESTORE TYPE
         B        TRYD
LOOPIT   BDR,R2   FIND+3
         LW,SR1   TXTFFFF           IF CONTROLLER OR MOD. # DO NOT
         STW,SR1  MODEL2,R3          MATCH THE MODNUM FILE,
         STW,SR1  NOCONT,R3         SET BOTH OF THEM TO 'FFFF'
BADMOD#  BAL,SR4  OUTLLERR          PRINT WARNING
         LI,SR4   FIND
         LI,D3    MOD#MSG
         B        LOGIT+1
RONGMODC CI,SR1   ')'
         BNE      SYNTAXER
         LW,SR1   TXTFFFF
         STW,SR1  MODEL2,R3         SET A NON-EXISTANT MODEL AND
         STW,SR1  NOCONT,R3         CONTROLLER # TO FFFF
         B        BADMOD#
MODELDONE LI,SR1  0
         STW,SR1  DISCFLG,R3
         LW,SR1   CHARSAVE,R3
         B        RPRENDPA
         PAGE
*                 THIS ROUTINE CONVERTS EBCDIC MODEL AND CONTROLLER
*                 NUMBERS INTO HEX EQUIVALENTS.
CONVERT  LCI      9
         PSM,R1   *0
         LI,R3    2
         LW,R1    SR3
         B        %+3
CONVERT1 STW,R6   SR3
         LW,R1    SR4
         LI,R6    0
         LI,R7    4
         LI,R2    0
CONVERT2 LB,SR2   1,2
         LI,R4    15
         CB,SR2   DIGITS,R4
         BE       %+4
         BDR,R4   %-2
         CB,SR2   DIGITS
         BNE      ABORT+1
         SLS,R6   4
         AW,R6    4
         AI,R2    1
         BDR,R7   CONVERT2
         BDR,R3   CONVERT1
         STW,R6   SR4
         LCI      9
         PLM,R1   *0
         B        STRIT
DIGITS   TEXT     '0123456789ABCDEF'
         PAGE
TRYNSPT  CW,R1    XNSPT
         BNE      TRYNCYL
         LI,R2    NSPTD*2+BYTDISP+1
         B        DEVOPVAL
TRYNCYL  CW,R1    XNCYL
         BNE      TRYNTPC
         LI,R2    NCYLD*2+BYTDISP+1
         B        DEVOPVAL
TRYNTPC  CW,R1    XNTPC
         BNE      TRYCYLS
         LI,R2    NTPCD*2+BYTDISP+1
         B        DEVOPVAL
TRYCYLS  CW,R1    XCYLS
         BNE      TRYTRKS
         LI,R2    CYLSD+BYTDISP
         B        DEVOPVAL
TRYTRKS  CW,R1    XTRKS
         BNE      TRYSECS
         LI,R2    TRKSD+BYTDISP
         B        DEVOPVAL
TRYSECS  CW,R1    XSECS
         BNE      TRYFIX
         LI,R2    SECSD+BYTDISP
         B        DEVOPVAL
TRYFIX   CW,R1    XFIXE
         BNE      TRYMOVE
         LW,SR4   =X'00000700'      SET UP TYPE AS 7
         LI,R2    DEVICDSZ
         STS,SR4  *D4,R2
         LI,R2    FLAGS/4
         LW,SR4   =X'20000000'
         STS,SR4  *D4,R2
         B        RPRENDPA
TRYMOVE  CW,R1    XMOVE
         BNE      TRYSS
         LW,SR4   =X'00000B00'
         LI,R2    DEVICDSZ
         STS,SR4  *D4,R2
         B        RPRENDPA
TRYSS    CW,R1    XSS
         BNE      TRYPER
         LI,R2    SSD*2+BYTDISP+1
         B        DEVOPVAL
TRYPER   CW,R1    XPER
         BNE      TRYPFA
         LI,R2    PERD*2+BYTDISP+1
         B        DEVOPVAL
TRYPFA   CW,R1    XPFA
         BNE      TRYPSA
         LI,R2    PFAD*2+BYTDISP+1
         B        DEVOPVAL
TRYPSA   CW,R1    XPSA
         BNE      TRYHANDL
         LI,R2    PSAD*2+BYTDISP+1
         B        DEVOPVAL
TRYMOD   EQU      %                 FOLLOWING FOR RBTS ONLY
         CW,R1    X7670             DEFAULT FOR RBTS
         BE       RPRENDPA
         CW,R1    XIRBT
         BE       IRBINFO
         CW,R1    X2780             IS IT A 2780 RBT
         BNE      TRYMOD1
TRYMOD2  EQU      %
         LW,SR2   Y04               SET BIT 5 IN FLAGS FOR A 2780
         B        GTHANDIN
TRYMOD1  EQU      %
         CW,R1    X3780
         BNE      TRYRBS
         LI,SR2   Y02
         STS,SR2  RBTTYP
         B        TRYMOD2
IRBINFO  LW,SR2   Y4                SET BIT 1 OF FLAG/DEVICD1 ENTRY
GTHANDIN LI,R2    FLAGS/4
         STS,SR2  *D4,R2
         STS,SR2  RBTTYP            SET TEMP FLAG WORD WHEN IRBT/2780
         LI,R1    HANDNDX           DISP TO HAND. NDX BYTE IN DEVICD1
         LB,R2    *D4,R1
         SLS,R2   2                 GET HAND INDEX
         LW,R1    HANDTADR,R3
         AW,R1    R2
         LI,SR3   HASPHAND
         CW,SR2   Y04               IF SO GET 2780 HANDLERS
         BAZ      %+2
         AI,SR3   K4
         LCI      4
         LM,SR3   *SR3              GO GET HAND1 AND HAND2 NAMES
         STM,SR3  *R1
         B        RPRENDPA
TRYRBS   CW,R1    XRBS
         BE       RPRENDPA          DEFAULT
         CW,R1    XRBX
         BNE      TRYWSN
         LI,R2    FLAGS/4
         LW,SR2   Y2                SET BIT 2 TO 1
         STS,SR2  *D4,R2            FOR RBX
         B        RPRENDPA
TRYWSN   CW,R1    XWSN
         BNE      TRYHANDL
         LI,SR2   KCOMMA
         BAL,SR4  CHARSCAN
         BCR,8    STORWSN
         BAL,R7   ERRBORT3
         B        RPRENDPA
STORWSN  BAL,SR4  CHSTSCAN          GET CHAR STRING
         BCR,8    %+3
         BAL,R7   ERRBORT3
         B        RPRENDPA
         LW,R2    FETCHCSL,R3
         CI,R2    8
         BLE      %+3
         BAL,R7   ERRBRT3
         LI,R2    8
         LW,R1    WSNAMES,R3
         MTW,1    *R1
         LW,SR2   *R1
         LI,R4    DEVTYNDX          DISP TO WSN NDX IN DEVICD1 TABLE
         STB,SR2  *D4,R4            SET WSN INDEX IN BYTE
         SLS,SR2  1
         AW,R1    SR2               AREA IN WSN FOR GIVEN ENTRY
         LW,D1    BLANK
         STW,D1   0,R1              BLANK OUT AREA
         STW,D1   1,R1
         LI,D1    FETCHBUF          GET BUFFER AREA
         AW,D1    R3
         AI,R2    -1
         LB,D2    *D1,R2
         STB,D2   *R1,R2
         BDR,R2   %-2
         LB,D2    *D1               TRANSFER 1ST BYTE
         STB,D2   *R1
         B        RPRENDPA
TRYHANDL CW,R1    XHANDLER
         BNE      TRYRHAND
         LW,R1    HANDTADR,R3       PT TO HANDLER TABLE
         LI,R4    0
         LI,SR2   KCOMMA
         BAL,SR4  CHARSCAN ***
         BCR,8    STORHAND
         BAL,R7   ERRBORT3 ***
SYNTAXER BAL,SR4  ERRBOR21  ***
         B        RPRENDPA
STORHAND EQU      %
         LW,R2    DEVICDPT,R3       ACTUAL ADDRESS NOW FOR DEVICE TABLE
         LI,R6    HANDNDX           DISP TO HAND. NDX BYTE IN DEVICD1
         LB,R2    *R2,R6            GET HANDLER NAME INDEX
         SLS,R2   2                 (2 HANDLER ENTRY POINTS = 4 WORDS)
         AW,R1    R2                R1 NOW PTS TO FIRST ENTRY PT SLOT
STRHANDA BAL,SR4  NAMSCAN           GET HANDLER NAME
         BCR,8    %+2               BRANCH IF O.K.
         BAL,R7   ERRBRT3
         AW,R1    R4                FOR ENTRY NAME1 OR NAME2
         LW,R2    FETCHCSL,R3       NO.CHARS.READ
         CI,R2    7
         BLE      %+3
         BAL,R7   ERRBRT3
         LI,R2    7
         LI,D1    FETCHBUF
         AW,D1    R3
         LW,D2    BLANK
         STW,D2   0,R1
         STW,D2   1,R1
         STB,R2   *R1               STORE COUNT FOR CHAR. STRING
STORHAN1 AI,R2    KN1
         LB,D2    *D1,R2            FROM FETCH BUFFER BYTE
         AI,R2    K1
         STB,D2   *R1,R2            TO HANDTABL,R3 BYTE + 1
         BDR,R2   STORHAN1
         CI,R4    0
         BNE      RPRENDPA          DONE WITH HANDLER NAME1/NAME2
         LI,R4    2                 NAME2 IS LEFT
         LI,SR2   KCOMMA
         BAL,SR4  CHARSCAN ***
         BCR,8    STRHANDA          GO GET NAME2
         BAL,R7   ERRBRT3
         LW,R1    DEVICDPT,R3
         B        DVCYCOUT
TRYRHAND CW,R1    XRHANDLER         IS IT A HANDLER THAT IS TO GO
         BNE      TRYFLOW           INTO THE MONITOR ROOT?
         LW,R4    HANDTADR,R3
         LW,R1    RHANDTAD,R3
         BEZ      TRYHANDL+2        IGNORE IF NO :HANDLERS2 CC
         MTW,1    *R1               INCREMENT RHANDLER COUNT
         MTW,-1   *R4               DECREMENT HANDLER COUNT
         LW,R4    *R1               RHANDLER INDEX
         LI,R6    HANDNDX           DISP TO HAND. NDX BYTE IN DEVICD1
         LW,R2    DEVICDPT,R3
         STB,R4   *R2,R6            STORE IN HANDLER INDEX SLOT IN
         LI,R6    MORFLGS
         LI,R4    1
         OR,R4    *R2,R6            SET FLAG INDICATING THAT THE
         STB,R4   *R2,R6            HANDLER INDEX IS NDX INTO RHANDTAD
         LI,SR2   KCOMMA
         LI,R4    0
         B        TRYHANDL+3
TRYFLOW  EQU      %
         LI,R2    FLAGS/4           POINT TO DEVICD1 WORD CONTAINING FLAS
         CW,R1    XINPUT
         BNE      TRYOUTPU
         LW,SR2   Y01               GET SET TO STORE 'IN' BIT IN FLAGS BYTE
         STS,SR2  *D4,R2            D4 POINTS TO DEVICD1 ENTRY
         B        RPRENDPA
TRYOUTPU CW,R1    XOUTPUT
         BNE      TRYIO
         LW,SR2   Y02               GET SET TO STORE 'OUT' BIT IN FLAGS BYTE
         STS,SR2  *D4,R2            IN DEVICD1 ENTRY
         B        RPRENDPA
TRYIO    CW,R1    XIO
         BNE      TRYDUP
         LW,SR2   Y03               GET SET TO STORE 'IN' AND 'OUT' BITS
         STS,SR2  *D4,R2            IN FLAGS BYTE
         B        RPRENDPA
TRYDUP   EQU      %
         CW,R1    XHALF
         BE       RPRENDPA
         CW,R1    XFULL
         BNE      TRYPAPER
         LI,R2    FLAGS/4
         LW,SR2   Y1
         STS,SR2  *D4,R2
         B        RPRENDPA
TRYPAPER LI,R2    PAPRSZ
         CW,R1    XPAPER
         BNE      TRYCLIST
         B        DEVOPVAL
TRYPWIDT LI,R2    PAPRWD
         B        DEVOPVAL
TRYCLIST CW,R1    XCLIST
         BNE      TRYMXREC
         LI,R2    CLSTBYT
         B        DEVOPVAL
TRYMXREC CW,R1    XMXREC
         BNE      TRYMREC
         LI,R2    MXREC
         B        DEVOPVAL
TRYMREC CW,R1     XMREC
         BNE      TRYCOMP
         LI,R2    MXREC+1
         B        DEVOPVAL
TRYCOMP  LI,R2    NEWFLGS/4
         CW,R1    XCOMP
         BNE      TRYL
         LW,SR2   =X'02000000'
         STS,SR2  *D4,R2
         B        RPRENDPA
TRYL     CW,R1    XL
         BNE      TRYT
         LW,SR2   =X'80000000'
         STS,SR2  *D4,R2
         LI,R2    DEVNDX
         LB,R2    *D4,R2            GET TYPE INDEX
         LW,SR2   TYCOUNT,R3        KEEP COUNT OF TYPE
         MTH,1    *SR2,R2
         B        RPRENDPA
TRYT     CW,R1    XT
         BNE      TRYCC
         LW,SR2   =X'40000000'
         STS,SR2  *D4,R2
         LI,R2    DEVNDX
         LB,R2    *D4,R2            GET TRUE TYPE INDEX
         LI,R4    DEVTYNDX          DISP TO TRUE TYPE NDX IN DEVICD1 TAB
         STB,R2   *D4,R4            SAVE IN 2ND BYTE WRD 3
         LI,R2    DEVNDX
         LI,SR2   X'B'              SET DUMMY INDEX TO B
         STB,SR2  *D4,R2
         LW,SR2   HANDTADR,R3
         LI,R2    MORFLGS
         LB,R2    *D4,R2            WAS AN RHANDLER SPECIFIED
         CI,R2    1
         BANZ     MODELDONE
         LI,R2    HANDNDX           DISP TO HAND. NDX BYTE IN DEVICD1
         LB,R2    *D4,R2            GET HANDLER INDEX
         SLS,R2   2
         AW,SR2   R2
         LB,R4    *SR2              GET BYTE CT OF HAND NAME
         BNEZ     MODELDONE
         LI,R4    -4
         AI,SR2   4
         LW,R2    MTIND+4,R4
         STW,R2   *SR2,R4
         BIR,R4   %-2
         LI,R4    CLSTBYT
         LB,SR2   *D4,R4            GET CLIST VALUE
         CI,SR2   6                 IS IT DEFAULT
         BNE      RPRENDPA          NO
         MTB,2    *D4,R4            YES.  INCREMENT CLIST
         B        RPRENDPA
TRYCC    CW,R1    XCC
         BNE      TRYDD
         LI,SR2   X'40'             TB:FLGS1 FLAG BIT
         STS,SR2  *D4,R2            R2 = DISP TO DEVICD1+3
         B        RPRENDPA
TRYDD    CW,R1    XDD
         BNE      TRYPUB
         LI,SR2   X'80'             TB:FLGS1 FLAG BIT
         STS,SR2  *D4,R2            R2 = DISP TO DEVICD1+3
         B        RPRENDPA
TRYD     CW,R1    XD
         BNE      EROR
********************************************************
* THIS SECTION CHECKS TO SEE IF CURRENT DP HAS A 3275 MODEL NUMBER
* IF SO, IT THEN CHECKS TO SEE IF PREVIOUS ENTRY CONTAINED
* THE SAME CHANNEL SYMBOL.  IF IT DOES, NO ENTRY IS MADE
* OTHERWISE CURRENT CHANNEL SYMBOL IS ENTERED IN STACK AREA.
* THIS INFORMATION IS REQUIRED FOR TAURUS IN THE XMONITOR MODULE
********************************************************
ASUMEDP  LW,R2    MODEL2,R3
         CW,R2    DP3275
         BNE      ASUMEDP1
         LI,SR2   DPAK3275
         AW,SR2   R3
         LB,R4    *D4               GET CHANNEL LETTER MNEUMONIC
         LB,R2    *SR2
         BEZ      INCR3275
         CB,R4    *SR2,R2           IF SAME AS PREVIOUS SKIP ENTERING IT
         BE       ASUMEDP1
INCR3275 LB,R2    *SR2
         CI,R2    35                ONLY 36 DIFFERENT CHANNELS POSSIBLE
         BG       ERRBOR24
         AI,R2    1
         STB,R2   *SR2
         STB,R4   *SR2,R2
ASUMEDP1 LI,R2    NEWFLGS/4
         LW,SR2   =X'20000000'
         STS,SR2  *D4,R2
         LI,R2    DEVNDX
         LB,SR2   *D4,R2            GET TRUE TYPE INDEX
         CI,SR2   TYCHEND
         BLE      TRYTYPE
         LI,R4    DEVTYNDX          DISP TO TRUE TYPE NDX IN DEVICD1 TAB
         STB,SR2  *D4,R4
         LI,SR2   X'D'
         STB,SR2  *D4,R2
         B        TRYTYPE
TRYPUB   CW,R1    XPUB
         BNE      TRYVFC
         B        RPRENDPA          BIT NOT SET CURRENTLY
TRYVFC   CW,R1    XVFC
         BNE      TRYBIN
         LW,SR2   =X'01000000'
         STS,SR2  *D4,R2
         B        RPRENDPA
TRYBIN   CW,R1    XBIN
         BNE      TRYR
         LW,SR2   =X'08000000'
         STS,SR2  *D4,R2
         B        RPRENDPA
TRYR     CW,R1    XR
         BNE      TRYDIAL
         LW,SR2   =X'04000000'
         STS,SR2  *D4,R2
         B        RPRENDPA
TRYDIAL  CW,R1    XDIAL
         BNE      TRYFECP
         LI,R2    FLAGS/4
         LW,SR2   Y8
         STS,SR2  *D4,R2
         B        RPRENDPA
TRYFECP  CW,R1    XFECP
         BNE      TRYINT
         MTW,1    FEDX#,R3          INCREMENT # OF FECP DEVICES
         LW,SR2   FEDX#,R3
         LI,R2    FEDX
         STB,SR2  *D4,R2            STORE # IN DEVICD1 TABLE
         LI,R2    FEX               GO GET USER SUPPLIED FECP #
         B        DEVOPVAL
TRYINT   CW,R1    XINT
         BNE      NORECOGN          BRANCH IF ALL :DEVICE OPTIONS CHECKED
*                                   AND THIS ONE IS NOT AMONGST THEM
         LI,R2    INT*2+1
         B        DEVOPVAL
         PAGE
*
NORECOGN EQU      %
         BAL,R7   ERRBRT3
RPRENDPA LI,R4    DEVOPTPA          EXIT = DEVOPTPA
*                                   IF RETURN HERE AFTER ERROR REPORT,
*                                    PASS CHARS. UNTIL THRU ')', THEN
*                                     B  DEVOPTPA  FOR COMMA AND NEXT
*                                      OPTION CHECK.
CYCRPREN EQU      %
         LI,SR2   KRPAREN
         BAL,SR4  CHARSCAN
         BCR,8    *R4               EXIT
         BAL,SR4  DVCDFINI
         LW,R4    CLD,R7            0,7 CONTAINS SIZE AND BYTE ADDRESS
*                                   OF DELIMETERS
         LB,SR2   R4                SR2 GETS SIZE OF DELIMITER LIST
LUK4DEL  CB,SR1   0,R4              IS CURRENT ILLEGAL CHARACTER A DELIM
         BE       YESDELIM          YES.
         AI,R4    1
         BDR,SR2  LUK4DEL           CONTINUE THRU REMAINDER OF LIST
         LI,SR1   0                 RESET SR1
         B        RPRENDPA          CONTINUE CHECKING CHARACTERS UNTIL
*                                   A RIGHT PAREN IS FOUND
YESDELIM LI,SR1   0
         B        NORECOGN          ISSUE THE % AND 'SYNTAX ERROR'
         PAGE
DEVOPVAL EQU      %
         LI,SR2   KCOMMA
         BAL,SR4  CHARSCAN ***
         BCR,8    DEVOPVLX
         CI,R2    TNGCD
         BE       RPRENDPA          VALUE OPTIONAL FOR NGC
         BAL,R7   ERRBORT3 ***
         BAL,SR4  ERRBOR21 ***
         B        RPRENDPA
DEVOPVLX EQU      %
         BAL,SR4  HEXSCAN           GET VALUE FOLLOWING KEYWORD
         BCR,8    %+2
         BAL,R7   ERRBRT3
         LW,R1    D1                VALUE RETURNED IN D1
         LW,R4    FETCHCSL,R3
         CI,R4    K4                4 CHARS MAX.
         BLE      %+2                NO
         BAL,R7   ERRBRT3
         LW,D4    DEVICDPT,R3
         CI,R2    MXREC
         BE       %+3               YES
         CI,R2    MXREC+1           IS IT MREC
         BNE      %+3               NO
         CI,R4    2                 MAX SIZE IS 1 BYTE
         BG       ERRMREC           ERROR
         CI,R2    TNGCD             IS IT NGCD
         BNE      NOT:SS            NO
         CI,R4    2
         BG       ERRNGC
NOT:SS   EQU      %
         CI,R2    CLSTBYT
         BNE      2BYTPOS
         AND,R1   XFE               INSURE EVEN VALUE FOR CLIST OPTION
         LI,R4    DEVNDX
         LB,R4    *D4,R4
         CI,R4    TYCHEND
         BG       ST1BYTE
         CW,R1    CLISTDAT,R4          USER CANNOT SPECIFY A VAL LESS
         BGE      ST1BYTE              THAN THE DEFAULT FOR A STANDARD
         LW,R1    CLISTDAT,R4          DEVICE. IF SO CLIST IS FORCED TO
         LI,D3    ERROR1               THE SYSGEN DEFAULT & WARNING
         BAL,SR4  LOGIT                MESSAGE IS PUT OUT
ST1BYTE  STB,R1   *D4,R2
         B        RPRENDPA
2BYTPOS  EQU      %
         CI,R2    FEX
         BNE      2BYTPOS2
         CI,R1    4
         BG       ERRFEX            FECP # MUST BE BETWEEN 1 AND 4
         CI,R1    0
         BE       ERRFEX
         LW,R4    FEDX#,R3
         CH,R1    R4                SEE IF THIS FECP # > PREVIOUS
         BLE      ST1BYTE           LEAVE AS IS IF NOT
         STH,R1   R4
         STW,R4   FEDX#,R3
         LW,R4    R1
         AI,R4    -1
         STB,R1   FEXFLGWD,R4       STORE FECP # IN FLAG WORD
         B        ST1BYTE           ONLY 1 BYTE NEEDS TO BE STORED
2BYTPOS2 EQU      %
         STB,R1   *D4,R2
         CI,R2    PERD*2+BYTDISP+1
         BNE      %+2
         MTW,1    PERFLAG
         CI,R2    PAPRSZ
         BE       TRYPWIDT          IF YES CHECK WIDTH OPTION
         CI,R2    INT*2+1
         BE       STONOTHER
         CI,R2    SSD*2+BYTDISP+1
         BE       STONOTHER
         CI,R2    CYLSD+BYTDISP
         BE       RPRENDPA
         CI,R2    TRKSD+BYTDISP
         BE       RPRENDPA
         CI,R2    SECSD+BYTDISP
         BE       RPRENDPA
         CI,R2    NSPTD*2+BYTDISP+1
         BL       RPRENDPA
STONOTHER  EQU    %
         AI,R2    KN1                     YES, ANOTHER BYTE TO STORE
         SLS,R1   -8
         STB,R1   *D4,R2                    STORE IT
         B        RPRENDPA
CYLDV    TEXTC    '*** WARNING DEVICE SIZE NOT EVENLY',;
                  ' DIVISIBLE BY NGC - REMAINDER IGNORED'
         PAGE
DVCDFINI EQU      %
         CI,SR1   KEOB              COL. 80?
         BE       DEVCDOUT           YES, OUT
         CI,SR1   KCRET             NO, CARRIAGE RETURN?
         BE       DEVCDOUT
         CI,SR1   KNL
         BNE      *SR4
DEVCDOUT EQU      %
         LW,R1    MODGIVEN          IS THERE A 'MOD' OPTION ON DEVICE
         BNEZ     ZEROMOD           COMMAND
         LW,R1    MODTABPTR,R3
         LW,R1    *R1               GET SIZE OF MODEL # TABLE
         LW,D4    DEVICDPT,R3       GET CURRECNT DEVICD1 ENTRY
         LI,R2    MOD#NDX           DISP TO MOD # INDEX IN DEVICD1
         STB,R1   *D4,R2            SET MOD # NDX TO 'FFFF' MOD # ENTRY
         BAL,SR4  OUTLLERR
         LI,SR4   DEVCDOUT1
         LI,D3    MOD#MSG
         B        LOGIT+1
ZEROMOD  LI,R1    0
         STW,R1   MODGIVEN          RE-INITIALIZE FOR NEXT DEV.COMMAND
DEVCDOUT1 EQU     %
         LW,R1    DEVICDPT,R3       OTHERWISE, HOUSEKEEP POINTERS
         LI,R2    DEVNDX
         LB,D4    *R1,R2
         CI,D4    X'D'
         BNE      %+3
         LI,R2    DEVTYNDX          DISP TO TRUE TYPE NDX IN DEVICD1 TAB
         LB,D4    *R1,R2            GET TRUE TYPE
         CI,D4    TYCHEND
         BLE      DVCDFIN2
         LW,D1    HANDTADR,R3
         LI,R2    MORFLGS
         LB,R2    *R1,R2            GET MORFLGS
         CI,R2    1                 SEE IF IT'S AN RHANDLER TYPE
         BANZ     DVCDFIN2
         LI,R2    HANDNDX           DISP TO HAND. NDX BYTE IN DEVICD1
         LB,R2    *R1,R2            HANDLER TABLE INDEX
         SLS,R2   2                  ENTRY NO. TIMES 4 W/ENTRY
         AW,D1    R2                  ADDRESS INCREMENT
         LB,D2    *D1               GET BYTE COUNT OF HANDLER NAME
         BNEZ     DVCDFIN2
         BAL,SR4  ERRBOR17          'ABORT: NO HANDLER NAME GIVEN'
MOD#HAND EQU      %
         LW,SR4   HANDTADR,R3
         MTW,-1   *SR4              DO NOT INCLUDE THIS HANDLER ENTRY
         STW,D4   R2
         LW,SR4   TYPMNEAD,R3
         STH,D2   *SR4,R2           ZERO OUT TYPMNE ENTRY
         MTW,-1   TYPMNESZ,R3       DECRE TYPMNE COUNT
         MTW,-1   DVCTR,R3          DECRE DEVICE COUNT
         MTW,1    P2ABRT,R3         SET DELAYED PASS2 ABORT FLG
         B        IODEFRD
DVCDFIN2 EQU      %
         LI,R2    FLAGS/4
         INT,D4   *R1,R2
         LI,R2    NEWFLGS
         LB,R4    *R1,R2
         STW,R1   DEVICDPT,R3
         LI,R2    DEVICDSZ
         AWM,R2   DEVICDPT,R3       INCREMENT BY # OF WORDS IN DEVICD1
*                                   PORTION OF DEVICE TABLE
         AND,D4   M16
         CI,D4    '9T'
         BE       MTAVRTSZ
         CI,D4    '7T'
         BE       MTAVRTSZ
         CI,R4    X'40'             IS IT TAPE TYPE DEVICE
         BANZ     MTAVRTSZ+2
         CI,D4    'DC'
         BE       DCTYPE
         CI,D4    'DP'
         BE       DPTYPE
         CI,R4    X'20'             NEW FLAGS
         BAZ      DVCDFIN4
         LW,SR4   =X'20000000'      CHK FOR FIXED HEAD DEVICE
         LI,R2    FLAGS/4
         CW,SR4   *R1,R2
         BAZ      DPTYPE
DCTYPE   LI,SR4   X'700'            INSURE THAT DC TYPE IS SET
         B        %+2
DPTYPE   LI,SR4   X'B00'            INSURE THAT DP TYPE IS SET
         LW,R6    DEVICDPT,R3       GET TO 1ST WORD OF DCINTBL PORTION
         STS,SR4  *R6
         LI,R2    NEWFLGS/4
         LW,SR4   =X'20000000'      SET DISK TYPE DEVICE
         STS,SR4  *R1,R2
         LI,R2    SIZED
         LH,D1    *R6,R2
         AND,D1   M16
         BEZ      ERRBOR30          TEST FOR NO SIZE
         LI,R4    1              CHK FOR CYLINDER BIT SET IN DCIN PART
         MTH,0    *R6,R4
         BGEZ     TRKSIZ
SIZECOMP EQU      %
         CI,D1    X'C8'             IS IT A 7242/7261 CYLINDER SIZE PACK
         BE       CALCLCYL
         CI,D1    X'190'            IS IT A 7271 CYLINDER SIZE
         BE       CALCLCYL
         CI,D1    X'194'            IS IT A 7275 CYLINDER SIZE
         BNE      STORSIZE          USE SUPPLIED SIZE IF NONE OF ABOVE
CALCLCYL LI,R4    NTPCD
         LH,SR4   *R6,R4            NTPC
         LI,R4    NSPTD
         LH,R4    *R6,R4            NSPT
         MW,SR4   R4                NSPT*NTPC
         AND,SR4  M16X2             NO ODD RESULTS ALLOWED
         MW,SR4   D1                NSPT*NTPC*NCYL = TOTAL # SECTORS
         LI,R4    SSD
         LH,R4    *R6,R4            GET SS
         LI,D2    K200              512+SS-1
         AW,D2    R4
         AI,D2    -1                /SS
         DW,D2    R4                = NSG
         DW,SR4   D2                =#GRAN
         LI,R4    NGC
         LB,R4    *R6,R4            GET NGC
         STW,SR4  D2
         LI,D1    0
         DW,D1    R4                REMAINDER D1,QUOT. D2
         CI,D1    0                 ANY REMAINDER
         BE       %+3               NO
         LI,D3    CYLDV             IGNORE REMAINDER & ISSUE WARNING
         BAL,SR4  LOGIT
         STW,D2   D1                SET QUOTIENT IN D1
         LI,R4    1
STORSIZE STH,D1   *R6,R2            STORE SIZE
         LH,R4    *R6,R4
         CI,R4    PRIVBIT
         BAZ      NOTPRIV
         MTW,1    PRIVDEV,R3
         LI,R4    DEVTYNDX          DISP TO TRUE TYPE NDX IN DEVICD1 TAB
         LB,R4    *R1,R4            GET TRUE TYPE INDEX
         LW,SR4   TYCOUNT,R3
         MTH,1    *SR4,R4           INCRE DISK TYPE COUNT OF PRIVATE
NOTPRIV  EQU      %
         LI,SR4   0
         LI,R2    PFAD
         STH,SR4  *R6,R2
         LI,R2    PERD
         MTH,0    *R6,R2
         BEZ      %+2
         BAL,SR4  ERRBOR19
         LI,R2    PSAD
         MTH,0    *R6,R2
         BEZ      %+2
         BAL,SR4  ERRBOR19
         LI,R2    PFAD
         STH,D1   *R6,R2
TRKSIZ   EQU      %
         LI,R7    1
         LH,R7    *R6,R7            LOAD RIGHT HALF OF DCINTBL PORTION
         LI,R2    DEVTYNDX             NEED TO CHECK DEVICE TYPE
         LB,R2    *R1,R2            NOTE: DEV. TYPE= DEV. TYPE + 1
         CI,R2    X'C'                 IS IT ORDINARY DP
         BE       CHKPRIV              BRANCH IF YES
         LI,R4    FLAGS/4              NEED TO CHK IF IT IS A DP TYPE
         LW,SR4   =X'20000000'         CHK IF IT'S A RAD
         CW,SR4   *R1,R4
         BANZ     CONTINUE             BRANCH IF IT'S A RAD
         CI,R7    PRIVBIT              SEE IF IT'S A PRIVATE NON-STAND
         BAZ      CONTINUE             PACK. BRANCH IF NOT
         LW,R4    TYCOUNT,R3           NEED TO DECREASE # FOR NON-STAND
         MTH,-1   *R4,R2               PRIV PACKS BECAUSE OF HOW THEY ARE
*                                   COUNTED.
         PAGE
CHKPRIV  CI,R7    PRIVBIT              NEED TO FIND 1ST PRIV DP
         BAZ      CONTINUE             BRANCH IF NOT
         LW,R7    FIRSTDP,R3        CHK IF 1ST ONE HAS ALREADY BEEN
         BEZ      MAKE1DP           FOUND. BRANCH IF NOT
         CI,R2    X'C'           IS THIS A STANDARD DP
         BNE      CONTINUE       IF NOT PROCEED
         CB,R2    R7             IS THE FIRST DP A STANDARD DP
         BE       CONTINUE       IF NOT PROCEED.
*                                   FORCE IT TO THE CURRENT ONE, SINCE
*                                   THERE IS AT LEAST 1 STAND DP
*
MAKE1DP  EQU      %                 GENERATE:
*
*                                *BYTE 0 BYTE 1    BYTES 2-3
*                                *****************************
*                                *DEV   *      *             *
*                                *TYPE  *   0  *      YY     *
*                                *NDX+1 *      *             *
*                                *****************************
*
         LI,R4    DEVNMNDX             NEED TO GET 'YY' PART OF DEV NAME
         LH,R4    *R1,R4
         AND,R4   M16
         STB,R2   R4
         STW,R4   FIRSTDP,R3           STORE DEV TYPE NDX (+1) AND 'YY'
CONTINUE EQU      %
         LI,R2    SSD
         MTH,0    *R6,R2
         BNEZ     %+4
         BAL,SR4  ERRBOR32B
         LI,SR4   X'100'            SUPPLY A SECTOR WORD SIZE OF 100
         STH,SR4  *R6,R2
         LI,R2    NSPTD
         MTH,0    *R6,R2
         BEZ      ERRBOR30
         LI,R2    PSAD
         MTH,0    *R6,R2            ANY PSA ENTRY IN DCINTBL PORTION
         BEZ      TRKSZON           BRANCH IF NOT
         LI,R4    MORFLGS           NEED TO KNOW IF THIS IS AN MPC DP
         LB,R4    *R1,R4
         CW,R4    X80               IS BIT 0 OF MORFLGS BYTE SET
         BAZ      OKPACK            BRANCH IF NOT AN MPC DP
         LI,D3    PSAONMPC          GET ERROR MESSAGE FOR MPC
         BAL,SR4  LOGIT             PRINT ERROR
         MTW,1    P2ABRT,R3
         LI,D3    0                 AND ZERO OUT PSA HW IN DCINTBL
         STH,D3   *R6,R2
         B        TRKSZON
OKPACK   MTW,1    #SWAPDEVS,R3      O.K. FOR PSA ON THIS DEVICE
         LI,R4    MOD#NDX
         LB,SR4   *R1,R4
         SLS,SR4  1                 SHIFT FROM DW TO WORD DISPLACEMENT
         AW,SR4   MODTABPTR,R3      GET SWAP MOD #
         LW,SR4   *SR4
         LW,R4    SWAPMOD#          PICK UP SIZE OF SWAP MOD #
         PSW,R6   *R0
         LW,R6    R4
         BEZ      GOSTORIT
SWPMODLP CW,SR4   SWAPMODT-1,R4      CHECK TO SEE IF THIS MODEL NO
         BNE      BDR                IS ALREADY IN TABLE. BR IF NOT
         AI,R4    -1
         MTB,1    S#BYT,R4           INCREMENT COUNT OF THIS TYPE
         B        CONTINU
BDR      BDR,R4   SWPMODLP
         LW,R4    R6
GOSTORIT MTB,1    S#BYT,R4           INCR. COUNT CORRESPONDING TO THIS
         STW,SR4  SWAPMODT,R4        TYPE AND STORE MODEL # IN
         AI,R4    1                 PARALLEL TABLE
         CI,R4    9                  ONLY PROVISION FOR 8 DIFF TYPES
         BL       %+4
         LI,D3    2MNYLKSW
         BAL,SR4  LOGIT
         B        %+2
         STW,R4   SWAPMOD#           ADJUST COUNT OF ITEMS IN TABLE
CONTINU  PLW,R6   *R0               R6 POINTS TO DCIN PORTION OF DEVICD1
         LW,R4    *R6
         AND,R4   =X'3F00'
         CW,R4    =X'700'
         BNE      CHKDPSWP
*                     NOTE: THAT THE NEXT 6 INSTRUCTIONS ASSUME
*                     THAT DISTINCTIONS BETWEEN RADS ARE BASED ON
*                     SECTOR SIZE AND NSPT DIFFERENCES
         LI,R4    SSD/2
         LW,SR4   *R6,R4
         LI,R4    -6
         CW,SR4   D7232+6,R4
         BE       TRKSZON
         BIR,R4   %+1
         BIR,R4   %-3
         B        ERRBOR31          IF NOT 7232,7212 OR 3214, ERROR
CHKDPSWP CW,R4    =X'B00'           IF NOT RAD, IT MUST BE A PACK
         BNE      ERRBOR31          ERROR IF NOT
         LI,R4    FLAGS/4
         LW,SR4   =X'40000000'
         CS,SR4   *R1,R4            SEE IF KNOWN DEVICE
         BANZ     %+2               BRANCH IF KNOWN
         BAL,SR4  ERRNEWS
         MTW,1    SWAPUTS,R3        SET DP SWAPPER FLAG
         LI,R4    1
         CW,R4    SWAPUTS,R3        1 DP ONLY FOR PSA
         BNE      ERRBOR32          ERROR
         CW,R4    #SWAPDEVS,R3      NO DP IF PSA ON RAD
         BE       TRKSZON           OK
         BAL,SR4  ERRBOR32A         ERROR
ERR2     EQU      %
         LI,R4    0                 ILLEGAL SS,NSPT FOR PSA
         STH,R4   *R6,R2            ZERO PSA
         MTW,-1   #SWAPDEVS,R3      BUMP DOWN PSA DEVICES
TRKSZON  EQU      %
         MTW,0    SWAPUTS,R3
         BEZ      TRKSZON1          SKIP NXT FEW INSTRUCTIONS FOR RADS
         LW,SR4   #SWAPDEVS,R3       GET TOTAL # OF SWAP DEVICES UP TILL
         CW,SR4   SWAPUTS,R3         NOW AND SEE IF SAME AS WHAT'S IN DP
         BLE      %+2                 SWAP COUNT.  BRANCH IF SO.
         BAL,SR4  ERRBOR32A          OTHERWISE NO DP IF PSA IS ON RAD ALSO
         LH,SR4   *R6,R2            GET PSA VALUE
         CW,SR4   XFF               NEED TO TRUNCATE IF GREATER
         BLE      TRKSZON1
         LW,SR4   XFF
         STH,SR4  *R6,R2            BECAUSE OF DP SWAP BYTE TABLES
         LI,D3    PSA2LG
         BAL,SR4  LOGIT
TRKSZON1 EQU      %
         BAL,R4   SIZECHK
         LI,R2    PERD              CHK FOR PER SIZE
         BAL,R4   SIZECHK
         LI,R2    PFAD              CHK FOR PFA SIZE
         BAL,R4   SIZECHK
         BEZ      PRNTDIAG+1        IF D1 = 0, ENTIRE DISK SPACE UTILIZED
         CI,SR4   0                 IS THERE ANY PFA
         BEZ      CHKPER            BR. IF NOT
ADDSP    AW,SR4   D1                ADD UNUSED SPACE TO PFA
         STH,SR4  *R6,R2
         B        PRNTDIAG
CHKPER   LI,R2    PERD
         LH,SR4   *R6,R2
         BNEZ     ADDSP             IF NOT 0 ADD UNUSED SPACE TO PER
         LI,R2    PSAD
         LH,SR4   *R6,R2
         BNEZ     PRNTDIAG+1        BRANCH IF THERE IS PSA
         AI,R2    1                 GET PFA DISPLACEMENT
         B        ADDSP             ADD UNUSED SPACE TO PFA
PRNTDIAG BAL,SR4  ERRBOR28A
         LI,D4    X'FFF00'          MOVE NGC TO PER HWD IF CYLBIT
         AND,D4   *R6
         XW,D4    *R6
         CI,D4    CYLBIT
         BAZ      CKDCIN            DON'T MOVE IT
         AND,D4   M8                GET NGC TO MOVE
         LI,R2    PERD
         STH,D4   *R6,R2
         B        CKDCIN
SIZECHK  EQU      %                 GET PSA,PER,PFA,BCHK,ABSF AS CUM-
         LH,SR4   *R6,R2
         AND,SR4  XFFFF
         CW,D1    SR4
         BGE      SIZECHK2            TO 'SIZE' VALUE.  TRUNCATE WHEN
         BAL,SR4  ERRBOR28 ***      GIVE WARNING MESSAGE
         STH,D1   *R6,R2
SIZECHK2 EQU      %
         LH,SR4   *R6,R2
         AND,SR4  XFFFF
         SW,D1    SR4
SIZECHK3 B        *R4               RETURN
*
MTAVRTSZ EQU      %
         LW,SR4   =X'40000000'      SET NEW FLAG
         LI,R2    NEWFLGS/4
         STS,SR4  *R1,R2            SET TAPE BIT IN NEW FLAGS
         MTW,1    AVRTBLSZ,R3
         MTW,1    NUMTAPES,R3       JUST KEEP COUNT OF TAPES HERE
         B        DVCDFIN4
         PAGE
*
* INTERPRET DISC INFO. STARTING AT *R1 (LINK:PER) JUST ENOUGH TO
*   GET IT INTO THE DISCINFO TABLE BEFORE RETURNING TO DVCDFIN3 TO CHECK
*     FOR DEVICE CARD TABLE END. (KEEP R1 AT PRESENT POINT)
*
*
*
CKDCIN   EQU      %
         LW,D4    DCINADDR,R3
CKDCIN01 CW,D4    DCINPNTR,R3       POINTS TO CURRENT ENTRY 1ST WORD
         BE       CKDCIN03
         LH,R4    *D4               R4=DEVICD1 LINK IN ITH DC ENTRY
         AI,R4    K1                 SET FOR 2ND WD. IN THIS DEVICD1
         LW,D2    DEVIADDR,R3       BASE DEVICD1 ADDRESS +R4 = 2ND WD.
         LW,D3    *D2,R4
         LI,R4    DEVNDX/4
         LW,D1    *R1,R4
         SLS,D1   16
         AND,D3   M16
         CH,D3    D1                CHECK IF THIS NDD ALREADY IN DEVICD1
         BE       CKDCIN06
         LI,R4    X'FF'             LOOK AT NEXT DISC
         AND,R4   *D4
         AW,D4    R4
         B        CKDCIN01
CKDCIN03 EQU      %
         CW,D4    DCINEND,R3
         BL       MVDCINFO
         B        DVCYCOUT
CKDCIN06 EQU      %
         BAL,SR4  ERRBOR27 ***
         B        DVCYCOUT
MVDCINFO EQU      %
         AI,D4    KN1
         LI,R4    DCINSZ            # OF WORDS TO MOVE INTO DCINTBL
         AWM,R4   *R6               R6 POINTS TO DCIN PORTION IN DEVICD1
         AI,R6    -1                R6 NOW = DCIN PORTION -1
         AWM,R4   DCINPNTR,R3       NEW POINTER VALUE FOR DCINTABL
         LI,D2    0
         LW,D3    *R6,R4
         STW,D3   *D4,R4
         STW,D2   *R6,R4
         BDR,R4   %-3
         CI,D3    X'800'            IS IT DISK PACK
         BAZ      DVCDFIN4          NO
         MTW,1    AVRTBLSZ,R3       KEEP COUNT
         LI,R4    TRKSD+4           CHK FOR TRACKS, CYLS = 0
         LI,D3    8
CYLSTRKS LB,D2    *D4,R4            GET TRACKS BYTE FIRST
         BNEZ     CHKCYLS
         STB,D3   *D4,R4            IF ZERO SUPPLY 8 THEN 16
CHKCYLS  AI,D3    8
         CI,R4    CYLSD+4
         BE       DVCDFIN4
         BDR,R4   CYLSTRKS
DVCDFIN4 MTW,1    DCTSIZE,R3
         B        IODEFRD           NO GO TRY FOR MORE DEVICE
*                   HERE ONLY WHEN AN ERROR HAS OCCURRED       *
DVCYCOUT EQU      %
         LW,SR2   HANDTADR,R3
         LI,R2    MORFLGS
         LB,R2    *R1,R2            IS IT AN RHANDLER TYPE
         CI,R2    1
         BAZ      %+2
         LW,SR2   RHANDTAD,R3
         MTW,-1   *SR2              DO NOT INCLUDE THIS HANDLER NAME
DVCYNXT  EQU      %
         LI,SR2   KCRET
         BAL,SR4  CHARSCAN
         BCR,8    IODEFRD
         CI,SR1   KEOB
         BE       IODEFRD
         CI,SR1   KNL
         BE       IODEFRD
         LI,SR1   K0
         B        DVCYNXT
         PAGE
*
*
*  SEARCH DEVICE TABLE FOR AN 2780 SPECIFICATION
*  IF SO  ALL HASPIO/HASPCU REFERENCES MUST BE CHANGED TO
*  2780IO/2780CU REFERENCES.
*
*
ENDITALL EQU      %
         LW,R7    Y06
         CW,R7    RBTTYP
         BAZ      CHKFEX#           NO SEARCH REQUIRED IF NO 2780'S
         LI,R2    K1
         LW,R7    DCTSIZE,R3        GET TOT. NO. OF DEVICES
         LCI      4
         LM,SR1   2780HAND          GET 2780IO AND 2780CU NAMES
         LW,R5    DEVIADDR,R3       GET START OF DEVICE TABLE
         AI,R5    -DEVICDSZ+2
SRCHDEVT AI,R5    DEVICDSZ          GET TO WORD 2 OF EA DEVICD1 ENTRY
         LH,R4    *R5,R2
         CH,R4    YD9C2             IS IT AN  RBT ENTRY
         BNE      NXTDVENT
         LW,R4    Y4                CHK IF IT'S AN IRBT DEVICE
         CW,R4    *R5
         BAZ      NXTDVENT
         EOR,R4   *R5               CHANGE IRBT BIT TO ZERO
         STW,R4   *R5
         LW,R1    Y04               MAKE IRBT LOOK LIKE A 2780 BY
         STS,R1   *R5               SETTING 2780 FLAG BIT
         LB,R4    *R5,R2            GET INDEX TO HAND. TAB.
         SLS,R4   2                 CHANGE TO WORD INDEX
         AW,R4    HANDTADR,R3
         LCI      4
         STM,SR1  *R4               CHANGE HASP NAMES TO 2780'S
NXTDVENT BDR,R7   SRCHDEVT
         SPACE    3
*        THIS CODE INSURES THAT USER SPECIFIED FECP NUMBERS GO FROM
*        1 TO THE HIGHEST NUMBER SPECIFIED, IN INCREMENTS OF 1
CHKFEX#  MTW,0    FEDX#,R3
         BEZ      UBENDITALL        NO SEARCH REQUIRED IF NO FECP
         LW,R4    FEDX#,R3
         SLS,R4   -16               GET HIGHEST FEX VALUE
         LI,R7    0
         LB,SR1   FEXFLGWD,R7
         BEZ      ERRINFNO
         AI,R7    1
         BDR,R4   %-3
         B        UBENDITALL
ERRINFNO LI,D3    ERRINNO1
         BAL,SR4  LOGIT
         MTW,1    P2ABRT,R3         THIS IS A DELAYED ABORT CONDITION
         PAGE
*
* PROCESS CARD INPUT VALUES TO FORM 'IOTABLE' LOAD MODULE OUTPUT
* NOW THAT ALL CARD INPUTS HAVE BEEN PREDIGESTED. ARRANGE THE
*   ACQUIRED INFORMATION INTO TABULAR FORM
*
         SPACE    5
UBENDITALL  EQU   %
         MTW,0    #SWAPDEVS,R3      PSA = 0 FOR UTS
         BGZ      %+2               NO
         BAL,SR4  ERRBOR34          YES,ERROR
         MTW,0    PERFLAG           ANY PER DEFINED
         BGZ      CKDONE            YES
         BAL,SR4  ERRBOR35          NO,ERROR
CKDONE   EQU      %
         MTW,0    RCHAN,R3          NO..IS THERE 1 CHAN CC POSSIBLY
         BNEZ     1:CHAN            YES.
         BAL,SR4  ERRBOR23          NO..NO CHAN/DEVICE INFO
         B        OUTOFIT
1:CHAN   EQU      %
*                                   R1 CONTAINS CHANPTR ADDRESS
         LW,R5    DEVICDPT,R3       FINISH SETTING CHANTABLE
         STW,R5   4,R1               POINTER TO END DEVICD1 TABLE
         CAL1,8   GETPAGES          GET SOME WORK AREA
         STW,SR1  SAVEPAGE,R3       SAVE PAGES
         STW,SR2  SAVEPAGE+1,R3      AND START LOCATION FOR RELEASE
         CI,SR1   0
         BLE      LMODERR
*
         SLS,SR1  9                 SR1=NO.PAGES*512=TOTAL WORDS USABLE
         LI,R1    K0                CLEAR PAGES TO ZERO
         LW,R5    SR1
         AI,R5    KN1
         STW,R1   *SR2,R5           ZAP
         BDR,R5   %-1                R1=0 FOR ENDSET02 LOOP
         STW,R1   *SR2
*                      ALLOCATE BASIC BLOCKS: SECT00;RFDF;EXPR;RELDIC
         STW,SR2  CLISTADR,R3        SET BEGIN OF SECT00
         STW,SR2  PACKRPTR,R3
         STW,SR2  DYSTORND,R3
         AWM,SR1  DYSTORND,R3         STORE LAST LOC. + 1 ADDR.
         STW,SR2  DCT1PTR,R3
         MTW,1    DCTSIZE,R3        NO.DEVICES + 1 NULL (1ST) DCT ENTRY
         LW,SR2   DCTSIZE,R3        GET NO. OF DCT CARDS ENTERED
         LI,R5    DCT1PTR           ADDRESS OF 1ST PTR
         AW,R5    R3                (ADJUST FOR STACK LOC.)
ENDSET02 EQU      %
         LW,D4    SR2               GET # ENTRIES
         LB,R2    RESOL,R1          GET SHIFT AMOUNT - 1
         SLS,R2   24                EXTEND SIGN
         SAS,R2   -24
         SLS,D4   1                 DWD SHIFT = 0
         SW,D4    R2                ROUND TO WORDS
         CI,R2    -3
         BANZ     %+5
         LW,SR1   *R5,R1            DW RES, MAKE PREV ADDR BOUND 8
         AI,SR1   1
         AND,SR1  M16X2
         STW,SR1  *R5,R1
         BNE      %+2
         AI,D4    4                 BYTE, ADD 7 TOTAL FOR ROUNDING
         SLS,D4   0,R2
         AW,D4    *R5,R1            START OF NEXT
         AI,R1    1
         STW,D4   *R5,R1
         CB,R1    RESOL,R1          END OF BLOCK INDICATOR
         BNE      ENDSET02          LOPO IF NOT
         CI,R1    NDCTS
         BNE      ENDSET03
         MTW,0    FEDX#,R3          WERE THERE ANY FECP DEVICES IN INPUTT
         BNE      CHKDUALF          BRANCH IF THERE WERE.
         LW,SR1   DCT27PTR,R3       IF NOT, EXTIRPATE THE DCT26 TABLE
         LW,SR2   DCT26PTR,R3
         SW,SR2   SR1
         AWM,SR2  DCT27PTR,R3       MOVE REMAINING DCT TABLES
         AWM,SR2  DCT28PTR,R3       DOWN OVER DCT 26'S VACATED AREA
         AWM,SR2  DCT29PTR,R3    NOTE: SR2 IS THE NEGATIVE SPACE SIZE
         AWM,SR2  DCT1PPTR,R3
         AWM,SR2  DCT1APTR,R3
         AWM,SR2  DCTLAST,R3
         AW,D4    SR2
CHKDUALF MTW,0    DUALFLG,R3        CHECK IF ANY DUAL SPECIFIED ON
*                                   ANY :CHAN COMMAND
         BNEZ     %+5
         LW,D4    DCT1PPTR,R3
         LW,SR1   DCT1PTR,R3
         STW,SR1  DCT1PPTR,R3
         STW,SR1  DCT1APTR,R3
         STW,D4   DCTLAST,R3
         STW,D4   CIT1PTR,R3        SET FOR NEXT PASS THROUGH
         AI,R1    1
         LW,SR2   RCHAN,R3
         AI,SR2   1
         B        ENDSET02
ENDSET03 EQU      %
         MTW,0    DUALFLG,R3
         BNEZ     %+4
         LW,D4    CIT6PTR,R3
         LW,SR1   CIT5PTR,R3
         STW,SR1  CIT6PTR,R3
         STW,D4   CITLAST,R3
ENDSET   EQU      %
         STW,D4   PSA%AD,R3
         AI,D4    1
         LW,SR1   DKSTYPES,R3       GET #DISK TYPE ENTRIES
         LW,SR1   *SR1
         AI,SR1   1                 FOR 0TH ENTRY
         STW,D4   DISCLIMSPTR,R3
         AW,D4    SR1
         STW,D4   CYLSPTR,R3
         AW,D4    SR1
         STW,D4   TRKSPTR,R3
         AW,D4    SR1
         STW,D4   SECSPTR,R3
         AW,D4    SR1
         STW,D4   NCYLPTR,R3
         AW,D4    SR1
         STW,D4   NTPCPTR,R3
         AW,D4    SR1
         STW,D4   NSPTPTR,R3
         AW,D4    SR1
         STW,D4   NSPCPTR,R3
         AW,D4    SR1
         LW,SR1   NUMTAPES,R3
         BEZ      NOTAPES
         STW,D4   AVRFLGAD,R3       NOW STORE AVRFLGS ADDRESS
         AI,SR1   3
         SLS,SR1  -2                CONVERT TO BYTE TABLE
         AW,D4    SR1
NOTAPES  EQU      %
         AI,D4    1
         AND,D4   M16X2             BOUND 8
         STW,D4   AVRTBLAD,R3       SET AVR TABLE ADDRESS
         LW,SR1   AVRTBLSZ,R3
         SLS,SR1  1                  DOUBLEWD9 TABLE
         AW,D4    SR1
         STW,D4   RBLIMSPTR,R3
         AI,D4    2
STORHGPA EQU      %
         STW,D4   HGP1ADDR,R3       SET HGP TABLE ADDRESS
         STW,D4   HGP1PTR,R3
         CW,D4    DYSTORND,R3       OUT OF BOUNDS ?
         BL       GNDCTCIT
         BAL,SR4  ERRBOR14
         B        OUTOFIT
         PAGE
*
GNDCTCIT EQU      %
* GENERATE ALL DCT/CIT TABLES
*        EACH TABLE BEGINS WITH A NULL ENTRY
*
         LI,R1    0
         STW,R1   REMEMBER,R3          CLEAR CELL
         LW,R1    DCT3PTR,R3
         LI,D3    X'C0'
         STB,D3   *R1
         LI,R1    1                 DCT INDEX
         MTW,1    TYPINDX,R3        BUMP TYPE
         LW,D3    DEVIADDR,R3       FIRST DEVICD1
GENEXT   EQU      %
         AI,D3    -DEVICDSZ+1
         CW,D3    DEVICDPT,R3
         BGE      GENEXT-2          TO NEXT TYPE
         LW,R2    TYPINDX,R3
         CW,R2    TYPMNESZ,R3
         BG       GENCIT            ALL DONE WITH DCTS
         AI,D3    DEVICDSZ
         CB,R2    *D3
         BNE      GENEXT+1          NOT THIS ONE
         AI,D3    -1                GOT ONE
         LI,R2    1                 INITIALIZE CITX
         LW,R4    CHANADDR,R3       BEGINNING OF CHANS
GENX2    CW,D3    4,R4              RIGHT CHANNEL?
         BL       GEN2              YES.
         AI,R4    5                 NO,TO NEXT
         AI,R2    1                 BUMP CITX
         B        GENX2             LOOK FOR RIGHT ONE
GEN2     EQU      %
         LCI      3                 GET FIRST 3 WORDS OF
         LM,SR1   *D3                 DEVICD1 ENTRY
GEN2A    EQU      %
         LW,D1    DCT1PTR,R3
         STH,SR2  *D1,R1         DCT1 =NDD = 'N' X'DD'
         PSW,R6   *R0
         MTW,0    FEDX#,R3
         BEZ      GETCLIST          SKIP FOLLOWING CODE IF NO FECP
         LI,R7    FEDX
         LB,R7    *D3,R7
         BEZ      CHKUNIT           BRANCH IF NOT AN FECP DEVICE
         LW,R6    SR3
         AND,R6   M16
         CW,R6    XME
         BE       NOWDCT26             LEAVE ME & FE DEVICE ADDRESSES AS IS
         CW,R6    TXTFE
         BE       NOWDCT26
         LW,R6    SR2               ALTER OTHER DEVICE ADDRESSES
         AND,R6   XFF00             GIVING THEM A UNIT # OF X'1E'
         AI,R6    X'1E'
         STH,R6   *D1,R1
NOWDCT26 EQU      %
         LW,D1    DCT26PTR,R3       STORE FEDX # IN DCT26 TABLE
         STB,R7   *D1,R1
         LW,D1    FDB:FEX,R3
         LI,R6    FEX
         LB,R6    *D3,R6            GET FEX FOR THIS DEVICE
         STB,R6   *D1,R7            STORE IT IN FDB:FEX TABLE
         LW,D1    FDB:DCT,R3
         STB,R1   *D1,R7            STORE DCTX IN FDB:DCT TABLE
         LW,D1    DCT13PTR,R3
         SLS,R1   1
         AW,D1    R1                DCT13 IS A D.W. TABLE
         AI,D1    1                 1ST BYTE IN 2ND WORD OF ENTRY
         MTB,3    *D1               GETS A 03 VAL. FOR FECP DEVICES
         SLS,R1   -1
         LB,D1    SR2               GET DEVICE TYPE +1 FROM DEVICD1
         CI,D1    16                IS IT AN FE DEVICE
         BNE      GETCLIST
         LW,D1    FEB:CDX,R3        YES.
         STB,R1   *D1,R6            STORE DCTX IN FDB:CDX TABLE
         LI,R7    INT
         LH,R7    *D3,R7            AN FENDD DEVICE SHOULD SPECIFY
         BNEZ     STRINT#
         XW,R7    D3                TEMP SAVE D3 IN R7
         LI,D3    ERRFEINT
         BAL,SR4  LOGIT             TELL USER RE ERROR
         MTW,1    P2ABRT,R3
         XW,R7    D3
         B        GETCLIST
STRINT#  LI,D1    INT#
         AW,D1    R3
         STH,R7   *D1,R6
         B        GETCLIST
CHKUNIT  STB,SR2  R6
         LB,R6    R6                NEED TO CHECK IF A X'1E' UNIT
         CI,R6    X'1E'             WAS GENERATED FOR A NON-FECP
         BNE      GETCLIST          DEVICE BECAUSE OF AN INVALID UNIT
         PSW,D3   *R0               SPECIFICATION.
         PSW,R1   *R0
         LW,D3    ERRUNMSG+13
         LW,R6    R1
         LI,R1    3
ERRUNLUP LI,R7    0
         SLD,R6   -4                INFORM USER AS TO NUMBER OF DEVICE
         SCS,R7   4
         LB,R7    CONVTBL,R7        C.C. IN ERROR. # GETS CONVERTED TO
         STB,R7   D3,R1             EBCDIC
         CI,R6    0
         BE       WRTUNERR
         AI,R1    -1
         B        ERRUNLUP
WRTUNERR STW,D3   ERRUNMSG+13
         LI,D3    ERRUNMSG
         BAL,SR4  LOGIT
         PLW,R1   *R0
         PLW,D3   *R0
GETCLIST EQU      %
         LW,D1    TCLSIZES,R3
         MTB,1    *D1               INCREASE SIZE OF TABLE
         LI,R7    CLSTBYT
         LB,R7    *D3,R7            GET CLIST VAL FROM DEVICD1
         STB,R7   *D1,R1            STORE IT IN TCLSIZES TBL FOR LATER
         LI,R7    0                 USED FOR DCT3 BITS 6-7
         MTW,0    DUALFLG,R3        IS DUAL FLAG SET
         BEZ      DCT3GEN           NO
         LW,D1    DCT1PPTR,R3       YES
         STH,SR2  *D1,R1            STORE NDD IN DCT1P
         LW,D1    DCT1APTR,R3       ADDRESS OF DCT1A
         MTW,0    *R4               THIS CHANTBLE DUAL ?
         BNEZ     %+3               YES
         STH,SR2  *D1,R1            NO, STORE NDD IN DCT1A
         B        DCT3GEN           GEN. DCT3
         LCI      3
         LM,SR1   *D3
         LH,R6    *R4               GET 1ST ND FROM CHANTBL
         SLS,R6   4                 ADJUST TO DEVICD1+1 NDD ENTRY
         LI,R7    X'FFF0'           MASK FOR ND
         CS,R6    SR2               DOES ND(1) = ND OF DEVICD1 ENTRY
         BNE      NDNTEQ            NO
         LW,R6    *R4               YES,GET DUAL ENTRY
         SLS,R6   4                 ADJUST TO DEVICD1+1 NDD ENTRY
         AND,R6   R7
         LI,R7    X'F'              EXTRACT 2ND D FROM NDD IN DEVICD1
         AND,R7   SR2
         OR,R6    R7                MERGE ND OF DUAL
         STH,R6   *D1,R1            STORE IN DCT1A
         LI,R7    3                 BITS 6-7 = 11
         B        DCT3GEN
NDNTEQ   EQU      %
         STH,SR2  *D1,R1            STORE NDD IN DCT1A
         MTW,0    *R4               IOPS DIFFERENT?
         BLZ      %+3               YES
         LI,R7    0
         B        DCT3GEN
         LCI      3
         LM,SR1   *D3
         LI,R7    X'FF00'           EXTRACT 'N' FROM DEVICD1+1
         CS,R6    SR2               IS N = 1ST N OF CHANTBL
         BNE      %+3
         LI,R7    1                 YES, BITS 6-7 = 01
         B        DCT3GEN
         LW,R6    *R4
         SLS,R6   4                 POSITION TO DEVICD1+1 ENTRY
         AND,R6   R7                ISOLATE N OF CHANTBL ND(2)
         CS,R6    SR2               IS N = 2ND N OF CHANTBL
         BNE      %+3
         LI,R7    2                 YES BITS 6-7 = 10
         B        DCT3GEN
         LI,R7    0                 NO,BITS 6-7 = 00
DCT3GEN  EQU      %
         LW,D1    DCT3PTR,R3
         STB,R7   *D1,R1
         LCI      3
         LM,SR1   *D3
         LW,D1    DCT24PTR,R3
         PSW,R5   *R0
         LB,R5    SR3
         AND,R5   =8                EXTRACT NOPART BIT FROM DEVICD1
         SLS,R5   -3
         MTW,0    1,R4              CHK FOR NOPART BIT IN CHANTBL
         BEZ      %+2
         AI,5     32                PICK UP NOPART ON CHAN CARD
         LI,R6    MORFLGS           GET BYTE DISPLACEMENT TO MORFLGS IN
         LB,R6    *D3,R6            DEVICD1 TABLE
         CW,R6    X80               SEE IF MPC BIT IS SET
         BAZ      %+3               BRANCH IF NOT
         SLS,R6   -5                TO SET BIT 5 OF DCT24 DEVICE BYTE
         EOR,R5   R6                MERGE WITH WHATEVER IS IN R5
         STB,R5   *D1,R1
         PLW,R5   *R0
         LI,R6    MOD#NDX
         LB,R6    *D3,R6
         BEZ      ABORT+1
         LW,D1    MODNUMPTR,R3
         STB,R6   *D1,R1
         PLW,R6   *R0
GENON    EQU      %
         LW,D1    DCT2PTR,R3
         STB,R2   *D1,R1            DCT2 = CIT INDEX
         LB,R7    SR2
         AI,R7    -1
         CI,R7    16                IS  IT 'ME'
         BNE      GENON1            NO
         LI,D1    COCS
         AW,D1    R3
         MTH,1    *D1
         LH,R2    *D1               FOR TAURUS STORE DCTX NOT 'NDD'
         CI,R2    8                 8 COC DEVICES IS THE MAXIMUM
         BLE      GENON1A
         PSW,D3   *R0
         LI,D3    2MNYCOCS
         BAL,SR4  LOGIT
         PLW,D3   *R0
         B        GENON1
GENON1A  EQU      %
         STH,R1   *D1,R2            STORE IT IN DCT2 TABLE
         LI,R6    FEX
         LB,R6    *D3,R6            CHECK FOR AN FECP SPECIFICATION
         BEZ      GENON1            ON THIS COC
         LI,D2    COCFEX#           YES. NEED TO GENERATE AN ENTRY
         AW,D2    R3                FOR USE BY P2COC PASS2 MODULE
         STB,R6   *D2,R2
GENON1   EQU      %
         CI,R7    14                IS THIS RB DEVICE
         BNE      GENON2            NO
         STW,R1   HIRBIN,R3         STORE AS RBT DCT INDEX
         MTW,0    LORBIN,R3         IS THIS FIRST RBT
         BNEZ     GENON2            NO
         STW,R1   LORBIN,R3         YES,GENERATE TABLE AREA
         LCI      15
         PSM,D2   *R0
         LW,D1    HGP1ADDR,R3       GET ADDR WHERE TABLES TO GO
         LW,D2    LORBIN,R3
         SLS,D2   1                 CNVT TO DW
         SW,D1    D2                BUMP PTR BACK
         PAGE
**** NOTE THAT RBDWSNPTR, RBFLAGPTR, RBHACKPTR AND RBBSPCPTR
**** ARE GOING TO OVERLAP OTHER TABLES.  HOWEVER THE START OF THESE
**** TABLES ARE MERELY USED TO CALCULATE THE DESIRED LOCATION WHICH
**** FALLS INTO UNIQUE AREAS FOR THESE TABLES.
*
         STW,D1   RBDWSNPTR,R3
         AW,D1    D2
         LW,D2    #RBTS,R3
         SLS,D2   1
         AW,D1    D2
         SW,D1    LORBIN,R3         BUMP PTR BACK
         STW,D1   RBFLAGPTR,R3      STORE AS START OF  TABLE
         AW,R1    #RBTS,R3          R1=LORBT+#RBTS
         AW,D1    R1                CURRENT PTR POSITION
         LW,D2    LORBIN,R3         INDEX VALUE
         SLS,D2   -2                AS #WORDS FOR BYTE TABLE
         AI,R1    3
         SLS,R1   -2                R1 = SIZE OF TABLE IN WORDS
         LI,R2    5
         LI,D3    RBBSPCPTR
         SW,D1    D2                BACK UP PTR
         STW,D1   *D3,R3            STORE AS PTR
         AW,D1    R1                BUMP UP CURRENT POSITION
         AI,D3    1                 CHANGE STORAGE LOC.
         MTW,-1   R2
         BNEZ     %-5
         AI,D1    1
         SLS,D1   -1                BOUND 8 FOR NEXT TABLE
         SLS,D1   1
         STW,D1   HGP1ADDR,R3
         STW,D1   HGP1PTR,R3
         LCI      15
         PLM,D2   *R0
         CW,D1    DYSTORND,R3
         BL       GENON2
         BAL,SR4  ERRBOR14
         B        OUTOFIT
GENON2   EQU      %
         CI,R7    X'A'              DUMMY TAPE TYPE
         BNE      SPTYP             NO
         PSW,R2   *R0               YES
         PSW,R7   *R0
         LI,R2    DEVTYNDX          DISP TO TRUE TYPE NDX IN DEVICD1 TAB
         LB,R7    *D3,R2            GET TRUE TYPE
         AI,R7    -1                CORRECT TO FINAL TYPEMNE
         BAL,SR4  SETDTTN4
GEN2O    PLW,R7   *R0
         PLW,R2   *R0
         B        GENONSTD
SPTYP    CI,R7    X'C'
         BE       GENON2+2
         LI,SR4   GENON2B
SETDTTN4 EQU      %
         LW,D1    DCT4PTR,R3
         STB,R7   *D1,R1            DCT4 = TYPMNE INDEX
         LW,D1    BTXPTR,R3         SET UP DCT INDEX
         MTB,0    *D1,R7            IN BTX,OTX,GTX TBLS
         BNEZ     GENON2B
         STB,R1   *D1,R7
         LW,D1    OTXPTR,R3
         STB,R1   *D1,R7
         LW,D1    GTXPTR,R3
         STB,R1   *D1,R7
         B        *SR4
GENON2B  EQU      %
         AI,R7    1
         LB,D2    IOFLOACT,R7
         CI,R7    IOFLOLNG
         BLE      GEN3              USE STD. FLOW (IO,I,O)
GENONSTD LB,D2    SR3               FOR NON-STANDARD DEVICES
         AND,D2   X3                FOR NON-STANDARD DEVICES
         BNEZ     %+2                  FLOW (IO,I,O) ON DEVICE CC
         LW,D2    X3
         SLS,D2   6
GEN3     EQU      %
         LW,D1    DCT3PTR,R3
         LB,R7    *D1,R1
         OR,D2    R7                'OR' BITS 6-7 WITH FLOWBITS
         STB,D2   *D1,R1            DCT3 = I/O/IO LEGAL FLAGS
         LW,D1    SR3               GET  --YY
         LW,D2    SR1                    NDD-
         AND,D1   M16
         SLD,D1   -8
         LI,SR4   KFFFF
         CS,SR3   XRB               IS IT RB
         BNE      %+3               NO
         OR,D1    L(X'155C4040')    YES
         B        %+2
         OR,D1    L(X'05404000')       'TAB BLNK BLNK YYNDD'
         LW,SR4   DCT16PTR,R3
         STD,D1   *SR4,R1           DCT16=NL YYNDD / TAB BLNK BLNK YYNDD
         LH,SR4   SR3
         AND,SR4  XFF
         SLS,SR4  2                 DWD INDEX HANDLER NAME1
         LI,R7    MORFLGS
         LB,R7    *D3,R7            CHECK IF THIS IS AN RHANDLER
         CI,R7    1
         BAZ      %+2
         OR,SR4   Y8                SET BIT0 OF DCT8 AS A FLAG
         LW,D1    DCT8PTR,R3
         STW,SR4  *D1,R1            DCT8 = HANDLER NAME1 ADDR.
*                            INITIALLY = INDEX TO HANDTAOR TABLE
         AI,SR4   2                 DWD INDEX HANDLER NAME2
         LW,D1    SR3               GET YY
         AND,D1   M16
         CW,D1    XMC
         BNE      GETDCT9
         MTW,0    MCDEV,R3          THERE SHOULD ONLY BE 1 MC DEVICE
         BEZ      SETBIT1
         LI,D1    2MNYMCS
         PSW,SR4  *R0
         XW,D3    D1
         BAL,SR4  LOGIT
         XW,D3    D1
         PLW,SR4  *R0
SETBIT1  OR,SR4   Y4
         STW,R1   MCDEV,R3          SET MC DEV INDEX
GETDCT9  EQU      %
         LW,D1    DCT9PTR,R3
         STW,SR4  *D1,R1            DCT9 = HANDLER NAME2 ADDR.
*                            INITIALLY = INDEX TO HANDTAOR TABLE
         LW,SR4   SR3
         AND,SR4  M16
         CI,SR4   '9T'
         BNE      CHK7
TESTTP   MTW,0    SVDFTP,R3
         BNEZ     AVRENT
         LW,D1    DCT4PTR,R3
         LB,D1    *D1,R1            GET TRUE TYPNEMONIC
         STW,D1   SVDFTP,R3
         B        AVRENT
CHK7     CI,SR4   '7T'
         BE       TESTTP
         CI,SR4   'DP'
         BNE      CHKDSK
         MTW,0    REMEMBER,R3          SEE IF FIRST DP DCT INDEX WAS
         BNEZ     TESTDK               SAVED. BRANCH IF SO
         STW,R1   REMEMBER,R3          SAVE LOWEST DCT INDEX
TESTDK   MTW,0    SVDFDK,R3
         BNEZ     AVRENT
         LW,D1    DCT4PTR,R3
         LB,D1    *D1,R1
         STW,D1   SVDFDK,R3
         B        AVRENT
CHKDSK   LB,SR4   SR2
         CI,SR4   X'D'              IS IT AN SP DEVICE
         BE TESTDK
         CI,SR4   X'B'              IS IT A MT DEVICE
         BE       TESTTP
         B        SETDCT1
AVRENT   EQU      %
         MTW,0    BATAPE,R3
         BNEZ     SETDCT1
         STW,R1   BATAPE,R3         NO, SAVE DCT INDEX OF 1ST MT
         STW,R1   NBATAPE,R3          AND MAKE NEGATIVE
         LCW,R1   R1                    AND SAVE
         XW,R1    NBATAPE,R3        R1 = ORIGINAL DCT INDEX
*
         PAGE
*                                GET PAPER SIZE AND WIDTH VALUES
*                                FOR DEVICES WITH SPECIAL INFO IN CLIST
*                                AND SAVE IT IN TABLE - TPSZWID FOR
*                                LATER PROCESSING IN P2COC
SETDCT1   EQU     %
         LI,SR4   KFFFF
         CS,SR3   XRB          RB?
         BE       SPCLIST           IF EQUAL THEN GO TO SPECIAL CLIST
         CS,SR3   L(X'C3D7')        CP
         BE       SPCLIST
         CS,SR3   L(X'E3E8')        TY
         BE       SPCLIST
         CS,SR3   L(X'D3D7')        LP
         BE       SPCLIST
ENDDCCHK EQU      %
*                                   BUILD TB:SZ,TB:MAX,TB:FLGS,TB:FLGS1
         LB,R7    SR2               GET TYPE INDEX
         CI,R7    X'B'              IS IT MT
         BE       %+3
         CI,R7    X'D'              IS IT SP
         BNE      %+3
         LI,R4    DEVTYNDX          DISP TO TRUE TYPE NDX IN DEVICD1 TAB
         LB,R7    *D3,R4
         LW,D2    TBMAXPTR,R3
         MTB,0    *D2,R7
         BNEZ     ENDDC3
         LCI      15
         PSM,R1   *R0
         LI,R4    NEWFLGS
         LB,D1    *D3,R4
         STB,D1   D2
         STW,D1   R5                SAVE NEWFLAGS BYTE TEMPORARILY
         CI,R7    TYCHEND
         BG       ENDCCHKB
         AND,D1   XF                GET RIGHT 4 BITS OF NEWFLAGS
         BEZ      ENDCCHKA
         LI,R2    MORFLGS
         LB,R2    *D3,R2          SEE IF IT'S AN MPC DEVICE
         CW,R2    X80             IF SO WE'VE SET THE NON-STAND
         BANZ     ENDCCHKA        DEVICE OPTIONS SO SKIP WARNING
*                                 MESSAGE
         LB,SR1   ERROR36
         BEZ      ENDCCHKA
         XW,SR1   D3                TEMPORARILY SAVE D3
         LI,D3    ERROR36
         BAL,SR4  LOGIT
         XW,SR1   D3
         LB,SR1   0                 INSURE THAT MESSAGE ONLY GETS
         STB,SR1  ERROR36           PRINTED ONCE
ENDCCHKA EQU      %
         LB,SR1   TYPEFLAGS,R7
         B        ENDUP
ENDCCHKB SLS,D2   1
         BEV      %+3               BRANCH IF NOT LISTING TYPE
         LI,SR1   X'53'
         B        ENDUP-3
         SLS,D2   1
         BEV      %+3               NOT TAPE TYPE
         LI,SR1   X'B0'
         B        ENDUP-3
         SLS,D2   1
         BOV      ENDCCHKC          BRANCH IF IT IS A DISK TYPE
         LI,R4    FLAGS              NOT DISK NEED TO KNOW IF ANY NON-
         LB,SR1   *D3,R4             STAND. DEVICE OPTIONS WERE SPECIFIED
         AND,SR1  X3                FOR A NON-STAND NON-DISK DEVICE
         SLS,SR1  4                 SUCH AS IN/INOUT/OUT THEN POSITION
         B        ENDCCHKD          FOR TB:FLGS REQUIREMENTS
ENDCCHKC EQU      %
         BNEZ     %+2               BEEN SAVED, BRANCH IF SO
         STW,R1   REMEMBER,R3       SAVE LOWEST DCT INDEX  FOR PACK
         LI,SR1   X'F0'
         B        ENDUP-3
         LI,SR1   0
         LW,SR2   =X'03000000'
         LS,SR2   SR3
         BNEZ     %+2
         LW,SR2   =X'03000000'
         SLS,SR2  -20               POSITION FOR I/O
         EOR,SR2  =X'30'            FLIP THE IO BITS
         BNEZ     %+2               IS EITHER I OR O
         LI,SR2   X'30'             IS IO
         OR,SR1   SR2
ENDCCHKD STB,D1   D2
         AND,D1   XF                GET BITS FROM NEW FLAGS
         OR,SR1   D1
ENDUP    LW,SR2   TBFLGSPTR,R3
         STB,SR1  *SR2,R7
         SLS,D2   1                 CHECK AGAIN FOR LISTING
         BOD      LISTTYPE          YES
         CI,R7    TYCHEND
         BG       MAXSTORE
         LI,SR1   X'FF'
         CI,R7    6                 IS IT CP
         BNE      %+2
         LI,SR1   120               FOR TBMAX
         CI,R7    X'13'             CHECK IF IT'S AN  MC DEVICE
         BNE      %+2
         LI,SR1   132               SET DEFAULT MXREC FOR MC, TO 132
         LI,SR3   1                 FOR TBSZ
         CI,R7    X'F'              CHK IF IT'S AN RB DEVICE
         BNE      %+2
         LW,SR1   X80               SET DEFAULT FOR RB TO 128
         B        ENDDC2
MAXSTORE EQU      %
*****             THE FOLLOWING CODE IS FOR THE MAX AND MIN RECORD
*                 LENGTHS FOR NON-STANDARD AND NON-LISTING DEVICES
         LI,R4    MXREC             GET MXREC
         LB,SR1   *D3,R4            TB:MAX
         BGZ      %+2
         LI,SR1   X'FF'
         AI,R4    1
         LB,SR3   *D3,R4            GET MREC
         BGZ      %+2
         LI,SR3   1
         B        ENDDC2
*****
LISTTYPE EQU      %
         LI,R4    PAPRWD
         LB,SR1   *D3,R4            PAPER WIDTH FOR LIST TYPE
         LI,R4    PAPRSZ
         LB,SR3   *D3,R4            PAPER SIZE
ENDDC2   EQU      %
         LW,SR2   TBMAXPTR,R3
         STB,SR1  *SR2,R7
         LW,SR2   TBSZPTR,R3
         STB,SR3  *SR2,R7
         CI,R5    X'40'             IS IT A TAPE TYPE DEVICE
         BAZ      ENDDC2A           BRANCH IF NOT
         LI,R4    CCDDBYT           DISP TO CC/DD FLAG BYTE
         LB,R5    *D3,R4
         LW,SR2   TBFLGS1PTR,R3
         LI,R4    MOD#NDX
         LB,R6    *D3,R4            GET MOD # INDEX
         SLS,R6   1                 IT'S A DW INDEX
         LW,R4    MODTABPTR,R3
         AW,R4    R6
         LW,R4    *R4
         LW,R2    X7332             IS IT A 7332 POTTER TAPE MOD #
         CW,R4    R2
         BE       POTRFLG
         AI,R2    1
         CW,R4    R2                IS IT A 7233 POTTER TAPE
         BNE      %+2
POTRFLG  AI,R5    X'20'
         STB,R5   *SR2,R7
ENDDC2A  EQU      %
         LCI      15
         PLM,R1   *R0
ENDDC3   EQU      %
         STW,R1   *D3               SAVE DCT INDEX
         AI,R1    1                 TO NEXT DCT ENTRY
         AI,D3    DEVICDSZ
         B        GENEXT
*
PULL2OUT EQU      %
         B        OUTOFIT
*
*
NODCABOR EQU      %
         BAL,SR4  ERRBOR16 ***      NO DISC DEFINED
         B        OUTOFIT
*
*
SPCLIST  EQU      %                 SET UP SPEC CLIST INFO IN TABLE
         LCI      2
         PSM,SR1  *R0
         LW,R4    R1                R4 WILL = DCTX
         SCS,R4   -8                R4 WILL CONTAIN FOLLOWING::::
         AND,SR1  M8
         SLS,SR1  8                 BYTE 0 = INDEX INTO CLIST SIZE TABLE
         SLS,SR2  -16               BYTE 1 = NOTHING
         AND,SR2  M8
         OR,R4    SR1               BYTE 2 = PAPER SIZE ENTRY OF DEVICD1
         OR,R4    SR2               BYTE 3 = PAPER WIDTH ENTRY OF  "
         LW,SR4   TPSZWID,R3
         LW,R7    *SR4              GET SIZE OF THIS TABLE
         AI,R7    1
         STW,R7   *SR4
         STW,R4   *SR4,R7           SAVE IT FOR LATER
         LI,SR4   KFFFF
         CS,SR3   XRB               IS IT AN RB DEVICE
         BE       RBCONT
         LCI      2
         PLM,SR1  *R0
         B        ENDDCCHK
         PAGE
*
RBCONT   EQU      %
         LW,SR1   RBBLPZPTR,R3
         STB,SR2  *SR1,R1           R1 =DCT INDEX
         LW,SR1   RBBCPZPTR,R3
         LI,SR2   X'50'
         STB,SR2  *SR1,R1
         LI,R4    FEX
         LB,SR2   *D3,R4
         BNEZ     %+4               CHECK IF THIS IS AN FECP RBT
         LI,SR2   2                 IF NO FECP, RBB:CRC BYTE GETS
         LW,SR1   RBBCRCPTR,R3      SET TO 2 - OTHERWISE IT'S ZERO
         STB,SR2  *SR1,R1
         LI,SR2   0
         CW,SR3   Y1                IS IT FULL
         BAZ      %+2               NO,HALF
         LI,SR2   X'8000'           YES
         CW,SR3   Y2                RBS
         BAZ      %+2               YES
         OR,SR2   X20000            NO,RBX
         CW,SR3   Y46
         BAZ      SETIRBT+1         NEITHER ONE THEN BRANCH
         CW,SR3   Y06
         BAZ      SETIRBT           BRANCH IF JUST IRBT SPECIFIED
         OR,SR2   Y002
         B        SETIRBT+1
SETIRBT  OR,SR2   Y02
         LI,R4    DEVTYNDX          DISP TO WSN NDX IN DEVICD1 TABLE
         MTB,0    *D3,R4            IS WSN SET
         BNEZ     SETWSNBT          BRANCH IF WSN HAS BEEN SPECIFIED
         CW,SR2   Y02               OTHERWISE CHK IF AN IRBT FLAG HAS BEEN
         BNE      CHKDIAL           SET. BRANCH IF NOT AN IRBT
         LW,SR1   RBTTYP            NOW LET'S CHK FOR AT LEAST 1-2780
         CW,SR1   Y04
         BNE      CHKDIAL           SKIP FOLLOWING IF NONE
         EOR,SR2  Y02               REMOVE SETTING IN THE CASE WHERE
*                                   IT'S AN IRBT AND NO WSN HAS BEEN
         OR,SR2   Y002              SPECIFIED. THEN CONVERT IRBT FLAG
*                                   TO A 2780 FLAG INSTEAD
         B        CHKDIAL
SETWSNBT OR,SR2   Y04               SET WSN SPECIFIED FLAG
CHKDIAL  CW,SR3   Y8                WAS A DIAL OPTION SPECIFIED
         BAZ      %+2
         OR,SR2   Y0008
         LW,SR1   RBFLAGPTR,R3
         STW,SR2  *SR1,R1
         LB,R4    *D3,R4
         BEZ      NOWSN
         LW,SR2   WSNAMES,R3
         LW,D2    RBDWSNPTR,R3
         LD,SR1   *SR2,R4
         STD,SR1  *D2,R1
NOWSN    EQU      %
         LCI      2
         PLM,SR1  *R0
         B        ENDDCCHK
*********
         PAGE
*********
*  SET CIT3 BIT 4 = 1 IF DUAL ACCESS CHANNEL
*
GENCIT   EQU      %
         LW,R1    RCHAN,R3          #ENTRIES
         LW,R2    CHANPTR,R3
         LW,D2    CIT3PTR,R3
         LI,R4    8
CITLOOP  EQU      %
         MTW,0    *R2
         BEZ      %+2
         STB,R4   *D2,R1
         AI,R2    -5
         BDR,R1   CITLOOP
*****
         PAGE
GENRBT   EQU      %
         LI,R1    1
         LW,D2    RBLIMSPTR,R3
         MTW,0    #RBTS,R3          ANY RBTS
         BNEZ     %+5               YES
         LW,D1    DCTSIZE,R3
         LW,D4    D1
         AI,D1   -1
         B        %+3
         LW,D1    HIRBIN,R3
         LW,D4    LORBIN,R3
         STW,D1   *D2,R1
         STW,D4   *D2
         PAGE
*********
*  SEACRH DISC INFO TABLE FOR PSA FIRST, THEN DO THE REST
*********
SRCHPSA  EQU      %
         LI,R1    %+2               RETURN FROM HGPENSET
         LW,D1    DCINADDR,R3
         LI,R2    PSAD
         MTH,0    *D1,R2            FIND ONE WITH PSA
         BNEZ     HGPENSET          GOT ONE
SRCHNXT  EQU      %
         MTW,0    *D1
         BEZ      NOSRCHPSA         END OF DISC INFO
         LI,R2    X'FF'             SKIP TO NEXT ENTRY
         AND,R2   *D1
         AW,D1    R2
         B        *R1
NOSRCHPSA EQU %
         CI,R1    %
         BG       ALLTMP
         LI,R1    %+2
         LW,D1    DCINADDR,R3
         MTW,0    *D1
         BLEZ     SRCHNXT           END OR BAD PSA
         PAGE
*
HGPENSET EQU      %
         PUSH     15,R1
         LW,D4    D1
         LH,SR1   *D1
         AW,SR1   DEVIADDR,R3       DEVICD1 ADDR
         LW,R1    *SR1              DCT INDEX
         LW,SR4   HGP1PTR,R3        STORE DCT INDEX
         STW,SR4  R7
         STW,SR4  LASTHGP1,R3       EACH TIME MAY BE THE LAST
         AI,R7    K40
         CW,R7    DYSTORND,R3
         BG       ERR11OUT
         AI,SR4   K1
         STH,R1   *SR4              DCT INDEX IN WORD2 OF HGP
         AI,SR4   K1                 ADJUST
         LI,R2    NSPTD
         LH,SR2   *D4,R2            GET NSPT
         STW,SR2  *SR4
         LI,R2    SSD
         LH,D3    *D4,R2            SECTOR SIZE
         BAL,R6   SET22             YES,GO SET DCT 22
         LW,R6    SSIZE,R3          SET DISC SECTOR SIZE
         BNEZ     HGPEN1              ONLY ON FIRST DISC
         STW,D3   SSIZE,R3          SAVE SECTOR SIZE (ALL DISCS SAME)
         STW,R1   DCN,R3            SAVE DCTX OF 1ST DISC DEVICE
HGPEN1   EQU      %
         LI,R7    K200              TAKE 512
         AW,R7    D3                  + SS - 1
         AI,R7    -1                DIVIDED BY
         DW,R7    D3                  SS = NSG
*
         AI,SR4   K1
         STW,R7   *SR4              NSG IN WORD4
         AI,SR4   K1                 AND
         STW,R7   *SR4                WORD5
         AI,SR4   -3                BACK TO WORD 2
         MTW,1    *SR4              NQT = 1
         LI,R6    X'FF00'           GET CYL,PRIV,TYPE
         AND,R6   *D4
         CI,R6    CYLBIT
         BAZ      NOTCYLIND
         LW,SR2   R7                CHANGE SR2 TO NSG*NGC
         LI,R2    PERD
         AH,R6    *D4,R2            ADD IN NGC
         MH,SR2   *D4,R2
         LI,R7    0                 ZAP PER
         STH,R7   *D4,R2
NOTCYLIND  EQU    %
         LI,R7    X'FFFF'
         STS,R6   *SR4
         CI,R6    X'800'            IS THIS DP
         BAZ      FORMHGP
         LW,R2    R1                GET DCT INDEX FOR THIS DP
         SW,R2    REMEMBER,R3       SUBTRACT OFF DCT INDEX OF 1ST DP
         AW,R2    NUMTAPES,R3
         SLS,R2   1                 SKIP OVER TO FIRST DP ENTRY IN
         AW,R2    AVRTBLAD,R3       AVR TABLE SO AS TO PRESET WORD 2
*                                   ENTRY WITH PUBLIC OR PRIV. BIT
         LI,R7    0                 0 = PRIVATE BIT
         CI,R6    PRIVBIT
         BANZ     %+2
         LW,R7    Y8                NO, PUBLIC
         AW,R7    HGP1PTR,R3
         SW,R7    HGP1ADDR,R3
         STW,R7   1,R2
         B        FORMHGP
         PAGE
************************************************************
*                                                          *
*     SET DCT22 AND BUILD DISCLIMS,NCYL,NTPC,NSPT,         *
*      CYL%SHFT,TRK%SHFT,SEC%SHFT TABLES                   *
*     ENTRY                                                *
*        R6= LINK                                          *
*        SR1 = DEVICD1 ADDRESS OF ENTRY                    *
*        SR2 = NSPT                                        *
*        R1 = DCT INDEX                                    *
*        D4= DCINADDR ADDRESS OF ENTRY                     *
************************************************************
SET22    EQU      %
         LCI      15                SAVE REGISTERS
         PSM,R1   *R0
         LI,R4    DSCLMNDX
         LB,R4    *SR1,R4           GET DSKTYPE INDEX
         LW,SR4   DCT22PTR,R3
         STB,R4   *SR4,R1           SET DCT22
         LW,SR4   DISCLIMSPTR,R3
         MTW,0    *SR4,R4           ALREADY SET
         BNEZ     FNHUP             YES
         LI,R2    2                 GET TYPE FROM DEVICD1 ENTRY
         LB,SR3   *D4,R2
         AND,SR3  =X'F'
         CI,SR3   7
         BNE      %+2
         OR,R6    =X'80000000'      BIT 0 SET IF FIXED HEAD
         LW,SR4   NSPTPTR,R3        SET NSPT FOR DEVICE TYPE
         STW,SR2  *SR4,R4
         LI,R2    NTPCD
         LH,D1    *D4,R2
         BNEZ     STORNTPC          EITHER KNOWN RAD OR DP
         MTW,0    R6                IS IT FIXED HEAD TYPE
         BGEZ     ERNTPC            NTPC NOT SPEC FOR NEW ONE
         LI,R2    SIZED
         LH,D1    *D4,R2            SIZE AS #TRACKS
         BEZ      ERSIZE            MISSING
STORNTPC  LW,SR4  NTPCPTR,R3
         STW,D1   *SR4,R4
         MW,SR2   D1                NSPT*NTPC
         AND,SR2  M16X2
         LW,SR4   NSPCPTR,R3
         STW,SR2  *SR4,R4
         MTW,0    R6
         BLZ      STORNOW           RAD TYPE
         LI,R2    NCYLD
         LH,D1    *D4,R2
         BEZ      ERNCYL
         LW,SR4   NCYLPTR,R3
         STW,D1   *SR4,R4
         MW,SR2   D1                NSPT*NTPC*NCYL
STORNOW  LW,SR4   DISCLIMSPTR,R3
         STW,SR2  *SR4,R4
         MTW,0    R6
         BGEZ     %+3
         LW,SR2   NOPDUM
         B        CYLSTOR
         LI,R2    CYLSD
         LB,SR2   *D4,R2            CYLS SHIFT VALUE
         OR,SR2   CYLSDUM
CYLSTOR  LW,SR4   CYLSPTR,R3
         STW,SR2  *SR4,R4
         LI,R2    TRKSD
         LB,SR2   *D4,R2            TRACK SHIFT VALUE
         OR,SR2   TRKSDUM
         LW,SR4   TRKSPTR,R3
         STW,SR2  *SR4,R4
         MTW,0    R6
         BLZ      %+3
         LW,SR2   NOPDUM
         B        SESTOR
         LI,R2    SECSD
         LB,SR2   *D4,R2
         OR,SR2   SECSDUM
SESTOR   LW,SR4   SECSPTR,R3
         STW,SR2  *SR4,R4
FNHUP    LCI      15
         PLM,R1   *R0
         B        0,R6
*
ERNTPC   M:PRINT  (MESS,ERNTPCM)
         MTW,1    P2ERR,R3          INCREMENT ERROR COUNT
         LCI      15
         PLM,R1   *R0
         B        OUTOFIT
ERNTPCM  TEXTC    '*** NTPC MISSING FOR MOVEABLE HEAD',;
                  ' DISK DEVICE'
*
ERSIZE   M:PRINT  (MESS,ERSIZEM)
         B        ERNTPC+1
ERSIZEM  TEXTC    '*** SIZE MISSING FOR FIXED HEAD DISK ',;
                  'DEVICE'
*
ERNCYL   M:PRINT  (MESS,ERNCYLM)
         B        ERNTPC+1
ERNCYLM  TEXTC    '*** NCYL MISSING FOR MOVEABLE HEAD',;
                  ' DISK DEVICE'
         PAGE
FORMHGP  EQU      %
         AI,SR4   2
         LW,R7    *SR4              GET NSG FROM HGPTABLE
         LI,R2    PSAD
         LH,D1    *D4,R2
         BEZ      PTWD6
         MTW,0    SWAPUTS,R3        DP SWAPPER
         BEZ      %+3               NOT DP SWAPPER
         BAL,R4   CHKDPKND          YES. DP SWAPPER
         B        CHKPSA
         LI,R4    FLAGS
         LB,D3    *SR1,R4           SR1= DEVICD1 ENTRY
         CI,D3    X'40'
         BANZ     CHKPSA            KNOWN RAD TYPE DEVICE
         BAL,R4   CHKNEWRAD
CHKPSA   EQU      %
         MTW,0    PSA,R3            PSA BEFORE
         BNEZ     PTWD6             YES
         PSW,SR2  *R0               SAVE NSPT
         MTW,0    SWAPUTS,R3        IF DP SWAPPER, D1 = # CYL.
         BEZ      ISTRKS
         LW,SR2   DPPSASEC          GET # OF DP SECTORS OF PSA
         B        %+2
ISTRKS   MW,SR2   D1                IT'S A RAD.
         STW,SR2  PSA,R3            SAVE FOR DEF
         PLW,SR2  *R0
PTWD6    AI,SR4   1                 PTS TO PER WRD LGTH WD 4
         LI,R4    PERD
         LW,SR1   *D4               GET WORD0 OF DEVICD1 ENTRY
         BAL,D3   SETGRANO          PER GRAN MAP DONE, SR4 =WD5
         BAL,D3   SETGRANO          PFA GRAN MAP DONE, SR4=WD6
*     R7= NSG
         STW,R7   R5
         AI,SR4   -1                PTS TO #WRDS PER
         LI,R4    1
         MTH,0    *D4,R4
         BLZ      ANYRAD
         MTW,0    SDGANSG,R3
         BNEZ     %+2
         STW,R7   SDGANSG,R3
ANYRAD   EQU      %
         LH,SR2   *SR4              SR2= #WRDS PER
         AI,SR4   1                 PTS TO PFA
         LH,SR3   *SR4              SR3= #WRDS PFA
         BAL,R4   FINHGP
         AW,SR2   SR4               ADD BIAS
         AW,SR2   SR3               #WRDS PFA
         AI,SR2   2                 +1 FOR NEXT+1 FOR DW
         SLS,SR2  -1
         SLS,SR2  1
         AI,SR4   -6
         STW,SR2  *SR4              SET FLINK
         LI,R2    PSAD              YES,GET PSA TRACKS
         LH,D1    *D4,R2
         LI,R2    4                 STORE IN LEFT HW - WD3
         STH,D1   *SR4,R2           USE TO GENERATE SWAPTBLS
         SW,SR2   HGP1PTR,R3                                            897
         AWM,SR2  HGP1PTR,R3        UPDATE TABLE POINTER
         LI,R2    3
         LH,SR2   *SR4,R2           IS IT PRIVATE HGP
         CI,SR2   X'4000'
         BAZ      HGPOUT
         AI,SR3   7
         CI,SR3   512
         BG       ERRPRIV
HGPOUT   EQU      %
*
         PULL     15,R1
         LI,R2    -1
         STH,R2   *D1               SET DONE FLAG
         B        SRCHNXT
*
ERR11PLOT  EQU    %
         PULL     D2                DUMMY PULL
ERR11OUT EQU      %
         PULL     15,R1
         LI,D3    MSG11
         BAL,SR4  LOGIT+1           'HGP TABLE FULL'
         BAL,SR4  PRPAGES           PRINT ACTUAL #PAGES GOTTEN
         B        PULL2OUT
ERRPRIV  PULL     15,R1
         LI,D3    PRIVM
         BAL,SR4  LOGIT
         B        OUTOFIT
PRIVM    TEXTC    '*** PRIVATE DISK HGP EXCEEDS ONEPAGE'
ERR12OUT EQU      %
         LI,D3    SGPERR
         BAL,SR4  LOGIT+1
         BAL,SR4  PRPAGES
         B        OUTOFIT
SGPERR   TEXTC    '*** CANNOT BUILD SGP OR NON-RESIDENT HGP'
         PAGE
************************************************************
*                                                          *
*  CHECKS FOR DP PSA                                       *
*                                                          *
*   ENTRY - ALL REGISTERS SAVED                            *
*     R4 = LINK ADDRESS                                    *
*     D4 = WD0 OF DCINTBL ENTRY                            *
*     D1 = # OF PHYSICAL CYLINDERS                         *
*    SR2 = NSPT                                            *
*          R7 = NSG                                        *
*          SR1 = DEVICD1 ENTRY                             *
*   EXIT                                                   *
*                                                          *
*                                                          *
*                                                          *
*                                                          *
*                                                          *
************************************************************
CHKDPKND EQU      %
         LCI      15                SAVE REGISTERS
         PSM,R1   *R0
         LI,R1    8
         LB,D2    *SR1,R1           GET FLAGS BYTE
         CI,D2    X'40'
         BANZ     SIZOKPSA       BRANCH IF NOT A NEW DEVICE
         BAL,SR4  ERRNEWS           MESSAGE TO USER RE NEW DP SWAPPER
SIZOKPSA EQU      %
         STW,D1   SCYLPSA,R3        STORE PHYSICAL CYLINDERS
FNHCYL   EQU      %
         LI,R1    NTPCD
         LH,R1    *D4,R1            NTPC
         LW,R4    SR2
         MW,SR2   R1                CALC. # SEC/PHYSICAL CYLINDER
         AND,SR2  M16X2             ROUND OFF ANY UNEVEN NO.
         LW,R5    SR2
         DW,SR2   R7                NSPT*NTPC/NSG = GRAN/CYL
         SLS,SR2  16                POSITION FOR STORAGE
         STS,SR2  SCYLPSA,R3
         MW,R5    D1                NSPC*NCYL SPECIFIED = TOT SECTORS
         STW,R5   DPPSASEC          STORE # OF PSA SECTORS
         DW,R5    R4                SECTORS/NSPT = #OF TRACKS
         STW,R5   SPACKTRK
         LCI      15
         PLM,R1   *R0
         LI,R2    PSAD
         LH,D1    *D4,R2            RESTORE PSA CYLINDERS
         B        0,R4
*
ERRNEWS  LI,D3    NEWSWAP
         B        LOGIT
NEWSWAP  TEXTC    '*** WARNING NEW DISK PACK USED AS SWAPPER'
*
         PAGE
************************************************************
*                                                          *
*        NON-STANDARD FIXED HEAD DEVICE                    *
*        CHECKS THAT NUMBER OF TRACKS FITS INTO            *
*         MAX ALLOWABLE SECTORS                            *
*                                                          *
*      ENTRY                                               *
*        R4 = LINK ADDRESS                                 *
*        D4 = WRD0 OF DCINTBL ENTRY                        *
*       SR4 = HGP WRD3                                     *
*        D1 = #TRACKS PSA                                  *
*       SR1 = DEVICD1 ENTRY                                *
*       SR2= NSPT                                          *
*                                                          *
************************************************************
CHKNEWRAD LCI     4
         PSM,SR1  *R0
         LW,SR4   SR2               SAVE NSPT
         MW,SR2   D1                NSPT*#TRKS = SECTORS OF PSA
         CI,SR2   6144              MAX SECTOR SIZE OF 7232
         BLE      OKRAD
         LI,SR1   0
         LI,SR2   6144              MAX SECTORS/NSPT = ADJUSTED TRACKS
         DW,SR1   SR4
         LW,D1    SR2               RE-SET PSA TRACKS
         LI,R2    PSAD
         STH,D1   *D4,R2
         XW,SR3   D3
         LI,D3    NEWRADM
         BAL,SR4  LOGIT
         XW,SR3   D3
OKRAD    LCI      4
         PLM,SR1  *R0
         B        0,R4
NEWRADM  TEXTC    '*** FIXED HEAD DEVICE EXCEEDS MAX TRACKS',;
                  ' FOR SWAPPER - SET TO MAX TRACKS'
         PAGE
*
*  R7 = NSG; SR4 = WRD4,WRD5
*   D1 = PSA,PSA+PER;  R4 = PER,PFA ADDRESS  SR2=NSPT
*    D1 IS IN CYLINDER UNITS FOR PACKS. D1 IS IN TRACK UNITS FOR RADS
*      D4 PTS. TO DCINTBL
*
GMAPBIAS EQU      7
SETGRANO EQU      %
         AND,D1   M16               SETS GMAP FOR PER,PFA
         LH,D2    *D4,R4            GET SIZE TO ALLOCATE
         AND,D2   M16               STRIP
         STW,D2   R1                STORE IN R1
         BNEZ     %+3
         AI,SR4   1                 =0 SO GET OUT THIS TIME
         B        SETGRAN3
         CI,SR1   CYLBIT            IS IT LOGICAL CYLINDER ALLOCATED
         BANZ     SETGRAN1
         CI,SR1   DPTYPBIT          IS IT A PHYSICAL-CYLINDER DP
         BAZ      GETTOTSZ          BRANCH IF NOT A DP
*                                   OTHERWISE NEED TO CONVERTY  CYLINDERR
*                                   SPECIFICATION TO # OF SECTORS
         LI,R6    8
         LH,R6    *D4,R6            GET NTPC FROM WORD4 OF DCINTBL
         XW,R6    R1
         MW,R1    SR2               NTPC*NSPT = SECTORS/CYL
         AND,R1   M16X2             ROUND OFF ANY UNEVEN NO
         MW,D2    R1                #CYL*SEC/CYL = SECTORS
         XW,R1    R6
         B        %+2
GETTOTSZ EQU      %
         MW,D2    SR2
         DW,D2    R7                DIV BY NSG
SETGRAN1 EQU      %
         LH,R5    *SR4              =0 1ST TIME,PERWD 2ND TIME
         AI,R5    GMAPBIAS
         AI,SR4   1                 POINTS TO PER MAPWD;
*                                   POINTS TO PFA MAPWD
         PSW,D2   *R0               SAVE IF PER
         LW,R2    D2
         AND,R2   M5                IMPLIED DIV BY 32
*                                   WHERE R2 GETS LAST 5 BITS
         SLS,D2   -5
         CI,R2    0
         BE       %+2
         AI,D2    1                 D2=TOTAL #WRDS
         STW,D2   SR3               SR3 = TOTAL #WRDS
         XW,D1    R1                D1= #TRACKS OF PER THEN PFA
*                                   R1 = #TRACKS OF PSA THEN PSA+PER
*                                   R1 IS IN CYL. UNITS FOR PACKS
         PSW,R1   *R0
         CI,SR1   CYLBIT
         BANZ     TRKCALC
         CI,SR1   DPTYPBIT          IS IT A DISC PACK
         BAZ      TRKCALC           BRANCH IF NOT
         MW,R1    R6                #CYL*NTPC = NO OF TRACKS
         B        %+2
TRKCALC  EQU      %
         MW,R1    SR2               CALC. 1ST SECTOR
         AI,R1    K1             IF IT IS AN ODD SECTOR ADDRESS,
         AND,R1   M16X2          ROUND UP TO EVEN SEC. ADDRESS
         CI,R1    X'FFFF'           IS IT TOO BIG
         BG       SECTERR           YES
         SLS,D2   16
         OR,D2    R1
         STW,D2   *SR4              SET WRD 5; WRD 6
         PLW,R1   *R0
         AW,D1    R1                TOTAL # TRACKS PREV. ALLOC
         LW,R1    SR3
         AW,R5    HGP1PTR,R3        ADD ABS ADDR THIS BLOCK
         AW,SR3   R5                SR3 = LAST LOC +1
         CW,SR3   DYSTORND,R3       GMAP EXCEEDS AREA
         BGE      ERR11PLOT
         LW,D2    YFFFFFFFF
         LCW,R1   R1
         STW,D2   *SR3,R1
         BIR,R1   %-1
         CI,R2    0
         BE       %+6
         LI,R1    X'20'
         SW,R1    R2
         SLS,D2   0,R1
         AI,SR3   -1
         STW,D2   *SR3
         PLW,D2   *R0
         CI,R4    PERD
         BNE      %+2
         AWM,D2   #GRANPER,R3       ACCUMULATE #GRAN PER
SETGRAN3 AI,R4    -1
         B        *D3
*
SECTERR  EQU      %
         PLW,R1   *R0
         PLW,D2   *R0               DUMMY PULL FOR #GRAN
         LI,D2    0
         STH,D2   *D4,R4
         XW,D1    R1                RESTORE D1 TO #TRACKS PSA;
*                                   OR PSA+PER
*                                   IF DP,RESTORE TO CYLINDERS
         PSW,D3   *R0
         PSW,SR4  *R0
         CI,R4    PERD
         BE       PERERR
         LI,D3    PFASECT
         BAL,SR4  LOGIT
         B        PERERR+2
PERERR   LI,D3    PERSECT
         BAL,SR4  LOGIT
         PLW,SR4  *R0
         PLW,D3   *R0
         B        SETGRAN3
PFASECT  TEXTC    '*** PFA STARTING SECTOR EXCEEDS 16',;
                  ' BITS - PFA SET TO 0'
PERSECT  TEXTC    '*** PER STARTING SECTOR EXCEEDS 16',;
                  ' BITS - PER SET TO 0'
         PAGE
*     FINISH HGP ROUTINE
************************************************************
FINHGP   EQU      %
         LI,R2    -2
         LI,R6    GMAPBIAS
         CI,SR2   0
         BEZ      %+2
         STH,R6   *SR4,R2
         CI,SR3   0
         BEZ      %+3
         AW,R6    SR2
         STH,R6   *SR4
         LW,R5    SR3
         STH,SR2  R5
         STW,R5   *SR4,R2
         B        0,R4
         PAGE
*
*  ALLOCATE AREA FOR CONTROL TASK TEMP STACK
*
ALLTMP   EQU      %
         LW,R1    LASTHGP1,R3
         BEZ      NODCABOR          NO DISK DEFINED
         LW,R7    AVRTBLSZ,R3       GET TOTAL #DP & TAPES
         SLS,R7   16                SAVE IN LEFT HALF
         AW,R7    NUMTAPES,R3       NUMBER OF TAPES GOES IN RT HALF
         STW,R7   AVRTBLSZ,R3
         LI,R7    0
         STW,R7   *R1               SET LAST HGP LINK TO 0
         LW,SR3   HGP1PTR,R3
         LW,R1    HGP1ADDR,R3
         AI,R1    1
         STW,R1   *SR3              WORD-1 OF SPD
         AI,SR3   1
         LW,R1    DCTSIZE,R3        STACK SIZE IS:
         AW,R1    AVRTBLSZ,R3         DCTSIZE + AVRTBLSIZE + 1
         AND,R1   M16
         AI,R1    1
         STW,R1   R2
         AI,R1    X'8000'
         SLS,R1   16
         AI,R1    X'8000'
         STW,R1   *SR3              WORD-2 OF SPD
         STW,R2   SAVESWAP
         MTW,2    SAVESWAP
         AW,SR3   R2                MAKE END ADDRESS OF LM EVEN BOUND
         AI,SR3   1
*
*    ALLOCATE SWAP TABLES
*
ALLOSWAP EQU      %
         STW,SR3  SWAPPTR,R3        SAVE BEGINNING OF SWAP TABLES
         MTW,0    SWAPUTS,R3        SWAPPER DP ?
         BEZ      %+3               BRANCH IF NOT
         AI,SR3   4                 RESERVE 4 WORDS FOR DP SENSE BUFFER
         B        AD4SDP
         LI,R5    0                 NEED TO KNOW HOW MANY (IF ANY)
         LW,R4    SWAPMOD#          3214 DEVICES BECAUSE EACH SUCH
STSWLUP  LW,D1    SWAPMODT,R5       REQUIRES A 4-WRD SENSE BUFFER
         CW,D1    DP3214
         BNE      NDSWLUP        OTHER TYPES HAVE ONLY 1-WORD BUFFERS
         LB,R1    S#BYT,R5
         MI,R1    3              MULTIPLY # OF 3214 BY 3
         STW,R1   XTRASIZ           TO BE USED FOR STEPPING TO M:SGP TBL
         AW,SR3   R1             RESERVE SPACE FOR THIS SENSE AREA
         B        AD4SDP
NDSWLUP  AI,R5    1              STEP TO NEXT SWAP DEVICE ENTRY
         BDR,R4   STSWLUP
AD4SDP   AI,SR3   1              RESERVE 1 WORD FOR S:DP ENTRY
         LW,R1    #SWAPDEVS,R3      GET # OF PSA RADS
         MI,R1    #TWDSP            X # OF WORD TABLES=WORD TABLE AREA
         AW,SR3   R1                RESERVE SPACE FOR WORD TABLES
         LW,R1    #SWAPDEVS,R3      GET # OF PSA RADS
         AI,R1    1                 GET LENGTH OF HALFWORD TABLE
         SLS,R1   -1                AND MULTIPLY BY NUMBER OF H.W.
         MI,R1    #THWSP            TABLES TO GET HW TABLE AREA
         AW,SR3   R1                RESERVE SPACE FOR H.W.TABLES
         LW,R1    #SWAPDEVS,R3      DO ABOVE FOR BYTE TABLES
         AI,R1    3                 :
         SLS,R1   -2                :
         MI,R1    #TBYSP            :
         AW,SR3   R1                :
         AI,SR3   1                 MAKE SR3 BOUND 8 FOR SENSES
         SLS,SR3  -1                AND SGPS
         SLS,SR3  1                 :
         LI,R2    0                 INITIALIZE DEVICE INDEX
         LW,SR4   HGP1ADDR,R3       POINT TO FIRST HGP
SWAPSET  EQU      %                 OBTAIN RAD TYPE INDEX
         LI,R4    4                 PICK UP #TRACKS PSA
         LH,D4    *SR4,R4           FROM LEFT HW - WD3
         BEZ      HGPSTAK
         MTW,0    SWAPUTS,R3
         BEZ      %+2
         LW,D4    SPACKTRK          GET SWAP PACK # TRACKS
         LI,R1    0
         STH,R1   *SR4,R4           ZERO OUT LEFT HW - WD3
         LCI      3                 GET LINK,DCTX,NSPT INTO
         LM,SR4   *SR4              SR4,D1,D2
         LI,R1    0                 INITIALIZE TYPX
         CI,D2    82                NSPT=82?
         BE       SWAPTBLS          YES RAD IS 7212
         CI,D2    11                IS IT A 3214
         BNE      MSTB7232
         LI,R1    4                 ASSUME TYPE 4
         CI,D4    X'80'             IT'S 4 IF PSA IS 80 OR LESS
         BLE      SWAPTBLS
         AI,R1    1                 IT'S 5 IF PSA IS GREATER THAN 80
         B        SWAPTBLS
MSTB7232 LI,R1    1                 RAD IS 7232. ASSUME TYPE 1
         CI,D4    X'80'             IF PSA IS 80 OR LESS,
         BLE      SWAPTBLS          TYPX IS ONE
         AI,R1    1                 IF PSA IS BETWEEN 80 AND
         CI,D4    X'100'            100 TYPX IS 2
         BLE      SWAPTBLS          IF PSA IS GREATER THAN
         AI,R1    1                 100 TYPX IS 3
SWAPTBLS EQU      %                 BUILD TABLES WITH DEFAULTS
         LI,R4    #BYSWTBLS         GET # OF BYTE TABLES W/DEFAULTS
         LW,R5    SWAPPTR,R3        R5 POINTS TO TABLE AREA
         CI,R2    0                 FIRST PSA RAD/DP
         BNEZ     2SWAP             NO
         LI,SR1   0
         MTW,0    SWAPUTS,R3        IS IT DP
         BEZ      %+6               NO
         LW,SR1   SCYLPSA,R3        YES
         SLS,SR1  -16
         STW,SR1  *R5               STORE #GRAN/PHY CYL
         AI,R5    1
         LI,SR1   1
         STW,SR1  *R5               SET UP S:DP
         AI,R5    1
         STW,R5   SWAPHOLD          SAVE START OF SWAPPER TBLS
2SWAP    EQU      %
         LW,R5    SWAPHOLD          GET TRUE START
         LI,SR1   SWAPDFLT          SR1 POINTS TO DEFAULT AREA
         LW,R7    #SWAPDEVS,R3      R7 IS LENGTH OF BYTE TABLE
         AI,R7    3                 :
         SLS,R7   -2                :
SWBTBL   EQU      %                 BUILD BYTE TABLES
         LB,R6    *SR1,R1           GET DEFLT INDEXED BY TYPX
         STB,R6   *R5,R2            STORE IN TABLE INDEXED BY DEVX
         AW,R5    R7                ADVANCE TO NEXT TABLE
         AI,SR1   2                 ADVANCE TO NEXT DEFAULTS
         BDR,R4   SWBTBL            DO ALL BYTE TBLS WITH DEFLTS
         LH,R6    D1                GET DCTX
         STB,R6   *R5,R2            STORE IN MB:SDI
         AW,R5    R7                ADVANCE TO NEXT TABLE
         LI,R4    #WDSWTBLS         GET # WD. TABLES W/DEFLTS
SWWTBL   EQU      %                 BUILD WORD TABLES
         LH,SR2   *SR1,R1           GET DEFAULT
         STW,SR2  *R5,R2            PUT IN TABLE
         AW,R5    #SWAPDEVS,R3      ADVANCE TO NEXT TABLE
         AI,SR1   3                 ADVANCE TO NEXT DFLT HW TBL
         BDR,R4   SWWTBL            DO ALL WD TBLS W/DFLTS
         LW,D2    D4                #TRACKS/PHY CYLIN
         MTW,0    SWAPUTS,R3        DP SWAPPER
         BEZ      %+4               NO
         LW,D2    SCYLPSA,R3        GET #PHY CYLIN
         SLS,D2   16                YES
         B        CHKFREE-2
         CI,R1    0                 7212 ?
         BE       %+3               YES
         SLS,D2   20                EITHER A 7232 OR 3214
         B        %+2
         SLS,D2   23                7212
         STW,D2   *R5,R2
         AW,R5    #SWAPDEVS,R3
CHKFREE  EQU      %
         CI,R2    0                 FIRST PSA RAD
         BE       NOFREE            YES. FREE#GRAN = 0
         LW,D2    D4                NO. GET #TRACKS PSA AND
         CI,R1    0                 MULTIPLY BY # GRANULES
         BE       TY7212
         CI,R1    4                 CHK FOR 3214 TYPE
         BGE      TY3214
         MI,D2    6                 NUMBER OF GRANULES PSA
         B        NOFREE-1
TY7212   MI,D2    41                # OF GRAN PER TRACK FOR 7212
         B        NOFREE-1
TY3214   MI,D2    11                # OF SECTOR PER TRACK FOR 3214
         SLS,D2   -1                CONVERT TO GRANULES OF PSA
         STW,D2   *R5,R2            STORE IN FREE#GRAN
NOFREE   EQU      %                 :
         LW,R4    HGP1PTR,R3        THIS IS TO GET RIGHT
         SW,R4    HGP1ADDR,R3       WHEN HGP MOVES LATER
         AW,R5    #SWAPDEVS,R3      ADVANCE TO NEXT TABLE
         LW,D2    DCT1PTR,R3        GET DEVICE ADDRESS AND
         LH,R7    *D2,R6            STORE IN M:SWAPD
         AND,R7   XFFFF
         STW,R7   *R5,R2            *
         AW,R5    #SWAPDEVS,R3      ADVANCE TO NEXT TABLE
         LW,D2    SR3               BUILD TIC TO *SR3
         SW,D2    R4
         SLS,D2   -1                AND STORE IN M:HLTIC
         OR,D2    Y08               :
         STW,D2   *R5,R2            :
         AW,R5    #SWAPDEVS,R3      ADVANCE TO NEXT TABLE
         CI,R2    0
         BG       %+2
         STW,R5   SENSPTR           ONLY DO FOR FIRST SWAP DEVICE
         LW,D2    SENSPTR           BUILD SENSE INTO CURRENT
         CI,R1    4                 CHECK FOR 3214 TYPE
         BL       %+2
         MTW,3    SENSPTR           NEED TO STEP UP PTR FOR POSSIBLE
*                                   NEXT TIME TRHU IF MORE THAN 1 SWAP
*                                   RAD
         AW,D2    R2                TABLE AND STORE AT *SR3
         SW,D2    R4
         SLS,D2   2                 THEN BUMP SR3 PAST DWD.
         OR,D2    Y04               :
         STW,D2   *SR3              :
         AI,SR3   1                 :
         LW,D2    FLGSNSE,R1
         MTW,0    SWAPUTS,R3        DP SWAPPER ?
         BEZ      %+3               NO
         LW,D2    FLGSNSED          YES
         AI,R5    3                 ALLOW 4-WORDS FOR SENSE BUFFER
         STW,D2   *SR3              :
         AI,SR3   1                 :
         AW,R5    #SWAPDEVS,R3      ADVANCE TO NEXT TABLE
         AW,R5    XTRASIZ           ADD IN EXTRA RESERVE SPACE DUE TO
*                                   PRESENCE OF 3214 SWAP DEVICES
         LW,D3    SR3
         SW,D3    R4
         STW,D3   *R5,R2
         LW,R7    D4                GET PSA INTO R7
         LW,SR2   SR3               SGP ADDR INTO SR2
         LI,D3    4                 START BY ASSUMING TYPE 4
         CI,R1    4                 (WIDTH FOR TYPE 4 IS 4.)
         BE       STTRKSHF          BR. IF IT IS
         BL       %+3
         AI,D3    4                 WIDTH FOR TYPE 5 IS 8
         B        STTRKSHF
         LI,D3    2                 GET WIDTH OF SGP AND
         SLS,D3   0,R1              SAVE IN D2 AND D3
STTRKSHF STW,D3   D2
         CI,R2    0                 FIRST PSA RAD?
         BE       ENDSGP            YES SGP IS ZERO
         LI,R6    7212TBL           GET CORRECT TBL FOR PSA TYPE
         CI,R1    0                 7212 ?
         BE       INCTBL            BR IF IT'S A 7212 TYPE
         CI,R1    4
         BL       7232TYP
         LI,R6    3214TBL           TYPE4 & TYPE5 = 3214 RAD
         B        INCTBL
7232TYP  LI,R6    7232TBL            IT'S A 7232 TYPE RAD
INCTBL   AW,R6    TBLGTH,R1         INCREMENT BY TBL. LNGTH
         STW,R6   TYPETBL           STORE AS START ADD.
         PSW,D4   *R0               NEED ANOTHER REG
DOSGP    EQU      %                 BUILD SGP
         LB,R4    GPT,R1            GET HEIGHT OF SGP
         LI,R5    0                 SET INDEX TO SGT = 0
         LCW,R6   TBLGTH,R1         INDEX INTO TYPE TBLE
         AI,R7    -32               WHOLE WRD OF 1 LEFT
         BLZ      PRTWD             NO
         LW,D4    *TYPETBL,R6       CORRECT MASK FOR TYPE & ENTRY
         STW,D4   *SR2,R5           FILL COLUMN OF SGP
         AW,R5    D3                INCREMENT
         BIR,R6   %+2               ADJ INDEX INTO TYPE TBL
         LCW,R6   TBLGTH,R1
         BDR,R4   %-5
         AI,SR2   1
         BDR,D2   DOSGP
         B        FNHSGP            DONE
PRTWD    EQU      %                 BUILD PARTIAL ENTRIES
         PSW,R2   *R0
         LCW,R2   R7                COMP FOR SHIFT VALUE
         LW,D4    *TYPETBL,R6       GET MASK
         SLS,D4   0,R2              SHIFT TO ADJUST MASK
         SLS,D4   0,R7              ADJ MASK BACK
         STW,D4   *SR2,R5           FILL COLUMN
         AW,R5    D3
         BIR,R6   %+2
         LCW,R6   TBLGTH,R1
         BDR,R4   PRTWD+2
         PLW,R2   *R0
FNHSGP   EQU      %
         MTW,-1   *SR3              GRAN POS.0 NOT USED
         CI,R1    0                 LAST 4 GRAN 7212 AND
*                                   TYPE 3 SET TO 0
         BE       TYPE035
         CI,R1    3
         BE       TYPE035
         CI,R1    5
         BNE      ENDSGP-1
TYPE035  EQU      %                 DOUBLEWORDS - 37,23 AND 6  (DEC)
*                                   FOR TYPE 0,3,5 RESPECTIVELY
*                                   MUST BE ADJUSTED TO 08888888,2AAAAAAA,
*                                   AND 04848484 RESPECTIVELY
         LI,R6    4
         LW,R5    ENDWDS,R1
SGPMOD   LW,D4    *SR3,R5
         CI,R1    5
         BNE      %+5
         AI,D4    -X'80'
         SCS,D4   -8
         LI,6     1
         B        %+3
         SLS,D4   1
         SLS,D4   -1
         STW,D4   *SR3,R5
         AW,R5    LGTINC,R1
         BDR,R6   SGPMOD
         PLW,D4   *R0               RESTORE D4
ENDSGP   EQU      %                 FINISH SGP
         LB,R4    DWT,R1            ADVANCE SR3 TO END OF SGP
         SLS,R4   1                 :
         AW,SR3   R4                :
         CW,SR3   DYSTORND,R3
         BG       ERR12OUT
         AI,R2    1                 INCREMENT DEVX
         CW,R2    #SWAPDEVS,R3      DONE WITH ALL PSA RADS?
         BL       SWAPSET
HGPSTAK  EQU      %
WRTHGP   EQU      %
         LW,R4    HGP1ADDR,R3
         STW,R4   SECT0BUF
         PAGE
****************************************************
*  THIS CODE CHECKS THAT A DISK PACK PSA DEVICE PRECEDES ANY OTHER
*  DISK PACK DEVICE COMMAND OTHERWISE AVRTBL SEARCHES GET INTO
*  TROUBLE.
*
*  ALSO CHECKS FOR DP INDEX GREATER THAN 63.  ERROR IF SO.
*
****************************************************
         LCI      7
         PSM,R1   *R0
         LI,R1    0
         LW,R6    *R4
         BEZ      PULLREG7
         LI,R2    1
         LI,R6    5
GETDCTX1 LW,R7    *R4,R2            GET 2ND WORD OF HGP
         CI,R7    DPTYPBIT
         BAZ      GETNXT            BRANCH IF NOT DP
         LB,R5    *R4,R6         GET DCT INDEX FOR DEVICE
         CW,R5    R1                O.K. IF R5 IS GREATER
         BL       CHK4PSA
GETDCTX2 LW,R1    R5
         CI,R1    64                CHK FOR DP INDEX >63
         BL       GETNXT            SINCE A LARGE INDEX MAY INTERFERE
         LI,D3    IX2LGMSG          WITH 3282 TYPE DP ADDRESSING
         B        DPERMSG
GETNXT   EQU      %
         LW,R4    *R4               GET TO HEAD OF NEXT HGP TABLE
         BEZ      PULLREG7
         B        GETDCTX1
CHK4PSA  EQU      %
         MTW,0    SWAPUTS,R3        CHECK IF THERE IS A DP SWAPPER
         BEZ      GETDCTX2
         LW,R7    SECT0BUF          YES. NEED TO KNOW IF THE OUT-OF-
         LB,R7    *R7,R6            SEQUENCE PACK IS THE PSA DEVICE
         CW,R7    R1
         BNE      GETNXT
         LI,D3    PSASEQER          GET PSA DP ORDERING MESSAGE
DPERMSG  EQU      %
         BAL,SR4  LOGIT
         MTW,1    P2ABRT,R3         SET DELAYED ABORT ERROR
PULLREG7 LCI      7
         PLM,R1   *R0
         PAGE
         LW,R5    HGP1PTR,R3
         SW,R5    HGP1ADDR,R3
         BEZ      AVRIDX
         AI,R5    1
         SLS,R5   -1
         SLS,R5   1
         STW,R4   RFHADR
         STW,R4   RFHA1
         SLS,R5   2
         STW,R5   HSEC0SZ
         SLS,R5   -2
         STW,R5   EHSZ
         SLD,R4   -1
         STW,R4   HHADR
         STW,R4   HHSA
         STW,R4   THSA
         STH,R5   HHSA
         STH,R5   THSA
         SLD,R4   1
         AI,SR3   1
         STW,SR3  HRELDBUF
         AI,R5    1
         SLS,R5   -1
         STW,R5   HRELDSZ
         AI,R5    3
         SLS,R5   -2
         LW,R6    SR3
         AW,R6    R5
         CW,R6    DYSTORND,R3
         BG       ERR12OUT
         LW,R6    L(X'EEEEEEEE')
         STW,R6   *SR3,R5
         BDR,R5   %-1
         STW,R6   *SR3
         LI,R1    HGP1ADDR
         AW,R1    R3
PUT2IN   EQU      %
         LW,R4    *R1
         MTW,0    *R4
         BEZ      DUN2IN
         SW,R4    HGP1ADDR,R3
         LI,R5    0
         SLD,R4   -3
         SCS,R5   5
         AI,R5    -28
         LCW,R5   R5
         LI,R6    2
         LI,R7    X'F'
         SLD,R6   0,R5
         STS,R6   *SR3,R4
         LW,R1    *R1
         B        PUT2IN
DUN2IN   EQU      %
         CAL1,1   OPENTM
HWRT     LI,R1    6
         LW,R2    HKEYADR,R1
         LW,R4    HBUF,R1
         LW,R5    HSIZ,R1
         CAL1,1   WRITETM           WRITE M:HGP LOAD MODULE
         BDR,R1   HWRT+1
         CAL1,1   CLOSETM
HMOVIT   EQU      %
         LW,R5    HRELDSZ
         AI,R5    3
         SLS,R5   -2
         AI,SR3   -1
         LI,R1    0
         STW,R1   *SR3,R5
         BDR,R5   %-1
         LW,R6    AVRTBLSZ,R3
         AND,R6   M16
         SLS,R6   1
         AW,R6    AVRTBLAD,R3
         AI,R6    1
         LI,D1    0
         LW,R1    HGP1ADDR,R3
         STW,SR3  SR2
HMVHGP   EQU      %
         LI,R4    1
         LW,R2    *R1,R4
         CI,R2    X'800'
         BAZ      HMVHDR
         LB,R7    R2,R4             GET DCTX FOR THE PACK
         SW,R7    REMEMBER,R3       SUBTRACT OFF 1ST DP DCTX
         SLS,R7   1                 GET CORRECT DISP. INTO AVRTABLE
         LW,R5    Y8
         LS,R5    *R6,R7            GET PUBLIC/PRIVATE BIT
         OR,R5    D1
         STW,R5   *R6,R7            GET FLINK IN HGP
*                                   2ND WORD OF AVRTABLE ENTRY
         CI,R2    X'4000'           IS IT A PRIVATE PACK
         BAZ      HMVHDR
         LW,R5    *R1               GET FLINK IN HGP
         BNEZ     %+2
         LW,R5    HGP1PTR,R3
         SW,R5    R1                CALCULATE DISP. TO NEXT HGP
         B        %+2
HMVHDR   EQU      %
         LI,R5    8
         LW,R2    R5
         LW,R4    *R1,R2
         STW,R4   *SR3,R2
         BDR,R2   %-2
         LW,R4    SR3
         AW,SR3   R5
         AW,D1    R5
         LW,R5    SR3
         AW,R5    HGP1ADDR,R3
         SW,R5    HGP1PTR,R3
         STW,R5   *R4
         LW,R1    *R1
         BNEZ     HMVHGP
         STW,R1   *R4
         LW,R1    HGP1ADDR,R3
         SW,SR2   HGP1PTR,R3
         LW,R2    HGP1PTR,R3
         AI,R1    -1
         AI,R2    -1
         LW,R6    SR3
         LW,R4    SR3
         SW,R4    HGP1PTR,R3
         LW,SR3   R4
         AW,SR3   HGP1ADDR,R3
         LI,R7    1
         LW,R5    *R2,R7            MOVE ALL TABLES TO
         STW,R5   *R1,R7            START OF OLD HGP AREA
         AI,R7    1
         BDR,R4   %-3
         AI,R1    1
         STW,R1   HGP1PTR,R3
         AW,R1    SAVESWAP
         STW,R1   SWAPPTR,R3
         LI,R1    0
         SW,R6    SR3
         AI,R6    2
         STW,R1   *SR3,R6
         BDR,R6   %-1
         STW,R6   *SR3
         AWM,SR2  HGP1ADDR,R3
AVRIDX   EQU      %
         LCI      4                 SAVE SR2-D1, R1 AVAILABLE
         PSM,SR2  *R0
         LW,SR4   DCT23PTR,R3       GET DCT23 ADDRESS
         LW,SR3   HGP1ADDR,R3       ADDRESS OF HGP
         LW,SR2   *SR3              GET FLINK
DODCT23  EQU      %
         LW,D1    SR2               SAVE FLINK FOR SUBTRACTING
         BEZ      DNDCT23           ALL DONE
         LI,R1    5
         LB,R1    *SR2,R1           GET DCT OF 2ND(NEXT) ENTRY
         SW,D1    SR3               ABS VALUE FROM HGP
         STH,D1   *SR4,R1           STORE IN DCT23
         LW,SR2   *SR2              GET NEW FLINK
         B        DODCT23
DNDCT23  EQU      %
         LCI      4
         PLM,SR2  *R0
         LW,R1    AVRTBLSZ,R3
         BEZ      CHK4FEX
         MTH,0    R1
         BEZ      %+2
         SLS,R1   -16
         STW,SR3  AVRIDARA,R3       AVRID TABLE ADDRESS
         AI,R1    1                 # HALF WORDS
         SLS,R1   -1                # WORDS IN AVRID TABLE
         AW,SR3   R1
         AW,SR3   R1
         STW,SR3  SOLICIT,R3        POINTER TO SOLICIT TABLE AREA
         AI,R1    1                 SOLICIT IS BYTE TABLE
         SLS,R1   -1                TABLE SIZE = AVRTBLNE (IN BYTES)
         AW,SR3   R1                :
CHK4FEX  LW,R1    FEDX#,R3
         BEZ      MKBOND8           SKIP FOLLOWING CODE IF NO FECP
         AND,R1   XFFFF             EXTRACT HIGHEST FEDX VALUE
         AI,R1    2                 SET UP FOR FEDX+1 IN H.W
         SLS,R1   -1
         STW,SR3  FEDXHWT,R3
         AW,SR3   R1
         AI,R1    1                 SET UP FOR FEDX+1 IN BYTES
         SLS,R1   -1
         STW,SR3  FEDXBYTT,R3
         MI,R1    4                 THERE ARE 4 BYTE FEDX INDEXED
*                                   TABLES. THEY ARE:
*                                     FDB:FEX
*                                      FDB:DCT
*                                       FDB:LNK
*                                        FDB:TO
         AW,SR3   R1
         STW,SR3  FEXWT,R3
         LW,R1    FEDX#,R3          SET UP FOR FEX+1 TABLES
         SLS,R1   -16
         AI,R1    1                 SET UP FOR FEX+1 WORD TABLE
         AW,SR3   R1
         STW,SR3  FEXHWT,R3
         AI,R1    1
         SLS,R1   -1                SET UP FOR FEX+1 H.W. TABLE
         AW,SR3   R1
         STW,SR3  FEXBYTT,R3
         AI,R1    1                 SET UP FOR FEX+1 BYTE TABLES
         SLS,R1   -1
         MI,R1    3                 THERE ARE 3 BYTE FEX INDEXED
*                                   TABLES. THEY ARE:
*                                     FEB:CDX
*                                      FEB:IHD
*                                       FEB:CIO
         AW,SR3   R1
MKBOND8  EQU      %
         MTW,0    SWAPUTS,R3        CHK FO A DP SWAPPER
         BEZ      MKBOND8A          SKIP IF NO DP SWAPPER
         MTW,1    DPSWPTYP          ANY DP SETS DPSWPTYP TO 1
         LW,R1    SWAPMODT
         CW,R1    DP7271
         BE       %+3
         CW,R1    DP7242
         BNE      %+2
         MTW,1    DPSWPTYP          7242/7271 CAUSES DPSWPTYP TO = 2
         STW,SR3  MH2NDSK,R3        PTR TO MH2NDSK LOCATION
MKBOND8A EQU      %
         AI,SR3   2
         SLS,SR3  -1
         SLS,SR3  1
         LW,R1    P2OVLOP1,R3       CHK FOR AN MPC DEVICE
*
*                                        CONTENTS OF P2OVLOP1
*
*                                     MPC                     MPC
*                                     DP                      MT
*                                   ********************************
*                                   *      *       *       *       *
*                                   *  01  *  00   *  00   *  01   *
*                                   *      *       *       *       *
*                                   ********************************
*
         BEZ      MKBOND8B          BRANCH IF NO MPC DEVICE
OK4MPC   LB,R2    R1                R2 WILL = 01 IF THERE'S AN MPC DP
         AND,R1   XFF               R1 WILL = 01 IF THERE'S AN MPC MT
         STW,SR3  MPCTABAD,R3       SAVE PTR TO START OF MPC TABLE
         LI,R4    0                 R4 WILL CONTAIN PARALLEL MPC
         AI,SR3   2                 ALLOW FOR ZEROTH ENTRY IN D.W. TABLE
         CI,R2    1                 WERE THERE ANY MPC DP'S ?
         BNE      TRYMTNAM          BRANCH IF NONE SPECIFIED
         LD,D1    MPCOVNMD          PRE-STORE MPC OV NAME FOR DP IN TABLE
         STD,D1   *SR3              NAMED 'MPCNTBL'
         AI,SR3   2                 STEP UP TABLE ENTRY PTR
         LI,D1    X'C0'             C0 = TYPE VALUE FOR AN MPC DP
         STB,D1   R4,R2             SAVE IN REGISTER 4
         AW,R1    R2                R1 WILL = 2 IF BOTH MPC MT AND DP
         CI,R1    1                 WERE SPECIFIED
         BE       SETMPCFL          BRANCH IF ONLY AN MPC DP
TRYMTNAM LD,D1    MPCOVNMT          PRE-STORE MPC OV NAME FOR MT IN TABLE
         STD,D1   *SR3              NAMED 'MPCNTBL'
         AI,SR3   2                 STEP UP TABLE ENTRY PTR
         LI,D1    X'80'             80 = TYPE BYTE FOR AN MPC TAPE
         STB,D1   R4,R1             SAVE IT IN REG. 4 FOR TYPE TABLE
SETMPCFL STW,R1   MPC#              SAVE # OF MPC TYPES IN MPC#
         AI,R1    2                 GENERATE # OF WORDS REQUIRED FOR
         SLS,R1   1                 THE IOTABLE LMN
         AW,SR3   R1                AND SET THE POINTER
         LI,R2    -2
         STW,R4   *SR3,R2           STORE MPC TYPE IN THE TABLE
*                                   FOLLOWING THE 'MPCDATE' TABLE
*
MKBOND8B EQU      %
*
         STW,SR3  MAX00,R3
         STW,SR3  RDICADDR,R3
         STW,SR3  PACKRPTR,R3
         B        LOADMODL
         PAGE
LOADMODL EQU      %
*
*   AFTER PACKING CIT,DCT,HGP,OPLBT,TYPMNE,AVRTBL, SET UP LOAD MODULE.
*
         LI,R1    TREE-HEAD
         STW,R1   HEADLNG,R3        NO.OF WORDS IN HEAD
         LI,R1    MAX00-TREE
         STW,R1   TREELNG,R3        NO.OF WORDS IN TREE
         LW,R1    PACKRPTR,R3       END -
         LI,SR2   TREE
         AW,SR2   R3
         STW,SR2  TREEADDR,R3
         LW,R2    SR2
         AI,R2    K6                ALL REST OF TREE IS PRESET FROM DATA
         LW,R4    CLISTADR,R3       BEGINING SECT00
         SCS,R4   -1                 DWD.ADDR.
         STW,R4   *R2                STORE ADDRESS INTO TREE
         SCS,R4   1                  WD.RESOL.
         SW,R1    R4                END-BEGIN=LENGTH
         SCS,R1   -1                 DWD.RESOL. BEFORE STORE
         STH,R1   *R2               STORE SECT00 LENGTH
         LI,SR3   LMODPLIS
         AW,SR3   R3
         AI,SR3   K2
         STW,SR2  *SR3
         MTW,1    *SR3              STORE ADDRESS OF TREE 'BODY'
         LI,SR2   HEAD
         AW,SR2   R3
         STW,SR2  HEADADDR,R3
         SCS,R1   1                 MAKE SECT00 SIZE   WORD RESOL.
         STW,R1   SECT0LNG,R3       NO.OF WORDS OF TABLES IN SECT00
         LW,R2    R1                 DIVIDE (N+7) BY 8 FOR RELDICT
         AI,R2    K7                                   LENGTH IN WDS.
         SLS,R2   -3
         STW,R2   RDICLNG,R3        NO.OF WORDS OF RELOCATION DICTIONARY
         LW,R4    RDICADDR,R3
         AW,R4    R2                ADD RDICLNG,R3 (WORD RESO.)
         CW,R4    DYSTORND,R3        OVER PAGE END ?
         BLE      %+3                NO
         BAL,SR4  ERRBOR14           YES
         B        OUTOFIT
*
         AI,R4    K1                DWD. BOUND
         SLS,R4   -1
         SLS,R4   1
         STW,R4   RDEFADDR,R3       START OF RDEF AREA
         AI,SR3   K2                SET TO STORE SECT00 AND RELDIC
         LW,SR2   CLISTADR,R3       WORD RES. ADDRESSES INTO PLIST
         SLS,SR2  -1
         STW,SR2  *SR3               STORE SECTOO ADDRESS
         LW,R4    HEADADDR,R3
         LI,R2    K5
         STH,SR2  *R4,R2            PUT SECT.00 ADDRESS IN HEAD
         LI,R2    K6
         STH,SR2  *R4,R2
         LW,R4    RDICADDR,R3
         SLS,R4   -1
         STH,R4   *SR3               STORE RELDIC ADDRESS
         SLS,R4   1
*                             INITIALIZE RELDICT TO ALL 'E'
         LW,R2    R1
         SLS,R1   -1                R1=NO.BYTES/2=NO.RELDICT ENTRIES
         CI,R2    K1                 CHECK IF ODD NO. SECT00 WORDS
         BAZ      %+3                 NO, EVEN
         LI,SR1   KE0
         STB,SR1  *R4,R1            STORE LAST 4BIT RELDICT ENTRY NOW
         AI,R1    KN1
         LI,SR1   KEE
         STB,SR1  *R4,R1            SET ALL 'E'
         BDR,R1   %-1
         STB,SR1  *R4
*
         LW,R4    DYSTORND,R3       SET ARBIT.RDEF, EXPR ALLOCATION
         SW,R4    RDEFADDR,R3        GET REMAINING SPACE TO ALLOCATE
         SLS,R4   -1                AND DIVIDE EVENLY BETWEEN REF-
         AW,R4    RDEFADDR,R3       DEF AND EXPRESSION STACKS.
         SLS,4    -1
         SLS,4    1
         STW,R4   EXPRADDR,R3       WD.ADDR OF EXP STK
         LCI      4
         LM,D1    EXENTRY           STORE EXPR ENTRY IN EXPR STACK
         STM,D1   *R4
         SLS,R4   -1                 DWD
         AI,SR3   KN1
         STW,R4   *SR3              SET EXPRADDR (DW) IN CALL PLIST
         AW,R4    Y0004
         STW,R4   TREE+9,R3          SET ALSO IN TREE
*
         LW,R4    RDEFADDR,R3
         LCI      K4
         LM,D1    DEFENTRY          PUT ORIGINAL DUMMY DEF
         LW,D2    CLISTADR,R3         IN DEF STACK
         LCI      K4                  WITH SECT.00 ADDRESS
         STM,D1   *R4
         AI,R4    K4
         LW,R1    Y05               MAKE DUMMY (WDCNT.ALREADY IN TREE)
         STW,R1   *R4               TO START REFDEF STACK
         AI,R4    K1                AND ASSURE COMPLETE
         LW,R1    CLISTADR,R3
         STW,R1   *R4
         AI,R4    K1
         LI,R1    K100
         STW,R1   *R4
         AI,R4    K1
         LW,R1    TREEDATA+1
         STW,R1   *R4
         AI,R4    K1
         LW,R1    TREEDATA+2
         STW,R1   *R4
         AI,R4    KN8
*
         SLS,R4   -1
         STH,R4   *SR3              SET REFDEFADDR (DW) IN PLIST
         LW,SR2   TREE+7,R3
         OR,R4    SR2
         STW,R4   TREE+7,R3
         LW,R4    *SR3               GET BACK EXPR. DWD
         LW,R1    DYSTORND,R3       UPPER LIMIT = PAGES LIMIT - 1 DWD
         SLS,R1   -1                                 DWD.RES.
         AI,SR3   K4                 POINT TO UPPER LIMITS IN PLIST
         AI,R1    KN1
         STW,R1   *SR3              SET
         AI,R4    KN1
         STH,R4   *SR3               PLIST COMPLETE
*                      NOW PLIST IS READY FOR DEF, EXPR, DICT SUBRTNS.
         LI,R5    K0
         LI,R1    DEFCALL
         AW,R1    R3
         LI,R7    LMODPLIS          SET R7 FOR ALL MODIFY ROUTINES
         AW,R7    R3
         STW,R1   *R7               MAKE DEFCALL 1ST
         LI,R6    DCT1PTR
         AW,R6    R3
DEFVALUE LW,R4    0,R6              GET POINTER
         SW,R4    CLISTADR,R3       MAKE ADDRESS RELATIVE
         STW,R4   DEFCALL+5,R3      SET VALUE
         BAL,SR3  SETMODFY          USES SR1 TO SAVE R3
DEFVALSK AI,R6    K1                FOR NEXT POINTER (DCT)
         LW,D1    Y01
         CI,R5    K8                COMPLETED 9
         BGE      %+3               YES
         AWM,D1   DEFCALL+2,R3
         B        DEFVAL02
         CI,R5    K9                COMPLETED 10
         BGE      DEFVAL01          YES
         AWM,D1   DEFCALL+1,R3
         LW,D1    YF1F0               NO, HOUSEKEEP NAME FOR 10-15
         STW,D1   DEFCALL+2,R3
         B        DEFVAL02
DEFVAL01 EQU      %
         CI,R5    18                COMPLETED 19
         BNE      %+4
         LW,D1    L(X'F2F04040')    HOUSEKEEP NAME FOR 20-21
         STW,D1   DEFCALL+2,R3
         B        DEFVAL02
         CI,R5    NDCTS-7           CHK FOR IMPENDING DEF TO DCT26
         BE       DEFVALYN          BRANCH IF IT IS
         CI,R5    NDCTS-3
         BG       DEFVAL02M         BRANCH IF WE'RE AT DCT1A TABLE
         BL       DEFVAL02P         BRANCH IF OTHER THAN DCT1P TABLE
*                                   OTHERWISE FALL THRU TO DO DCT1P
         LW,D1    L(X'F1D74040')
         STW,D1   DEFCALL+2,R3
         B        DEFVAL02
DEFVAL02M EQU     %
         CI,R5    NDCTS-1           REALLY DONE?
         BGE      DEFVAL03          YES
         LW,D1    L(X'F1C14040')
         STW,D1   DEFCALL+2,R3
         B        DEFVAL02
DEFVAL02P         EQU   %
         LW,D1    Y0001               NO, INCREMENT NAME IN CALL
         AWM,D1   DEFCALL+2,R3
DEFVAL02 AI,R5    K1
         B        DEFVALUE
DEFVALYN MTW,0    FEDX#,R3          ANY FECP DEVICES
         BNEZ     DEFVAL02P         IF YES THEN INCLUDE DCT26
         AI,R5    1
         LW,D1    Y0001
         AWM,D1   DEFCALL+2,R3      INCREMENT NAME TO DCT26 TO SET
*                                   IT UP FOR NEXT CALL FOR DCT27
         B        DEFVALSK          OTHERWISE SKIP DEF-ING IT
*                           FINISHED DCT TABLE DEFS
DEFVAL03 EQU      %
         LD,R4    DEFCITX
         STW,R4   DEFCALL+1,R3      GENERATE
         STW,R5   DEFCALL+2,R3        DEFS FOR
         AI,R6    1
         LI,R5    0                 CIT1-5
DEFCITV  EQU      %
         LW,R4    *R6
         SW,R4    CLISTADR,R3
         STW,R4   DEFCALL+5,R3
         BAL,SR3  SETMODFY ***
         AI,R6    1
         LW,D1    Y01
         AWM,D1   DEFCALL+2,R3
         CI,R5    NCITS-2
         BG       DEFCITV1
         BL       DEFCITV1+2
DEFCITV1 EQU      %
         CI,R5    NCITS-1
         BGE      RDEFAVFL
         AI,R5    1
         B        DEFCITV
RDEFAVFL LD,R4    DEFAVRFL
         LW,R2    AVRFLGAD,R3
         BAL,SR3  GETMODFY
*
RDEFAVRT LD,R4    DEFAVRTB
         LW,R2    AVRTBLAD,R3
         BAL,SR3  GETMODFY
*
RDEFHGP  LW,R5    DEFHGP
         LD,R6    XIOTABLE
         LW,SR1   HGP1ADDR,R3
         SW,SR1   CLISTADR,R3       MAKE ADDRESS RELATIVE TO START
         LCI      K4
         STM,R5   DEFCALL+1,R3
         MTW,0    LASTHGP1,R3       ANY HGP TABLES
         BEZ      %+2               NO..
         BAL,SR3  SETMODFY
*
*
RDEFICTQ LD,R4    DEFIOCTQ
         LD,R6    XIOTABLE
         LW,SR1   HGP1PTR,R3        IOCTQ ADDR
         SW,SR1   CLISTADR,R3
         PSW,SR1  *R0               SAVE REL.POSITION IN LM FOR FUTURE
         LCI      5                   USE IN SETTING REL.DICT.
         STM,R4   DEFCALL+1,R3
         BAL,SR3  SETMODFY
*
RDEFAVRI LW,SR1   AVRIDARA,R3
         BEZ      RDEFDCN           NO AVRTBL
         LD,R4    DEFAVRID
         LD,R6    XIOTABLE
         SW,SR1   CLISTADR,R3
         LCI      5
         STM,R4   DEFCALL+1,R3
         BAL,SR3  SETMODFY
*
RDEFDCN  LW,R4    DEFDCN
         LI,R5    K0
         LW,R6    DCN,R3
         LCI      K3
         STM,R4   DEFCALL+1,R3
         BAL,SR3  SETMODFY
*
RDEFDCTZ LD,R4    DEFDCTSZ
         LW,R1    DCTSIZE,R3
         AI,R1    -1
         LI,R2    K0
         STW,R2   DEFCALL+3,R3
         STW,R1   DEFCALL+4,R3
         BAL,SR3  EQUMODFY
*
RDEFCITZ LD,R4    DEFCITSZ
         LW,R1    RCHAN,R3
         STW,R1   DEFCALL+4,R3
         BAL,SR3  EQUMODFY
*
RDEFBATA LD,R4    DEFBATAP
         LW,R1    BATAPE,R3
         STW,R1   DEFCALL+4,R3
         BAL,SR3  EQUMODFY
*
RDEFNBAT LD,R4    DEFNBATA
         LW,R1    NBATAPE,R3
         STW,R1   DEFCALL+4,R3
         BAL,SR3  EQUMODFY
*
RDEFAVTZ LCI      K3
         LM,R5    DEFAVRSZ
         LI,SR1   K0
         LW,SR2   AVRTBLSZ,R3
         AND,SR2  M16
         STW,SR2  AVTBLGTH,R3
         LCI      K5
         STM,R5   DEFCALL+1,R3
         BAL,SR3  SETMODFY
*
         LCI      3
         LM,R5    DEFAVRNE
         LI,SR1   0
         LW,SR2   AVRTBLSZ,R3
         LH,SR2   SR2
         BNEZ     %+2
         LW,SR2   AVRTBLSZ,R3
         LCI      5
         STM,R5   DEFCALL+1,R3
         BAL,SR3  SETMODFY
*
         PAGE
EXPRESS  EQU      %
*
****  THIS CODE GENERATES REFS TO PRE-HANDLERS IN DCT8 TABLE
****    AND EXPRESSION ENTRIES POINTING TO THOSE REFS
*
         LI,D1    EXPRCALL
         AW,D1    R3
         STW,D1   *R7
         LI,R6    0
         LW,D3    DCT8PTR,R3        ADDR. OF 1ST WORD
         OR,D3    EXPRCALL+3,R3
         SW,D3    CLISTADR,R3       MAKE ADDRESS RELATIVE
         STW,D3   EXPRCALL+3,R3
EXPRESS2 EQU      %
         LW,D4    DCT8PTR,R3
         BAL,R2   GENEXP   ***      GEN.EXPR. FOR HANDLER NAME1
         AI,R6    K1
         CW,R6    DCTSIZE,R3        THROUGH ?
         BGE      EXPRESSW          YES
         MTW,1    EXPRCALL+3,R3     NO
         B        EXPRESS2
*
EXPRESSW EQU      %
*
****  THIS CODE GENERATES REFS TO POST-HANDLERS IN DCT9 TABLE
****    AND EXPRESSION ENTRIES POINTING TO THOSE REFS
*
         LI,R6    0
         LW,D3    DCT9PTR,R3
         OR,D3    EXPRDATA+3
         SW,D3    CLISTADR,R3
         STW,D3   EXPRCALL+3,R3
EXPRESSX EQU      %
         LW,D4    DCT9PTR,R3
         BAL,R2   GENEXP   ***      GEN.EXPR.FOR HANDLER NAME2
         AI,R6    1
         CW,R6    DCTSIZE,R3
         BGE      EXPRESS3
         MTW,1    EXPRCALL+3,R3     TO NEXT DCT ENTRY
         B        EXPRESSX
         PAGE
GETMODFY EQU      %                 R7 = STILL SET TO LMODPLIS ADDRESS
         SW,R2    CLISTADR,R3       MAKE ADDRESS RELATIVE
         STW,R2   DEFCALL+5,R3        DEF NAME
EQUMODFY EQU      %
         STW,R4   DEFCALL+1,R3                SET DEF. NAME
         STW,R5   DEFCALL+2,R3       R1= DEFCALL ADDRESS
SETMODFY STW,R3   SR1               SAVE
         LI,R7    LMODPLIS
         AW,R7    R3
         BAL,SR4  MODIFY
         STW,SR1  R3                RESTORE (NO EFFECT ON CC)
         BCR,8    *SR3
         MTW,1    P2ERR,R3          INCREMENT ERROR COUNT
         BAL,SR4  ERRBOR15
         B        OUTOFIT
*
LMODERR  BAL,SR4  ERRBOR15
         BAL,SR4  ERRBOR14
         BAL,SR4  PRPAGES
         B        OUTOFIT
*
GENEXP   EQU      %
         PSW,R2   *R0
         LW,D3    *D4,R6            HANDTABLE INDEX
         BGEZ     %+4
         EOR,D3   Y8                REMOVE RHANDLER FLAG
         AW,D3    RHANDTAD,R3
         B        %+2
         AW,D3    HANDTADR,R3        MAKE CORRECT ADDRESS
         LW,D1    YFF
         AND,D1   D3                EXTRACT MC BIT (IF ANY)
         STW,D1   *D4,R6            BUT ZERO OUT REST OF DCT8/DCT9
         LB,D4    *D3               GET B'COUNT
         LI,D1    K4                4 +
         AW,D1    *R7                  EXPRCALL
         STB,D4   *D1               SET IN 1ST BYTE EXPRCALL+4,R3
         STW,D4   R1                 SET INDEX
         LB,D4    *D3,R1            TRANSFER
         STB,D4   *D1,R1             REMAINING BYTES OF NAME
         BDR,R1   %-2
         LB,D4    *D3               GET B'COUNT BACK
         AI,D4    K4                ADD 1 FOR B'CT.BYTE AND 3 FOR
         SLS,D4   -2                WORD RESOL. ADJUSTMENT
         AW,D4    D1                NOW ADD BIAS OF EXPRCALL+4 ADDRESS
         LI,D1    K0                D4 = LAST WORD OF EXPRCALL =0
         STW,D1   *D4
         BAL,SR3  SETMODFY          DO IT
         PLW,R2   *R0
         B        *R2
*
EXPRESS3 EQU      %
         PAGE
******  THIS CODE SETS UP REFS TO CLIST BUFFERS GENERATED IN COC MODULE
*
*
         LCI      15
         PSM,R1   *R0
         MTW,1    EXPRCALL,R3       CHANGE FROM WORD TO DW RESOL.
         LI,R6    0
         STW,R6   EXPRCALL+6,R3     ZERO OUT LAST WORD OF PLIST
         LW,R6    CLISTS            SET UP REF TO CLISTS
         STW,R6   EXPRCALL+4,R3     STORE FIRST PART OF CLIST WORD IN
         LW,R6    CLISTS+1
         STW,R6   EXPRCALL+5,R3     PUT REF NAME IN EXPRESSION ENTRY
         LW,D3    DCT7PTR,R3        START OF DCT7 HW TABLE
         SW,D3    CLISTADR,R3       GET DISP. FROM START OF SECTION
         OR,D3    EXPHWRT           MERGE CORE EXPRESSION ITEMS FOR A
         STW,D3   EXPRCALL+3,R3     RT HALF DW REF
         BAL,SR3  SETMODFY
         LI,R6    1
         LI,R5    0
GENELOOP AI,R6    1
         CW,R6    DCTSIZE,R3        IS IT THE LAST ONE?
         BGE      DCT7END
         LI,R2    0
         LW,D3    EXPRCALL+3,R3
         CI,R6    1                 IF R6 IS EVEN, REF IS IN LEFT HALF
         BANZ     ANDD3             OF WORD FOR DCT7
         AI,D3    1
         LI,R2    1
ANDD3    AND,D3   M17
         EOR,D3   EXPHWRT,R2
         STW,D3   EXPRCALL+3,R3
         LW,R4    TCLSIZES,R3
         AI,R5    1
         LB,SR3   *R4,R5            GET DISPLACEMENT FROM
         SLS,SR3  -1                CHANGE DISPLACEMENT TO DW DISP
         AW,SR3   EXPRCALL+6,R3     'CLISTS' REF FOR DCT7 DW ENTRY
         STW,SR3  EXPRCALL+6,R3
         BAL,SR3  SETMODFY
         B        GENELOOP
DCT7END  LCI      15
         PLM,R1   *R0
         LI,R6    DICTCALL
         AW,R6    R3
         STW,R6   *R7
         LI,SR4   K3                SET UP DICT CHANGE DESCRIPTION      897
         SLS,SR4  K18                 TABLE FOR MODIFY                  897
         AI,SR4   K2                                                    897
         STW,SR4  DICTCALL,R3                                           897
         LW,SR4   DEFHGP                                                897
         STW,SR4  DICTCALL+1,R3                                         897
         LI,SR4   K0                                                    897
         STW,SR4  DICTCALL+2,R3                                         897
         LW,SR1   HGP1ADDR,R3                                           897
         MTW,0    LASTHGP1,R3       ANY HGP TABLES
         BEZ      WRITEOUT          NO..
MODDICT  EQU      %                                                     897
         LW,SR2   *SR1              GET HGP TABLE LINK                  897
         BEZ      WRITEOUT          EXIT IF AT END                      897
         PSW,SR1  *R0                                                   987
         BAL,SR3  SETMODFY          CHANGE REL.DICT.                    897
         PLW,SR1  *R0                                                   987
         LW,SR2   *SR1                                                  897
         LW,SR1   SR2                                                   897
         SW,SR2   HGP1ADDR,R3       TO NEXT LINK                        897
         STW,SR2  DICTCALL+2,R3                                         897
         B        MODDICT                                               897
         DATA     LMODERR           ERROR RETURN FOR MODGEN
WRITEOUT EQU      %
*
*  BEFORE WRITING LM, SET REL.DICT.FOR IOCTQ TABLE TO RELOCATABLE
*
         LD,SR3   XIOTABLE
         STW,SR3  DICTCALL+1,R3
         STW,SR4  DICTCALL+2,R3
         PLW,SR4  *R0               DISPLACEMENT IN LM OF IOCTQ
         STW,SR4  DICTCALL+3,R3       SAVED PREVIOUSLY
         BAL,SR3  SETMODFY
SETPLIST EQU      %
         STW,7    *7                SET UP LMODPLIS FOR MODGEN
         MTW,4    *7                :
         MTW,4    *7                :
RDEFSWAP EQU      %                 DEF SWAP TABLES
         LW,R1    #SWAPDEVS,R3
         BEZ      DFSOL
         AI,R1    1
         SLS,R1   -1
         STW,R1   R2
         AI,R1    1
         SLS,R1   -1
         LW,SR1   SWAPPTR,R3
         LW,D1    #SWAPDEVS,R3
         AI,D1    -1
         BAL,SR3  MODGEN
         TEXTC    'LSWAP0'
         B        %+1
         MTW,0    SWAPUTS,R3        DP SWAPPER
         BEZ      NODPGEN
         LW,D2    SCYLPSA,R3
         SLS,D2   -16
         AI,D2    -2                SC2SK = ((SCYLSZ-2)/4)*10
         SLS,D2   -2
         MI,D2    10
         LI,D1    0
         STH,D2   D1
         LW,R4    DPSWPTYP
         CI,R4    1                 IF IT'S A 1, ONLY ONE H.W. ENTRY
         BE       %+7
         LW,D2    SCYLPSA,R3
         LH,D2    D2
         SLS,D2   -2
         MI,D2    10               ((SCYLSZ)/4)*10
         AH,D2    D1                ((SCYLSZ-2)/4)*10 + ((SCYLSZ)/4)*10
         AW,D1    D2
         BAL,10   MODGEN
         TEXTC    'S:CYLSZ1'
         AI,SR1   1
         PSW,SR1  *R0               SAVE CURRENT SR1 CONTENTS
         LW,SR1   MH2NDSK,R3
         TEXTC    'MH:2NDSK1'
         STW,D1   *SR1
         PLW,SR1  *R0
         AI,10    1
NODPGEN  BAL,10   MODGEN
         TEXTC    'S:DP1'
         AI,SR1   1
         TEXTC    'MB:GAM11'
         AW,SR1   R1
         TEXTC    'MB:GAM21'
         AW,SR1   R1
         TEXTC    'MB:GAM31'
         AW,SR1   R1
         TEXTC    'MB:GAM41'
         AW,SR1   R1
         TEXTC    'MB:GAM51'
         AW,SR1   R1
         TEXTC    'MB:GAM61'
         AW,SR1   R1
         TEXTC    'MB:GAM71'
         AW,SR1   R1
         TEXTC    'MB:SPT1'
         AW,SR1   R1
         TEXTC    'MB:GPT1'
         AW,SR1   R1
         TEXTC    'MB:SWAPS1'
         AW,SR1   R1
         TEXTC    'MB:DWT1'
         AW,SR1   R1
         TEXTC    'MB:SPACEJIT1'
         AW,SR1   R1
         TEXTC    'MB:SDI1'
         AW,SR1   R1
         TEXTC    'M:GATLIM1'
         AW,SR1   #SWAPDEVS,R3
         TEXTC    'M:GASLIM1'
         AW,SR1   #SWAPDEVS,R3
         TEXTC    'M:ADRINCR1'
         AW,SR1   #SWAPDEVS,R3
         TEXTC    'M:SWPEND1'
         AW,SR1   #SWAPDEVS,R3
         TEXTC    'M:FREE#GRAN1'
         AW,SR1   #SWAPDEVS,R3
         TEXTC    'M:SWAPD1'
         AW,SR1   #SWAPDEVS,R3
         TEXTC    'M:HLTIC1'
         LW,R4    #SWAPDEVS,R3
         LW,D1    SR1
         B        %+1
RDARND   EQU    %                   MAKE RELOCATION DICTIONARY
         LW,SR1   *D1               CHANGES FOR M:SGP,M:HLTIC,
         AND,SR1  M20               AND SENSE COMMANDS
         SLS,SR1  1
         BAL,SR3  MODGEN
         TEXTC    '02'
         LW,SR1   D1
         TEXTC    '32'
         AI,D1    1
         BDR,R4   RDARND
         LW,SR1   D1
         TEXTC    'M:SNSDA1'
         AW,SR1   #SWAPDEVS,R3
         MTW,0    SWAPUTS,R3        IF DP SWAPPER NEED TO SKIP 3 WORDS
         BEZ      %+3               BR. IF NOT
         AI,SR1   3
         AI,SR3   1                 CONTINUE IN MODGEN MODE
         BAL,SR3  MODGEN
         AW,SR1   XTRASIZ
         TEXTC    'M:SGP1'
         B        %+1
         LW,R4    #SWAPDEVS,R3
         BAL,SR3  MODGEN
         TEXTC    '22'
         AI,SR1   1
         BDR,R4   %-3
         TEXTC    'M:SBAND1'
         AW,SR1   #SWAPDEVS,R3
         TEXTC    'M:JITPAGE1'
         AW,SR1   #SWAPDEVS,R3
         TEXTC    'M:CLBGN1'
         AW,SR1   #SWAPDEVS,R3
         TEXTC    'M:WCKBCL1'
         AW,SR1   #SWAPDEVS,R3
         TEXTC    'M:WCKECL1'
         AW,SR1   #SWAPDEVS,R3
         TEXTC    'MH:CLEND1'
*
         AW,SR1   R2
         TEXTC    'MB:#RTRY1'
         AW,SR1   R1
         TEXTC    'MB:SFC1'
DFSOL    EQU      %
         B        %+1
         LW,R1    FEDX#,R3
         BEZ      DFSOL1
         LW,SR1   FEDXHWT,R3
         BAL,SR3  MODGEN
         TEXTC    'FDH:CLS1'
         LW,SR1   FEDXBYTT,R3
         TEXTC    'FDB:FEX1'
         AND,R1   XFFFF             EXTRACT HIGHEST FEDX #
         LW,D1    R1
         TEXTC    'FECPD#0'
         AI,R1    3
         SLS,R1   -2                CONVERT TO WORDS OF BYTE TABLES
         LW,R2    R1                TEMP SAVE OF FEDX VAL + 1 IN WORDS
         AW,SR1   R1
         LW,D2    SR1               TEMP SAVE TABLE POINTER FOR FDB:DCT
         TEXTC    'FDB:DCT1'
         AW,SR1   R1
         TEXTC    'FDB:LNK1'
         AW,SR1   R1
         TEXTC    'FDB:TO1'
         LW,SR1   FEXWT,R3
         TEXTC    'FE:CRD1'
         LW,SR1   FEXHWT,R3
         TEXTC    'FEH:ADR1'
         LW,SR1   FEXBYTT,R3
         TEXTC    'FEB:CDX1'
         LW,R1    FEDX#,R3
         LH,R1    R1
         LW,D1    R1
         TEXTC    'FECP#0'
         AI,R1    3
         SLS,R1   -2
         AW,SR1   R1
         TEXTC    'FEB:IHD1'
         AW,SR1   R1
         TEXTC    'FEB:CIO1'
         LW,R4    FEB:CDX,R3        MOVE GENERATED TABLE FOR FEB:CDX
         LW,SR1   FEXBYTT,R3        INTO LOAD MODULE ENTRY
         AI,R1    -1
         BEZ      %+4
         LW,R5    *R4,R1
         STW,R5   *SR1,R1
         BDR,R1   %-2
         LW,R5    *R4
         STW,R5   *SR1
         LW,SR1   FEDXBYTT,R3       MOVE GENERATED TABLES FOR FDB:FEX
         LW,R6    FDB:FEX,R3        AND FDB:DCT INTO LOAD MODULE ENTRIES
         LW,R1    FDB:DCT,R3
         AI,R2    -1
         BEZ      %+6
         LW,R4    *R6,R2
         LW,R5    *R1,R2
         STW,R4   *SR1,R2
         STW,R5   *D2,R2
         BDR,R2   %-4
         LW,R4    *R6
         LW,R5    *R1
         STW,R4   *SR1
         STW,R5   *D2
         B        %+1
DFSOL1   EQU      %
         BAL,SR3  MODGEN
         LW,SR1   SOLICIT,R3
         BEZ      %+4
         TEXTC    'SOLICIT1'
         SW,SR1   AVRIDARA,R3
         SLS,SR1  -1
         B        %+1
         BAL,10   MODGEN
         AW,SR1   AVRIDARA,R3
         TEXTC    'AVRNOU1'
         MTW,0    #RBTS,R3          ANY RBTS
         BEZ      RBLIMGEN          NO
         LW,SR1   RBFLAGPTR,R3
         TEXTC    'RB:FLAG1'
         LW,SR1   RBBCRCPTR,R3
         TEXTC    'RBB:CRC1'
         LW,SR1   RBBSPCPTR,R3
         TEXTC    'RBB:SPC1'
         LW,SR1   RBBSFCPTR,R3
         TEXTC    'RBB:SFC1'
         LW,SR1   RBBCPZPTR,R3
         TEXTC    'RBB:CPZ1'
         LW,SR1   RBBLPZPTR,R3
         TEXTC    'RBB:LPZ1'
         LW,SR1   RBDWSNPTR,R3
         TEXTC    'RBD:WSN1'
         AI,10    1
RBLIMGEN EQU      %
         BAL,10   MODGEN
         LW,SR1   RBLIMSPTR,R3
         TEXTC    'RBLIMS1'
         LW,SR1   PSA%AD,R3
         TEXTC    'PSA%END1'
         LW,D1    PSA,R3
         STW,D1   *SR1
         LW,D1    SVDFDK,R3
         TEXTC    'SV:DFDK0'
         LW,D1    SVDFTP,R3
         TEXTC    'SV:DFTP0'
         LW,D1    OCDCTVAL,R3
         TEXTC    'OCDCT0'
         LW,D1    EHSZ
         TEXTC    'HGPSIZE0'
         LW,SR1   DISCLIMSPTR,R3
         TEXTC    'DISCLIMS1'
         LW,SR1   NCYLPTR,R3
         TEXTC    'NCYL1'
         LW,SR1   NTPCPTR,R3
         TEXTC    'NTPC1'
         LW,SR1   NSPTPTR,R3
         TEXTC    'NSPT1'
         LW,SR1   NSPCPTR,R3
         TEXTC    'NSPC1'
         LW,SR1   CYLSPTR,R3
         TEXTC    'CYL%SHFT1'
         LW,SR1   TRKSPTR,R3
         TEXTC    'TRK%SHFT1'
         LW,SR1   SECSPTR,R3
         TEXTC    'SEC%SHFT1'
         LW,R6    TREEADDR,R3
         LW,D1    6,R6
         SLS,D1   -15
         TEXTC    'IOTBLSIZ0'
         LW,D1    SWAPUTS,R3        AND FDB:DCT INTO LOAD MODULE
         TEXTC    ':DP0'
         LW,D1    PRIVDEV,R3
         BEZ      CHKMPC            IF NO PRIVATE DP'S, BRANCH
         TEXTC    'PRIV0'           OTHERWISE GENERATE VALUE DEF
         AI,SR3   1                 THIS KEEPS EXECUTION IN MODGEN ROUTINE.
CHKMPC   BAL,SR3  MODGEN            ENTER MODGEN CODE
         LW,D1    MPC#              GET # OF MPC DEVICE TYPE
         BEZ      GENSMOD#          BRANCH IF NONE
         TEXTC    '#MPC0'           MAY NEED 2 OR 3 IF TAPE & CARD
*                                   DEVICES (ON MPC) ARE ADDED TO CPV
         LW,SR1   MPCTABAD,R3
         TEXTC    'MPCNTBL1'
         AI,D1    1                 CALC. NEXT TABLE ENTRY
         SLS,D1   1
         AW,SR1   D1
         TEXTC    'MPCDATE1'
         AW,SR1   D1
         TEXTC    'MPCTYPE1'
         B        GENSMOD#
         PAGE
****************************************
*THIS CODE GENERATES DEFS FOR SWAPPING DEVICES WITH AN
*'S' PRECEDING THE MODEL # AND A VALUE EQUAL TO # OF
*SWAPPING DEVICES WITH THIS MODEL NUMBER
****************************************
*                                   GET MOD # OUT OF TABLE AND MERGE
*                                   INTO TEXTS#
GENSMOD# EQU      %
         LI,R5    0
         LI,R2    1
         LW,R1    SWAPMOD#
         PAGE
         BEZ      NOSWAP
DONE1A   LW,D1    SWAPMODT,R5
         STH,D1   TEXTS#+1
         SLS,D1   -16
         STH,D1   TEXTS#,R2
         BAL,SR4  S#SETUP
         AI,R5    1
         BDR,R1   DONE1A
         B        NOSWAP
S#SETUP  BAL,10   MODGEN
         LB,D1    S#BYT,R5
TEXTS#   TEXTC    'S    0'
         B        %+1
         B        *SR4
NOSWAP   EQU      %
         LD,D1    XIOTABLE
         STD,D1   FLNME
         LW,SR4   TREE+7,R3
         LH,SR4   SR4
         STW,SR4  RDEFLNG,R3
         LW,SR4   TREE+9,R3
         LH,SR4   SR4
         STW,SR4  EXPRLNG,R3
*
         CAL1,1   OPENTM            OPEN FILE 'IOTABLE'
         LW,R6    RDEFADDR,R3
         LCI      K4
         LM,D1    NEWDEF            PUT DUMMY DEF IN DEF STACK
         LW,D2    1,R6              SET SECT.00 ADDRESS
         LCI      K4
         STM,D1   *R6
         LW,SR2   L(X'FFFF0000')
         LW,R6    TREEADDR,R3       SET NEW UTS HEAD
         LW,R7    HEADADDR,R3
         LW,SR1   3,R7
         SLS,SR1  -16
         LS,SR1   6,R6
         STW,SR1  3,R7              SECT.00 SIZE (DWDS.)
         LW,SR1   7,R6
         STS,SR1  5,R7              REFDFSTK SIZE (WDS.)
         LI,SR1   X'18'
         AWM,SR1  *R7               NEW HEAD SIZE (BYTES)
         LCI      K2
         LM,R6    WRITETM
         LI,R5    HEADADDR          SET
         AW,R5    R3
         LI,SR3   HEADKEY           ADDRESS OF KEYNAME
*
*                                   WRITE IOTABLE LOAD MODULE
*
WRITELM1 LW,SR1   0,R5
         LW,SR2   6,R5
         SLS,SR2  2
         CAL1,1   R6                CAL SAVES ALL REGISTERS
*
         AI,R5    K1                ALL 6 BUFFER POINTERS SEQUENTIAL
         AI,SR3   K3                EACH KEYNAME ADDRESS +3 FROM PREV.
         CI,SR3   NAME03
         BLE      WRITELM1
*
         CAL1,1   CLOSETM           CLOSE FILE
*
         PAGE
********
*  GENERATE 'SPEC:HAND' FILE OF HANDLER NAMES (USED BY PASS3)
********
GENSPECH EQU      %
         LW,R1    PACKRPTR,R3
         LW,R2    DYSTORND,R3
         LI,R4    0
         STW,R4   *R1               SET WORK AREA TO ZERO
         AI,R1    1
         CW,R1    R2
         BL       %-3
***********************************************************************
* THE FOLLOWING CODE CHECKS FOR AN ILLEGAL RHANDLER SPECIFICATION
* BY COMPARING SPECIFICATION TO ALL KNOWN STANDARD HANDLERS
***********************************************************************
*
*
         LW,R5    RHANDTAD,R3
         BEZ      REGHAND            IS ZERO IF NO :HANDLERS2 CC
         LW,R1    *R5               GET SIZE OF ROOT HANDLER TABLE
         BEZ      REGHAND           SKIP THIS CODE IF THERE ARE NONE
         LW,SR1   PACKRPTR,R3
         LW,SR2   HANDTADR,R3
         AI,R1    1                 GET SET TO MOVE RHANDTAD TBL
         SLS,R1   1                 TEMPORARILY INTO PACKRPTR WORK
         LI,R4    0                 AREA
         LD,D1    *R5,R4
         STD,D1   *SR1,R4
         BIR,R4   %+1
         BDR,R1   %-3
         LW,R1    *R5
         LI,R2    1                 NOW MUST PURGE NAME2 OF HANDLER
         LI,R4    2                 FROM TABLE--COMPACTING TO 2-WORD
PURGENM2 LD,D1    *R5,R4            NAME1 ENTRIES
         STD,D1   *R5,R2
         AI,R2    1
         AI,R4    2
         BDR,R1   PURGENM2
         LW,R1    *R5               GET SIZE AGAIN--IT'S STILL SAME
RHANLUP1 LI,R4    HANDNEND          # OF WORDS IN STANDARD HANDLER TABLE
         LW,R2    R4
         SLS,R2   -2                # OF STANDARD HANDLERS IN HANDNAME
*                                   TABLE
         AI,R4    HANDNAME          START WITH LAST NAME IN TABLE
         LD,D1    *R5,R1            GET SPECIFIED NAME
FIXHLUP1 CD,D1    *R4
         BNE      INRLUP1           BRANCH IF O.K.
         CD,D1    XCOC              IF IT'S 'COC' IGNORE REMOVING IT
         BE       ENDHLUP1          SINCE IT IS A ROOT ELEMENT ANYWAY
         CD,D1    XRAS              SAME GOES FOR 'RAS'
         BE       ENDHLUP1
         LI,R2    ENDHLUP1
INRINRLP MTW,1    *SR2           ***NOTE EXU LOOP AT OUTOFLUP+3
         LW,R4    *SR2              TABLE
         SLS,R4   2
         AW,R4    SR2
         STD,D1   *R4               NAME1 GOES TO END OF HANDTADR
         AI,R4    2                 POINT TO NAME2 SLOT IN HANDTADR
         LW,R6    BLANK
         STB,R6   D1
         STW,D1   RHANDMES+5        POST NAME IN ERROR MESSAGE
         STW,D2   RHANDMES+6
         MTW,1    P2ERR,R3          INCREMENT ERROR COUNT
         LI,SR3   RHANDMES
         BAL,SR4  PRINTMSG
         LW,R6    R1                NAME2 IS TO BE FOUND IN
         SLS,R6   2                 CORRESPONDING PACKRPTR AREA
         AW,R6    SR1
         AI,R6    2
         LD,D3    *R6               GET NAME2 AND PUT IT AFTER
INRLUP0  STD,D3   *R4               NAME1 IN HANDTADR TABLE
*                                ***NOTE EXU LOOP AT INRLUP2-2
         LW,R4    *R5               GET # OF ENTRIES IN RHANDLER
         LD,D1    *R5,R4            GET LAST NAME IN RHANDLER
         STD,D1   *R5,R1            STORE IT OVER OFFENDING ENTRY
         MTW,-1   *R5               DECREMENT RHANDLER # ENTRIES
         B        *R2
INRLUP1  AI,R4    -4
         BDR,R2   FIXHLUP1
ENDHLUP1 BDR,R1   RHANLUP1
         LW,R1    *R5
         BEZ      REGHAND           ALL THRU THIS CHECK IF 0.
*                                   STILL NEED TO DO AN ADDITIONAL
*                                   SET OF HANDLERS THAT ARE 2
         LI,R4    MORHAND           WORDS LONG
         LW,R2    R4
         SLS,R2   -1                # OF THESE STANDARD HANDLERS
         AI,R4    XMAGTAPE-2
         LD,D1    *R5,R1
FIXHLUP2 CD,D1    *R4
         BNE      INRLUP2           BRANCH IF O.K.
         CD,D1    XMOCIOP           IF IT IS 'MOCIOP', IGNORE REMOVING
         BE       ENDHLUP2          IT SINCE IT'S A ROOT ELEMENT ANYWAY
         CD,D1    XHSPM             SAME GOES FOR 'HSPM'
         BE       ENDHLUP2
         LI,R2    ENDHLUP2
         LW,R6    *SR1
         CW,R6    *R5               IF RHANDTAD SIZE = PACKRPTR
         BE       INRINRLP          SIZE THEN PROCESSING IS SIMPLIFIED
         LW,D3    R6                OTHERWISE HAVE TO CHECK THRU
         SLS,D3   2                 PACKRPTR TABLE LOOKING FOR CORRES-
         AW,D3    SR1               PONDING ENTRY SO AS TO GET TO
         CD,D1    *D3               NAME2
         BE       OUTOFLUP
         AI,D3    -4
         BDR,R6   %-3
OUTOFLUP AI,D3    2
         LD,D3    *D3               GOT NAME2
         LI,R7    -13
         EXU      INRINRLP+13,R7    NOW TRANSFER NAME1 INTO HANDTADR TBL
         BIR,R7   %-1               END.
         LI,R7    -6
         EXU      INRLUP0+6,R7      NOW TRANSFER NAME2 INTO HANDTADR
         BIR,R7   %-1               TABLE END.
INRLUP2  AI,R4    -2
         BDR,R2   FIXHLUP2
ENDHLUP2 BDR,R1   ENDHLUP1+3
         LW,R1    *SR1
         AI,R1    1
         SLS,R1   1
         LI,R4    0                 NEED TO ZERO OUT PACKRPTR AREA
         STW,R4   *SR1              USED BY RHANDTAD PROCESSING
         LD,D1    *SR1
         STD,D1   *SR1,R4
         BIR,R4   %+1
         BDR,R1   %-2
         PAGE
REGHAND  LW,R1    PACKRPTR,R3
         LW,R2    HANDTADR,R3       HANDLER NAME TABLE SOURCE
         LI,R4    1                 INDEX TO 1-ST ENTRY
         LW,R5    *R2               # HANDLER ENTRYS
         BEZ      SPECHNDER         GO PRINT SPEC:HAND ERR. MESSAGE
****
*  (R1) = DESTINATION
*  (R2) = NAME SOURCE BASE ADDR.
*  (R4) = REL.POSITION TO NAME1
*  (R5) = # NAMES
****
         AI,R1    2                 R1 PTS TO FIRST ENTRY SLOT
         LI,SR4   G2NXT
NXTNAM1  EQU      %
         SLS,R4   1
         LD,D1    *R2,R4            PUT NAME1
         CD,D1    XV2IO             V2IO IS AN MO DEVICE HANDLER
         BNE      %+4
         LI,R7    1
         STS,R7   MOTYP             SET BIT 31
         B        STRHAND
         CD,D1    X3270             3270 IS AN MO DEVICE HANDLER
         BNE      %+4
         LI,R7    2
         STS,R7   MOTYP             SET BIT 30
         B        STRHAND
         CD,D1    HASPHAND          SEE IF HASPIO INCLUDED IN CUR. HAND
         BNE      %+4
         LI,R7    8
         STS,R7   MOTYP             SET BIT 28
         B        STRHAND
         CD,D1    XCOC              SKIP ADDING COC NOW TO SPEC:HAND
*                                   IT WILL BE ADDED AS 'COC' OR
*                                   'TPCOC' IN P2COC MODULE.
         BE       G2NXT
         CD,D1    XRAS              IF RAS HANDLER, IT GOES LATER
         BNE      %+4               TO HANDLERS FILE
         LI,R7    16
         STS,R7   MOTYP             SET BIT 27 OF MOTYP
         B        G2NXT
         CD,D1    7446IO            NEED TO CONVERT IF SO TO 'NSLP'
         BNE      %+3
         LD,D1    NSLP
         B        STRHAND
         CD,D1    MTAP              NEED TO CONVERT TO MAGTAPE
         BNE      STRHAND           IF SO
         LD,D1    XMAGTAPE
STRHAND  STD,D1   *R1
         AI,R1    2                 INCR. PTR TO ENTRY AREA IN HANDLERS
G2NXT    SLS,R4   -1
         AI,R4    1                 NEXT NAME1
         CW,R4    R5                AT END
         BLE      NXTNAM1           NO--
         BAL,R4   ADDHAND
         MTW,0    AVTBLGTH,R3       ANY TAPES ON SYSTEM
         BEZ      NOTMAG            NO
         LD,D1    XMAGTAPE          YES NEED TO ADD MAGTAPE HANDLER
         BAL,D3   ADIT
         B        NOTMAG
ADIT     STD,D1   *R1
         AI,R1    2
         B        *D3
2HANDLERS LW,R6   RHANDTAD,R3       THIS CODE PLACES THE HANDLERS ONLY
         MTW,1    *R6               HANDLER NAMES INTO THE ROOT HAND.
         LW,R6    *R6               RECORD WHEN BOTH HANDLERS AND
         SLS,R6   1                 HANDLERS2 RECORDS ARE TO BE
         AW,R6    RHANDTAD,R3       GENERATED
         STD,D1   *R6
         B        *D3
NOTMAG   EQU      %
         MTW,0    #RBTS,R3          ANY RBTS
         BEZ      NOBTS
GRRBHO   LD,D1    XRBSSS            ADD RBSSS NAME TO UMOV RECORD
         BAL,D3   ADIT
GTRBH1   EQU      %
         LW,R7    RBTTYP            GET IRBT/2780 FLAG WORD
         BEZ      NOBTS             BRANCH IF NEITHER ONE
         CW,R7    Y4                WAS AN IRBT SPECIFIED
         BAZ      GTBSCIO           SKIP IF NOT
         CW,R7    Y04               WAS A 2780 ALSO SPECIFIED
         BAZ      GTBSCIO           IF NOT 'HASPIO' HANDLER IS IN.
         LW,R7    MOTYP
         BAL,R4   CHKHSPM1          IF SO, HSPM MUST BE ADDED TO
*                                   HANDLERS RECORD IN SPEC:HAND
         LD,D1    HASPHAND          AND HASPIO MUST BE ADDED TO
*                                   TO WORK AREA
         BAL,D3   ADIT
GTBSCIO  LD,D1    XBSCIO
         LI,D3    NOBTS
         B        ADIT
NOBTS    EQU      %
*                 THE FOLLOWING ARE ALWAYS PRESENT EITHER IN HANDLERS
*                 OR HANDLERS2
         LD,D1    XINSYM
         BAL,D3   ADIT
         LD,D1    XOUTSYM
         BAL,D3   ADIT
         LD,D1    XSWAPPER
         BAL,D3   ADIT
         LW,R2    PACKRPTR,R3       BASE ADDR.
         SW,R1    R2                FILE SIZE
         LW,R7    R1
         SLS,R7   -1
         AI,R7    -1
         STW,R7   *R2            UPDATE SPEC:HAND SIZE TO
*                                ACCOUNT FOR ENTRIES INTO HANDLERS2
         SLS,R1   2                   (BYTES)
         LI,D1    HANDLERS          ASSUME HANDLERS ONLY RECORD
         MTW,0    HAND2FLG,R3
         BEZ      %+2               BRANCH IF ONLY HANDLERS IS GENERATED
         LI,D1    HANDLERS2         OTHERWISE ALL UBCHAN HANDLERS GO
*                                   INTO HANDLERS2 RECORD OF SPEC:HAND
*                                   EXCEPT FOR POSSIBLE MOCIOP & HSPM
         M:OPEN   M:TM,(FILE,'SPEC:HAND'),(OUT),(KEYED),(DIRECT),;
                       (KEYM,63),(SAVE)
         M:WRITE  M:TM,(BUF,*R2),(SIZE,*R1),(KEY,*D1),;
                       (NEWKEY),(WAIT)
         LW,R1    RHANDTAD,R3
         BEZ      CLOZETM
         LW,R1    *R1
         AI,R1    1                 GET READY TO WRITE OUT HANDREC
         SLS,R1   3                 R1 IS NOW SIZE OF REC. IN BYTES
         LW,R2    RHANDTAD,R3
         M:WRITE  M:TM,(BUF,*R2),(SIZE,*R1),(KEY,HANDLERS),;
                       (NEWKEY),(WAIT)
CLOZETM  EQU      %
         M:CLOSE  M:TM,(SAVE)
*********
*  END OF TABLE OUTPUT FOR CHAN,DEVICE COMMANDS
*    MOVE,DCT1,DCT4,DCT16 TO PERM AREA FOR FOLLOWING
*     COMMANDS; ALSO SET UP DP,SP ENTRIES TO BE IDENTICAL
*    THEN RELEASE WORK AREA TEMPORARILY OBTAINED AND
*      RETURN FOR SUBSEQUENT PROCESSING
*
WRAPUP   EQU      %
         LW,R7    DCTSIZE,R3
         LW,SR1   DCT1PTR,R3
         LW,R5    DCT1TEMP,R3
         LH,D1    *SR1,R7
         STH,D1   *R5,R7
         BDR,R7   %-2
         LW,R7    DCTSIZE,R3
         LW,SR1   DCT4PTR,R3
         LW,R5    DCT4TEMP,R3
         LB,D1    *SR1,R7
         STB,D1   *R5,R7
         BDR,R7   %-2
         LW,R7    DCTSIZE,R3
         LW,SR1   DCT16PTR,R3
         LW,R5    DCT16TEMP,R3
         LD,D1    *SR1,R7
         STD,D1   *R5,R7
         BDR,R7   %-2
*                                   MOVE DP INFOR INTO SP SLOT FOR
*                                   TB:MAX,TB:SZ,TB:FLGS,OB:BTX,
*                                   OB:OTX AND OB:GTX
         LW,SR1   TBFLGSPTR,R3      GET ADDRESS OF TB:FLGS ENTRIES
         LI,R5    1                 'NO' DEVICE NDX
         LB,D1    TYPEFLAGS,R5      GET 'NO' DEVICE DEFAULT VALUE
         STB,D1   *SR1,R5           STORE IT IN 'NO' SLOT IN TB:FLGS
         LI,R1    X'D'              DEVICE TYPE (+1) FOR SP
         LW,R7    FIRSTDP,R3        BYTE 0 = FIRST PRIVATE DP NDX
         LB,R7    R7                DEVICE TYPE (+1) FOR 1ST PRIV DP
         BEZ      FREEPGS           SKIP IF NO PRIVATE DP TYPE DEVICES
         LB,D1    *SR1,R7           GET TBFLGS ENTRY FOR PRIV DP
         STB,D1   *SR1,R1           STORE PRIV DP ENTRY VAL. IN SP SLOT
         LW,SR1   TYCOUNT,R3
         LH,D1    *SR1,R7
         STH,D1   *SR1,R1
         LW,SR1   TBMAXPTR,R3
         LB,D1    *SR1,R7
         STB,D1   *SR1,R1
         LW,SR1   TBSZPTR,R3
         LB,D1    *SR1,R7
         STB,D1   *SR1,R1
         AI,R1    -1                GET TRUE INDEX
         AI,R7    -1                FOR THE PACKS
         LW,SR1   BTXPTR,R3
         LB,D1    *SR1,R7
         STB,D1   *SR1,R1
         LW,SR1   OTXPTR,R3
         LB,D1    *SR1,R7
         STB,D1   *SR1,R1
         LW,SR1   GTXPTR,R3
         LB,D1    *SR1,R7
         STB,D1   *SR1,R1
FREEPGS  LW,R7    SAVEPAGE,R3       GET UBCHAN'S WORK PAGES AND FREE
*                                   THEM
         OR,R7    =X'09000000'
         CAL1,8   R7
         LI,D2    -1
         LI,D1    -1
         LW,7     FETCHADR,R3
         BAL,11   COREALLOC         GET CORE FOR MOD AND CONT
         LW,R1    DVCTR,R3          GET COUNT
         AI,R1    2
         SLS,R1   -1
         LW,6     8
         BAL,10   MODGEN
         TEXTC    'DEVMOD#1'
         AW,8     R1
         TEXTC    'CNTMOD#1'
         LW,D3    8
         AW,8     R1
         TEXTC    'E2'
         B        %+1
         LW,R1    DVCTR,R3
         LI,R2    1
         LW,12    MODTABPTR,R3
         LW,SR2   MODNUMPTR,R3
STRLOOP  LB,R5    *SR2,R2           TRANSFER DATA
         BEZ      SKIPCON           IF ZERO SKIP CONVERSON
         LD,SR3   *12,R5
         B        CONVERT
STRIT    STH,SR3  *6,R2
         STH,SR4  *D3,R2
SKIPCON  AI,R2    1
         BDR,R1   STRLOOP
         LI,D3    FILENAME
         AI,SR1   -1
         BAL,SR4  WRITELM           WRITE M:DCTMOD LOAD MODULE
         LW,R7    #INTPAGES,R3
         OR,R7    =X'09000000'
         CAL1,8   R7
         LW,R7    DPSWPTYP          ADD 1 OR 2 TO SWAPUTS FOR
         AWM,R7   SWAPUTS,R3        DP SWAPPERS FOR LATER USE BY IMC
         LI,R7    0
         STW,R7   SAVEPAGE,R3
         STW,R7   SAVEPAGE+1,R3
         STW,R7   #INTPAGES,R3
         STW,R7   GETINTERPTR,R3
         LI,R1    -STACKEND
         AI,R1    P2DYNEND
         MSP,R1   *R0
         LW,R7    FETCHADR,R3
         LW,R5    R3
         M:PRINT  (MESS,ASTER)      PRINT 2 LINES OF ASTERISKS
         M:PRINT  (MESS,ASTER)      BEFORE FINALLY LEAVING UBCHAN
         B        READSTRG
*
ADDHAND  EQU      %
         LW,R2    SWAPUTS,R3        GET SWAP FLAG
         LD,D1    SWAPHAND,R2
         BAL,D3   ADIT
         LW,R7    MOTYP             CHK FOR PRESENCE OF MO HAND.
         CW,R7    X3
         BAZ      CHKHSPM
         LD,D1    XMOCIOP           ADD THIS NAME TO HANDLERS RECORD
         LI,D3    CHKHSPM
TWOHRECT MTW,0    HAND2FLG,R3       CHK IF HANDLERS & HANDLERS2 RECS.
         BEZ      %+2               ARE TO BE GENERATED. BR IF NOT.
         B        2HANDLERS
         B        ADIT
CHKHSPM  CI,R7    8                 IF SET, 'HSPM' HANDLER IS NEEDED
         BAZ      CHKRAS
CHKHSPM1 LD,D1    XHSPM             ADD 'HSPM' TO HANDLERS RECORD
         LI,D3    CHKRAS
         B        TWOHRECT
CHKRAS   CI,R7    16                SEE IF BIT 27 IS SET
         BAZ      *R4
         LD,D1    XRAS
         LW,D3    R4                D3 WILL PT BACK TO G2NST + 4
         B        TWOHRECT
**********
*
*
SPECHNDER MTW,1   P2ERR,R3          INCREMENT ERROR COUNT
         LI,SR3   SPECMSG
         BAL,SR4  PRINTMSG
OUTOFIT  EQU      %
         LI,SR3   PASS2MSG
         BAL,SR4  PRINTMSG          PASS2 UNABLE TO CONTINUE
         CAL1,9   2                 ERROR ABORT OF PASS2
*
*
SPECMSG  TEXTC    '*** SPEC:HAND CANNOT BE GENERATED'
PASS2MSG TEXTC    '*** PASS2 UNABLE TO CONTINUE'
SEQERRM  TEXTC    '*** UNKNOWN OR NON-STANDARD PACKS MUST BE',;
                  ' ORDERED AFTER STANDARD'
PSASEQER TEXTC    '***A PSA-ALLOCATED PACK MUST ALWAYS PRECEDE',;
                  ' ALL OTHER PACK DEVICE COMMANDS (DELAYED ABORT)'
2MNYMCS  TEXTC    '*** ONLY 1 MC DEVICE COMMAND IS LEGAL'
2MNYCOCS TEXTC    '*** TOO MANY COCS SPECIFIED--ONLY 8 ARE ALLOWED'
2MNYLKSW TEXTC    '*** TOO MANY LIKE SWAP DEVICES TO FIT IN S#XXXX',;
                  ' TABLE. ONLY FIRST 8 SUPPLIED'
IX2LGMSG TEXTC    '*** DP INDEX EXCEEDS 63 DEC.  THIS IS A PROBLEM',;
                  ' IF 3282 PACKS ARE INVOLVED.'
         PAGE
NOPA     TEXT     'NOPA'
MODE     TEXT     'MOD'
NOPABIT  DATA     X'8000000'        NOPART BIT PATTERN
FILENAME TEXTC    'M:DCTMOD'
KEY      GEN,8,64,8 9,'M:MODNUM',3
ABORT    BAL,SR4  OUTLLERR
         LI,SR4   DIE
         BAL,SR3  PRINTMSG
         TEXTC    'TROUBLE WITH M:MODNUM FILE OR MODEL COMMAND.',;
                  '  PASS2 UNABLE TO CONTINUE'
DIE      CAL1,9   2
EROR     BAL,SR4  OUTLLERR
         BAL,SR4  ERRBOR21
         B        ASUMEDP
         PAGE
*
****     ERROR MESSAGES FOR DEVICE/CHAN CARD PROCESSOR
*
PSA2LG   TEXTC    '***PSA VALUE TOO LARGE. REDUCED TO HEX FF.'
MOD#MSG  TEXTC    '*** WARNING INCORRECT MOD. # OR CONT.',;
                  ' #. FFFF HAS BEEN SUBSTITUTED FOR BOTH'
ERRBORT3 BAL,SR4  OUTLLERR
         PUSH     D3
         B        ERRBT3
ERRBRT3  EQU      %
         BAL,SR4  OUTLLERR
         PUSH     D3
         LI,SR4   ERRBT3
         LI,D3    %+2
         B        LOGIT+1
         TEXTC    '*** SYNTAX ERROR'
ERRBT3   EQU      %
         PULL     D3
         LW,SR4   R7
         LW,R7    FETCHADR,R3
         XW,SR4   FETCHLST+4,R3
         AND,SR4  L(X'DFFFFFFF')
         XW,SR4   FETCHLST+4,R3
         B        *SR4
MSG11    TEXTC    '*** HGP TABLE FULL'                                  897
PRPAGES  EQU      %
         PUSH     15,R1
         LI,R1    0
         LW,D1    SAVEPAGE,R3       GET # OF PAGES
         SLD,D1   -32
         CI,D2    0
         BNE      %+3
         AI,R1    X'F0'
         B        OUTCNVT
         DW,D1    =10
         AI,D1    X'F0'
         SLS,R1   -8
         STB,D1   R1
         LI,D1    0
         CB,D2    0
         BG       %-6
         CI,R1    X'40'
         BANZ     %+3
         SLS,R1   -8
         B        %-3
OUTCNVT  OR,R1    =X'40404040'
         STW,R1   PAGES+2
         PULL     15,R1
         LI,D3    %+2
         B        LOGIT
PAGES    TEXTC    ' ONLY  XXXX PAGES OBTAINED'
ERBOR13A EQU      %                                                     897
         MTW,1    P2ERR,R3
         BAL,SR3  PRINTMSG                                              897
MSG13    TEXTC    '*** UNKNOWN DEVICE YYNDD FOR CH'
ERRBOR14 MTW,1    P2ERR,R3
         BAL,SR3  PRINTMSG
         TEXTC    '*** INSUFFICIENT PAGES AVAILABLE'                    897
ERRBOR15 EQU      %
         BAL,SR3  PRINTMSG
         TEXTC    '*** LOAD MODULE CANNOT BE GENERATED'
ERRBOR16 MTW,1    P2ERR,R3
         BAL,SR3  PRINTMSG
         TEXTC    '*** NO DISC DEFINED'                                 897
ERRBOR17 LI,D3    %+2
         B        LOGIT
         TEXTC    '*** NO HANDLER-DEVICE IGNORED --DELAYED',;
                  ' ABORT CONDITION'
ERRBOR18 EQU      %                                                     897
         AND,D3   M16                                                   897
         SLS,D3   K8                                                    897
         OR,D3    L(X'40000040')                                        897
         STW,D3   MSG18+4                                               897
         LI,D3    %+2
         B        LOGIT+1
MSG18    TEXTC    '*** DEVICE TYPE YY ILLEGAL'                          897
ERRBOR19 EQU      %
         LI,R4    0
         STH,R4   *R1,R2            ZAP PER OR PSA
         LI,D3    %+2
         B        LOGIT
         TEXTC    '*** ONLY PFA VALID ON PRIVATE OR',;
                  ' CYLIN ALLOCATED DEVICE'
ERRBOR20 EQU      %
         LI,D3    %+2
         B        LOGIT+1
         TEXTC    '*** VALID ''CHAN'' CC MUST PRECEED ''DEVICE'' CC'
ERRBOR21 EQU      %
         LI,D3    %+2
         B        LOGIT+1
         TEXTC    '*** ''NAME'' OR SYNTAX INVALID'
ERRBOR2X  EQU     %
         LI,D3    %+2
         B        LOGIT+1
         TEXTC    '*** SYNTAX ERROR DUAL OPTIONS USED'
ERRBOR23 EQU      %
         LI,D3    %+2
         B        LOGIT
         TEXTC    '*** NO CHAN/DEVICE INFO'
ERRBOR24 EQU      %
         LI,SR4   ASUMEDP1          RETURN TO ASUMEDP1
         LI,D3    %+2
         B        LOGIT
         TEXTC    '***MORE THAN 36 DP-3275 CHANNELS SPECIFIED',;
                  ' ONLY FIRST 36 RETAINED'
ERRBOR28A EQU     %
         LI,D3    %+2
         B        LOGIT
         TEXTC    '*** SUM PSA+PER+PFA < SIZE'
ERRBOR27 EQU      %
         LI,D3    %+2
         B        LOGIT
         TEXTC    '*** THIS DISC ALREADY DEFINED'
PSAONMPC TEXTC    '***PSA NOT VALID ON MPC DP DEVICE.',;
                  ' PASS2 ABORT ERROR'
ERRBOR28 EQU      %
         LI,D3    %+2
         B        LOGIT
         TEXTC    '*** SUM OF PSA+PER+PFA > SIZE'
ERRBOR30 EQU      %
         MTW,1    P2ERR,R3
         M:PRINT  (MESS,30MESS)
         B        OUTOFIT
30MESS   TEXTC    '***SS/NSPT/SIZE MUST BE NON ZERO'
ERRBOR31 EQU      %
         LI,SR4   ERR2              RETURN ADDRESS FROM LOGIT
         LI,D3    %+2               D3 GETS ERROR MESSAGE ADDRESS
         B        LOGIT
         TEXTC    '*** PSA MUST BE ON 7212/7232/3214 RAD OR DISC PACK',;
                  ' - PSA IGNORED'
ERRBOR32 EQU      %
         LI,SR4   ERR2              RETURN ADDRESS FROM LOGIT
         LI,D3    %+2               D3 GETS ERROR MESSAGE ADDRESS
         B        LOGIT
         TEXTC    '*** PSA PREVIOUSLY DEFINED ON DP',;
                  ' - PSA IGNORED'
ERR4MPCU TEXTC    '*** THE UNIT ADDRESS OF AN MPC DEVICE CANNOT BE',;
                  ' ZERO (I.E. THE LOW ORDER D IN THE YYNDD ',;
                  'DEVICE NAME).'
ERRBOR32A EQU     %
         LI,R4    0
         STW,R4   SWAPUTS,R3        ZERO DP SWAPPER FLAG
         LI,D3    %+2
         B        LOGIT
         TEXTC    '*** PSA DEFINED ON RAD, NOT ALLOWED ON DP'
ERRBOR32B LI,D3   %+2
         B        LOGIT
         TEXTC    '*** IF SS,TRKS,CYLS OMITTED - ',;
                  'DEFAULTS: 100,8,16 WILL BE SUPPLIED'
ERRFEX   LI,SR4   RPRENDPA
         MTW,1    P2ABRT,R3
         LI,D3    %+2
         B        LOGIT
         TEXTC    '*** FECP # MUST BE BETWEEN 1 AND 4',;
                  '  (DELAYED ABORT)'
ERRINNO1 TEXTC    '*** FECP # MUST GO FROM 1 TO HIGHEST # SPEC',;
                  'IFIED IN INCREMENTS OF 1. (DELAYED ABORT)'
ERRFEINT TEXTC    '*** INT VALUE MUST BE SPECIFIED ON THE FE',;
                  ' DEVICE COMMAND (DELAYED ABORT)'
ERRUNMSG TEXTC    '*** UNRECOGNIZEABLE UNIT ON DEVICE ',;
                  'CONTROL COMMAND #   '
ERRBOR34  LI,D3   %+2
         B        LOGIT
         TEXTC    '*** NO PSA DEFINED'
ERRBOR35 LI,D3    %+2
         B        LOGIT
         TEXTC    '*** NO PER DEFINED'
ERROR1   TEXTC    '***A STANDARD DEVICE CLIST VALUE CANNOT BE LESS',;
                  ' THAN SYSGEN DEFAULT. SYSGEN DEFAULT USED'
ERROR36  TEXTC    '***NON-STANDARD DEVICE OPTIONS SUCH AS VFC',;
                  ', BIN, R AND COMP IGNORED FOR STAN',;
                  'DARD DEVICES'
************************************************************************
ASTER    TEXTC    '********************************'
ERRNGC   EQU      %
         LI,SR4   RPRENDPA
         LI,R4    2
         LW,SR2   =X'40000000'
         CS,SR2   *D4,R4            IS IT KNOWN DEVICE
         BAZ      NEWDEFLT          NO
         LI,R4    NSPTD*2+BYTDISP+1
         LB,R4    *D4,R4
         CI,R4    X'B'
         BL       42DFLT
         LI,R4    55
         STB,R4   *D4,R2
         LI,D3    %+2
         B        LOGIT
         TEXTC    '*** NGC > 255 -- 55 USED FOR 7261/7275/3275'
42DFLT   EQU      %
         CI,R4    8              CHECK NSPT VALUE
         BE       9210DFLT
         LI,R4    30
         STB,R4   *D4,R2
         LI,D3    %+2
         B        LOGIT
         TEXTC    '*** NGC > 255 -- 30 USED FOR 7242/7271'
9210DFLT LI,R4    112               THIS IS THE DEFAULT VALUE FOR NGC
         STB,R4   *D4,R2            SET IT INDCINTBL
         LI,D3    %+2
         B        LOGIT             ISSUE WARNING ERROR
         TEXTC    '*** NGC > 255 -- HEX 70 USED FOR A 9210'
NEWDEFLT  EQU     %
         MTW,1    P2ERR,R3
         STB,R4   *D4,R2
         BAL,SR3  PRINTMSG
         LI,D3    %+2
         B        LOGIT
**********
ERRMREC  EQU      %
         LI,R4    X'FF'
         CI,R2    16
         BE       %+2
         LI,R4    1
         STB,R4   *D4,R2
         LI,SR4   RPRENDPA
         LI,D3    %+2
         B        LOGIT
         TEXTC    '*** MREC/MXREC VALUE INVALID -- SYSGEN',;
                  ' DEFAULT USED'
RHANDMES TEXTC    '*** THIS HANDLER - XXXXXXXX - WILL BE PLACED',;
                  ' IN THE UMOV OVERLAY'
         PAGE
K0       EQU      X'0'
K1       EQU      X'1'
K2       EQU      X'2'
K3       EQU      X'3'
K6       EQU      X'6'
K8       EQU      X'8'
K40      EQU      X'40'
KN1      EQU      -X'1'
KCRET    EQU      X'0D'
KNL      EQU      X'15'
KEOB     EQU      X'26'
SSD      EQU      2                 H.W. DISP TO SIZE IN DCINTBL
NSPTD    EQU      3
SIZED    EQU      4
PSAD     EQU      9
PFAD     EQU      10
PERD     EQU      11
NCYLD    EQU      7
NTPCD    EQU      8
CYLSD    EQU      10                BYTE ACCESS
TRKSD    EQU      11                BYTE ACCESS
SECSD    EQU      12                BYTE ACCESS
CLSTBYT  EQU      19                BYTE ACCESS
MORFLGS  EQU      18                BYTE ACCESS
FEX      EQU      20                BYTE ACCESS
FEDX     EQU      21                BYTE ACCESS
INT      EQU      11                H.W. ACCESS
DCINSZ   EQU      6
DEVICDSZ EQU      6
BYTDISP  EQU      DEVICDSZ*4        BYTE DISP. TO START OF DCIN AREA
NGC      EQU      3                 BYTE DISP TO NGC IN DCINTBL
TNGCD    EQU      BYTDISP+NGC       BYTE DISP TO NGC IN DEVICD1
DEVNDX   EQU      4
DEVTYNDX EQU      13                BYTE DISP TO WSN/TRUE NDX
DEVNMNDX EQU      5                 HW DISP TO DEVICE NAME 'YY'
DEVUNNDX EQU      7                 BYTE DISP TO UNIT 'DD' INFORMATION
HANDNDX  EQU      9                 BYTE DISP TO HANDLER NDX
DEVDCIN  EQU      DEVICDSZ+DCINSZ    TOTAL SIZE OF DEVICD1 TABLE
*                                   BEFORE SEPARATING DCIN PORTION
MOD#NDX  EQU      14                BYTE ACCESS
CCDDBYT  EQU      15                BYTE ACCESS
DSCLMNDX EQU      CCDDBYT           BYTE ACCESS
FLAGS    EQU      8                 BYTE ACCESS
NEWFLGS  EQU      12                BYTE ACCESS
PAPRSZ   EQU      3                 BYTE ACCESS
PAPRWD   EQU      5                 BYTE ACCESS
MXREC    EQU      16                BYTE ACCESS
CYLBIT   EQU      X'8000'
PRIVBIT  EQU      X'4000'
DPTYPBIT EQU      X'800'
         PAGE
******************
********
DCDPCM   EQU      %                 KNOWN DC,DP DEVICE TYPES
         TEXT     '7202'            DC
         TEXT     '7203'            DC
         TEXT     '7204'            DC
         TEXT     '7232'            DC
         TEXT     '7212'            DC
DP3214   TEXT     '3214'            DC
DPAKTYP  EQU      %-DCDPCM+1
DP7271   TEXT     '7271'            DP
DP7242   TEXT     '7242'            DP
         TEXT     '7261'            DP
         TEXT     '7275'            DP
DP3275   TEXT     '3275'            DP
         TEXT     '3282'            DP
DP9210   TEXT     '9210'         DP  MPC TYPE (MUST BE LAST OF DP LIST)
#DCDPCM  EQU      %-DCDPCM
********
         BOUND    8
DEFAULTS EQU      %                 (SS,NSPT,SIZE,TYPE,NGC)
*                     NOTE: SIZE IS IN PHYSICAL CYLS. FOR DP
*                           SIZE IS IN TRACKS FOR DC
*                           TYPE = 7 IS FOR DC
*                           TYPE = X'B' IS FOR DP
 GEN,16,16,16,8,8 90,16,128,7,0     7202
 GEN,16,16,16,8,8 90,16,256,7,0     7203
 GEN,16,16,16,8,8 90,16,512,7,0     7204
****              D7232 THRU D3214 SHOULD REMAIN IN ORDER AND
****              NOT BE SEPARATED
D7232    GEN,16,16,16,8,8 256,12,512,7,0  7232
D7212    GEN,16,16,16,8,8 256,82,64,7,0   7212
D3214    GEN,16,16,16,8,8  256,11,256,7,0 3214
D7271    GEN,16,16,16,8,8  256,6,X'190',11,30    7271
D7242    GEN,16,16,16,8,8  256,6,X'C8',11,30     7242
D7261    GEN,16,16,16,8,8  256,11,X'C8',11,55    7261
D7275    GEN,16,16,16,8,8  256,11,X'194',11,52   7275
D3275    GEN,16,16,16,8,8  256,12,X'194',11,57   3275
D3282    GEN,16,16,16,8,8  256,12,X'328',11,57   3282
D9210    GEN,16,16,16,8,8  256,8,X'336',11,112   9210  (MPC)
*******           DEFAULTS SECS,TRKS,CYLS IN BYTES
         BOUND    4
DFBYTES  DATA     0,0,0,0
         DATA,1   0,16,20,0         7232
         DATA,1   0,16,23,0         7212
         DATA,1   0,16,20,0         3214
         DATA,1   0,0,8,16          7271
         DATA,1   0,0,8,16          7242
         DATA,1   0,0,8,16          7261
         DATA,1   0,0,8,16          7275
         DATA,1   0,0,8,16          3275
         DATA,1   0,0,8,16          3282
         DATA,1   0,0,8,16          9210  (MPC) FOR THIS DEV TRKS
*                                   AND CYLS ARE MEANINGLESS
*******           DEFAULTS FOR NTPC,NCYL IN HALFWORDS
         BOUND    4
DFHLFS   DATA     0,0,0,0
         DATA,2   512,0             7232
         DATA,2   64,0              7212
         DATA,2   256,0             3214
         DATA,2   20,400            7271
         DATA,2   20,200            7242
         DATA,2   20,200            7261
         DATA,2   19,404             7275
         DATA,2   19,404            3275
         DATA,2   19,808            3282
         DATA,2   28,822            9210  (MPC)
         BOUND    4
********
*     SWAPPER DATA
DPSWPTYP DATA     0
#TWDSP   EQU      14                TOTAL # OF SWAP WD.TBLS.
#THWSP   EQU      1                 TOTAL # OF SWAP HW TBLES.
#TBYSP   EQU      15                TOTAL # OF SWAP BYTE TBLS.
#BYSWTBLS EQU     12                BYTE TABLES WITH DEFAULTS
#WDSWTBLS EQU     3                 WORD TABLES WITH DEFAULTS
SWAPDFLT EQU      %                 DEFAULT VALUES INDEXED BY TYPX
GAM1     GEN,8,8,8,8 X'3F',X'7',X'7',X'7'
         GEN,8,8,16   7,7,0
GAM2     GEN,8,8,8,8 1,3,7,15
         GEN,8,8,16   3,7,0
GAM3     GEN,8,8,8,8 -1,-2,-3,-4
         GEN,8,8,16   -2,-3,0
GAM4     GEN,8,8,8,8 6,3,3,3
         GEN,8,8,16   3,3,0
GAM5     GEN,8,8,8,8 -7,-4,-4,-4
         GEN,8,8,16   -4,-4,0
GAM6     GEN,8,8,8,8 X'7F',X'F',X'F',X'F'
         GEN,8,8,16   X'F',X'F',0
GAM7     GEN,8,8,8,8 0,0,0,0
         GEN,8,8,16   16,16,0
SPT      GEN,8,8,8,8 82,12,12,12
         GEN,8,8,16   11,11,0
GPT      GEN,8,8,8,8 41,6,6,6
         GEN,8,8,16   6,6,0
SWAPS    GEN,8,8,8,8 0,1,2,3
         GEN,8,8,16   1,2,0
DWT      GEN,8,8,8,8 41,12,24,48
         GEN,8,8,16   12,24,0
SPACEJIT GEN,8,8,8,8 7,1,1,1
         GEN,8,8,16   1,1,0
GATLIM   GEN,16,16,16,16 X'3F',X'7F',X'FF',X'1FF'
         GEN,16,16    X'7F',X'FF'
GASLIM   GEN,16,16,16,16 80,10,10,10
         GEN,16,16    10,10
ADRINCR  GEN,16,16,16,16 X'2E',4,4,4
         GEN,16,16    5,5
7212TBL  EQU      %                 TABLE FOR 7212 SGP ENTRIES
         DATA     X'11111111'
         DATA     X'88888888'
         DATA     X'44444444'
         DATA     X'22222222'
7232TBL  EQU      %                 TBL FOR 7232 TYPE ENTRIES
         DATA     X'55555555'
         DATA     0
         DATA     X'AAAAAAAA'
         DATA     0
         DATA     X'55555555'
         DATA     0
3214TBL  EQU      %
         DATA     X'21212121'       TABLE FOR 3214 SGPENTRIES
         DATA     X'84848484'
         DATA     X'12121212'
         DATA     X'48484848'
         DATA     X'21212121'
         DATA     X'04040404'
TBLGTH   DATA     4,6,6,6,6,6       #OF ENTRIES IN ABOVE TABLES
*                                   ACCESSED BY PSA TYPE INDEX
TYPETBL  DATA     0                 ADD. OF CURRENT TBL
ENDWDS   DATA     75,0,0,47,0,12    SGP INDEX FOR LAST 4 GRAN
LGTINC   DATA     2,0,0,16,0,0      INCR FRO ACCESS LAST 4 GRAN
SWAPHOLD DATA     0                 STORAGE OF SWAPPER TBLE START
SWAPMOD# DATA     0
SWAPMODT EQU      %
         DO1      8
         DATA     0
S#BYT    DATA     0
         DATA     0
SPACKTRK DATA     0                 FOR # OF SWAPPING PACK TRACKS
DPPSASEC DATA     0                 FOR # OF PSA SECTORS FOR PACKS
***********
FLGSNSED DATA     X'1E000010'       FOR ANY DP SWAPPER
FLGSNSE  DATA     X'1E000004'       FOR 7212
         DATA     X'1E000003'       FOR 7232
         DATA     X'1E000003'       FOR 7232
         DATA     X'1E000003'       FOR 7232 (TYPE 3)
         DATA     X'1E000010'       FOR 3214 (TYPE 4)
         DATA     X'1E000010'       FOR 3214 (TYPE 5)
X3       DATA     X'3'
XF       DATA     X'F'
X1F      DATA     X'1F'
X44      DATA     X'44'
X80      DATA     X'80'
X84      DATA     X'84'
X90      DATA     X'90'
XFE      DATA     X'FE'
XFF      DATA     X'FF'
X3FF     DATA     X'3FF'
XFFFF    DATA     X'FFFF'
XFF00    DATA     X'FF00'
********
XDUAL    DATA     'DUAL'
XCYLI    DATA     'CYLI'
XPRIV    DATA     'PRIV'
XSIZE    DATA     'SIZE'
XNSPT    DATA     'NSPT'
XSS      DATA     'SS  '
XPER     DATA     'PER '
XPFA     DATA     'PFA '
XPSA     DATA     'PSA '
XINPUT   DATA     'INPU'
XOUTPUT  DATA     'OUTP'
XIO      DATA     'IO  '
XHANDLER DATA     'HAND'
XRHANDLER DATA    'RHAN'
XPAPER   DATA     'PAPE'
XHALF    DATA     'HALF'
XFULL    DATA     'FULL'
XMXREC   DATA     'MXRE'
XMREC    DATA     'MREC'
XCOMP    DATA     'COMP'
XL       DATA     'L   '
XT       DATA     'T   '
XCC      DATA     'CC  '
XDD      DATA     'DD  '
XD       DATA     'D   '
XFECP    DATA     'FECP'
XINT     DATA     'INT '
XVFC     DATA     'VFC '
XBIN     DATA     'BIN '
XPUB     DATA     'PUB '
XR       DATA     'R   '
XCLIST   DATA     'CLIS'
X7670    DATA     '7670'
X2780    DATA     '2780'
X3780    DATA     '3780'
XIRBT    DATA     'IRBT'
XRBS     DATA     'RBS '
XRBX     DATA     'RBX '
XWSN     DATA     'WSN '
XDIAL    DATA     'DIAL'
XNCYL    DATA     'NCYL'
XNTPC    DATA     'NTPC'
XCYLS    DATA     'CYLS'
XTRKS    DATA     'TRKS'
XSECS    DATA     'SECS'
XFIXE    DATA     'FIXE'
XMOVE    DATA     'MOVE'
BLANK    DATA     '    '
TXTFFFF  TEXT     'FFFF'
********
XCHAN    DATA     'CHAN'
XDEV     DATA     'DEVI'
********
XMC      DATA     'MC'
XME      DATA     'ME'
TXTFE    DATA     'FE'
XRB      DATA     X'D9C2'
YC4D7    DATA     X'C4D70000'
YE2D7    DATA     X'E2D70000'
7TAPFL   DATA     0                  FLAG SET IF 7T SPEC IS ON C.C.
MODGIVEN DATA     0                 FLAG SET IF 'MOD' SPEC IS ON C.C.
MOTYP    DATA     0                 KEEPS FLAGS FOR PRESENCE OF FOLLOWING
*                                   BIT 31 SET IF V2IO   PRESENT
*                                   BIT 30 SET IF 3270IO PRESENT
*                                   BIT 28 SET IF HASPIO PRESENT
*                                   BIT 27 SET IF RAS PRESENT
RBTTYP   DATA     0
MPC#     DATA     0
SENSPTR  DATA     0                 PTR TO SENSE BUFFER ADDRESS IN
*                                   IOTABLE LOAD MODULE CONSTRUCTION
XTRASIZ  DATA     0                 XTRA SIZE OF SENSE BUFFER FOR 3214'S
NOPDUM   NOP
CYLSDUM  SLS,7    0
SECSDUM  SLS,8    0
TRKSDUM  SLS,9    0
FEXFLGWD DATA     0
*
CLD      EQU      0                 INCREMENT INTO DELIM LIST
M5       EQU      X1F
M20      DATA     X'000FFFFF'
M8       EQU      XFF
M10      EQU      X3FF
M16      EQU      XFFFF
M16X2    DATA     X'1FFFE'
X7332    DATA     '7332'            MOD # FOR POTTER TAPES
*
Y1       DATA     X'10000000'
Y0001    DATA     X'00010000'
Y0004    DATA     X'00040000'
Y0008    DATA     X'00080000'
Y002     DATA     X'00200000'
Y01      DATA     X'01000000'
Y02      DATA     X'02000000'
Y03      DATA     X'03000000'
Y05      DATA     X'05000000'
Y08      DATA     X'08000000'
Y04      DATA     X'04000000'
Y39      DATA     X'39000000'
Y8       DATA     X'80000000'
Y44      DATA     X'44000000'
Y46      DATA     X'46000000'
Y06      DATA     X'06000000'
YD4E3    DATA     X'D4E30000'
YD5D6    DATA     X'D5D60000'
YD9C2    DATA     X'D9C20000'       RB
YF       DATA     X'F0000000'
YF1F0    DATA     X'F1F00000'
YFF      DATA     X'FF000000'
YFFFFFFFF DATA    X'FFFFFFFF'
Y4       DATA     X'40000000'
Y2       DATA     X'20000000'
X20000   DATA     X'00020000'
PERFLAG  DATA     0
*
CPSIZE   EQU      X'4A'             SPECIAL CARD PUNCH SIZE
K4       EQU      X'4'
K5       EQU      X'5'
K7       EQU      X'7'
K9       EQU      X'9'
K18      EQU      X'18'
KE0      EQU      X'E0'
KEE      EQU      X'EE'
K100     EQU      X'100'
K200     EQU      X'200'
KFFFF    EQU      X'FFFF'
*
KCOMMA   EQU      ','
KLPAREN  EQU      '('
KRPAREN  EQU      ')'
********
KN8      EQU      -X'8'
KNC1     EQU      -X'C1'
********
DEFENTRY GEN,8,24 4,0
         DATA     0,X'100'
         GEN,8,24 1,0
NEWDEF   GEN,8,8,16  3,6,0
         DATA     0,0
         GEN,8,8,16  1,5,0
EXENTRY  DATA     X'04032202'
         DATA     4
         DATA     0,0
         PAGE
* STANDARD VALUES FOR HANDLER NAMES CORRESPONDING TO STANDARD YY
*                 VALUES FOR TYPMNE
         BOUND    16
HANDNAME EQU      %
         DATA     0,0,0,0           NO HANDLER
         BOUND    16
XKBTIO   TEXTC    'KBTIO'           TY
         TEXTC    'KBTCU'           TY
         BOUND    16
         TEXTC    'PTAP'            PR
         TEXTC    'PTAPCU'          PR
         BOUND    16
         TEXTC    'PTAP'            PP
         TEXTC    'PTAPCU'          PP
         BOUND    16
         TEXTC    'CRDIN'           CR
         TEXTC    'CRDINCU'         CR
         BOUND    16
         TEXTC    'CRDOUT'          CP
         TEXTC    'CRDOCU'          CP
         BOUND    16
         TEXTC    'PRTOUT'          LP
         TEXTC    'PRTCU'           LP
         BOUND    16
DCIND    EQU      %
         TEXTC    'DISCIO'          DC
         TEXTC    'DISCCU'          DC
         BOUND    16
MTIND    EQU      %
         TEXTC    'MTAP'            9T
         TEXTC    'MTAPCU'          9T
         BOUND    16
7TAP     TEXTC    '7TAP'            7T
         TEXTC    '7TAPCU'          7T
         BOUND    16
MTAP     TEXTC    'MTAP'            MT
         TEXTC    'MTAPCU'          MT
         BOUND    16
DPIND    EQU      %
         TEXTC    'DPAK'            DP
         TEXTC    'DPAKCU'          DP
         BOUND    16
         TEXTC    'DPAK'            SP
         TEXTC    'DPAKCU'          SP
         BOUND    16
         TEXTC    'PLOT'            PL
         TEXTC    'PLOTCU'          PL
         BOUND    16
XDSCIO   TEXTC    'DSCIO'           RB
         TEXTC    'DSCCU'           RB
         TEXTC    'FECPIO'          FE
         TEXTC    'FECPCU'          FE
XCOC     TEXTC    'COC'             ME
         TEXT     '    '
         TEXTC    'COC'             ME
         TEXT     '    '
X3270    TEXTC    '3270IO'          MO
         TEXTC    '3270CU'          MO
XRAS     TEXTC    'RAS'             MC   (RAS DEVICE)
         TEXT     '    '
         TEXTC    'RASCU'           MC   (RAS DEVICE)
**********DO NOT SEPARATE THE FOLLOWING*********
HASPHAND TEXTC    'HASPIO'          FOR IRBT TYPE
         TEXTC    'HASPCU'
2780HAND TEXTC    '2780IO'          FOR 2780 RBT
         TEXTC    '2780CU'
**********                             *********
DISHAND  TEXTC    'DISKAB'          HANDLERS FOR 7260,7265,7275,
         TEXTC    'DSKABCU'         3275 AND 3282
MPCHAND  TEXTC    'MPCDIO'          HANDLER FOR 9210 MPC DP DEVICE
         TEXTC    'MPCDCU'
HANDNEND EQU      %-XKBTIO
XMAGTAPE TEXTC    'MAGTAPE'
XRBSSS   TEXTC    'RBSSS'
XBSCIO   TEXTC    'BSCIO'
*  RBSSS AND BSCIO NAMES SHOULD NOT BE SEPARATED
SWAPHAND TEXTC    'TSIO'
         TEXTC    'DPSIO'
XV2IO    TEXTC    'V2IO'            AN MO TYPE HANDLER
XMOCIOP  TEXTC    'MOCIOP'
XHSPM    TEXTC    'HSPM'
XINSYM   TEXTC    'INSYM'
XOUTSYM  TEXTC    'OUTSYM'
XSWAPPER TEXTC    'SWAPPER'
7446IO   TEXTC    '7446IO'          POSSIBLE STANDARD HANDLERS BUT
NSLP     TEXTC    'NSLP'            NOT DEFAULTED
         TEXTC    'NSTAP'
         TEXTC    'CRDOUTL'
MORHAND  EQU      %-XMAGTAPE
MPCOVNMD TEXTC    'MPC9210'         WARNING THIS NAME MUST BE ON DW BOUND
MPCOVNMT TEXTC    'MPC9310'         SAME GOES FOR THIS NAME.
HANDLERS TEXTC    'HANDLERS'
HANDLERS2 TEXTC   'HANDLERS2'
*
*
CLISTS   TEXTC    'CLISTS'
         PAGE
*
RESOL    EQU      %
*  ALLOCATION TYPE: BYTE=-3,HWD=-2,WD=-1,DWD=0
*  DCT TABLES
*
* * * *                             BELOW IS FOR DCT1 THRU DCT8
*
         DATA,1   -2,-3,-3,-3,-3,-3,-2,-1
*
* * * *                             BELOW IS FOR DCT9 THRU DCT21
*
         DATA,1   -1,-2,-1,-1,0,-3,-3,0,-2,-3,-3,-3,-2
         DATA,1   -3,-2,-3,-1,-3    DCT 22,23,24,25,26
         DATA,1   -3,-3,-2,-2,-2  DCT27, 28, 29, 1P, 1A
         DATA,1   BA(%)-BA(RESOL)   FLAG TO END DCTS
*   CIT TABLES
         DATA,1   -3,-3,-3,-1,-3,-3
         DATA,1   BA(%)-BA(RESOL)    # OF CIT RESOLUTIONS
         PAGE
*    TYPEFLAGS IS A BYTE TABLE OF STANDARD TYPMNE ENTRIES
*      FOR TB:FLGS,ACCESSED BY TYPMNE INDEX
*      BITS 0-1 =DEVICE TYPE, BIT 3=IN,OUT, BIT4 =BIN
*      BIT5 = READ REVERSE, BITS6-7 =COMP,VFC
*
         BOUND    4
TYPEFLAGS EQU     %
         DATA,1   0                 NOT USED MUST STAY
         DATA,1   X'30',X'73',X'28',X'18',X'28' NO,TY,PR,PP,CR
         DATA,1   X'1A',X'53',X'C0',X'BC'  CP,LP,DC,9T
         DATA,1   X'B8',X'BC',X'F0',X'F0'  7T,MT,DP,SP
         DATA,1   X'18',0,0,X'3B',0        PL,RB,FE,ME,MO
         DATA,1   X'3B'                     MC
         BOUND    4
         PAGE
*
TYPCHARS EQU      %
         DATA,2   0,'NO'
         DATA,2   'TY','PR','PP','CR','CP','LP'
         DATA,2   'DC','9T','7T','MT','DP','SP'
         DATA,2   'PL'              PLOTTER
         DATA,2   'RB'
         DATA,2   'FE'              FE
         DATA,2   'ME'              COC
         DATA,2   'MO'              CNM/MOC
         DATA,2   'MC'              RAS DEVICE
TYCHEND  EQU      HA(%)-HA(TYPCHARS)-1
         BOUND    4
*
IOFLOACT EQU      %     X'40'=IN,X'80'=OUT,XC0'=IN/OUT
         DATA,1   0,X'C0',X'C0',X'40' -,NO,TY,PR
         DATA,1   X'80',X'40',X'80'     PP,CR,CP
         DATA,1   X'80',X'C0',X'C0'     LP,DC,9T
         DATA,1   X'C0',X'C0',X'C0'     7T,MT,DP
         DATA,1   X'C0',X'80',X'C0',X'C0'  SP,PL,RB,FE
         DATA,1   X'C0',X'C0',X'C0'     ME,MO,MC
IOFLOLNG EQU      BA(%)-BA(IOFLOACT)-1
*
         PAGE
         BOUND    8
OPENTM   EQU      %          PLIST: STATIC DATA (FOR DEVICE/STDLB)
         GEN,8,24 X'14',M:TM
         GEN,8,7,9,8 7,36,0,1
         DATA     2                 ORG
         DATA     2                 ACCESS
         DATA     2                 FUN
         DATA     2                 SAVE
         DATA     63                KEYMAX.
         GEN,8,8,8,8 1,0,2,2        GET RID OF ACCOUNT
FLNME    TEXTC    'M:HGP'
         GEN,8,8,8,8 2,1,0,2        GET ACCOUNT BACK TO OWN
         RES      2                 DUMMY SLOTS
*
CLOSETM  EQU      %          PLIST: STATIC DATA (FOR DEVICE/STDLB)
         GEN,8,24 X'15',M:TM
         GEN,1,31 1,0
         GEN,32   2
*
         BOUND    8
WRITETM  EQU      %       DYNAMIC:  FOR EACH OF 6 RECORDS
         GEN,8,24 X'11',M:TM        GET INTO GEN.REGS.WITH LD,X WRITETM
         GEN,5,27 7,X'30'
         PZE      *R4
         PZE      *R5
         PZE      *R2
         PAGE
*           EACH KEYNAME ADDRESS WILL BE REFERENCED FOR WRITING
HEADKEY  TEXTC    'HEAD'            STATIC DATA (FOR DEVICE/STDLB)
         DATA     0
TREEKEY  TEXTC    'TREE'               (EACH KEY MUST BE 3 WORDS
         DATA     0
NAME00   GEN,8,24     8,'IOT'
         GEN,32       'ABLE'
         GEN,8,24     0,0
NAME01   GEN,8,24     8,'IOT'
         GEN,32       'ABLE'
         GEN,8,24     1,0
NAME02   GEN,8,24     8,'IOT'
         GEN,32       'ABLE'
         GEN,8,24     2,0
NAME03   GEN,8,24     8,'IOT'
         GEN,32       'ABLE'
         GEN,8,24     3,0
         PAGE
         BOUND    8
* GENERALLY, IT IS DESIRABLE TO KEEP THE 2 WORD NAMES ON DWD.BOUNDS
*                 FOR USE OF LD INSTRUCTIONS
DEFCITX  TEXTC    'CIT1'
DEFAVRFL TEXTC    'AVRFLGS'
DEFAVRTB TEXTC    'AVRTBL'
DEFHGP   TEXTC    'HGP'
DEFDCN   TEXTC    'DCN'
         BOUND    8
DEFCITSZ TEXTC    'CITSIZ'
DEFIOCTQ TEXTC    'IOCTQ'
DEFAVRID TEXTC    'AVRID'
DEFDCTSZ TEXTC    'DCTSIZ'
DEFBATAP TEXTC    'BATAPE'
DEFNBATA TEXTC    'NBATAPE'
DEFAVRSZ TEXTC    'AVRTBLSIZ'
DEFAVRNE TEXTC    'AVRTBLNE'
         BOUND    8
HHEAD    DATA     X'8100FF30'
         DATA     X'40000000'
HHADR    DATA     0
HHSA     DATA     0
         DATA     0
         DATA,2   8,12
         DATA     0,0,0,0,0,0
HRDF     DATA     X'03060000'
RFHADR   DATA     0
         DATA     X'100'
         DATA     X'01050000'
         DATA     X'04000000'
RFHA1    DATA     0
         DATA     X'100'
         TEXTC    'HGP'
HEXPR    DATA     X'06040122'
         DATA     X'02000000'
         DATA     4,0,0,0
HTRE     DATA     X'C'
         TEXTC    'M:HGP'
         DATA     0,0,0
THSA     DATA     0
         DATA,2   8,DA(HRDF)
         DATA     0
         DATA,2   6,DA(HEXPR)
         DATA     0,0,0
*KEY,SIZE,AND BUF TABLES FOR M:HGP
HKEYADR  EQU      %-1
         DATA     TREEKEY
         DATA     HGPK3
         DATA     HGPK2
         DATA     HGPK1
         DATA     HGPK0
         DATA     HEADKEY
HBUF     EQU      %-1
         DATA     HTRE
SECT0BUF DATA     0
HRELDBUF DATA     0
         DATA     HEXPR
         DATA     HRDF
         DATA     HHEAD
HSIZ     EQU      %-1
         DATA     48
HSEC0SZ  DATA     0
HRELDSZ  DATA     0
         DATA     24                SIZE OF EXP STACK RECORD
         DATA     32                SIZE OF REF/DEF STACK RECORD
         DATA     48
HGPK0    DATA     X'06D47AC8'
         DATA     X'C7D70000'
HGPK1    DATA     X'06D47AC8'
         DATA     X'C7D70100'
HGPK2    DATA     X'06D47AC8'
         DATA     X'C7D70200'
HGPK3    DATA     X'06D47AC8'
         DATA     X'C7D70300'
SAVESWAP DATA     0
HSTKADR  DATA     0
EHSZ     DATA     0                 STORAGE FOR SIZE OF M:HGP MODULE
         PAGE
         BOUND    8
XIOTABLE TEXTC    'IOTABLE'
* THE DATA FROM PLISDAT TO CLISDAT
*    WILL BE TRANSFERRED TO
*    DYNAMIC RESERVE AS A CONTIGUOUS BLOCK.
*
PLISTDAT EQU      %
         DATA     0,0,0,0,0,0,0,0
EXPRDATA EQU      %
         DATA     2
         TEXTC    'IOTABLE'
         GEN,8,7,17 17,31,0
         DATA     0,0,0,0,0,0
HEADDATA EQU      %
         DATA     X'8100FF18'
         DATA     X'4'**28,0,0,0
         DATA     12
         DATA     0,0,0,0,0,0
TREEDATA EQU      %
         DATA     12
         TEXTC    'IOTABLE'
         DATA     0,0,0,0
         DATA,4   X'00090000'       9WD.DUMMY PRESET IN REFDEFSTK
         DATA,4   0,0,0,0
MAX00DAT EQU      %
         DATA     0
DEFDATA  EQU      %
         GEN,8,24 4,4
         TEXTC    'DCT1'
         TEXTC    'IOTABLE'
         DATA     0,0,0
DICTDATA EQU      %
         GEN,8,24 3,10
         TEXTC    'DCT7'
         DATA     0,0
         PAGE
* CLISTDAT INFO FOR THE CLISTS FOR IO HANDLERS(# WORDS/CLIST).
*    INDEXED BY POSITION OF YY IN STD.TYPCHARS(TYPMNE)LIST.
CLISTDAT EQU      %
         DATA     6                 NULL(NON-STANDARD)
         DATA     6                 NO
         DATA     6                 TY  (3RD DWD = PAPER SIZE/WIDTH)
         DATA     16                PR
         DATA     16                PP
         DATA     2                 CR
         DATA     CPSIZE            CP  (SPECIAL CLIST DATA)
         DATA     6                 LP  (3RD DWD = PAPER SIZE/WIDTH)
         DATA     6                 DC
         DATA     8                 9T
         DATA     8                 7T
         DATA     8                 MT
         DATA     8                 DP
         DATA     8                 SP
         DATA     6                 PL
         DATA     RBSIZ               RB
         DATA     6                 FE
         DATA     6                 ME
         DATA     18                MO
         DATA     6                 MC
********
         PAGE
*********
GETPAGES GEN,8,24 8,100
*
*
********
         END

