*     UBCHAN  (SYSGEN PASS2  :CHAN/:DEVICE)
         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,NOROOM
         REF      PRINTMSG
         REF      NAMSCAN,CHARSCAN,CHSTSCAN,HEXSCAN
         REF      COREALLOC,WRITELM
         REF      TEXTAUK
         REF      CLIST#
         REF      EXPHWRT
         REF      M17
         REF      RBSIZ
         PAGE
************************************************************************
*  PASS2 STACK ALLOCATION -- POINTED TO VIA (R3).
************************************************************************
BASESTAC EQU      0      REL.DISPLACEMENT TO STACK BASE
********                          ****
SSIZE    EQU      BASESTAC+1          DISC SECTOR SIZE(FROM :DEVICE)
CORE     EQU      BASESTAC+2          CORE SIZE(FROM :MONITOR)
SDGANSG  EQU      BASESTAC+3        #SECT/GRAN PER
#GRANPER EQU      BASESTAC+4        #GRAN PER
72FLAG   EQU      BASESTAC+5
LASTSPEC  EQU   BASESTAC+6      NOT UNUSED
CCBUFRS  EQU      LASTSPEC+1        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.
P2FLAGS  EQU      CCBUFRS+60        BASE OF PASS2 FLAGS
********                          ****
         PAGE
CHANFLG  EQU      P2FLAGS+1         CHANCC ENCOUNTERED
P2OVLOP  EQU      P2FLAGS+2         FLGS FOR OPTIONAL MON. OVERLAYS
P2ERR    EQU      P2FLAGS+3         COUNT OF # OF ERR MESSAGES
P2ABRT   EQU      P2FLAGS+4         PASS2 DELAYED ABORT
****
RCHAN    EQU      P2FLAGS+5         #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
****
P2CORE   EQU      CCPTR+1           BASE OF PASS2 CORE VALUES
DYSTORND EQU      P2CORE+1          END AVAILABLE CORE
SAVEPAGE EQU      P2CORE+2          #PAGES CORE,1ST PAGE ADR
GETPGPTR EQU      P2CORE+4          LAST ADDR OF PAGE GOTTEN
#PAGES   EQU      P2CORE+5          #PAGES GOTTEN FOR PERM AREA
ENDUSED  EQU      P2CORE+6          END OF CURRENT USED AREA
****
DP3275   EQU      ENDUSED+1         # OF 3275 DP'S AND CHANNEL SYMBOL
COCS     EQU      DP3275+1          # COCS & ADR (MAX = 11)
AVTBLGTH EQU      COCS+6            #TAPE ENTRIES
LORBIN   EQU      COCS+7            LOW RBT DCT INDEX
HIRBIN   EQU      COCS+8            HIGH RBT DCT INDEX
#RBTS    EQU      COCS+9            #RBTS DEFINED
DUALFLG  EQU      COCS+10           DUALFLG
BIG9FLG  EQU      COCS+11           BIG 9 FLAG
****
SCYLPSA  EQU      BIG9FLG+1         #GRAN/PHYCYLIN;#PHY CYL
SWAPUTS  EQU      SCYLPSA+1         DP SWAPPER
PRIVDEV  EQU      SCYLPSA+2         TOT # PRIVATE DEVICES
****
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
OCPTYP   EQU      #RATS+11          OCP DEV TYP INDEX
P2DYNEND EQU      #RATS+12
         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
         SPACE    2
DCINPNTR EQU      P2DYNEND+6        PTR TO NXT DCINTBL
DCINADDR EQU      P2DYNEND+7        PTR TO START OF DCINTBL
DCINEND  EQU      P2DYNEND+8        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
DCT1PPTR EQU      DCT25PTR+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
CLISTPTR EQU      CITLAST+3           POINTER TO CLIST TABLE
PACKRPTR EQU      CLISTPTR                   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          # WORDS IN ALL COMMAND LISTS
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               ****
NUMTAPES EQU      LASTHGP1+1        INITIALLY PTR TO COUNT OF TAPES
AVRTBLAD EQU      NUMTAPES+1        PTR TO AVR TABLE
AVRTBLSZ EQU      AVRTBLAD+1        AVR TABLE SIZE
#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
DPCMD    EQU      AVRTBLAD+13       PTR TO DPCMD TABLE
DPLOC    EQU      AVRTBLAD+14       PTR TO DPLOC LOCATION
DKSTYPES EQU      AVRTBLAD+15       PTR TO DISK TYPE TABLE
**********
         SPACE    2
DCN      EQU      DKSTYPES+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
TCLSIZES EQU      DCN+3             POINTER TO CLIST SIZE H.W. TABLE
TPSZWID  EQU      DCN+4             POINTER TO PAPER WIDTH AND SIZE TABLE
PSA%AD   EQU      DCN+5             ADDR OF PSA DEF
PSA      EQU      DCN+6             HI SECT# OF PSA 1ST 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
RBHACKPTR  EQU    TREETOP+3         PTR TO RBH:ACK
RBBSPCPTR EQU     TREETOP+4         PTR TO RBB:SPC
RBBSFCPTR EQU     TREETOP+5         PTR TO RBB:SFC
RBBCPZPTR EQU     TREETOP+6         PTR TO RBB:CPZ
RBBLPZPTR EQU     TREETOP+7         PTR TO RBB:LPZ
RBDWSNPTR  EQU    TREETOP+8         PTR TO RBD:WSN
DISCLIMSPTR  EQU  TREETOP+9         PTR TO DISCLIMS
NCYLPTR  EQU      TREETOP+10        PTR TO 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 AWX%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
         PUSH     1,R1              SAVE FLAG(CHAN=1,STDLB=4,
         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
         CW,SR2   GETPGPTR,R3
         BLE      %+3
         LI,R2    GETPGPTR+1
         BAL,R1   GETPGS
         STW,SR2  DCT1TEMP,R3
         LW,SR1   DVCTR,R3
         AI,SR1   1+1
         SLS,SR1  -1
         AW,SR2   SR1
         STW,SR2  DCT4TEMP,R3
         SLS,SR1  -1
         AW,SR2   SR1
         AI,SR2   1
         SLS,SR2  -1
         SLS,SR2  1
         STW,SR2  DCT16TEMP,R3
         LW,SR1   DVCTR,R3
         AI,SR1   1
         SLS,SR1  1
         AW,SR2   SR1
         AI,SR2   1
         CW,SR2   GETPGPTR,R3
         BLE      %+3
         LI,R2    GETPGPTR+1
         BAL,R1   GETPGS
         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    11                *11 WRDS/ENTRY
         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,R1    DVCTR,R3
         AI,R1    1
         MI,R1    4
         AW,SR2   R1
         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    6                 *6 WORDS/ENTRY
         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     1,R1              GET FLAG(CHAN=1,STDLB=4,
*                                            OSTDLB=X'10000')
         PULL     7,R2
CHANCC   EQU      %
PRTASTR  M:PRINT  (MESS,ASTER)
         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       %
IODEF    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
         AI,R6    -'A'              CONVERT N TO BIN
         BLZ      CHANNG            TOO SMALL
         CI,R6    7
         BG       CHANNG            TOO BIG
         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
         STB,R6   *R4,R1
         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,X'NDD'
*        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,16,16          NEW FLAGS,'YY' TEMP
*                           FLAGS=L,T,D,PUB,BIN,R,COMP,VFC
*         GEN,8,8,16         MXREC,MREC,CLIST
*        GEN,16,1,1,6,8             DEVICD DISP,CYL,PRIV,TYPE,NGC->FLINK
*        GEN,16,16                  SS,NSPT
*        GEN,16,16      SIZE,NCYL
*        GEN,16,8,8     NTPC,CYLS,TRKS
*         GEN,8,8,16    SECS,0,PSA
*        GEN,16,16                  PFA,PER
*         GEN,16,16            AVAILABLE
*
* * * R7 IS DEVOTED TO PLIST ADDRESS FOR SCAN ROUTINES (EXCEPT ABORT)
* *  SR1 IS DEVOTED TO CCHAR IMAGE OR ZERO (IF READY TO MOVE ON)
*
IODDEV01 EQU      %
         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
         AI,D2    KNC1              CHAN.A = 0, ETC.
         CI,D2    K7
         BLE      AOK               NO HIGHER THAN 'H'                  897
BAD      EQU      %                                                     897
         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
         CI,D2    K0                                                    897
         BL       BAD                                                   897
         SLS,D1   8
         CH,D3    YD9C2             IS IT RBT
         BNE      %+4               NO
         OR,D1    X80               YES DEFAULT WIDTH=128
         MTW,1    #RBTS,R3          KEEP COUNT OF RBTS
         B        %+2
         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 0-F)
         CS,SR3   YF
         BGE      AOK2              IF 0-9                              897
         AW,SR3   Y39               IF A-F
         CS,SR3   YF                                                    897
         BL       BAD                                                   897
AOK2     EQU      %                                                     897
         SLS,SR3  4
         SCD,SR3  4
         BDR,R4   GETDD             R4 = ZERO
         STB,SR4  D2
         SLD,D1   8                 COMBINE WITH PREVIOUS
         LW,D2    DEVICDPT,R3        CLEAR 4 ENTRY WDS; 5 DISC OPTION
         LI,R2    25                   WDS; 16 DISC BADTRACK WDS
         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
         PULL     D3
         AI,D2    K1
         STW,D1   *D2
         AI,D2    1
         AND,D3   M16
         STW,D3   *D2               PUT AWAY YY
         AI,D2    1
         CI,D3    'LP'
         BE       LISTDV
         CI,D3    'XP'              IS IT AN OCP DEVICE
         BNE      NOLISTDV           BR. IF NOT A LISTING DEVICE
         AI,D2    -3                 NEED TO CHANGE DEFAULT
         LI,R2    28                 LINES ON PAGE TO 66 (DECIMAL)
         AWM,R2   *D2
         AI,D2    3
