         DO       TCOR(UTSPROC,S:INT)=0
UTSPROC  SET      1
         FIN
         DO       TCOR(S69PROC,S:INT)=0
S69PROC  SET      UTSPROC
         FIN
         DO       TCOR(MONPROC,S:INT)=0
MONPROC  SET      0
         FIN
         DO       TCOR(ANSPROC,S:INT)=0
ANSPROC  SET      0
         FIN
         DO       TCOR(DCBPROC,S:INT)=0
DCBPROC  SET      0
         FIN
         DO       TCOR(DISCBPROC,S:INT)=0                               DISCB
DISCBPROC SET     0                                                     DISCB
         FIN                                                            DISCB
         DO1      TCOR(BITS,S:FR)
BITS     SET      0
         DO1      TCOR(UFLAGS,S:FR)
UFLAGS   SET      0
         DO1      TCOR(MPBITS,S:FR)
MPBITS   SET      0
*
         OPEN     CREF,S:S,BD,HD,HBIT
*
*   PROC FOR CONDITIONAL REFS
*
CREF     CNAME
         PROC
         DO1      TCOR(S:FR,AF)
         REF      AF
         PEND
         PAGE
         DO       BITS
         CREF     BT31TO0
BIT      CNAME
         PROC
LF       EQU      BT31TO0+32-AF
         PEND
*
*
Y8       BIT      0
Y4       BIT      1
Y2       BIT      2
Y1       BIT      3
Y08      BIT      4
Y04      BIT      5
Y02      BIT      6
Y01      BIT      7
Y008     BIT      8
Y004     BIT      9
Y002     BIT      10
Y001     BIT      11
Y0008    BIT      12
Y0004    BIT      13
Y0002    BIT      14
Y0001    BIT      15
X8000    BIT      16
X4000    BIT      17
X2000    BIT      18
X1000    BIT      19
X800     BIT      20
X400     BIT      21
X200     BIT      22
X100     BIT      23
X80      BIT      24
X40      BIT      25
X20      BIT      26
X10      BIT      27
X8       BIT      28
X4       BIT      29
X2       BIT      30
X1       BIT      31
         CREF     MASKS
M1       EQU      MASKS+1
M2       EQU      MASKS+2
M3       EQU      MASKS+3
M4       EQU      MASKS+4
M5       EQU      MASKS+5
M6       EQU      MASKS+6
M7       EQU      MASKS+7
M8       EQU      MASKS+8
M9       EQU      MASKS+9
M10      EQU      MASKS+10
M11      EQU      MASKS+11
M12      EQU      MASKS+12
M13      EQU      MASKS+13
M14      EQU      MASKS+14
M15      EQU      MASKS+15
M16      EQU      MASKS+16
M17      EQU      MASKS+17
M18      EQU      MASKS+18
M19      EQU      MASKS+19
M20      EQU      MASKS+20
M21      EQU      MASKS+21
M22      EQU      MASKS+22
M23      EQU      MASKS+23
M24      EQU      MASKS+24
M25      EQU      MASKS+25
M26      EQU      MASKS+26
M27      EQU      MASKS+27
M28      EQU      MASKS+28
M29      EQU      MASKS+29
M30      EQU      MASKS+30
M31      EQU      MASKS+31
M32      EQU      MASKS+32
         FIN
         PAGE
         PAGE
         DO       MPBITS
STARTBIT EQU      1
STOPBIT  EQU      2
         CREF     NB31TO0
NSTARTB  EQU      NB31TO0+1
NSTOPB   EQU      NB31TO0+2
IDLE     EQU      1
USER     EQU      2
STOPPED  EQU      0
VPXPSDT  EQU      1                 VP # FOR XPSD TARGETS
         DO       TCOR(S:FR,NCPU)
         CREF     NSCPU
NCPU     SET      NSCPU+1
         FIN      NCPU
         FIN      MPBITS
SCREECH  CNAME    0
SUA      CNAME    1
DUMP     CNAME    2
         PROC
         CREF     RCVPSD
LF       XPSD,10  RCVPSD
         GEN,16,8,8  AF(1),NAME(1),AF(2)
         PEND
BLOCK    CNAME
         PROC
         CREF     BLOCKER
LF       BAL,1    BLOCKER
         PEND
         DO       UTSPROC
         DO1      TCOR(S5PROC,S:INT)=0
S5PROC   SET      0
         DO       S5PROC
         SYSTEM   SIG5FP
         ELSE
         SYSTEM   SIG9P
         FIN
         PAGE
*************************************
*        PROC DEFINITIONS           *
*************************************
*  COMPUTED SELECT FUNCTION
*
S:S      FNAME
         PROC
         PEND     AF(AF(1)+2)
*
EQ       CNAME
         PROC
LF       EQU      S:UFV(AF)
         DISP     LF
         PEND
*
*
*                 OVERLAY PROCS
*
OVERLAY  CNAME    1
OVERTO   CNAME    2
         PROC
LF       LI,2     AF(1)
         DO       NUM(AF)>1
         LI,0     AF(2)
         FIN
         DO       NAME=1
         CREF     T:OVERLAY
         BAL,11   T:OVERLAY
         ELSE
         CREF     T:OVER
         B        T:OVER
         FIN
         PEND
REMEMBER CNAME
         PROC
         CREF     T:REMEMBER
LF       BAL,14   T:REMEMBER
         PEND
*
DESTRUCT CNAME
         PROC
