         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
         PAGE
SCREECH  CNAME    0
SUA      CNAME    1
DUMP     CNAME    2
         PROC
LF       DO1      TCOR(RCVPSD,S:FR)
         REF      RCVPSD
         XPSD,0   RCVPSD
         GEN,16,8,8  AF(1),NAME(1),AF(2)
         PEND
         DO       UTSPROC
         SYSTEM   SIG7FDP
         PAGE
*************************************
*        PROC DEFINITIONS           *
*************************************
*
*                 OVERLAY PROCS
*
         REF      T:OVERLAY,T:OVER,T:REMEMBER
OVERLAY  CNAME    1
OVERTO   CNAME    2
         PROC
LF       LI,2     AF(1)
         DO       NUM(AF)>1
         LI,0     AF(2)
         FIN
         DO       NAME=1
         BAL,11   T:OVERLAY
         ELSE
         B        T:OVER
         FIN
         PEND
REMEMBER CNAME
         PROC
         BAL,14   T:REMEMBER
         PEND
*
DESTRUCT CNAME
         PROC
LF       DO1      NUM(AF)>0
         LI,11    AF(1)
         B        T:SELFDESTRUCT
         PEND
*
         REF      T:SELFDESTRUCT
*                 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
LF       LI,AF(2) AF(1)
         MSP,AF(2)  TSTACK
         PEND
         REF      TSTACK
*
*                 PUSH OR PULL N WORDS SPECIFIED BY FIRST ARGUMENT INTO
*                 REGISTERS STARTING AT SECOND ARGUMENT.
*
*                 ACCEPTABLE FORMS ARE:
*                   PUSH R              PULL R
*                   PUSH 1,R            PULL 1,R
*                   PUSH N,R            PULL N,R 1<N<17
*
PUSH     CNAME    X'9',X'B'
PULL     CNAME    X'8',X'A'
         PROC
         DO       NUM(AF)=1
LF       GEN,1,7,4,3,17  0,NAME(1),AF(1),0,TSTACK
         ELSE
         DO       AF(1)=1
LF       GEN,1,7,4,3,17  0,NAME(1),AF(2),0,TSTACK
         ELSE
         DO       AF(1)=16
LF       LCI      0
         ELSE
LF       LCI      AF(1)
         FIN
         GEN,1,7,4,3,17  0,NAME(2),AF(2),0,TSTACK
         FIN
         FIN
         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
LF       STCF     TEMP
         PUSH     7,13
         LD,0     AF
         BAL,2    ENTSUB
         PEND
*
*                PROCS TO MAP AND UNMAP
*
         REF      MAP,UNMAP
MAP     CNAME
        PROC
LF       BAL,1    MAP
        PEND
UNMAP   CNAME
        PROC
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
         REF      T:SAVE
*                 PROCEDURE TO SVE CURRENT ENVIRONMENT
*                 ARG IS PSD
T:PUSHE  CNAME
         PROC
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
RTR      EQU      X'1'
BRK      EQU      X'2'
EC       EQU      X'4'
ABRT     EQU      X'8'
PPSWP    EQU      X'10'
ERR      EQU      X'20'
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'
         REF      X1,X2,X4,X8,X10,X20,X40,X80,X100
         REF      X400,X4000
         REF      BT31TO0,NB31TO0
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,M,S,R
         PROC