LISTDV   EQU      %
         LW,D4    =X'80000000'
         STW,D4   *D2               SET UP LISTING TYPE
NOLISTDV EQU      %
         AI,D2    2
         LB,R2    D1                GET TYPMNE INDEX
         CI,R2    X'C'
         BE       CLSTCHK
         CI,R2    TYCHEND           WITHIN RANGE
         BG       CLSTCHK           SKIP COUNT NOW FOR NEW DEVICE
         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
         CI,D3    'XP'
         BNE      CLSTCHK
         MTW,0    OCPTYP,R3
         BNEZ     CLSTCHK
         STW,R2   OCPTYP,R3         STORE TYPE INDEX
         MTW,-1   OCPTYP,R3         CONVERT TO TRUE INDEX
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
         AWM,D4   CLISWDCT,R3       KEEP COUNT OF WRDS
         LW,D1    DEVICDPT,R3       GET CURRENT DEVICD1
         LI,R4    9
         STH,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
         STW,D1   *D2
         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    9
       STB,R4   *D2,R2             SET INDEX INTO DEVCD1 TABLE
       LI,R2    4                  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    2
         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    5
         STS,SR4  *D4,R2
         B        RPRENDPA
TRYCYL   EQU      %
         CW,R1    XCYLI
         BNE      TRYSIZE
         LI,SR4   CYLBIT
         LI,R2    5
         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+21
         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
         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    6                 IS IT PACK TYPE
         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
         LI,SR4   X'D'
         STB,SR4  *D4,R1
         LI,R1    3
         LW,SR4   =X'20000000'      SET D BIT
         STS,SR4  *D4,R1
CLDEF    EQU      %
         LI,R1    9
         LH,SR4   *D4,R1            GET CLIST VALUE
         CI,SR4   6
         BNE      SETKNOWN-1        NOT DEFAULT LEAVE AS IS
         MTH,2    *D4,R1            CHANGE CLIST TO THE VALUE 8
         MTW,2    CLISWDCT,R3       CHANGE CLIST SIZE BY +2
         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+5
         STW,SR3  *D4,R1            SET SS,NSPT
         LW,SR3   SR4
         LI,SR4   X'3FFF'           MASK TO STORE TYPE,NGC
         LI,R1    5
         STS,SR3  *D4,R1
         LI,SR4   X'F0000'          LEFT HWD MASK
         LI,R1    SIZED/2+5
         STS,SR3  *D4,R1
         LI,R1    CYLSD+20
         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+10          DEAULT NCYL,NTPC
         LW,SR3   DFHLFS,R2
         STH,SR3  *D4,R1
         AI,R1    1
         SLS,SR3  -16
         STH,SR3  *D4,R1
         LI,SR4   DCIND+4
         CI,R2    6
         BL       CHKHAND
         CI,R2    7
         BG       SET6065
         LI,SR4   DPIND+4
CHKHAND  LW,SR2   HANDTADR,R3
         LI,R2    9
         LB,R2    *D4,R2
         SLS,R2   2
         AW,SR2   R2
         LB,R4    *SR2
         B        MODELDONE
HANDSIN  LI,R4    -4
         AI,SR2   4
         LW,R2    *SR4,R4
         STW,R2   *SR2,R4
         BIR,R4   %-2
         B        MODELDONE
SET6065  LI,SR4   DISHAND+4
         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
         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    14
         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
         LI,SR1   0                 IF CONTROLLER OR MOD NO DO NOT
         STW,SR1  MODEL2,R3          MATCH THE MODNUM FILE,
         STW,SR1  NOCONT,R3          ZERO BOTH OF THEM
         BAL,SR4  OUTLLERR           AND PRINT WARNING
         LI,SR4   MODELDONE          BUT CONTINUE PASS2
BADMOD#  MTW,1    P2ERR,R3
         BAL,SR3  PRINTMSG
         TEXTC    '*** WARNING INCORRECT MOD. # OR CONT.',;
                  ' #.  ZERO HAS BEEN SUBSTITUTED FOR BOTH'
RONGMODC CI,SR1   ')'
         BNE      SYNTAXER
         BAL,SR4  OUTLLERR
         LI,SR4   RPRENDPA
         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+21
         B        DEVOPVAL
TRYNCYL  CW,R1    XNCYL
         BNE      TRYNTPC
         LI,R2    NCYLD*2+21
         B        DEVOPVAL
TRYNTPC  CW,R1    XNTPC
         BNE      TRYCYLS
         LI,R2    NTPCD*2+21
         B        DEVOPVAL
TRYCYLS  CW,R1    XCYLS
         BNE      TRYTRKS
         LI,R2    CYLSD+20
         B        DEVOPVAL
TRYTRKS  CW,R1    XTRKS
         BNE      TRYSECS
         LI,R2    TRKSD+20
         B        DEVOPVAL
TRYSECS  CW,R1    XSECS
         BNE      TRYFIX
         LI,R2    SECSD+20
         B        DEVOPVAL
TRYFIX   CW,R1    XFIXE
         BNE      TRYMOVE
         LW,SR4   =X'00000700'      SET UP TYPE AS 7
         LI,R2    5
         STS,SR4  *D4,R2
         LI,R2    2
         LW,SR4   =X'20000000'
         STS,SR4  *D4,R2
         B        RPRENDPA
TRYMOVE  CW,R1    XMOVE
         BNE      TRYSS
         LW,SR4   =X'00000B00'
         LI,R2    5                 SET UP AS TYPE B
         STS,SR4  *D4,R2
         B        RPRENDPA
TRYSS    CW,R1    XSS
         BNE      TRYPER
         LI,R2    SSD*2+21
         B        DEVOPVAL
TRYPER   CW,R1    XPER
         BNE      TRYPFA
         LI,R2    PERD*2+21
         B        DEVOPVAL
TRYPFA   CW,R1    XPFA
         BNE      TRYPSA
         LI,R2    PFAD*2+21
         B        DEVOPVAL
TRYPSA   CW,R1    XPSA
         BNE      TRYSWPCD
         LI,R2    PSAD*2+21
         B        DEVOPVAL
TRYSWPCD CW,R1    XSWAP             SWAPCD SPECIFIED
         BNE      TRYHANDL
         LB,R2    R1
         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      TRYRBS
         LW,SR2   Y04               SET BIT 5 IN FLAGS FOR A 2780
         B        GTHANDIN
IRBINFO  LW,SR2   Y4                SET BIT 1 OF FLAG/DEVICD1 ENTRY
GTHANDIN LI,R2    2
         STS,SR2  *D4,R2
         STS,SR2  RBTTYP            SET TEMP FLAG WORD WHEN IRBT/2780
         LI,R1    9
         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    2
         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    13
         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      TRYFLOW
         LI,R4    0
         LI,SR2   KCOMMA
         BAL,SR4  CHARSCAN ***
         BCR,8    STORHAND
         BAL,R7   ERRBORT3 ***
SYNTAXER BAL,SR4  ERRBOR21  ***
         B        RPRENDPA
STORHAND EQU      %
         BAL,SR4  NAMSCAN           HANDLER NAME
         BCR,8    %+2
         BAL,R7   ERRBRT3
         LW,R1    HANDTADR,R3       GET ACTUAL ADDRESS OF 1ST NAME
         LW,R2    DEVICDPT,R3       ACTUAL ADDRESS NOW FOR DEVICE TABLE
         LI,R6    9
         LB,R2    *R2,R6            GET TYPMNEMONIC INDEX
         SLS,R2   2                    TIMES 4 WDS PER NAME
         AW,R2    R4                +0 (NAME1) OR +2(NAME2)
         AW,R1    R2
         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    STORHAND          NAME2 FIELD POSSIBLE
         BAL,R7   ERRBRT3
         B        DVCYCOUT
TRYFLOW  EQU      %
         LI,R2    K8
         CW,R1    XINPUT
         BNE      TRYOUTPU
         MTB,1    *D4,R2            INPUT
         B        RPRENDPA
TRYOUTPU CW,R1    XOUTPUT
         BNE      TRYIO
         MTB,2    *D4,R2            OUTPUT
         B        RPRENDPA
TRYIO    CW,R1    XIO
         BNE      TRYDEDIC
         MTB,+3   *D4,R2
         B        RPRENDPA
TRYDEDIC CW,R1    XDEDICAT
         BNE      TRYDUP
         LI,R2    2
         LW,SR2   Y8
         STS,SR2  *D4,R2
         B        RPRENDPA
TRYDUP   EQU      %
         CW,R1    XHALF
         BE       RPRENDPA
         CW,R1    XFULL
         BNE      TRYPAPER
        LI,R2     2
         LW,SR2   Y1
         STS,SR2  *D4,R2
         B        RPRENDPA
TRYPAPER LI,R2    3                 BYTE 3
         CW,R1    XPAPER
         BNE      TRYCLIST
         B        DEVOPVAL
TRYPWIDT LI,R2    5                 BYTE 5
         B        DEVOPVAL
TRYCLIST CW,R1    XCLIST
         BNE      TRYMXREC
         LI,R2    19
         B        DEVOPVAL
TRYMXREC CW,R1    XMXREC
         BNE      TRYMREC
         LI,R2    16
         B        DEVOPVAL
TRYMREC CW,R1     XMREC
         BNE      TRYCOMP
         LI,R2    17
         B        DEVOPVAL
TRYCOMP  CW,R1    XCOMP
         BNE      TRYL
         LI,R2    3
         LW,SR2   =X'02000000'
         STS,SR2  *D4,R2
         B        RPRENDPA