LF       DO1      NUM(AF)>0
         LI,11    AF(1)
         CREF     T:SELFDESTRUCT
         B        T:SELFDESTRUCT
         PEND
*
*                 PROCEDURES USED IN BATCH MONITOR.
*
*
*                 ENABLE ALL INTERRUPTS (CLEAR MASTER INHIBITS).
*
ENABLE   CNAME
         PROC
LF       GEN,8,24 X'6D',X'27'       ENABLE
         PEND
*
*                 DISABLE ALL INTERRUPTS (SET MASTER INHIBITS).
*
DISABLE  CNAME
         PROC
LF       GEN,8,24 X'6D',X'37'       DISABLE
         PEND
*
*                 BUMP STACK POINTER BY AMOUNT SPECIFIED BY FIRST ARG-
*                 UMENT. USE REGISTER SPECIFIED BY SECOND ARGUMENT.
*
BUMP     CNAME
         PROC
         CREF     TSTACK
LF       LI,AF(2) AF(1)
         MSP,AF(2)  TSTACK
         PEND
*
*                 PUSH OR PULL N WORDS SPECIFIED BY FIRST ARGUMENT INTO
*                 REGISTERS STARTING AT SECOND ARGUMENT.
*
*                 ACCEPTABLE FORMS ARE:
*                   PUSH                PULL
*                   PUSH R              PULL R
*                   PUSH 1,R            PULL 1,R
*                   PUSH (R2,R8)        PULL (R2,R8)
*                   PUSH (R12,R4)       PULL (R12,R4)
*
PUSH     CNAME    X'B',9
PULL     CNAME    X'A',8
         PROC
         LOCAL    T
T        SET      S:S((NUM(CF)=2)*8+(NUM(AF)>1)*4+(NUM(AF)>0)*2+;
   (NUM(AF(1))>1),(0,16),,(AF(1),1),(AF(1,1),AF(1,2)-AF(1,1)+1),,,;
   (AF(2),AF(1)),,(CF(2),1),,(CF(2),AF(1)))
T(2)     SET      S:S(T(2)<0,S:S(T(2)=16,T(2)),T(2)+16)
LF       DO1      T(2)]=1
         LCI      T(2)
         CREF    TSTACK
         GEN,8,4,20    NAME((T(2)=1)+1),T(1),TSTACK
         PEND
*
*
*                 OB UNCONDITIONALLY TRANSFERS TO SPECIFIED SEGMENT.
*                 OBAL SAME EXCEPT SET SR4 TO RETURN ADDRESS.
*                 OBSR4 BRINGS BACK CALLING SEG AND EXECUTES B *SR4.
OB      CNAME
         PROC
LF       GEN,1,7,4,20  AFA(1),X'68',0,AF(1)
        PEND
OBAL    CNAME
        PROC
LF       GEN,1,7,4,20  AFA(1),X'6A',11,AF(1)
         PEND
OBSR4   CNAME
         PROC
LF      B        *SR4
        PEND
ENTRY    CNAME
         PROC
         CREF     ENTSUB
         CREF     TEMP
LF       STCF     TEMP
         PUSH     7,13
         LD,0     AF
         BAL,2    ENTSUB
         PEND
*
*                PROCS TO MAP AND UNMAP
*
MAP     CNAME
        PROC
         CREF     MAP
LF       BAL,1    MAP
        PEND
UNMAP   CNAME
        PROC
         CREF     UNMAP
LF       BAL,1    UNMAP
        PEND
         OPEN     G
HBIT     FNAME    2
         PROC
G        SET      AF
K        SET      0
I        DO       NUM(G)
K        SET      K|(1**((NAME*8-1)-G(I)))
         FIN
         PEND     K
         CLOSE    G
WORTAB   CNAME    4
HAFTAB   CNAME    2
BYTAB    CNAME    1
         PROC
LF       EQU      %
         DO       AF(1)
         DATA,NAME   AF(2)
         FIN
         BOUND    4
         PEND
*                 PROCEDURE TO SVE CURRENT ENVIRONMENT
*                 ARG IS PSD
T:PUSHE  CNAME
         PROC
         CREF     T:SAVE
LF       PUSH     6,13
         LD,0     AF(1)
         BAL,2    T:SAVE
         PEND
*
HD       FNAME    0
BD       FNAME    1
         PROC
Z        SET      AF(1)+AF(1)
         DO       NAME
Z        SET      Z+Z
         FIN
         PEND
         PAGE
         DO       UFLAGS
*
*   EQUATES FOR UH:FLG BIT NAMES
*
RTR      EQU      X'1'
PPSWP    EQU      X'10'
DIC      EQU      X'40'
TIC      EQU      X'80'
BAT      EQU      X'100'
JIC      EQU      X'200'
DELA     EQU      X'400'
INIT     EQU      X'800'
SJAC     EQU      X'1000'
DCBS     EQU      X'2000'
         FIN
SETT     CNAME    0
SETST    CNAME    1
LSET     CNAME    2
LSETST   CNAME    3
SETR     CNAME    4
SETRST   CNAME    5
LSETR    CNAME    6
LSETRST  CNAME    7
RSET     CNAME    8
RSETST   CNAME    9
LRSET    CNAME    10
LRSETST  CNAME    11
RSETS    CNAME    12
RSETSST  CNAME    13
LRSETS   CNAME    14
LRSETSST CNAME    15
         OPEN     J,K,G
         PROC
J        SET      SCOR(AF(1),RTR,,,,PPSWP,,DIC,TIC,BAT,;
                  JIC,DELA,INIT,SJAC,DCBS)