J        SET      SCOR(AF(1),RTR,BRK,EC,ABRT,PPSWP,ERR,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|NAME=3|NAME=6|NAME=7|NAME=10|NAME=11|NAME>13
         LH,G     UH:FLG,K
         FIN
         DO       NAME>3&NAME<8
         OR,G     BT31TO0+J
         FIN
         DO       NAME>11
         AND,G    NB31TO0+J
         FIN
         DO       NAME<4
         AI,G     AF(1)
         FIN
         DO       NAME>7&NAME<12
         AI,G     -AF(1)
         FIN
M        DO       NAME-(NAME/2*2)
         STH,G    UH:FLG,K
         FIN
         PEND
         CLOSE    J,K,G,M,S,R
         FIN
         PAGE
         DO       S69PROC
LOAD     CNAME    18
STORE    CNAME    21
MODTST   CNAME    19
COMPARE  CNAME    17
         PROC
         DO1      TCOR(S:FR,:BIG)
         REF      :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
         DO1      TCOR(S:FR,:BIG)
         REF      :BIG
LF       GEN,1,7,4,2,1,17  0,X'6F',CF(2),2,:BIG,AF(1)
         PEND
LRA      S:SIN,0  X'2C'             DEFINE LRA INST
RIO      COM,1,7,4,3,3,14    AFA(1),X'4F',CF(2),AF(2),X'1',AF(1)
POLP     COM,1,7,4,3,3,14    AFA(1),X'4F',CF(2),AF(2),X'2',AF(1)
POLR     COM,1,7,4,3,3,14    AFA(1),X'4F',CF(2),AF(2),X'3',AF(1)
*   PROC TO BUILD PSDS (2 OR 4 WORD)
:PSD     CNAME
         PROC
         LOCAL    :B9MA,:560MA,P
         DO1      TCOR(S:FR,:B9)
         REF      :B9,: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      :B9               SET FOR BIG9'S ONLY
: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
         DO1      TCOR(S:FR,CSED%PSD%IOFAIL)
         REF      CSED%PSD%IOFAIL
LF       LCI      0
:A       SET      %
         GEN,1,7,4,3,17  AFA,NAME,CF(2),AF(2),AF(1)
         BCR,2    %+2
         XPSD,10  CSED%PSD%IOFAIL
         PEND
*   THIS PROC IS FOR BRANCHING AROUND MACHINE DEPENDANT CODE
*
BIF      CNAME
         PROC
         DO1      TCOR(S:FR,CSED%MACHINE)
         REF      CSED%MACHINE      DEF'D IN M:CPU BY SYSGEN
         LOCAL    P,BR
LF       LC       CSED%MACHINE      PICK UP CC BITS
P        SET      SCOR(CF(2),S7,S9,X560,S7S9,S9S7,;
                  S7X560,X560S7,S9X560,X560S9,UNK)
         ERROR,3,(P<1)|(P>10)  'CONFIGURATION CONDITION NOT',;
                                    ' RECOGNIZED'
BR       SET      8,4,2,12,12,10,10,6,6,15
         GEN,1,7,4,3,17  AFA(1),X'69'-(P=10),BR(P),AF(2),WA(AF(1))
         PEND
         FIN
         PAGE
         DO       ANSPROC
         PCC      0
         OPEN     ZONE,DIGIT,S,I
SXP      FNAME                      ANS HASH FUNCTION
         PROC
ZONE,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
* COMPUTED SELECT FUNCTION
*
S:S      FNAME
         PROC
         PEND     AF(AF(1)+2)
         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
         LIST     0
B        SET      0
I        DO       NUM(NAME)
D(I),B   SET      B+NAME(I)
         FIN
         LIST     1
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
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)
ZERO     EQU      0
ONE      EQU      1
TWO      EQU      2
CP       EQU      5                 CARD PUNCH
PP       EQU      3
LP       EQU     6                 LINE PRINTER
DC       EQU      7                 RAD
MT       EQU     8
MTCODE   EQU      8
DP       EQU      X'B'              DISC PACK
CM       EQU      X'C'              MAGNETIC CARD MEMORY (CRAM)
KNEOD    EQU      4
*
DV       EQU      0                 PRIVATE VOLUME DEBUG VERSION FLAG
*                                       0=DEBUG VERSION
*                                       1=SHORTENED OPERATING VERSION
*
*
         FIN
         PAGE
         DO       DCBPROC
*
*        SYSTEM DCBS
*        3/23/70
*                                   PROGRAMMER LEE SCANTLIN
*
*
N        SET      8                 NAME
SN       SET      3                 SHORT NAME
A        SET      2                 ACCT
P        SET      2                 PASSWORD
E        SET      2                 EXPERATION DATE
R        SET      16                READ ACCTS
W        SET      16                WRITE ACCTS
I        SET      3                 INSNS
O        SET      3                 OUTSNS
S        SET      8                 SYNONYMOUS NAME
X        SET      16                EXECUTE ACCTS
V        SET      3                 EXECUTE VEHICLE
K        SET      8                 KEY BUFFER
IN       SET      1
OUT      SET      2
INO      SET      3
M:C      CNAME    0,0,0,0,0,0,0,0,0,0,0,0,'C ',0,0,IN,120
M:OC     CNAME    0,0,0,0,0,0,0,0,0,0,0,0,'OC',0,0,INO,80
M:BI     CNAME    N,A,P,E,0,0,I,0,0,0,0,K,'BI',0,0,IN,120
M:LI     CNAME    N,A,P,E,0,0,I,0,0,0,0,K,'LI',0,0,IN,120
M:CI     CNAME    N,A,P,E,0,0,I,0,0,0,0,K,'CI',0,0,IN,120
M:SI     CNAME    N,A,P,E,0,0,I,0,0,0,0,K,'SI',0,0,IN,80
M:EI     CNAME    N,A,P,E,0,0,I,0,0,0,S,K,'EI',X,V,IN,120
M:BO     CNAME    N,A,P,E,R,W,0,O,0,0,0,K,'BO',0,0,OUT,120
M:CO     CNAME    N,A,P,E,R,W,0,O,0,0,0,K,'CO',0,0,OUT,120
M:SO     CNAME    N,A,P,E,R,W,0,O,0,0,0,K,'SO',0,0,OUT,80
M:PO     CNAME    N,A,P,E,0,0,0,0,0,0,0,K,'PO',0,0,OUT,120
M:GO     CNAME    N,A,P,E,0,0,0,0,0,0,0,K,'GO',0,0,OUT,120
M:LO     CNAME    N,A,P,E,0,0,0,O,0,0,0,K,'LO',0,0,OUT,132
M:DO     CNAME    N,A,P,E,0,0,0,O,0,0,0,K,'DO',0,0,OUT,132
M:EO     CNAME    N,A,P,E,R,W,0,O,0,0,S,K,'EO',X,V,OUT,120
M:LL     CNAME    N,A,P,E,0,0,0,O,0,0,0,K,'LL',0,0,OUT,132
M:SL     CNAME    SN,A,P,E,0,0,0,0,0,0,0,K,'SL',0,0,OUT,120
M:AL     CNAME    SN,A,P,E,0,0,0,0,0,0,0,K,'AL',0,0,OUT,120
         PROC