TRYL     CW,R1    XL
         BNE      TRYT
         LI,R2    3
         LW,SR2   =X'80000000'
         STS,SR2  *D4,R2
         LI,R2    4
         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
         LI,R2    3
         LW,SR2   =X'40000000'
         STS,SR2  *D4,R2
         LI,R2    4
         LB,R2    *D4,R2            GET TRUE TYPE INDEX
         LI,R4    13
         STB,R2   *D4,R4            SAVE IN 2ND BYTE WRD 3
         LW,SR2   TYCOUNT,R3
         MTH,1    *SR2,R2           KEEP COUNT OF TRUE TYPE
         LI,R2    4
         LI,SR2   X'B'              SET DUMMY INDEX TO B
         STB,SR2  *D4,R2
         LW,SR2   HANDTADR,R3
         LI,R2    9
         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    9
         LH,SR2   *D4,R4            GET CLIST VALUE
         CI,SR2   6                 IS IT DEFAULT
         BNE      RPRENDPA          NO
         MTH,2    *D4,R4            YES,INCRE CLIST
         MTW,2    CLISWDCT,R3       INCRE TOT TO 8
         B        RPRENDPA
TRYCC    CW,R1    XCC
         BNE      TRYDD
         LI,R2    3
         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,R2    3
         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    T3275
         BNE      ASUMEDP1
         LI,SR2   DP3275
         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 MTB,1    *SR2
         AI,R2    1
         STB,R4   *SR2,R2
ASUMEDP1 LI,R2    3
         LW,SR2   =X'20000000'
         STS,SR2  *D4,R2
         LI,R2    4
         LB,SR2   *D4,R2            GET TRUE TYPE INDEX
         CI,SR2   TYCHEND
         BLE      TRYTYPE
         LI,R4    13
         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
         LI,R2    3
         LW,SR2   =X'01000000'
         STS,SR2  *D4,R2
         B        RPRENDPA
TRYBIN   CW,R1    XBIN
         BNE      TRYR
         LI,R2    3
         LW,SR2   =X'08000000'
         STS,SR2  *D4,R2
         B        RPRENDPA
TRYR     CW,R1    XR
         BNE      TRY1200
         LI,R2    3
         LW,SR2   =X'04000000'
         STS,SR2  *D4,R2
         B        RPRENDPA
TRY1200  CW,R1    X1200             OCP MODEL #
         BNE      NORECOGN
         B        RPRENDPA
         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
         LI,SR1   K0                RESET FOR NEXT CHAR.
         B        CYCRPREN
         PAGE
DEVOPVAL EQU      %
         LI,SR2   KCOMMA
         BAL,SR4  CHARSCAN ***
         BCR,8    DEVOPVLX
         CI,R2    TNGCD
         BE       RPRENDPA          VALUE OPTIONAL FOR NGC
         CB,R2    XSWAP             DEFAULT VAL. TO BE USED FOR SWAPCD
         BE       RPRENDPA
         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    16                IS IT MXREC
         BE       %+3               YES
         CI,R2    17                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    19
         BNE      NOTCLIST
         LI,R2    9
         LH,R4    *D4,R2            HAVE STORED CLIST VALUE
         STH,R1   *D4,R2
         SW,R4    R1                SUBTRACT VALUE
         BEZ      RPRENDPA          =,NO NEED TO STORE
         LCW,R4   R4                CHANGE VALUE
         AWM,R4   CLISWDCT,R3       INCRE/DECRE CLIST COUNT
         B        RPRENDPA
NOTCLIST EQU      %
         STB,R1   *D4,R2
         CI,R2    PERD*2+21
         BNE      %+2
         MTW,1    PERFLAG
         CI,R2    3                 R2=3 IF DOING PAPER SIZE
         BE       TRYPWIDT          IF YES CHECK WIDTH OPTION
         CI,R2    SSD*2+21
         BE       STONOTHER
         CI,R2    CYLSD+20
         BE       RPRENDPA
         CI,R2    TRKSD+20
         BE       RPRENDPA
         CI,R2    SECSD+20
         BE       RPRENDPA
         CI,R2    27
         BL       RPRENDPA
         CB,R2    XSWAP
         BNE      STONOTHER
         AND,R1   XFF
         STW,R1   SWAPCD
         B        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
         LI,SR4   DEVCDOUT1          NO SIGNAL ERROR
         B        BADMOD#
ZEROMOD  LI,R1    0
         STW,R1   MODGIVEN          RE-INITIALIZE FOR NEXT DEV.COMMAND
DEVCDOUT1 EQU     %
         LW,R1    DEVICDPT,R3       OTHERWISE, HOUSEKEEP POINTERS
         AI,R1    K1                POINT TO 2ND WORD
         LB,D4    *R1               GET TYPMNE INDEX VALUE
         CI,D4    X'D'
         BNE      %+3
         LI,R2    9
         LB,D4    *R1,R2            GET TRUE TYPE
         CI,D4    TYCHEND
         BLE      DVCDFIN2
         LW,D1    HANDTADR,R3
         LI,R2    5
         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
         LI,R2    9
         LW,SR4   DEVICDPT,R3
         LCH,SR4  *SR4,R2
         AWM,SR4  CLISWDCT,R3       DECRE CLIST COUNT
         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      %
         AI,R1    K1                POINT TO LAST DEVICE ENTRY WORD (3)
         LW,R2    R1
         INT,D4   *R1               GET 'YY' OF WRD 2
         AI,R1    1
         LB,R4    *R1               GET NEW FLAGS
         AI,R1    1
         STW,R1   DEVICDPT,R3
         MTW,1    DEVICDPT,R3       INCRE BY 1 AS ENTRY 5 WRDS LONG
         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
         CW,SR4   -2,R1             IN FLAGS WORD
         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
         STS,SR4  1,R1
         LW,SR4   =X'20000000'      SET DISK TYPE DEVICE
         STS,SR4  -1,R1             R1 = WRD 4 OF DEVICD1 ENTRY
         LI,R2    SIZED+2
         LH,D1    *R1,R2
         AND,D1   M16
         BEZ      ERRBOR30          TEST FOR NO SIZE
         LI,R4    1+2
         MTH,0    *R1,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    10
         LH,SR4   *R1,R4            NTPC
         LI,R4    5
         LH,R4    *R1,R4            NSPT
         MW,SR4   R4                NSPT*NTPC
         AND,SR4  M16X2             NO ODD RESULTS ALLOWED
         MW,SR4   D1                NSPT*NTPC*NCYL = TOTAL # SECTORS
         BE       %+3
         MTW,1    P2ERR,R3
         LI,R4    4
         LH,R4    *R1,R4            SS
         LI,D2    K200              512+SS-1
         AW,D2    R4
         AI,D2    -1                /SS
         DW,D2    R4                = NSG
         DW,SR4   D2                =#GRAN
         LI,R4    7
         LB,R4    *R1,R4            GET NGC
         STW,SR4  D2
         LI,D1    0
         DW,D1    R4                REMAINDER D1,QUOT. D2
         CI,D1    0                 ANY REMAINDER
         BE       %+2               NO
         M:PRINT  (MESS,CYLDV)      YES,SAY DO
         STW,D2   D1                SET QUOTIENT IN D1
         LI,R4    3
STORSIZE EQU      %
         STH,D1   *R1,R2
         LH,R4    *R1,R4
         CI,R4    PRIVBIT
         BAZ      NOTPRIV
         MTW,1    PRIVDEV,R3
         LI,R4    -3
         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+2
         STH,SR4  *R1,R2
         LI,R2    PERD+2
         MTH,0    *R1,R2
         BEZ      %+2
         BAL,SR4  ERRBOR19
         LI,R2    PSAD+2
         MTH,0    *R1,R2
         BEZ      %+2
         BAL,SR4  ERRBOR19
         LI,R2    PFAD+2
         STH,D1   *R1,R2            SET PFA TO SIZE
TRKSIZ   EQU      %
         LI,R2    SSD+2
         MTH,0    *R1,R2            SS MUST BE NONZERO
         BNEZ     %+4
         BAL,SR4  ERRBOR32B
         LI,SR4   X'100'            SUPPLY A SECTOR WORD SIZE OF 100
         STH,SR4  *R1,R2
         LI,R2    NSPTD+2
         MTH,0    *R1,R2
         BEZ      ERRBOR30
         LI,R2    PSAD+2
         MTH,0    *R1,R2            YES. IS PSA=0?
         BEZ      TRKSZON           YES
         MTW,1    #SWAPDEVS,R3      NO.  INCREMENT # OF PSA RADS
         LI,R4    2
         LW,SR4   -1,R1             GET MOD # DISP
         LB,SR4   SR4,R4            OUT OF DEVICD1 TABLE
         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 #
         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       %+5
         LI,SR3   2MNYLKSW
         MTW,1    P2ERR,R3
         BAL,SR4  PRINTMSG
         B        %+2
         STW,R4   SWAPMOD#           ADJUST COUNT OF ITEMS IN TABLE