LF       EQU      %
         DO       NUM(AF)=3
K        SET      AF(3)
         ELSE
K        SET      4
         FIN
         DO       NUM(AF)=1
G        SET      15
         ELSE
G        SET      AF(2)
         FIN
         DO       (NAME&2)/2
         CREF     UH:FLG
         LH,G     UH:FLG,K
         FIN
         DO       NAME>3&NAME<8
         CREF     BT31TO0
         OR,G     BT31TO0+J
         FIN
         DO       NAME>11
         CREF     NB31TO0
         AND,G    NB31TO0+J
         FIN
         DO       NAME<4
         AI,G     AF(1)
         FIN
         DO       NAME>7&NAME<12
         AI,G     -AF(1)
         FIN
         DO       NAME&1
         CREF     UH:FLG
         STH,G    UH:FLG,K
         FIN
         PEND
         CLOSE    J,K,G
         FIN
         PAGE
         DO       S69PROC
LOAD     CNAME    18
STORE    CNAME    21
MODTST   CNAME    19
COMPARE  CNAME    17
         PROC
         CREF     :BIG
LF       GEN,1,1,1,5,4,3,17 ;
         AFA,1,1-:BIG,NAME,CF(2),AF(2),AF(1)
         PEND
*
*
LDMAP    CNAME
         PROC
         CREF     :BIG
LF       GEN,1,7,4,2,1,17  0,X'6F',CF(2),2,:BIG,AF(1)
         PEND
*   PROC TO BUILD PSDS (2 OR 4 WORD)
:PSD     CNAME
         PROC
         LOCAL    :B9MA,:B560MA,P
           CREF      :BSIG,:B560
         BOUND    8
P        SET      S:KEYS(2,*0,CC,IA,WK,RP,18,OMA,RES,;
                  FR,FS,FZ,FN,(SLAVE,MASTER),MAP,DM,AM,;
                  CI,II,EI,INH)
         DO       (P(2)&X'2040')=0  NOT MAP & NOT OMA
:B9MA      SET       :BSIG
:B560MA  SET      :B560             SET FOR BIG560'S ONLY
         ELSE
:B9MA    SET      0
:B560MA  SET      0
         FIN
LF       GEN,((P(2)&X'1000')>0)*64,;   OPTIONAL TWO WORDS OF ZEROS
         4,8,3,17,;   CC,(FR,FS,FZ,FN,SLAVE,MAP,DM,AM),,IA
         2,2,1,3,1,6,1,;            0,WK,,(CI,II,EI),:B9MA,,:B9MA
         8,4,1,1,2 ;                0,RP,,:B560MA,0
         0,;                        OPTIONAL TWO WORDS OF ZEROS
         AF(P(3),2),;               CC
         (P(2)**-4)&X'FF',;         FR,FS,FZ,FN,SLAVE,MAP,DM,AM
         0,;
         AF(P(4),2),;               IA
         0,;
         AF(P(5),2),;               WK
         0,;
         ((P(2)**-1)&7)|((P(2)&1)*7),;  CI,II,EI, OR INH
         :B9MA,;                    MA FOR SIGMA 9
         0,;
         :B9MA,;                    EA FOR SIGMA 9
         0,;
         AF(P(6),2),;               RP
         0,;
         :B560MA,;                  MA FOR XEROX 560
         0
         PEND
*
*   THE FOLLOWING PROC CHECKS FOR AN I/O INSTRUCTION FAILURE
*     ONLY WITIN INITIALIZATION,XDELTA, AND RECOVERY
*
:SIO     CNAME    X'4C'
:TIO     CNAME    X'4D'
:TDV     CNAME    X'4E'
:HIO     CNAME    X'4F'
         PROC
LF       EQU      %
:A       SET      %
         GEN,1,7,4,3,17  AFA,NAME,CF(2),AF(2),AF(1)
         PEND
*   THIS PROC IS FOR BRANCHING AROUND MACHINE DEPENDANT CODE
*
BIF      CNAME
         PROC
         CREF     C%CPU             DEF'D IN M:CPU
         LOCAL    P,BR
LF       LC       C%CPU             PICK UP CC BITS
P        SET      SCOR(CF(2),S7,S9,X560,S7S9,S9S7,;
                  S7X560,X560S7,S9X560,X560S9,UNK,;
                  S5S7,S7S5,S5,S5X560,X560S5,S5S9,S9S5,;
                  S5S7S9X560,X560S9S7S5,S5ONLY)
         ERROR,3,(P<1)|(P>20)  'CONFIGURATION CONDITION NOT',;
                                    ' RECOGNIZED'
BR       SET      8,4,2,12,12,10,10,6,6,15,;
                  9,9,9,11,11,13,13,15,15,1
         GEN,1,7,4,3,17  AFA(1),X'69'-(P=10),BR(P),AF(2),WA(AF(1))
         PEND
*
*   :WD - THIS PROC GENERATES WD'S TO CONTROL THE INTERRUPT STATES
*
*      FORM: :WD,NONZERO-REG  KEYWORD
*            :WD,NONZERO-REG  KEYWORD,INT-GRP#
*            :WD,NONZERO-REG  KEYWORD,*INDX REG
*
*      KEYWORDS:  ACTIVATE - 1000
*                 DISARM - 1100
*                 ARM%ENABLE - 1200
*                 ARM%DISABLE - 1300
*                 ENABLE - 1400
*                 DISABLE - 1500
*                 ENABLE%DISABLE - 1600
*                 TRIGGER - 1700
*
:WD      CNAME
         PROC
         LOCAL    FC,IDX,GRP