SZ       SET      22                DEVICE SIZE
I        DO       12
         DO       NAME(I)~=0
SZ       SET      SZ+NAME(I)+1
         FIN
         FIN
         GEN,8,24 SZ,3              0
         GEN,15,1,16 NAME(16),1,NAME(13)   1 FUNCTION-OPLABEL
         GEN,8,24 3,0               2  RETRIES
         GEN,15,17  NAME(17),0      3  RECL
         DATA     0
         GEN,1,23,4,4 1,0,1,1       5  SAVE-SEQ-DIR
FLP      SET      %
         DATA     0                 6
         DO       3                 7-9
         DATA     0
         FIN
KBUF     SET      %
         DATA     0                 10
         DO       11
         DATA     0                 11-21
         FIN
         DO       NAME(1)~=0
L        SET      %
         ORG      FLP
         DATA     L
         ORG      L
         FIN
I        DO       15
         DO1      (I=12)|(I=13)
         GOTO     SKIP
         DO       NAME(I)~=0
         DATA,1   I
LST      SET      %
         DATA,1   0,0,NAME(I)
         DO       NAME(I)
         DATA     0
         FIN
         FIN
SKIP     FIN
         DO       NAME(1)~=0
L        SET      %
         ORG      LST
         DATA,1   1
         ORG      L
         FIN
         DO       NAME(12)~=0
L        SET      %
         ORG      KBUF
         DATA     L
         ORG      L
         RES      8
         FIN
         PEND
         FIN
         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
REFER%   FNAME                                                          DISCB
         PROC                                                           DISCB
AF(1)    SET      1                                                     DISCB
         PEND                                                           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    REFER%(R%LDCTX)                                       DISCB
         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
         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    REFER%(R%STDCTX)                                      DISCB
         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
         BAL,0       STORE%DCT%CDA  BAL,R0  STORE%DCT%CDA               DISCB
         ELSE                                                           DISCB
         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
         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    REFER%(R%LSECTA)                                      DISCB
         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
         BAL,0       LOAD%SECTOR%ADDR       BAL,R0 LOAD%SECTOR%ADDR     DISCB
         ELSE                                                           DISCB
GEN%INLINE LABEL%                                                       DISCB
         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    REFER%(R%STSECTA)                                     DISCB
         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(2)=AF(1)|CF(3)=AF(1)        DISCB
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
         DO1         NO%WORK%REG                                        DISCB
         PSW,WORK%REG TSTACK                                            DISCB
         LH,WORK%REG  CF(2)                                             DISCB
         MI,WORK%REG 5**5                                               DISCB
         AND,WORK%REG SECTOR%MASK%1                                     DISCB
         STH,CF(2)   WORK%REG                                           DISCB
         SCS,WORK%REG 16                                                DISCB
         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
*        THE FOLLOWING WILL GENERATE EXTERNAL REF'S                     DISCB
*                                                                       DISCB
*                                                                       DISCB
         DO1      R%LDCTX                                               DISCB
         REF      DCT%MASK                                              DISCB
*                                                                       DISCB
         DO       R%STSECTA                                             DISCB
         REF      SECTOR%MASK%1                                         DISCB
         REF      DCT%MASK%1                                            DISCB
         FIN                                                            DISCB
*                                                                       DISCB
         DO       R%LSECTA                                              DISCB
         DO1      DISCBPROC=1                                           DISCB
         REF      LOAD%SECTOR%ADDR                                      DISCB
         REF      SECTOR%MASK                                           DISCB
         FIN                                                            DISCB
*                                                                       DISCB
         DO       R%STDCTX                                              DISCB
         DO       DISCBPROC=1                                           DISCB
         REF      STORE%DCT%CDA                                         DISCB
         REF      STORE%DCT%SR1                                         DISCB
         FIN                                                            DISCB
         REF      INVERTED%DCT%MASK                                     DISCB
         FIN                                                            DISCB
*                                                                       DISCB
*                                                                       DISCB
         FIN                                                            DISCB
         END