CONTINU  LI,R4    2
         LW,R4    *R1,R4            GET THEM
         CW,R4    D7212             COMPARE WITH THOSE OF 7212
         BE       TRKSZON           AOK  RAD IS 7212
         CW,R4    D7232             COMPARE WITH 7232
         BE       TRKSZON           AOK RAD IS 7232
         CW,R4    D3214
         BE       TRKSZON           S` O.K. IF 3214 RAD
         LI,R4    6
         LB,R4    *R1,R4            GET DEVICE TYPE
         AND,R4   L(X'0000003F')    GET TYPE ONLY
         CI,R4    X'B'              IS IT DP TYPE
         BE       %+3
         CI,R4    7
         BNE      ERRBOR31
         LI,R4    -2
         LW,SR4   =X'40000000'
         CS,SR4   *R1,R4            SEE IF NEW DEVICE
         BANZ     %+2               NO IS KNOWN DEVICE
         BAL,SR4  ERRBOR29
         LI,R4    5
         LH,SR4   *R1,R4            GET NSPT
         CI,SR4   X'C'              CHK FOR PSA ON 3275 PACK
         BE       ERRBOR31A         IF SO - IT'S NOT ALLOWED
         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   *R1,R2            ZERO PSA
         MTW,-1   #SWAPDEVS,R3      BUMP DOWN PSA DEVICES
TRKSZON  EQU      %
         BAL,R4   SIZECHK
         LI,R2    PERD+2
         BAL,R4   SIZECHK
         LI,R2    PFAD+2
         BAL,R4   SIZECHK
NOCKAB   EQU      %
         LI,D4    X'FFF00'          MOVE NGC TO PER HWD IF CYLBIT
         AND,D4   1,R1
         XW,D4    1,R1              ZAP OLD PLACE
         CI,D4    CYLBIT
         BAZ      CKDCIN            DON'T MOVE IT
         AND,D4   M8                GET NGC TO MOVE
         LI,R2    PERD+2
         STH,D4   *R1,R2
         B        CKDCIN
SIZECHK  EQU      %                 GET PSA,PER,PFA,BCHK,ABSF AS CUM-
         LH,SR4   *R1,R2
         AND,SR4  XFFFF
         CW,D1    SR4
         BGE      SIZECHK2            TO 'SIZE' VALUE.  TRUNCATE WHEN
         BAL,SR4  ERRBOR28 ***      GIVE WARNING MESSAGE
         STH,D1   *R1,R2              SIZE LIMIT HAS BEEN REACHED AND
SIZECHK2 EQU      %
         LH,SR4   *R1,R2
         AND,SR4  XFFFF
         SW,D1    SR4
SIZECHK3 B        *R4               RETURN
*
MTAVRTSZ EQU      %
         LW,SR4   =X'40000000'      SET NEW FLAG
         STS,SR4  -1,R1             R1 WRD 4 OF DEVICD1 FOR TAPE
         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
         LW,D1    -3,R1
         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    6                 #WRDS TO MOVE TO DCINTBL
*                                   R1=WRD4 OF DEVICD1
         AWM,R4   1,R1              SET FLINK
         AWM,R4   DCINPNTR,R3       NEW POINTER VALUE FOR DCINTABL
         LI,D2    0
         LW,D3    *R1,R4            XFER DISCINFO TO DCINTABL
         STW,D3   *D4,R4                TABLE
         STW,D2   *R1,R4            ZERO OUT MOVED WRDS
         BDR,R4   %-3
         CI,D3    X'800'            IS IT DISK PACK
         BAZ      DVCDFIN4          NO
         MTW,1    AVRTBLSZ,R3       KEEP COUNT
         LI,R4    15                CHECK FOR CYLS AND TRACKS = 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    14
         BE       DVCDFIN4
         BDR,R4   CYLSTRKS
DVCDFIN4 MTW,1    DCTSIZE,R3
         B        IODEFRD           NO, GO TRY FOR MORE DEVICE OR STDLB
*
DVCYCOUT EQU      %
         LW,SR2   HANDTADR,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    Y04
         CW,R7    RBTTYP
         BAZ      UBENDITALL        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    -3
SRCHDEVT AI,R5    5                 GET TO WORD 2 OF EA. 5-WORD ENTRY
         LH,R4    *R5,R2
         CH,R4    YD9C2             IS IT AN  RBT ENTRY
         BNE      NXTDVENT
         LW,R4    *R5
         CW,R4    Y4                IS IT AN IRBT ENTRY
         BAZ      NXTDVENT
         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
         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      %
         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  CLISTPTR,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    DUALFLG,R3
         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   NUMTAPES,R3       NOW STR AVRFLGS ADR HERE
         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
         STW,D4   TCLSIZES,R3
         LW,SR1   DCTSIZE,R3        CLIST SIZE TABLE IS A HW TABLE
         AI,SR1   2
         SLS,SR1  -1
         AW,D4    SR1
         STW,D4   TPSZWID,R3        NEED ROOM FOR PAPER WIDTH AND SIZE
         SLS,SR1  1
         AW,D4    SR1
         AI,D4    1
         AND,D4   M16X2
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
*
         LW,1     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    -4
         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    5
         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 NEXT
         LM,SR1   *D3                 DEVICD1 ENTRY
GEN2A    EQU      %
         LW,D1    DCT1PTR,R3
         LW,R7    SR2
         BAL,D4   MAKENDD
         LW,SR2   R7
         STH,SR2  *D1,R1            DCT1 = NDD
         LI,R7    0                 USED FOR DCT3 BITS 6-7
         PSW,R6   *R0
         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
         LB,R6    *R4               GET 1ST ND OF CHANTBL
         SLS,R6   25
         SLS,R6   -21
         LI,R7    X'7F0'            MASK
         CS,R6    SR2               ND=ND OF DEVICE?
         BNE      NDNTEQ            NO
         LW,R6    *R4               YES,GET DUAL ENTRY
         SLS,R6   9
         SLS,R6   -21               POSITION IT
         LI,R7    X'F'              EXTRACT D FROM NDD
         AND,R7   SR2
         OR,R6    R7                MERGE ND OF DUAL
         LW,R7    R6
         BAL,D4   MAKENDD
         LW,R6    R7
         STH,R6   *D1,R1            STORE IN DCT1A
         LI,R7    3                 BITS 6-7 = 11
         B        DCT3GEN
NDNTEQ   EQU      %
         LW,R7    SR2
         BAL,D4   MAKENDD
         LW,SR2   R7
         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'700'
         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   9
         SLS,R6   -21
         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
         SLS,R5   -3
         MTW,0    1,R4
         BEZ      %+2
         AI,5     32                PICK UP NOPART ON CHAN CARD
         STB,R5   *D1,R1
         PLW,R5   *R0
         LI,R6    14
         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
         PSW,R1   *R0
         LI,D1    COCS
         AW,D1    R3
         MTH,1    *D1
         LH,R2    *D1               FOR TAURUS STORE DCTX NOT 'NDD'
         CI,R2    11                11 COC DEVICES IS THE MAXIMUM
         BLE      GENON1A
         PSW,R2   *R0
         LI,R2    2MNYCOCS
         XW,SR3   R2
         MTW,1    P2ERR,R3
         BAL,SR4  PRINTMSG
         XW,SR3   R2
         PLW,R2   *R0
GENON1A  EQU      %
         PLW,R1   *R0
         STH,R1   *D1,R2            STORE IT IN DCT1 TABLE
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
         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   -1                AS #WORDS FOR HW TABLE
         SW,D1    D2                BACK UP PTR
         STW,D1   RBHACKPTR,R3      STORE AS TABLE START
         AI,R1    1
         SLS,R1   -1                R1= INCREMENT AS HW
         AW,D1    R1                CURRENT PTR POSITION
         SLS,D2   -1                D2=INDEX VALUE AS #WRDS/BYTE TABLE
         AI,R1    1                 R1=INCREMENT IN WRDS FOR BYTE TABLE
         SLS,R1   -1
         LI,R2    4
         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    13
         LB,R7    *D3,R2            GET TRUE TYPE
         AI,R7    -1                CORRECT TO FINAL TYPEMNE
         LW,D1    DCT4PTR,R3
         STB,R7   *D1,R1            SET TRU INDEX
         LW,D1    BTXPTR,R3
         MTB,0    *D1,R7
         BNEZ     GEN2O
         STB,R1   *D1,R7
         LW,D1    OTXPTR,R3
         STB,R1   *D1,R7
         LW,D1    GTXPTR,R3
         STB,R1   *D1,R7
GEN2O    PLW,R7   *R0
         PLW,R2   *R0
         B        GENON2B+4
SPTYP    CI,R7    X'C'
         BE       GENON2+2
         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
GENON2B  EQU      %
         AI,R7    1
         LB,D2    IOFLOACT,R7
         CI,R7    IOFLOLNG
         BLE      GEN3              USE STD. FLOW (IO,I,O)
         LB,D2    SR3               USE FLOW (IO,I,O) FROM DEVICE CC
         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
         LI,D2    1
         CW,SR3   Y8
         BANZ     %+2               DEDICATE DEVICE
         LI,D2    0
         LW,D1    DCT14PTR,R3
         STB,D2   *D1,R1            DCT14 = DEDICATE COUNT FOR DEVICE
         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
         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
         XW,SR3   D1
         MTW,1    P2ERR,R3
         BAL,SR4  PRINTMSG
         XW,SR3   D1
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
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'
         BE       TESTDK
         CI,SR4   X'B'
         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
*                        CLIST DWD ADDRESSES ARE GENERATED ACCORDINGLY
*                         AS CLISTS FOR EACH DEVICE ARE INSERTED
*                          IN L.MODULE OUTPUT FORM AT THE VERY FRONT.
*                           CLISTS ARE KEPT AS STATIC DATA FOR STANDARD
*                            YY NAMES IN TYPCHARS HW TABLE.
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
         CS,SR3   L(X'E7D7')        XP
         BE       SPCLIST
ENDDCCHK EQU      %
*                                   BUILD TB:SZ,TB:MAX,TB:FLGS,TB:FLGS1
         LB,R7    SR2               GET TYPE INDEX
         CI,R7    X'B'              TAPE ?
         BE       %+3
         CI,R7    X'D'
         BNE      %+3
         LI,R4    13
         LB,R7    *D3,R4
         LW,D2    TBMAXPTR,R3
         MTB,0    *D2,R7
         BNEZ     ENDDC3
         LCI      15
         PSM,R1   *R0
         LI,R4    12
         LB,D1    *D3,R4
         STB,D1   D2
         STW,D1   R5                SAVE NEWFLAGS BYTE TEMPORARILY
         CI,R7    TYCHEND
         BG       %+3
         LB,SR1   TYPEFLAGS,R7
         B        ENDUP
         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
         BEV      %+3               NOT DISK TYPE
         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
         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
         LI,SR3   1                 FOR TBSZ
         B        ENDDC2
MAXSTORE EQU      %
         LI,R4    16
         LB,SR1   *D3,R4            TB:MAX
         BGZ      %+2
         LI,SR1   X'FF'
         AI,R4    1
         LB,SR3   *D3,R4
         BGZ      %+2
         LI,SR3   1
         B        ENDDC2
LISTTYPE EQU      %
         LI,R4    5
         LB,SR1   *D3,R4            PAPER WIDTH FOR LIST TYPE
         AI,R4    -2
         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    15                BYTE DISP TO TB:FLGS1 BYTE
         LB,R5    *D3,R4
         LW,SR2   TBFLGS1PTR,R3
         AI,R4    -1
         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    X7232             IS IT A 7232 POTTER TAPE
         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    5
         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
********
*  SPECIAL CP CLIST GENERATOR
********
CPCLIST  EQU      %
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,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   Y44               2780 AND OR IRBT
         BAZ      SETIRBT+1         NEITHER ONE THEN BRANCH
         CW,SR3   Y04               WAS A 2780 SPECIFIED
         BAZ      SETIRBT           BRANCH IF JUST IRBT SPECIFIED
         OR,SR2   Y002
         B        SETIRBT+1
SETIRBT  OR,SR2   Y02
         LI,R4    13
         MTB,0    *D3,R4            IS WSN SET
         BEZ      %+2               NO
         OR,SR2   Y04               YES
         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 HAD 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
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      NOAVRENT
         LW,R2    AVRTBLAD,R3       YES, MAKE AVRTBL ENTRY RIGHT
         SLS,R2   -1
         AW,R2    R1
         AW,R2    NBATAPE,R3
         SLS,R2   1
         LI,R7    0                 PRIVATE
         CI,R6    PRIVBIT
         BANZ     %+2
         LW,R7    Y8                NO, PUBLIC
         AW,R7    HGP1PTR,R3
         SW,R7    HGP1ADDR,R3
         STW,R7   1,R2
         LW,R7    AVRTBLSZ,R3
         MTH,0    R7                IS THIS FIRST NONTAPE AVRENT
         BNEZ     NOAVRENT          NO
         SW,R2    AVRTBLAD,R3       YES,SAVE # TAPES
         SLS,R2   -1
         STH,R7   R2
         STW,R2   AVRTBLSZ,R3
         B        NOAVRENT
         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    15
         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
         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)
         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
NOAVRENT EQU      %
FORMHGP  EQU      %
         AI,SR4   2
         LW,R7    *SR4              GET NSG FROM WD4
         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    8
         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
         MW,SR2   SPACKTRK
         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
         BAL,SR4  ERRBOR11 ***      'HGP TABLE FULL'
         BAL,SR4  PRPAGES           PRINT ACTUAL #PAGES GOTTEN
         B        PULL2OUT
ERRPRIV  PULL     15,R1
         M:PRINT  (MESS,PRIVM)
         B        OUTOFIT
PRIVM    TEXTC    '*** PRIVATE DISK HGP EXCEEDS ONEPAGE'
ERR12OUT EQU      %
         M:PRINT  (MESS,SGPERR)
         BAL,SR4  PRPAGES
         B        OUTOFIT
SGPERR   TEXTC    '*** CANNOT BUILD SGP OR NON-RESIDENT HGP'
         PAGE
************************************************************
*                                                          *
*  CHECKS FOR DP PSA                                       *
*    WHEN PSA DEFINED ON DP FOR UTS                        *
*   ENTRY - ALL REGISTERS SAVED                            *
*     R4 = LINK ADDRESS                                    *
*     D4 = WD0 OF DCINTBL ENTRY                            *
*    SR4 = HGP WD3                                         *
*     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'
         BAZ      CNVTNEW           NEW TYPE DEVICE
         LW,R1    SWAPCD            WAS SWAPCD SPECIFIED WITH 'PSA' OPTION
         BNEZ     SIZOKPSA          IF SO SKIP DEFAULTS
         CI,SR2   6                 IS IT 7242/7270
         BNE      TY6175            NO IT MAY BE 7261 OR 7275
DEFSWPCD LI,R1    X'13'
         STW,R1   SWAPCD
         B        SIZOKPSA
TY6175   EQU      %
         LI,R1    7
         STW,R1   SWAPCD
         B        SIZOKPSA
CNVTNEW  M:PRINT  (MESS,NEWSWAP)
         MTW,1    P2ERR,R3
         LW,R1    SWAPCD            IF UNKNOWN PACK AND NO SWAPCD
         BEZ      DEFSWPCD          DEFAULT TO X'13'
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
         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
*
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
         M:PRINT  (MESS,NEWRADM)
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
*
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
         CI,R4    PERD
         BE       PERERR
         M:PRINT  (MESS,PFASECT)
         B        SETGRAN3
PERERR   M:PRINT  (MESS,PERSECT)
         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
         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      %+2               NO
         AI,SR3   4                 YES ADD SPACE FOR 2-TABLES
*                             INCLUDING 4 WORD BUFFER FOR SENSE INFO
         AI,SR3   1
         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
         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
         LW,D2    R5                BUILD SENSE INTO CURRENT
         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
         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
****************************************************
*  THIS CODE IS TO CHECK THAT IF THEIR ARE UNKNOWN DISC DEVICES
*  PASS2 WILL ABORT UNLESS THEY ARE ORDERED AFTER THE KNOWN ONES
*  IN THE CHAN/DEVICE COMMAND INPUT. (SAME ORDER AS HGP'S).
*  OTHERWISE HAVOC IS CREATED WITH AVRTBL AND FILE-MGMT.  SEARCHES.
****************************************************
         LCI      7
         PSM,R1   *R0
         LI,R1    0
         LW,R2    #SWAPDEVS,R3      SKIP OVER THE SWAPPING RADS OR DP
         LW,R6    *R4
         BEZ      PULLREG7
         LW,R4    R6
         BDR,R2   %-3
         LI,R2    1
         LI,3     5
GETDCT4I LW,R7    *R4,R2
         CI,R7    DPTYPBIT
         BAZ      GETNXT            BRANCH IF NOT DP
         LB,R5    *R4,R3            GET INDEX INTO DCT4 TABLE
         CW,R5    R1                O.K. IF R5 IS GREATER
         BL       SEQERR
         LW,R1    R5
         CI,R1    64                CHK FOR DP INDEX >63
         BL       GETNXT            SINCE A LARGE INDEX MAY INTERFERE
         LI,SR3   IX2LGMSG          WITH 3282 TYPE DP ADDRESSING
         MTW,1    P2ERR,R3
         BAL,SR4  PRINTMSG
GETNXT   EQU      %
         LW,R4    *R6
         BEZ      PULLREG7
         LW,R6    R4
         B        GETDCT4I
SEQERR   EXU      PULLREG7
         EXU      PULLREG7+1
         LI,SR3   SEQERRM
         MTW,1    P2ERR,R3
         BAL,SR4  PRINTMSG
         B        OUTOFIT
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
         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
         LW,R5    Y8
         LS,R5    *R6
         OR,R5    D1
         STW,R5   *R6
         AI,R6    2
         CI,R2    X'4000'
         BAZ      HMVHDR
         LW,R5    *R1
         BNEZ     %+2
         LW,R5    HGP1PTR,R3
         SW,R5    R1
         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      MAKBOND8          NO AVRTBL
         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                PARALLEL TO AVRID
         AW,SR3   R1                :
MAKBOND8 EQU      %
         MTW,0    SWAPUTS,R3        CHK FO A DP SWAPPER
         BEZ      MKBOND8A          SKIP IF NO DP SWAPPER
         LW,R1    SWAPCD
         SCS,R1   -8                GET DPCODE IN LEFTMOST BYTE
         AI,SR3   2                 DPCMD TABLE MUST BE BOUND 8
         SLS,SR3  -1
         SLS,SR3  1
         STW,SR3  DPCMD,R3          PTR TO DPCMD TABLE
         AI,SR3   2
         STW,SR3  DPLOC,R3          PTR TO DPLOC
         LW,R2    SR3
         SLS,R2   2                 CONVERT DPLOC ADDRESS TO BYTE AD.
         EOR,R2   R1                GEN,8,24 = DPCODE,BA(DPLOC)
         LW,R1    DPCMD,R3
         STW,R2   *R1               SET DPCMD
         AI,R1    K1
         LW,R2    DPCMD1
         STW,R2   *R1               SET DPCMD+1
         AI,R1    K1
         LI,R2    K0
         STW,R2   *R1               SET DPLOC TO ZERO
MKBOND8A EQU      %
         AI,SR3   2
         SLS,SR3  -1
         SLS,SR3  1
*
         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
         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-3
         BG       DEFVAL02M
         BL       DEFVAL02P
         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
*                           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    NUMTAPES,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      %
         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      %
         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
         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
         LB,D1    D3                SAVE BYTE0 IN CASE BIT1 SET FOR MC
         LI,R1    K0                ZERO OUT REST OF DCT9
         STB,D1   R1                BUT SAVE BYTE SETTING
         STW,R1   *D4,R6              ENTRY
         AW,D3    HANDTADR,R3        MAKE CORRECT ADDRESS
         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    CLIST#            SET UP CLIST REF
         STW,R6   EXPRCALL+4,R3     STORE FIRST PART OF CLIST WORD IN
         LI,R6    X'F0F1'           PLIST. FIRST REF IS 'CL#01'
         SLS,R6   16
         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
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    R6
******   THIS SECTION GENERATES NUMERICAL PART OF 'CL#  '
         LI,R2    1
         LI,R5    0
         SLD,R4   -4
         SCS,R5   4
CONVEBCD CI,R4    9
         BG       %+3
         AI,R4    X'F0'
         B        %+3
         AI,R4    -9
         AI,R4    X'C0'
         AI,R2    -1
         BNEZ     %+3
         XW,R4    R5
         B        CONVEBCD
         SLS,R5   8
         AW,R5    R4
         SLS,R5   16
         STW,R5   EXPRCALL+5,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
         LW,D1    D2
         BAL,10   MODGEN
         TEXTC    'SC2SK0'
         TEXTC    'S:CYLSZ1'
         AI,SR1   1
         PSW,SR1  *R0               SAVE CURRENT SR1 CONTENTS
         LW,SR1   DPCMD,R3
         TEXTC    'DPCMD1'
         TEXTC    '02'
         LW,SR1   DPLOC,R3
         TEXTC    'DPLOC1'
         LW,D1    SWAPCD
         TEXTC    'SWAPCD0'
         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
         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
         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   RBBCPZPTR,R3      YES,GEN TABLES
         TEXTC    'RBB:CPZ1'
         LW,SR1   RBBLPZPTR,R3
         TEXTC    'RBB:LPZ1'
         AI,10    1
RBGENTBL EQU      %
         BAL,10   MODGEN
         LW,SR1   RBFLAGPTR,R3
         TEXTC    'RB:FLAG1'
         LW,SR1   RBHACKPTR,R3
         TEXTC    'RBH:ACK1'
         LW,SR1   RBBSPCPTR,R3
         TEXTC    'RBB:SPC1'
         LW,SR1   RBBSFCPTR,R3
         TEXTC    'RBB:SFC1'
         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    OCPTYP,R3
         TEXTC    'OCPTYP0'
         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'
         B        %+1
****************************************
*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#
         LI,R5    0
         LI,R2    1
         LW,R1    SWAPMOD#
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
*
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
*
*        WRITE OUT CLIST BUFFER INFORMATION FOR PORCESSING LATER
*        IN THE COC ROUTINE
*
         LW,R2    DCT1PTR,R3        WRITE OUT DCT1 INFO AS A KEYED REC.
         LW,R1    DCTSIZE,R3
         AI,R1    3
         SLS,R1   -2                ROUND UP TO WORD BOUNDARY
         SLS,R1   3                 CONVERT TO BYTES FOR SIZE OF REC.
*           KEY IS BUILT AS 'TA#' E.G. 'TA1'  (TA1=DCT1 REC.)
         LI,R4    TEXTAUK
         M:OPEN   M:TM,(FILE,'TAURTMP'),(OUT),(KEYED),(SAVE),(DIRECT)
WRITCLST M:WRITE  M:TM,(BUF,*R2),(SIZE,*R1),(KEY,*R4),(NEWKEY),;
                  (WAIT)
         MTW,1    *R4               INCREMENT KEY
         LW,R2    TCLSIZES,R3       'TA2' RECORD = CLIST SIZES
         EXU      WRITCLST
         MTW,1    *R4
         LW,R2    TPSZWID,R3
         EXU      WRITCLST
         MTW,1    *R4
         LW,R2    DCT4PTR,R3        'TA4'  RECORD = DCT4 TABLE
         EXU      WRITCLST
         M:CLOSE  M:TM,(SAVE)
********
*  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
         LW,R1    PACKRPTR,R3       WORK AREA BASE
         CI,R1    1                 FORCE IT TO BOUND 8
         BAZ      %+2
         AI,R1    1
         LW,R2    HANDTADR,R3       HANDLER NAME TABLE SOURCE
         LI,R4    1                 INDEX TO 1-ST ENTRY
         LW,R5    *R2               # HANDLER ENTRYS
         BEZ      OUTOFIT-2
****
*  (R1) = DESTINATION
*  (R2) = NAME SOURCE BASE ADDR.
*  (R4) = REL.POSITION TO NAME1
*  (R5) = # NAMES
****
         STW,R5   *R1               SET # ENTRIES IN FILE
         AI,R1    2                 TO FIRST ENTRY
         LI,SR4   G2NXT
NXTNAM1  EQU      %
         SLS,R4   1
         LD,D1    *R2,R4            PUT NAME1
         LI,R7    1
         CD,D1    XV2IO             IF SO LEAVE OUT OF HANDLERS RECORD
         BE       STRUMOVA          AND PUT IN UMOV RECORD
         SLS,R7   1
         CD,D1    X3270             THE SAME PROCESS FOR THESE NEXT
         BE       STRUMOVA          FEW NAMES
         SLS,R7   1
         CD,D1    XDSCIO
         BE       STRUMOVA
         SLS,R7   1
         CD,D1    HASPHAND
         BE       STRUMOVA
         SLS,R7   1
         CD,D1    2780HAND
         BE       STRUMOVA
         SLS,R7   1
         CD,D1    XOCPIO
         BE       STRUMOVA
         STD,D1   *R1                 IN RECORD
         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
         LW,R2    XMAGTAPE          YES STORE NAME OF
         STW,R2   *R1               SECOND TAPE HANDLER
         AI,R1    1
         LW,R2    XMAGTAPE+1
         STW,R2   *R1
         AI,R1    1
         LW,R2    7TAPFL
         BEZ      NOTMAG-2
         LCI      2
         LM,D1    MTAP
         STM,D1   *R1
         AI,R1    2
         EXU      NOTMAG-2
         MTW,2    *R2
         B        NOTMAG
STRUMOVA CW,R7    UMOVTYP
         BANZ     G2NXT             GO TO G2NXT IF ALREADY IN RECORD
         STS,R7   UMOVTYP
STRUMOVB LW,R7    UMOVREC           GET CURRENT SIZE (IN D.W.)
         AI,R7    1                 INCREASE IT BY NEW ENTRY ABOUT
         STD,D1   UMOVREC,R7        TO BE PUT IN
         STW,R7   UMOVREC
         B        *SR4
         LW,R2    PACKRPTR,R3
         MTW,1    *R2
NOTMAG   EQU      %
         MTW,0    #RBTS,R3          ANY RBTS
         BEZ      NOBTS
GRRBHO   LD,D1    XRBSSS            ADD RBSSS NAME TO UMOV RECORD
         LI,SR4   GTRBH1
         B        STRUMOVB
GTRBH1   EQU      %
         LW,R7    RBTTYP            GET IRBT/2780 FLAG WORD
         BEZ      NOTMAG1           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.
         BAL,R4   CHKHSPM1          IF SO, HSPM MUST BE ADDED TO
*                                   HANDLERS RECORD IN SPEC:HAND
         LD,D1    HASPHAND          AND HASPIO MUST BE ADDED TO
         LI,SR4   GTBSCIO           TO HANDLERS2 RECORD IN SPEC:HAND
         B        STRUMOVB
GTBSCIO  LD,D1    XBSCIO
         LI,SR4   NOBTS
         B        STRUMOVB
NOTMAG1  LW,R2    PACKRPTR,R3
         MTW,1    *R2
NOBTS    EQU      %
         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 #NAMES TO
*                                   COMPENSATE FOR UMOV ENTRIES
         SLS,R1   2                   (BYTES)
         M:OPEN   M:TM,(FILE,'SPEC:HAND'),(OUT),(KEYED),(DIRECT),;
                       (KEYM,63),(SAVE)
         M:WRITE  M:TM,(BUF,*R2),(SIZE,*R1),(KEY,HANDLERS),;
                       (NEWKEY),(WAIT)
         LW,R1    UMOVREC
         AI,R1    1                 GET READY TO WRITE OUT UMOV RECORD
         SLS,R1   3                 R1 IS NOW SIZE OF REC. IN BYTES
         M:WRITE  M:TM,(BUF,UMOVREC),(SIZE,*R1),(KEY,UMOVNM),;
                       (NEWKEY),(WAIT)
         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
*
         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
         LI,R1    X'D'
         LI,R7    X'C'
         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   TBFLGSPTR,R3
         LB,D1    *SR1,R7
         STB,D1   *SR1,R1
         LI,R5    1
         LB,D1    TYPEFLAGS,R5      GET NO
         STB,D1   *SR1,R5
         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
         LW,R7    SAVEPAGE,R3
         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
         BAL,SR4  WRITELM
         LW,R7    #INTPAGES,R3
         OR,R7    =X'09000000'
         CAL1,8   R7
         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
         EXU      PRTASTR
         B        READSTRG
*
ADDHAND  EQU      %
         LW,R2    SWAPUTS,R3        GET SWAP FLAG
         LD,D1    SWAPHAND,R2
         STW,D1   *R1
         AI,R1    1
         STW,D2   *R1
         AI,R1    1
         LW,R2    PACKRPTR,R3
         MTW,1    *R2
         LW,R7    UMOVTYP
         CW,R7    X3
         BAZ      CHKHSPM
         LD,D1    XMOCIOP           ADD THIS NAME TO HANDLERS RECORD
         STD,D1   *R1
         AI,R1    2
         MTW,1    *R2
CHKHSPM  CI,R7    8
         BAZ      *R4
CHKHSPM1 LD,D1    XHSPM             ADD 'HSPM' TO HADNLERS RECORD
         STD,D1   *R1
         AI,R1    2
         MTW,1    *R2
         B        *R4
**********
*
*
         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'
2MNYMCS  TEXTC    '*** ONLY 1 MC DEVICE COMMAND IS LEGAL'
2MNYCOCS TEXTC    '*** TOO MANY COCS  SPECIFIED--ONLY 11 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
MAKENDD  EQU      %
         STH,R7   SAVESPOT          SAVE DD
         LB,R7    SR1               STORE N AS THE CHANNEL LETTER FOR TAURUS
         STB,R7   SAVESPOT          REBUILD NEW NDD
         LW,SR2   TCLSIZES,R3
         MTH,1    *SR2              INCREASE TABLE SIZE BY 1
         LI,R7    9                 GET CLIST SIZE FOR THIS DEVICE
         LH,R7    *D3,R7
         STH,R7   *SR2,R1           STORE IT IN HALF-WORD TABLE (TCLSIZES)
         LH,R7    SAVESPOT
         B        *D4
SAVESPOT RES      1
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/STDLB CARD PROCESSOR
*
ERRBORT3 BAL,SR4  OUTLLERR
         PUSH     SR3
         B        ERRBT3
ERRBRT3  EQU      %
         BAL,SR4  OUTLLERR
         PUSH     SR3
         LI,SR4   ERRBT3
         BAL,SR3  PRINTMSG
         TEXTC    '*** SYNTAX ERROR'
ERRBT3   EQU      %
         PULL     SR3
         LW,SR4   R7
         LW,R7    FETCHADR,R3
         XW,SR4   FETCHLST+4,R3
         AND,SR4  L(X'DFFFFFFF')
         XW,SR4   FETCHLST+4,R3
         B        *SR4
ERRBOR11 BAL,SR3  PRINTMSG
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
         MTW,1    P2ERR,R3
         BAL,SR3  PRINTMSG
PAGES    TEXTC    ' ONLY  XXXX PAGES OBTAINED'
ERBOR13A EQU      %                                                     897
         MTW,1    P2ERR,R3
         BAL,SR3  PRINTMSG                                              897
MSG13    TEXTC    '*** UNKNOWN DEVICE YYNDD FOR LL'
ERRBOR14 MTW,1    P2ERR,R3
         BAL,SR3  PRINTMSG
         TEXTC    '*** INSUFFICIENT PAGES AVAILABLE'                    897
ERRBOR15 MTW,1    P2ERR,R3
         BAL,SR3  PRINTMSG
         TEXTC    '*** LOAD MODULE CANNOT BE GENERATED'
ERRBOR16 MTW,1    P2ERR,R3
         BAL,SR3  PRINTMSG
         TEXTC    '*** NO DISC DEFINED'                                 897
ERRBOR17 MTW,1    P2ERR,R3
         BAL,SR3  PRINTMSG
         TEXTC    '*** NO HANDLER-DEVICE IGNORED --DELAYED',;
                  ' ABORT CONDITION'
ERRBOR18 EQU      %                                                     897
         MTW,1    P2ERR,R3
         AND,D3   M16                                                   897
         SLS,D3   K8                                                    897
         OR,D3    L(X'40000040')                                        897
         STW,D3   MSG18+4                                               897
         BAL,SR3  PRINTMSG                                              897
MSG18    TEXTC    '*** DEVICE TYPE YY ILLEGAL'                          897
ERRBOR19 EQU      %
         MTW,1    P2ERR,R3
         LI,R4    0
         STH,R4   *R1,R2            ZAP PER OR PSA
         BAL,SR3  PRINTMSG
         TEXTC    '*** ONLY PFA VALID ON PRIVATE OR',;
                  ' CYLIN ALLOCATED DEVICE'
ERRBOR20 EQU      %
         MTW,1    P2ERR,R3
         BAL,SR3  PRINTMSG
         TEXTC    '*** VALID ''CHAN'' CC MUST PRECEED ''DEVICE'' CC'
ERRBOR21 EQU      %
         MTW,1    P2ERR,R3
         BAL,SR3  PRINTMSG
         TEXTC    '*** ''NAME'' OR SYNTAX INVALID'
ERRBOR2X  EQU     %
         MTW,1    P2ERR,R3
         BAL,SR3  PRINTMSG
         TEXTC    '*** SYNTAX ERROR DUAL OPTIONS USED'
ERRBOR23 EQU      %
         BAL,SR3  PRINTMSG
         TEXTC    '*** NO CHAN/DEVICE INFO'
ERRBOR27 EQU      %
         MTW,1    P2ERR,R3
         BAL,SR3  PRINTMSG
         TEXTC    '*** THIS DISC ALREADY DEFINED'
ERRBOR28 EQU      %
         MTW,1    P2ERR,R3
         BAL,SR3  PRINTMSG
         TEXTC    '*** SUM OF PSA+PER+PFA > SIZE'
ERRBOR29   EQU    %
         MTW,1    P2ERR,R3
         BAL,SR3  PRINTMSG
         TEXTC    '***WARNING NEW DISK TYPE USED',;
                  ' FOR SWAPPER'
ERRBOR30 EQU      %
         MTW,1    P2ERR,R3
         M:PRINT  (MESS,30MESS)
         B        OUTOFIT
30MESS   TEXTC    '***SS/NSPT/SIZE MUST BE NON ZERO'
ERRBOR31 EQU      %
         MTW,1    P2ERR,R3
         LI,SR4   ERR2
         BAL,SR3  PRINTMSG
         TEXTC    '*** PSA MUST BE ON 7212/7232/3214 RAD OR DISC PACK',;
                  ' - PSA IGNORED'
ERRBOR31A MTW,1   P2ERR,R3
         LI,SR4   ERR2
         BAL,SR3  PRINTMSG
         TEXTC    '*** PSA NOT ALLOWED ON 3275 PACK',;
                  ' - PSA IGNORED'
ERRBOR32 EQU      %
         MTW,1    P2ERR,R3
         STW,R4   SWAPUTS,R3        RESET FLAG TO 1
         LI,SR4   ERR2
         BAL,SR3  PRINTMSG
         TEXTC    '*** PSA PREVIOUSLY DEFINED ON DP',;
                  ' - PSA IGNORED'
ERRBOR32A EQU     %
         MTW,1    P2ERR,R3
         LI,R4    0
         STW,R4   SWAPUTS,R3        ZERO DP SWAPPER FLAG
         BAL,SR3  PRINTMSG
         TEXTC    '*** PSA DEFINED ON RAD, NOT ALLOWED ON DP'
ERRBOR32B MTW,1   P2ERR,R3
          BAL,SR3 PRINTMSG
         TEXTC    '*** IF SS,TRKS,CYLS OMITTED - ',;
                  'DEFAULTS: 100,8,16 WILL BE SUPPLIED'
ERRBOR34 MTW,1    P2ERR,R3
         BAL,SR3  PRINTMSG
         TEXTC    '*** NO PSA DEFINED'
ERRBOR35 MTW,1    P2ERR,R3
         BAL,SR3  PRINTMSG
         TEXTC    '*** NO PER DEFINED'
************************************************************************
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+21
         LB,R4    *D4,R4
         CI,R4    X'B'
         BNE      42DFLT
         LI,R4    55
         STB,R4   *D4,R2
         MTW,1    P2ERR,R3
         BAL,SR3  PRINTMSG
         TEXTC    '*** NGC > 255 -- 55 USED FOR 7260/7265'
42DFLT   EQU      %
         MTW,1    P2ERR,R3
         LI,R4    30
         STB,R4   *D4,R2
         BAL,SR3  PRINTMSG
         TEXTC    '*** NGC >255 -- 30 USED FOR 7242/7270'
NEWDEFLT  EQU     %
         MTW,1    P2ERR,R3
         LI,R4    30
         STB,R4   *D4,R2
         BAL,SR3  PRINTMSG
         TEXTC    '*** NGC > 255--NGC SET TO 30'
**********
ERRMREC  EQU      %
         MTW,1    P2ERR,R3
         LI,R4    X'FF'
         CI,R2    16
         BE       %+2
         LI,R4    1
         STB,R4   *D4,R2
         LI,SR4   RPRENDPA
         BAL,SR3  PRINTMSG
         TEXTC    '*** MREC/MXREC VALUE INVALID -- SYSGEN',;
                  ' DEFAULT USED'
         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'
K20      EQU      X'20'
K40      EQU      X'40'
KN1      EQU      -X'1'
KCRET    EQU      X'0D'
KNL      EQU      X'15'
KEOB     EQU      X'26'
SSD      EQU      2
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
TNGCD    EQU      23
CYLBIT   EQU      X'8000'
PRIVBIT  EQU      X'4000'
DPTYPBIT EQU      X'800'
NSPTBL   EQU      %
         DATA     0,X'10',X'C',X'52',6
         PAGE
FETCHSTR EQU      %
         GEN,8,24 NDELIM,BA(CCDELIM)
         GEN,8,24 CNCLM,READCONT    CONT.COL.NO.; CONTINUE READ RTN.
         DATA     CCLIST,0           2WDS   FOR OUTR AND CCP
         GEN,8,24 0,0               STORE BUFFER ADDRESS BEFORE OPING
         DATA     0,0                 CSL, FCPF
CCDELIM  DATA,4   '(),.'
         DATA,3   ' +-'
NDELIM   EQU      BA(%)-BA(CCDELIM)
         BOUND    4
CNCLM    EQU      0                 CONTINUE COL. NO. 0-79
CCLIST   EQU      0                 0=NO AUTOMATIC OUTPUT LISTING
*
         PAGE
******************
#7212    EQU      82                # SECTORS/TRACK ON 7212 RAD
********
DCDPCM   EQU      %                 KNOWN DC,DP DEVICE TYPES
         TEXT     '7202'            DC
         TEXT     '7203'            DC
         TEXT     '7204'            DC
         TEXT     '7232'            DC
         TEXT     '7212'            DC
         TEXT     '3214'            DC
         TEXT     '7271'            DP
         TEXT     '7242'            DP
         TEXT     '7261'            DP
         TEXT     '7275'            DP
T3275    TEXT     '3275'            DP
         TEXT     '3282'            DP
#DCDPCM  EQU      %-DCDPCM
********
         BOUND    8
DEFAULTS EQU      %                 (SS,NSPT,SIZE,TYPE,NGC)
*                            NOTE: SIZE IN IS PHYSICAL CYLS. 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    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
*******           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
*******           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
         BOUND    4
********
*     SWAPPER DATA
SWAPCD   DATA     0                DP SWAPPER CMND DOUBLE WORD
DPCMD1   GEN,8,24 X'2C',1
#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    4,4
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
***********
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'1E000004'       FOR 3214 (TYPE4)
         DATA     X'1E000004'       FOR 3214 (TYPE5)
         DATA     X'1E000003'       FOR 7232
X3       DATA     X'3'
X4       DATA     X'4'
XF       DATA     X'F'
X1F      DATA     X'1F'
X80      DATA     X'80'
X84      DATA     X'84'
X90      DATA     X'90'
XFF      DATA     X'FF'
X3FF     DATA     X'3FF'
XFFFF    DATA     X'FFFF'
XSIZEM   TEXTC    'SIZE'
XHGM     TEXTC    'HGM'
********
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 '
XSWAP    DATA     'SWAP'
XINPUT   DATA     'INPU'
XOUTPUT  DATA     'OUTP'
XIO      DATA     'IO  '
XDEDICAT DATA     'DEDI'
XHANDLER DATA     'HAND'
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   '
XVFC     DATA     'VFC '
XBIN     DATA     'BIN '
XPUB     DATA     'PUB '
XR       DATA     'R   '
XCLIST   DATA     'CLIS'
X7670    DATA     '7670'
X2780    DATA     '2780'
X1200    DATA     '1200'            OCP MODEL #
XIRBT    DATA     'IRBT'
XRBS     DATA     'RBS '
XRBX     DATA     'RBX '
XWSN     DATA     'WSN '
XNCYL    DATA     'NCYL'
XNTPC    DATA     'NTPC'
XCYLS    DATA     'CYLS'
XTRKS    DATA     'TRKS'
XSECS    DATA     'SECS'
XFIXE    DATA     'FIXE'
XMOVE    DATA     'MOVE'
BLANK    DATA     '    '
********
XCHAN    DATA     'CHAN'
XDEV     DATA     'DEVI'
********
XMC      DATA     'MC'
XRB      DATA     X'D9C2'
XC4C3    DATA     X'C4C3'
XC4D7    DATA     X'C4D7'
YC4D7    DATA     X'C4D70000'
YE2D7    DATA     X'E2D70000'
65FLG    DATA     0
7TAPFL   DATA     0                  FLAG SET IF 7T SPEC IS ON C.C.
MODGIVEN DATA     0                 FLAG SET IF 'MOD' SPEC IS ON C.C.
UMOVTYP  DATA     0                 KEEPS FLAGS OF OPTIONAL OVLAY NAMES
*                                   BIT 31 SET IF V2IO   PRESENT
*                                   BIT 30 SET IF 3270IO PRESENT
*                                   BIT 29 SET IF DSCIO  PRESENT
*                                   BIT 28 SET IF HASPIO PRESENT
*                                   BIT 27 SET IF 2780IO PRESENT
*                                   BIT 26 SET IF OCPIO  PRESENT
RBTTYP   DATA     0
NOPDUM   NOP
CYLSDUM  SLS,7    0
SECSDUM  SLS,8    0
TRKSDUM  SLS,9    0
*
M5       EQU      X1F
M20      DATA     X'000FFFFF'
M8       EQU      XFF
M10      EQU      X3FF
M16      EQU      XFFFF
M16X2    DATA     X'1FFFE'
X7232    DATA     '7232'
*
Y1       DATA     X'10000000'
Y7       DATA     X'70000000'
Y0001    DATA     X'00010000'
Y008     DATA    X'00800000'
Y0004    DATA     X'00040000'
Y002     DATA     X'00200000'
Y0040    DATA     X'00400000'
Y01      DATA     X'01000000'
Y05      DATA     X'05000000'
Y08      DATA     X'08000000'
Y04      DATA     X'04000000'
Y39      DATA     X'39000000'
Y8       DATA     X'80000000'
Y44      DATA     X'44000000'
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'
Y02      DATA     X'02000000'
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'
K13      EQU      X'13'
K14      EQU      X'14'
K15      EQU      X'15'
K17      EQU      X'17'
K18      EQU      X'18'
K19      EQU      X'19'
K1B      EQU      X'1B'
K1C      EQU      X'1C'
K1D      EQU      X'1D'
K1F      EQU      X'1F'
KC0      EQU      X'C0'
KE0      EQU      X'E0'
KEE      EQU      X'EE'
KF0      EQU      X'F0'
K100     EQU      X'100'
K200     EQU      X'200'
KFFFF    EQU      X'FFFF'
*
KF7E3    EQU      X'F7E3'
KF9E3    EQU      X'F9E3'
KCOMMA   EQU      ','
KLPAREN  EQU      '('
KRPAREN  EQU      ')'
********
KN2      EQU      -X'2'
KN6      EQU      -X'6'
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
         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
         BOUND    16
XOCPIO   TEXTC    'OCPIO'           XP (OCP HANDLER)
         TEXTC    'OCPCU'           XP  (OCP HANDLER)
         BOUND    16
         TEXTC    'COC'             ME (DUMMY USE ONLY)
         TEXT     '    '
         TEXTC    'COC'             ME (DUMMY USE ONLY)
         TEXT     '    '
XV2IO    TEXTC    'V2IO'            MO
         TEXTC    'V2CU'
         TEXTC    'RAS'             MC   (RAS DEVICE)
         TEXT     '    '
         TEXTC    'RASCU'           MC   (RAS DEVICE)
         BOUND    16
HANDNEND EQU      %
XMAGTAPE TEXTC    'MAGTAPE'
XRBSSS   TEXTC    'RBSSS'
XBSCIO   TEXTC    'BSCIO'
*  RBSSS AND BSCIO NAMES SHOULD NOT BE SEPARATED
         BOUND    16
DISHAND  TEXTC    'DISKAB'          HANDLERS FOR 7260/7265
         TEXTC    'DSKABCU'
         BOUND    8
SWAPHAND TEXTC    'TSIO'
         TEXTC    'DPSIO'
         BOUND    8
HASPHAND TEXTC    'HASPIO'          FOR IRBT TYPE
         TEXTC    'HASPCU'
2780HAND TEXTC    '2780IO'           FOR 2780 RBT
         TEXTC    '2780CU'
*   THE 2780 AND  HASP HANDLER NAMES SHOULD NOT BE SEPARATED
*
*
X3270    TEXTC    '3270IO'
XMOCIOP  TEXTC    'MOCIOP'
XHSPM    TEXTC    'HSPM'
HANDLERS TEXTC    'HANDLERS'
         PAGE
*
RESOL    EQU      %
*  ALLOCATION TYPE: BYTE=-3,HWD=-2,WD=-1,DWD=0
*  DCT TABLES
         DATA,1   -2,-3,-3,-3,-3,-3,-2,-1
         DATA,1   -1,-2,-1,-1,0,-3,-3,0,-2,-3,-3,-3,-2
         DATA,1   -3,-2             FOR DCT 22,DCT23 (UTS ONLY)
         DATA,1   -3,-1             FOR DCT 24 AND 25 (CPV ONLY)
         DATA,1   -2,-2
         DATA,1   BA(%)-BA(RESOL)   FLAG TO END DCTS
*   CIT TABLES
         DATA,1   -3,-3,-3,-1,-3,-3,BA(%)-BA(RESOL)
         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,X'53',X'3B',X'3B' PL,RB,XP,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   'XP','ME'
         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'80'   SP,PL,RB,XP
         DATA,1   X'C0',X'C0',X'C0'     ME,MO,MC
IOFLOLNG EQU      BA(%)-BA(IOFLOACT)-1
*
         PAGE
UMOVNM   TEXTC    'HANDLERS2'
         BOUND    8
UMOVREC  DATA     2,0               UMOV RECORD FOR SPEC:HAND FILE
         TEXTC    'INSYM'           PRESENT
         TEXTC    'OUTSYM'
         DO1      16                8 RESERVED SLOTS FOR THE FOLLOWING
         DATA     0                 POSSIBLE ENTRIES:
*                                   RBSSS,DSCIO,BSCIO,OCPIO,2780IO
*                                   HASPIO,V2IO OR 3270IO
         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
DEFHGPSZ TEXTC    'HGPSIZE'
DEFCITSZ TEXTC    'CITSIZ'
DEFIOCTQ TEXTC    'IOCTQ'
DEFAVRID TEXTC    'AVRID'
DEFDCTSZ TEXTC    'DCTSIZ'
DEFBATAP TEXTC    'BATAPE'
DEFNBATA TEXTC    'NBATAPE'
DEFAVRSZ TEXTC    'AVRTBLSIZ'
DEFAVRNE TEXTC    'AVRTBLNE'
DEFSPSIZ TEXTC    'M:SPSIZE'
         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     8                 XP  (OCP)
         DATA     6                 ME
         DATA     18                MO
         DATA     2                 MC
********
         PAGE
*********
GETPAGES GEN,8,24 8,100
*
*
********
         END