FC       SET      SCOR(AF(1),ACTIVATE,DISARM,ARM%ENABLE,ARM%DISABLE,;
                  ENABLE,DISABLE,ENABLE%DISABLE,TRIGGER)-1
         ERROR,3,FC<0[AF(2)>X'F'     'ILLEGAL AF'
         DO       AFA(2)
GRP      SET      0
IDX      SET      AF(2)
         ELSE
GRP      SET      AF(2)
IDX      SET      0
         FIN
LF       WD,CF(2) 1**12+FC**8+GRP,IDX
         PEND
         FIN
         PAGE
         DO       ANSPROC
         OPEN     ZONE,DIGIT,S,I
SXP      FNAME                      ANS HASH FUNCTION
         PROC
ZONE     SET      0
DIGIT    SET      0
S        SET      S:UT(AF)
I        DO       6
ZONE     SET      (ZONE**2)|(+S(I)**-4&3)
DIGIT    SET      (DIGIT*10)+(+S(I)&X'F')
         FIN
         PEND     ZONE**20|DIGIT
         CLOSE    ZONE,DIGIT,S,I
         SPACE
***********************************
*    TEMPORARY ANS COMMANDS UNTIL THEY ARE REMOVED FROM ALL CODE
***************************************:
*
*
ANSB     CNAME
         PROC
LF       B        AF
         PEND
ANSNB    CNAME
ANSNOP   CNAME
         PROC
LF       NOP      AF
         PEND
ANSBAL   CNAME
         PROC
LF       BAL,CF(2) AF
         PEND
ERRABNCD COM,7,17,8 AF(2),,AF(1)
         SPACE    1
         OPEN     D,I,B
DAYS     CNAME    0,31,28,31,30,31,30,31,31,30,31,30
         PROC
B        SET      0
I        DO       NUM(NAME)
D(I)     SET      B+NAME(I)
B        SET      B+NAME(I)
         FIN
LF       DATA,2   0,D
         BOUND    4
         PEND
         CLOSE    D,I,B
         PAGE
NOTANS   EQU      1                 NOT ANS
NOTEXPR  EQU      2                 NOT EXPIRED
ANSVOL   EQU      3                 ANS VOLUME
*
F        EQU      1                 FIXED
D        EQU      2                 VARIABLE (DECIMAL)
V        EQU      3                 VARIABLE (BINARY)
U        EQU      4                 UNDEFINED
FSN      EQU      16                FILE SEQUENCE NUMBER
FMT      EQU      5                 RECORDING FORMAT
LRCSZ    EQU      18                LOGICAL RECORD LENGTH
ABCERR   EQU      0                 ABNORMAL BLOCK COUNT ERROR
SNFN     EQU      0                 SERIAL #/FILE NAME
BLKSZ    EQU      3                 BLOCK SIZE
BLKCNT   EQU      17                BLOCK COUNT
BACONCAT EQU      14*4              CONCATINATION
VERSION  EQU      X'2B'             VERSION (REAL CORE ADDRESS)
ANSFNMAX EQU      17                ANS FILE NAME MAXIMUM SIZE
ANSASN   EQU      X'A'              ANS DCB ASSIGN CODE
         FIN
         PAGE
         DO       MONPROC
*************************************
*        PROC DEFINITIONS           *
*************************************
CLEAR    CNAME
         PROC
LF       LI,8     0
         LI,10    0
         PEND
LIF      CNAME
         PROC
LF      LI,15 AF(1)
         PEND
         PAGE
*
*                 CFU DEFINITIONS SECTION.
*
NOU      EQU      0                 WD WITH NO. USERS
CFUPRIVBIT  EQU   X'10000'          PRIVATE FILE FLAG  MASK  (BIT 15)
*                                      (0=PUBLIC,  1=PRIVATE)
BAFUNM   EQU      2                 BYTE WITH FUNCTION
BASLIDES EQU      3                 BYTE WITH SLIDES
FDA      EQU      1                 FIRST DISC ADDRESS
CDAM     EQU      2                 CUR. DISC ADDR. MASTER INDEX
GAVAL    EQU      3                 GRANULE AVAIL(IN CYLINDER) - BYTE 0
*                                   CONTAINS NUMBER
CCBD     EQU      4                 CURRENT BUFFER DISP(AVAIL BYTE)
HACCBD   EQU      2*CCBD            HALF WORD
SCFU     EQU      4                 SECONDARY CFU (IF ALSO OPEN IN-OUT)
TDA      EQU      5                 TOP DISC ADDRESS (OF MULTI-LEVEL)
SREC     EQU      6                 GRANULE AVAILABLE FOR RECORDS.
FSP      EQU      7                 FREE SECTOR POOL (ACNCFU & FILCFU)
LDA      EQU      7                 LAST DISC ADDRESS OF MASTER INDEX (
*                                   BGRCFU ONLY)
ACNDISP  EQU      9                 ACCOUNT NUMBER POSITION
FILDISP  EQU      11                FILE NAME POSITION - WORD
BAFILDISP EQU     4*FILDISP         BYTE
FNEMAX   EQU      32                MAX FILE NAME LENGTH (BYTES)
WFNEMAX  EQU      (FNEMAX+3)/4      WORDS
ACNMAX   EQU      12
MAXACN   EQU      16
*
*                 BUFFER (BLOCKING AND INDEX) DEFINITIONS
*
XBUFSIZ  EQU      1024              HALF GRANULE FOR INDEX BLOCKS(BYTES)
WXBUFSIZ EQU      XBUFSIZ/4         WORDS
BUFSIZ   EQU      512*4             BYTES IN BLK BUFFER (ONE GRANULE)
*
*                 MASTER INDEX DEFINITIONS
*
BLINK    EQU      0                 BACK LINK
FLINK    EQU      1                 FOREWARD LINK
NAV      EQU      4                 NEXT AVAILABLE
NAVX     EQU      2                 WORD INDEX OF NAV
MIDIS    EQU      12                DISPLACEMENT TO FIRST KEY.
*
*                 PRIVATE VOLUME FD AND AD DISC ADR'S
*
DPADFDA  EQU      X'00010002'       FDA OF DISC PACK ACCOUNT DIRECTORY
DPFDFDA  EQU      X'00010004'       FDA OF DISC PACK FILE DIRECTORY
*
*                 AVRTBL  DEFINITIONS
*
BAAVRNOU EQU      5                 BYTE POSITION OF 'NO OF USERS' FIELD
*
*                 VOLUME  TABLE OF  CONTENTS  DEFINITIONS
*
VTOC:SNTD    EQU  3           WORD DISPLACEMENT TO VOL'S SERIAL NO TABLE
VTOC:MAPWL   EQU  4           WORD LENGTH OF VOLUME'S CYLINDER BIT MAP
VTOC:NVAT    EQU  5           NEXT VOLUME'S CYLINDER ZERO ALLOCATION TBL
VTOC:BITMAP  EQU  7           FWA OF VOLUME'S CYLINDER BIT MAP
*
*                 ALLOCATION TABLE DEFINITIONS (HGP)
*
AT:NVAT      EQU  5           NEXT VOLUME'S CYLINDER ZERO ALLOCATION TBL
ATPRIVBIT    EQU  X'4000'     PRIVATE DEVICE FLAG  (0=PUBLIC,1=PRIVATE)
ATCYLBIT     EQU  X'8000'     DEVICE ALLOCATED BY CYL/GRAN FLAG MASK
*                                (0=GRANULE, 1=CYLINDER)
BAATNGC  EQU      (1*4)+3           BYTE INDEX OF # GRAN/CYLINDER       DISCB
*                                                                       DISCB
         PAGE
*
*                 BUFFER DEFINITIONS
*
BUFF1    EQU      X'9400'
BUFF2    EQU      X'9600'
BUF1MSK  EQU      X'1F'
BUF2MSK  EQU      X'1F'**5
TOPMSK   EQU      X'1F'**10
*
*                 DCB DEFINITIONS
*
AGV      EQU      0
ASN      EQU      0
BTD      EQU      0
DIR      EQU      0
EGV      EQU      0
EOP      EQU      0
EXT      EQU      0
FCD      EQU      0
FCON     EQU      0
FRM      EQU      0
MBG      EQU      0
MOD      EQU      0
TTL      EQU      0
USR      EQU      0
VFC      EQU      0
WAT      EQU      0
NOSEP    EQU      0
CYL      EQU      0
NXTA     EQU      16
PCK      EQU      0
PRIV     EQU      0
TOF      EQU      0
SWXV     EQU      0                 SWITCH VOLUME  FLAG (BIT 16)
DSI      EQU      1
CFU      EQU      1
FUN      EQU      1
BUF      EQU      2
NRA      EQU      2
TYC      EQU      2
ERA      EQU      3
RSZ      EQU      3
ABA      EQU      4
ARS      EQU      4
ACS      EQU      5
ORG      EQU      5
FIL1     EQU      5
RAX      EQU      5
NLR      EQU      5
NWK      EQU      5
NXTF     EQU      5
ONWK     EQU      5
SEQ      EQU      5
RNDEV    EQU      5
TRN      EQU      5
FLP      EQU      6
BLK      EQU      6
QBUF     EQU      7
FCN      EQU      7
CDA      EQU      8
NVA      EQU      8
BUFX     EQU      9
CVI      EQU      9
CVO      EQU      9
VSND     EQU      9      WORD DISPLACEMENT TO PRIV VOL SET SERIAL NO TBL
VSETID   EQU      X'F'              VOLUME SET ID
VDCTX    EQU      10     DCT INDEX OF THE CURRENT PRIVATE VOLUME
KBUF     EQU      10
LVA      EQU      10
VNO      EQU      11                VOLUME NO OF CURRENT PRIVATE VOLUME
OVC      EQU      11                OPEN VOLUME COUNT
CIS      EQU      11
COS      EQU      11
FPARAM   EQU      11
CLK      EQU      12
KEYM     EQU      12
SND      EQU      12
ULB      EQU      12
RWS      EQU      13
CSC      EQU      14
TLB      EQU      14
IMT      EQU      14
BCDA     EQU      15
TAB1     EQU      15
TCFU     EQU      15
BFL      EQU      16
BBUD     EQU      16                BLOCKING  BUFFER (BUF1) UPDATED FLAG
MIUD     EQU      16                MASTER INDEX (BUF2) UPDATED FLAG
RNR      EQU      16
SCR      EQU      17
PAT      EQU      17     CURRENT PRIVATE VOLUME'S ALLOCATION TABLE ADR
KAD      EQU      18
CBD      EQU      18
DSC      EQU      19
HLC      EQU      19
SVA      EQU      19
WRDL0    EQU      19
CMD      EQU      20
PBD      EQU      20
CVA      EQU      20
FVA      EQU      20
HSC      EQU      20
RSTORE   EQU      20
SQS      EQU      20
ACD      EQU      21
FLD      EQU      21
RLIM     EQU      21
SID      EQU      21
DCBCDAM  EQU      21                CUR DA MASTER INDEX
*
BUF1     FNAME    9
BUF2     FNAME    16
         PROC
         ERROR,1  'BUF1/BUF2 NO LONGER VALID'
         PEND     NAME(1)
*
HWDSI    EQU      DSI*2+1
BADSI    EQU      (4*DSI)+3
BAORG    EQU      (4*ORG)+3
BAIMT    EQU      (4*IMT)
BACOS    EQU      4*COS
HAPBD    EQU      (2*PBD)+1
HAACD    EQU      (2*ACD)
HAFLD    EQU      (2*FLD)+1
HACMD    EQU      (2*CMD)
HASND    EQU      2*SND+1
BACSC    EQU      (4*CSC)
BASCR    EQU      (4*SCR)
BADSC    EQU      (4*DSC)
BAHSC    EQU      (4*HSC)
BAKEYM   EQU      (4*KEYM)
BALVA    EQU      (4*LVA)+1
BASVA    EQU      (4*SVA)+1
BAFCN    EQU      4*FCN
BANLR    EQU      1+4*NLR
BANRA    EQU      NRA*4
BARNDEV  EQU      4*RNDEV+2
BARAX    EQU      4*RAX+1
BACIS    EQU      4*CIS
BACVO    EQU      4*CVO
BACVI    EQU      4*CVI
BADEVTP  EQU      6
BAVNO    EQU      4*VNO             BYTE POSITION OF VNO
BAVDCTX  EQU      4*VDCTX           BYTE POSITION OF VDCTX
BAVSND   EQU      4*VSND            BYTE POSITION OF VSND
BAOVC    EQU      4*OVC+1           BYTE POSITION OF OVC (7 BIT FIELD)
RDL0     EQU      4*19
LSLIDES  EQU      4*19+1
LRDL0    EQU      4*19+2
BASPARE  EQU      4*19+3
DCBPRIVBIT   EQU  X'800'            MASK FOR DCB  PRIV FLAG  (BIT 20)
DCBSWXVBIT   EQU  X'8000'         MASK FOR DCB SWXV FLAG (BIT 16)
DCBNOSEPBIT  EQU  X'200'            MASK FOR DCB  NOSEP FLAG (BIT 22)
DCBCYLBIT  EQU    X'20000'          MASK FOR DCB CYL FLAG (BIT14)
*                                       0=DEBUG VERSION
*                                       1=SHORTENED OPERATING VERSION
*
*
         FIN
         PAGE
         PAGE                                                           DISCB
         DO       DISCBPROC>0                                           DISCB
*****************************************************************
*        THE FOLLOWING PROCS ARE USED FOR IMPLEMENTATION OF DISC B      DISCB
*                                                                       DISCB
********************************************************************    DISCB
*                                                                       DISCB
DCT%FLD  EQU      10,6              DEFINES START,LENGTH OF DCT INDEX
*
SECT%FLD EQU      8,2               DEFINES START,LENGTH OF HI BITS
*                                     OF RELATIVE SECTOR #              DISCB
*        THE ABOVE ARE ALSO DEFINED IN TABLES: IE CHANGE BOTH           DISCB
*                                                                       DISCB
*                                                                       DISCB
*                                   THE FOLLOWING PROC IS FOR INTERNAL LABELS
*                                                                       DISCB
LABEL%   CNAME                                                          DISCB
         PROC                                                           DISCB
         PEND                                                           DISCB
*                                                                       DISCB
R%LDCTX  SET      0                                                     DISCB
R%LSECTA SET      0                                                     DISCB
R%STDCTX SET      0                                                     DISCB
R%STSECTA SET     0                                                     DISCB
*                                                                       DISCB
DCT%SHIFT%AMT EQU 32-DCT%FLD(1)-DCT%FLD(2)                              DISCB
*                                                                       DISCB
*                                                                       DISCB
*                 THE FOLLOWING PROC WILL LOAD THE DCT INDEX            DISCB
*                 IT IS OF THE FORM:  LDCTX,R   |*~R |,I~               DISCB
*                                                                       DISCB
LDCTX    CNAME
         PROC                                                           DISCB
         ERROR,7,NUM(AF(2))~=0&(AF(2)>7|AF(2)<1) 'INVALID INDEX REG'    DISCB
LF       EQU      %                                                     DISCB
         DO          NUM(AF)=2                                          DISCB
         GEN,1,7,4,3,17 AFA,X'32',CF(2),AF(2),AF(1)                     DISCB
         SLS,CF(2)   -DCT%SHIFT%AMT                                     DISCB
         ELSE                                                           DISCB
         GEN,1,7,4,3,17 AFA,X'52',CF(2),0,AF(1)                         DISCB
         FIN                                                            DISCB
         CREF     DCT%MASK
         AND,CF(2)   DCT%MASK                                           DISCB
         PEND                                                           DISCB
*                                                                       DISCB
*                                                                       DISCB
*                 THE FOLLOWING PROC WILL STORE THE DCT INDEX.          DISCB
*                 EITHOR IN-LINE OR A CALL TO A SUBROUTINE WILL BE      DISCB
*                 GENERATED.  IT IS OF THE FORM:                        DISCB
*                                   STDCTX,R |,I~ |*~R |,I~             DISCB
*                 IF IT IS OF THE FORM STDCTX,3 SR1 THEN A SUBROUTINE   DISCB
*                   CALLING STORE%DCT WILL BE GENERATED.                DISCB
*                 IF CF(3) IS SPECIFIED IN WILL BE GENERATED INLINE.    DISCB
*                                                                       DISCB
         OPEN     NO%SUB,GENERATE%SUB,GENERATE%INLINE                   DISCB
STDCTX   CNAME
         PROC                                                           DISCB
         DO          SCOR(S,CF(3))                                      DISCB
         GOTO,CF(2)~=3|AFA=1     GENERATE%INLINE                        DISCB
         DO          SCOR(CDA,AF(1))                                    DISCB
NO%SUB   SET         AF(2)~=6                                           DISCB
         ELSE                                                           DISCB
NO%SUB   SET         NUM(AF)>1|AF(1)~=8                                 DISCB
         FIN                                                            DISCB
         ERROR,4,NO%SUB  'INVALID FORMAT FOR SUBROUTINE CALL'           DISCB
         GOTO,NO%SUB  GENERATE%INLINE                                   DISCB
GENERATE%SUB LABEL%                                                     DISCB
LF       EQU      %                                                     DISCB
         DO          SCOR(CDA,AF(1))                                    DISCB
         CREF     STORE%DCT%CDA
         BAL,0       STORE%DCT%CDA  BAL,R0  STORE%DCT%CDA               DISCB
         ELSE                                                           DISCB
         CREF     STORE%DCT%SR1
         BAL,0       STORE%DCT%SR1  BAL,R0  STORE%DCT%SR1               DISCB
         FIN                                                            DISCB
         ELSE                                                           DISCB
GENERATE%INLINE LABEL%                                                  DISCB
         ERROR,7,NUM(AF(2))~=0&(AF(2)>7|AF(2)<1) 'INVALID INDEX REG'    DISCB
LF       EQU      %                                                     DISCB
         GEN,1,7,4,3,17  AFA,X'46',CF(2),AF(2),AF(1)                    DISCB
         SCS,CF(2)   -DCT%SHIFT%AMT                                     DISCB
         CREF     INVERTED%DCT%MASK
         AND,CF(2)   INVERTED%DCT%MASK                                  DISCB
         GEN,1,7,4,3,17  AFA,X'49',CF(2),AF(2),AF(1)                    DISCB
         SCS,CF(2)   DCT%SHIFT%AMT                                      DISCB
         GEN,1,7,4,3,17  AFA,X'46',CF(2),AF(2),AF(1)                    DISCB
         FIN                                                            DISCB
         PEND                                                           DISCB
         CLOSE    NO%SUB,GENERATE%INLINE,GENERATE%SUB                   DISCB
*                                                                       DISCB
*                                                                       DISCB
*                 THE FOLLOWING PROC WILL CONVERT A SECTOR ADDRESS      DISCB
*                 IT IS OF THE FORM:                                    DISCB
*                                   LSECTA,ODD REG  REG                 DISCB
*                                                                       DISCB
         OPEN     SECTA%ERR,SECT%ERR%EXIT,GEN%INLINE                    DISCB
LSECTA   CNAME
         PROC                                                           DISCB
SECTA%ERR SET     (CF(2)&1)=0|NUM(AF)>1|AFA=1|AF(1)>15|CF(2)=AF(1)      DISCB
         ERROR,7,SECTA%ERR          'INVALID PROC USUAGE'               DISCB
         GOTO,SECTA%ERR             SECTA%ERR%EXIT                      DISCB
LF       EQU      %                                                     DISCB
         DO          SCOR(S,CF(3))                                      DISCB
SECTA%ERR  SET       CF(2)~=5|AF(1)~=12                                 DISCB
         ERROR,4,SECTA%ERR          'INVALID FORMAT FOR SUBROUTINE CALL'DISCB
         GOTO,SECTA%ERR GEN%INLINE                                      DISCB
         CREF     LOAD%SECTOR%ADDR
         BAL,0       LOAD%SECTOR%ADDR       BAL,R0 LOAD%SECTOR%ADDR     DISCB
         ELSE                                                           DISCB
GEN%INLINE LABEL%                                                       DISCB
         CREF     SECTOR%MASK
         LW,CF(2) AF(1)                                                 DISCB
         AND,CF(2)  SECTOR%MASK                                         DISCB
         MI,CF(2)  5**7                                                 DISCB
         SCS,CF(2)    2                                                 DISCB
         STH,AF(1)    CF(2)                                             DISCB
         SCS,CF(2)    16                                                DISCB
         FIN                                                            DISCB
SECTA%ERR%EXIT LABEL%                                                   DISCB
         PEND                                                           DISCB
         CLOSE       SECTA%ERR,SECTA%ERR%EXIT,GEN%INLINE                DISCB
*                                                                       DISCB
*                    THE FOLLOWING PROC WILL STORE A SECTOR ADDRESS     DISCB
*                                   IT IS OF THE FORM:                  DISCB
*                                    STSECTA,REG|,ODD REG~    REG       DISCB
*                                   CF(3) IS A WORK REG AND MUST BE ODD DISCB
*                                   IF IT IS NOW SPECIFIED 15 WILL BE SVED AND U
*                                                                       DISCB
*                                                                       DISCB
         OPEN        STSECTA%ERR,STSECTA%ERR%EXIT                       DISCB
         OPEN        NO%WORK%REG,WORK%REG                               DISCB
STSECTA  CNAME
         PROC                                                           DISCB
NO%WORK%REG SET      0                                                  DISCB
         DO          NUM(CF(3))                                         DISCB
STSECTA%ERR SET (CF(3)&1)=0|CF(2)=CF(3)|CF(3)=AF(1)
WORK%REG SET         CF(3)                                              DISCB
         ELSE                                                           DISCB
STSECTA%ERR SET  AF(1)=15|CF(2)=15                                      DISCB
WORK%REG SET         15                                                 DISCB
NO%WORK%REG SET      1                                                  DISCB
         FIN                                                            DISCB
STSECTA%ERR SET STSECTA%ERR|NUM(AF)>1                                   DISCB
         ERROR,7,STSECTA%ERR  'INVALID PROC FORMAT'                     DISCB
         GOTO,STSECTA%ERR           STSECTA%ERR%EXIT                    DISCB
LF       EQU      %                                                     DISCB
         DO       NO%WORK%REG
         CREF     TSTACK
         PSW,WORK%REG    TSTACK
         FIN
         LH,WORK%REG  CF(2)                                             DISCB
         MI,WORK%REG 5**5                                               DISCB
         CREF     SECTOR%MASK%1
         AND,WORK%REG SECTOR%MASK%1                                     DISCB
         STH,CF(2)   WORK%REG                                           DISCB
         SCS,WORK%REG 16                                                DISCB
         CREF     DCT%MASK%1
         AND,AF(1)   DCT%MASK%1                                         DISCB
         OR,AF(1)    WORK%REG                                           DISCB
         DO1         NO%WORK%REG                                        DISCB
         PLW,WORK%REG TSTACK                                            DISCB
STSECTA%ERR%EXIT LABEL%                                                 DISCB
         PEND                                                           DISCB
         CLOSE       STSECTA%ERR,STSECTA%ERR%EXIT                       DISCB
         CLOSE       WORK%REG,NO%WORK%REG                               DISCB
*                                                                       DISCB
         FIN                                                            DISCB
         PAGE
         DO       DCBPROC
*        SYSTEM   DCBS              JACK JACKSON/JOHN CATOZZI
*
IN       SET      1
OUT      SET      2
FILE     SET      (1,8),(2,2),(3,2),(4,2)
SFILE    SET      (1,3),(2,2),(3,2),(4,2)
RDWR     SET      (5,16),(6,16)
SN       SET      (7,3)
OSN      SET      (8,3)
SYN      SET      (X'B',8)
EX       SET      (X'14',16),(X'15',3)
*
M:C      CNAME    'C ',IN,120
M:OC     CNAME    'OC',IN+OUT,80
M:BI     CNAME    'BI',IN,120,FILE,SN
M:LI     CNAME    'LI',IN,120,FILE,SN
M:CI     CNAME    'CI',IN,120,FILE,SN
M:SI     CNAME    'SI',IN,80,FILE,SN
M:EI     CNAME    'EI',IN,120,FILE,SN,SYN,EX
M:BO     CNAME    'BO',OUT,120,FILE,RDWR,OSN
M:CO     CNAME    'CO',OUT,120,FILE,RDWR,OSN
M:SO     CNAME    'SO',OUT,80,FILE,RDWR,OSN
M:PO     CNAME    'PO',OUT,120,FILE
M:GO     CNAME    'GO',OUT,120,FILE
M:LO     CNAME    'LO',OUT,132,FILE,OSN
M:DO     CNAME    'DO',OUT,132,FILE,OSN
M:EO     CNAME    'EO',OUT,120,FILE,RDWR,OSN,SYN,EX
M:LL     CNAME    'LL',OUT,132,FILE,OSN
M:SL     CNAME    'SL',OUT,120,SFILE
M:AL     CNAME    'AL',OUT,120,SFILE
*
         PROC
         LOCAL    LL,I,J,LST,KBUF,NAM
NAM      SET      NAME              FORCE SUBSTITUTION FOR AP
         DATA     3                 DEVICE   (0)
         GEN,15,1,16 NAM(2),1,NAM(1)         (1)
         GEN,8,24  10,0             RETRIES  (2)
         GEN,15,17 NAM(3),0         RSZ      (3)
         DATA     0                          (4)
         GEN,1,23,4,4  1,0,1,1      SAV-SEQ-DIR (5)
         DO       NUM(NAM)>3
         DATA     %+16              FLP      (6)
         ELSE
         DATA     0                          (6)
         FIN
         DATA     0,0,0                   (7-9)
         DO       NUM(NAM)>3
         DATA     KBUF              KBUF   (10)
         ELSE
         DATA     0                        (10)
         FIN
         DO1      11
         DATA     0                     (11-21)
*
         DO       NUM(NAM)>3
I        DO       NUM(NAM)-3
J        SET      I+3
LST      SET      %
         GEN,8,16,8 NAM(J,1),0,NAM(J,2)
         DO1      NAM(J,2)
         DATA     0
         FIN
*
LL       SET      %
         ORG,1    BA(LST)+1
         DATA,1   1                 LST INDIC
         ORG      LL
KBUF     EQU      %
         RES      8
         FIN
         PEND
         FIN                        END DCBPROC
*
         CLOSE    CREF,S:S,BD,HD,HBIT
         END

