         TITLE    'DRSP - DYNAMIC REPLACEMENT OF SHARED PROCESSORS'
         PCC      0
INTEG    EQU      1
DEBUG    EQU      1
SR1      EQU      8
SR3      EQU      10
R0       EQU      0
R1       EQU      1
R2       EQU      2
R3       EQU      3
R4       EQU      4
R5       EQU      5
R6       EQU      6
R7       EQU      7
R8       EQU      8
R9       EQU      9
R10      EQU      10
R11      EQU      11
R12      EQU      12
R13      EQU      13
R14      EQU      14
R15      EQU      15
         SYSTEM   UTS
         SYSTEM   BPM
         DEF      DRSPMAIN
         DEF      DABEGIN,DOG
         DEF      XPATCH
*                                   MONITOR AND JIT REFS
         REF      P:NAME,PH:PDA,PB:LNK,PX:HPP,PX:TPP
         REF      PB:PSZ,PB:UC,PB:PVA,P:SA,P:AC,P:TCB,PH:DDA,PB:DSZ
         REF      PB:DCBSZ,PB:HVA,PBT:LOCK
         REF      PB:REP
         SREF     PB:C#,PB:DC#
         REF      NCYL,NSPT
         REF      CYL%SHFT,TRK%SHFT,SEC%SHFT
         REF      ROOTSA
         REF      MAXOVLY,PNAMEND,PPROCS
         REF      UH:FLG,MX:PPUT
         REF      UB:APR
         REF      J:ACCN,JB:PRIV
         REF      J:JIT
         REF      MB:GAM6,MB:GAM5,MB:GPT
         REF      S:CUN
         REF      S:SIP
         REF      SMUIS,M:FPPT,M:FPPC
         REF      GMB,RMB
         REF      MB:SDI
         REF      S:DP
         REF      DCT22
         REF      NSPC
         REF      DRSP
         REF      NEWQ
         REF      SYSMAK1
         REF      M:EI,M:BO
         REF      M:SI
         REF      M:C
M:SL     EQU      M:LL
*
         PAGE
BREAK    CNAME
         PROC
         MTW,0    BREAKWD
         BEZ      AF(2)
         LI,14    AF(1)
         STW,14   ERRFLAG
         BAL,15   FULLERR
         B        CLOSE
         PEND
         PAGE
M:MSG    DSECT    2
M:MSG    M:DCB    (FILE,'ERRMSG',':SYS'),(KEYED),(DIRECT),(IN),(SAVE),;
                  (ERR,BADERMSG),(ABN,BADERMSG)
         PAGE
         CSECT    0
*                                   DYNAMIC DATA
DABEGIN  EQU      %
MONPGS   RES      1
         BOUND    8
COMD     RES      2                 COMMAND
PRONAME  RES      4
FILE     RES      4                 FID NAME
ACCN     RES      2                 FID ACCT
PSWD     RES      2                 FID PASSWORD
SPSD     RES      2                 PROGRAM STATUS D.W. TO SET SLAVE
SPDSAVE  RES      2
KEY      RES      3
CFLAG    RES      1                 CODE FOR COMMAND
SADFPT   EQU      %
RPA      RES      1                 FPT FOR CHANGE VIRTUAL MAP
VA       RES      1
MADDR    RES      1                 BASE ADDRESS FOR REFERENCING MONITOR
PAGES    RES      1                 ADDRESS OF FIRST PAGE OBTAINED
OINDEX   RES      1                 INDEX FROM P:NAME TO PRONAME
NINDEX   RES      1                 INDEX FROM P:NAME TO AVAILABLE SLOT
NEWFLAGS RES      1                 PROCESSOR FLAGS
TEL:CCI  RES      1                 -1 IF TEL,1 IF CCI, 0 IF NEITHER
PFLAG    RES      1                 PERM FLAG. 0 IF NOT PERM
TYPE     RES      1                 -1 IF PROCESSOR, 1 IF MONITOR OVERLY
FFLAG    RES      1                 0 IF NO FLAGS IN COMMAND
MAXRCD   RES      1                 LONGEST RECORD IN FID (PAGES)
GRANEED  RES      1                 GRANULES NEEDED FOR FID
NOLAYS   RES      1                 NUMBER OF OVERLAYS
R0SAVE   RES      1
BREAKWD  RES      1
*                                   0 IF NO BREAK, -1 IF BREAK
ONLINE   RES      1
LCF      RES      1
ENDC     RES      1
OPENWAIT RES      1                 OPEN M:BO COUNTER.
BYTE     RES      1
SR1SR3PO RES      1
BDT      RES      1
ARS      RES      1
ERRFLAG  RES      1
ERRKEY   RES      1
XTRA     RES      1
BUF      EQU      %
ERRBUF   RES      20
CMDBUF   RES,1    80
CMDBUFSZ EQU      BA(%)-BA(CMDBUF)-1
         PAGE
*                                   ADDRESS TABLE
XP:NAME  RES      1
XPB:LNK  RES      1
XPX:HPP  RES      1
XPX:TPP  RES      1
XPB:PSZ  RES      1
XPB:UC   RES      1
XPB:PVA  RES      1
XPH:PDA  RES      1
XP:TCB   RES      1
XP:AC    RES      1
XP:SA    RES      1
XPH:DDA  RES      1
XPB:DSZ  RES      1
XPB:DCBSZ RES     1
XPB:HVA  RES      1
XPBT:LOCK   RES     1
XP:NAMEND RES    1
XPB:REP  RES      1
XMB:GAM6 RES      1
XMB:GAM5 RES      1
XMB:GPT  RES      1
XS:CUN   RES      1
XDRSP    RES      1
XS:SIP   RES      1
XUH:FLG  RES      1
XUB:APR    RES    1
XMX:PPUT RES      1
XM:FPPT  RES      1
XM:FPPC  RES      1
XMB:SDI  RES      1
XS:DP    RES      1
XDCT22   RES      1
XNSPC    RES      1
XPB:C#   RES      1
XPB:DC#  RES      1
XNCYL    RES      1
XNSPT    RES      1
XCYL%SHFT RES     1
XTRK%SHFT RES     1
XSEC%SHFT RES     1
         PAGE
SCRATCH  EQU      %
RETURN   RES      1
LOW      RES      1
HIGH     RES      1
XCOUNT   RES      1
TEMP     RES      1
RWRET    RES      1
FSTWDBUF RES      1
NGRAN    RES      1
GRAN1    RES      1
XNGRAN   RES      1
XGRAN1   RES      1
XPAGES   RES      1
MONBUF   RES      1
MODRET   RES      1
NINDEXR  RES      1
FC       RES      1
XMEM     RES      1
MIN      RES      1
MAYBE    RES      1
MAYBESLOTS RES    1
L500     RES      1                 LIST EXIT.
R502     RES      1                 RADNEED EXIT.
R503     RES      1                 CURRENT DATA SIZE IN PAGES.
R504     RES      1                 CURRENT PROC SIZE IN PAGES.
R505     RES      1                 CURRENT DCB  SIZE  IN PAGES.
R506     RES      1                 CURRENT NUMBER OF TREE WORDS.
R507     RES      1                 WORD DIFFERENCE, PAGE TO BEGIN ADDR.
R509     RES      1                 LOCATION FOLLOWING CAL1. (READ).
R510     RES      1                 ERROR CODE AND SUBCODE. (READ).
R511     RES      1                 (OPEN) LOCATION FOLLOWING CAL1.
R512     RES      1                 (OPEN) ERROR CODE AND SUBCODE.
EIPLIST  RES      1                 '14   DCB ADDR
         RES      1                 WD 1
         RES      1                 ERROR  ADDRESS
         RES      1                 ABNORMAL ADDRESS
         RES      1                 ORG
         RES      1                 ACC
         RES      1                 MODE
         RES      1                 SAVE
         RES      1                 KEY LENGTH
         RES      1                 CONTROL WORD
EIFILE   RES      4                 FILE NAME
         RES      1                 CONTROL WORD
EIACCN   RES      2                 ACCOUNT NUMBER.
         RES      1                 CONTROL WORD
EIPSWD   RES      2                 PASSWORD
S500     RES      1                 EXIT FOR SYNTAX (REG 15).
FFLAGS   RES      1                 0=NONE SET, NOT ZERO=FLAGS SET.
S507A    RES      1                 SEARCH: REG 6-WORKING
S508     RES      1                         REG 7-WORKING
S509     RES      1                         REG 8-TABLE BEGIN ADDRESS
S510     RES      1                         REG 9-TABLE END ADDRESS+1
S511     RES      1                         REG 10-ADDR OF 2-WORD FIELD.
S512     RES      1                         REG 11-EXIT
S513     RES      1                 TCTEST EXIT.
S514     RES      1                 XGRTEST EXIT.
T500     RES      1                 TELCCIONLY EXIT.
UAMESS   RES      1                 MESSAGE COUNT.
W500     RES      1                 BEGIN VIRTUAL ADDR FOR GET MAXRCD
W501     RES      1                 WRITESWAP EXIT.
W504     RES      1                 # PAGES AVAILABLE FROM GET-PAGES.
P500     RES      1                 PERM EXIT STORED.
BOPLIST  RES      1                 '14'  DCB ADDR
         RES      1                 WD 1
         RES      1                 ERROR ADDRESS
         RES      1                 ABNORMAL ADDRESS
         RES      1                 ORG
         RES      1                 ACC
BOMODE   RES      1                 MODE
         RES      1                 SAVE
         RES      1                 KEY LENGTH
         RES      1                 CONTROL WORD
BOFILE   RES      4                 FILE NAME
         RES      1                 CONTROL WORD
BOACCN   RES      2                 ACCOUNT NUMBER
         RES      1                 CONTROL WORD
BOPSWD   RES      2                 PASSWORD
SR1SAVE  RES      1                 LOCATION AND ERROR
SR3SAVE  RES      1                 .CODE ON I/O ERR/ABN EXIT.
LTYPE    RES      1                 -1 FOR LIST, 0 FOR LISTALL
LRANGE   RES      1
LFIRST   RES      1                 INITIAL INDEX TO LIST.
LLAST    RES      1                 LAST INDEX TO LIST.
LNAMES   RES      1                 0 FOR 'PRINT TABLE NAMES'. -1 FOR NO
LTITLE   RES      1                 -1 FOR P:NAME, +1 FOR 'PROCESSOR',
*                                   0 FOR NONE.
S400X    RES      1                 CONVERT INDEX TO HEX EXIT.
S430X    RES      1                 CONVERT CHR TO DIGIT EXIT.
S360X    RES      1                 CHECK FOR :PNN EXIT.
MAKERR   RES      1                 ERROR CODE FROM SYSMAK.
         BOUND    8
STACK    RES      2
         RES      X'30'
STKSIZE  EQU      %-STACK-2
CL500    RES      1                 CLEANUP EXIT
WAIT     RES      1                 WAIT FLAG: 0=NO WAIT. NON-ZERO=WAIT.
DAEND    EQU      %
         DATA     X'040172'         UPDATES DATE. 4/1/72
REGSMESS TEXT     '  SR1 = '
SR1TEXT  RES      2
         TEXT     '  SR3 = '
SR3TEXT  RES      2
EHH      TEXT     'EH @    '
EHHCNT   RES      1                 'EH' MESSAGE LENGTH =8 OR =3
BADKEY   TEXT  ' ERR MSG NOT FOUND. KEY =   '
NEEDS    TEXT     '  NEEDS XXXX GRANULES'
NNEEDS   EQU      BA(%)-BA(NEEDS)
         RES      2
         BOUND    4
G500     RES      1                 FILE ADDRESS SAVED
G501     RES      1                 ACCOUNT ADDRESS SAVED
G502     RES      1                 PSWD ADDRESS SAVED
G503     RES      1                 EXIT SAVED
G504     RES      4                 DUMMY SCAN FIELD
G505     RES      1                 WATCHOUT FLAG: SOME FIELD
*                                                  EXCEEDED MAXIMUM CHRS
G510     DATA     G504              R8= DESTINATION ADDRESS
G511     DATA     G514              R9= ADDRESS OF TERMINATORS
G512     DATA     G515              R10= LENGTH OF TERMINATOR TABLE
G513     DATA     8                 R11= MAXIMUM CHARACTERS
         BOUND    4
G514     DATA,1                     (DUMMY)
         DATA,1   ','               COMMA
         DATA,1   '='               EQUALS
         DATA,1   '.'               PERIOD
         DATA,1   '('               LEFT-PARENS
         DATA,1   ')'               RIGHT-PARENS
         DATA,1   '<'               LESS THAN
         DATA,1   '>'               GRTR THAN
         DATA,1   '#'               NUMBER
         DATA,1   '!'               BANG
         DATA,1   X'D'              EOI
         DATA,1   X'40'             SPACE
G515     EQU      BA(%)-BA(G514)-1  TABLE LENGTH
L502     TEXTC    '   XXXXXXXX #XX  XX USERS'
         BOUND    8
L503     TEXTC    'NXXXXXXX #XX GR=XXXX  X  USERS'
L503A    TEXT     '   #'
L503B    DATA     ' GR='
L520     TEXTC    ' XX'
         TEXT     'XX  '
L521     TEXT     'XXXX'
L522     TEXT     '  XX'
L528     TEXT     '  XX'
L529     TEXT     '  XX'
L530     TEXT     '  XX'
L525     TEXT     '  XX'
         TEXT     'XX  '
L527     TEXT     'XXXX'            DDA
L523     TEXT     '  XX'            DSZ
         TEXT     '    '
L524     TEXT     '  XX'            DCBSZ
L531     TEXT     '  XX'            HVA
         TEXT     '    '
L532     TEXT     'XXXXXXXX'        SA
BLANKS   TEXT     '    '
L510     TEXTC    '  H'
         TEXT     'PP  ',;
                  ' TPP',;
                  ' PSZ',;
                  '  UC',;
                  ' LNK',;
                  ' PVA',;
                  '   P',;
                  'DA  ',;
                  ' DDA',;
                  ' DSZ',;
                  '   DCBSZ',;
                  ' HVA',;
                  '    ',;
                  'SA  '
T501A    DATA     X'E3C5D315'
T501B    DATA     X'C3C3C915'
CL501    TEXTC    'OVLY LINK EXCEEDS TABLE LIMIT'
CL502    TEXTC    ' #   XX  XX USERS'
3PGERR   RES      1
         BOUND    8
MD500    TEXTC    'PRONAME REPLACED IN RAD SLOT # '
MD501    TEXT     'XX  '
         CSECT    0
XPATCH   RES      100
         PAGE
*                                   CONSTANTS
         CSECT    1
DOG      EQU      %
         BOUND    8
SPSDI    GEN,5,7,20   0,-1,0
         GEN,4,28     1,0
TXDRSP   TEXTC    'DRSP'
DUMLM    TEXTC    'M:DUMLM'
S700     TEXT     'LISTALL '
S702     TEXTC    'TEL'
SPACES   TEXT     '    '            SPACE-FILL WORD
S703     TEXTC    'CCI'
         TEXT     '    '
*        TABLE OF ILLEGAL PRONAME ENTRIES
         BOUND    8
S704     EQU      %
         DATA     X'06E7C4C5'       TEXTC 'XDELTA'
         DATA     X'D3E3C140'
S705     DATA     X'07D9C5C3'       TEXTC 'RECOVER'
         DATA     X'D6E5C5D9'
S706     DATA     X'06C7C8D6'       TEXTC 'GHOST1'
         DATA     X'E2E3F140'
S707     DATA     X'07D47AC4'       TEXTC 'M:DUMLM'
         DATA     X'E4D4D3D4'
S708     DATA     X'07C1D3D3'       TEXTC 'ALLOCAT'
         DATA     X'D6C3C1E3'
S709     EQU      %
S710     EQU      (S709-S704)**(-1)
TXHEAD   DATA,1   4,'H','E','A','D',0,0,0
TXTREE   DATA,1   4,'T','R','E','E',0,0,0
DRSPMESS TEXT     'DRSP INHIBIT SET'
HEX      TEXT     '0123456789ABCDEF'
Y0306    DATA     X'03060000'
STK2     GEN,1,15,1,15   1,STKSIZE,1,0
TEN      DATA     10
END      TEXT     'END'
DRSPHERE TEXT     'DRSP HERE'
REQS     TEXT     ' REQUIRES'
         BOUND    8
TXTGR    TEXT     'GRANULES'
         BOUND    4
DLMTS    DATA,1   0,' '
#DLMTS   EQU      BA(%)-BA(DLMTS)-1
         BOUND    4
*
ABNREAD  EQU      %
         LB,14    10
         CI,14    X'06'
         BE       ENDIT             END IF !EOD
         CI,14    X'07'
         BE       *8
         LI,14    X'1B'             IO ERR READING COMMAND
         BAL,15   POST
         B        RESTART
*
BREAKAD  EQU      %
         MTW,-1   BREAKWD
         CAL1,9   5
*
READCMD  GEN,8,7,17  X'10',,M:SI
         DATA     X'74000000'
         DATA     ABNREAD
         PZE      *1                BUFFER
         PZE      *12               SIZE
         PZE      *2                BTD
*
READCMD1 GEN,8,7,17  X'10',,M:C
         DATA     X'74000000'
         DATA     ABNREAD
         PZE      *1                BUFFER
         PZE      *12               SIZE
         PZE      *2                BTD
*
LISTCMD  GEN,8,7,17  X'11',,M:SL
         DATA     X'34000000'
         PZE      *1                BUFFER
         PZE      *12               SIZE
         PZE      *2                BTD
*
SETPC    GEN,8,16,8 X'2C',,'>'
SETBRK   GEN,8,7,17 X'0E',,BREAKAD
*
CMNDS    EQU      %
         DATA,1   0,'R','E','D','L'
         DATA,1   '?'
#CMNDS   EQU      BA(%)-BA(CMNDS)-1
SLV      LPSD,0   SPSD
Y07      DATA     X'07000000'
YFF8     DATA     X'FF800000'
X1FE00   DATA     X'1FE00'
XFFFF    DATA     X'FFFF'
Y00FF10  DATA     X'FF1000'
Y01      DATA     X'01000000'
M24      DATA     X'FFFFFF'
L501     TEXTC    'P:NAME TABLE'
L540     TEXTC    'PROCESSOR TABLES'
R500     GEN,1,7,7,17   0,X'14',0,M:EI    PLIST FOR M:EI.  WORD 0.
         DATA     X'C7480209'       WORD 1.
         DATA     R210              ERROR ADDRESS. (P1)
         DATA     R210              ABNORMAL ADDRESS. (P2)
         DATA     X'2'              ORG (P6)
         DATA     X'2'              ACC  (P7)
         DATA     X'1'              MODE (P8)
         DATA     X'2'              SAVE (P10)
         DATA     X'B'              KEY LENGTH (P13)
         DATA     X'01000404'       CONTROL WORD
         DATA     0,0,0,0           FILE NAME
         DATA     X'02000202'       CONTROL WORD
         DATA     0,0               ACCOUNT NUMBER
         DATA     X'03010202'       CONTROL WORD
         DATA     0,0               PASSWORD
R501     EQU      %                 END OF PLIST (M:EI)
R508     TEXTC    'TREE'
TCHEAD   TEXTC    'HEAD'
S502     TEXT     'PERM'
S503     TEXT     'WITH'
S504     TEXT     'FROM'
S506     DATA     X'00047AD7'       CONSTANT FOR C:PNN TEST.
EOI      DATA     X'D'
         BOUND    4                 SCAN, SCANT TERMINATORS.
S515     DATA,1                     (DUMMY)
         DATA,1   X'40'             SPACE
         DATA,1   X'D'              C/R = EOI
         DATA,1   '.'               PERIOD
         DATA,1   X'6B'             COMMA
         BOUND    4
S516     DATA,1                     (DUMMY)
         DATA,1   X'D'              C/R = EOI
         DATA,1   X'6B'             COMMA
         DATA,1   '.'               PERIOD
         DATA,1   X'40'             SPACE
         BOUND    4
S521     DATA     X'02000002'
S522     DATA     X'03010002'       PSWD CONTROL WORD IF NONE SPECIFIED.
S530     TEXTC    'WAIT OPTION IGNORED FOR MONITOR OVERLAYS'
P504     GEN,1,7,7,17  0,X'14',0,M:BO  PLIST FOR M:BO. WORD 0.
         DATA     X'C7480209'       WORD 1
         DATA     P220              ERROR ADDRESS (P1)
         DATA     P220              ABNORMAL ADDRESS (P2)
         DATA     X'2'              ORG (6)
         DATA     X'2'              ACC (P7)
         DATA     X'2'              MODE (P8)
         DATA     X'2'              SAVE (P10)
         DATA     X'B'              KEY LENGTH (P13)
         DATA     X'01000404'       CONTROL WORD
         DATA     0,0,0,0           FILE NAME
         DATA     X'02000202'       CONTROL WORD
         TEXT     ':SYS    '        ACCOUNT NUMBER
         DATA     X'03010002'       CONTROL WORD
         DATA     0,0               PASSWORD
P505     EQU      %                 END OF PLIST (M:BO)
STARLINE TEXT     '************'    COMMAND SEPARATOR LINE (BATCH ONLY)
P506     DATA     X'14020000'       FILE OPEN CODE
P507     DATA     X'FFFE0000'       ERR CODE MASK
         PAGE
ADLO     EQU      %
         DATA     P:NAME
         DATA     PB:LNK
         DATA     PX:HPP
         DATA     PX:TPP
         DATA     PB:PSZ
         DATA     PB:UC
         DATA     PB:PVA
         DATA     PH:PDA
         DATA     P:TCB
         DATA     P:AC
         DATA     P:SA
         DATA     PH:DDA
         DATA     PB:DSZ
         DATA     PB:DCBSZ
         DATA     PB:HVA
         DATA     PBT:LOCK
         DATA     P:NAME+PNAMEND+PNAMEND     =P:NAMEND
         DATA     PB:REP
NPTABS   EQU      %-ADLO
         DATA     MB:GAM6
         DATA     MB:GAM5
         DATA     MB:GPT
         DATA     S:CUN
         DATA     DRSP
         DATA     S:SIP
         DATA     UH:FLG
         DATA     UB:APR
         DATA     MX:PPUT
         DATA     M:FPPT
         DATA     M:FPPC
         DATA     MB:SDI
         DATA     S:DP
         DATA     DCT22
         DATA     NSPC
         DATA     PB:C#
         DATA     PB:DC#
         DATA     NCYL
         DATA     NSPT
         DATA     CYL%SHFT
         DATA     TRK%SHFT
         DATA     SEC%SHFT
ADHI     EQU      %
NAD      EQU      ADHI-ADLO
         PAGE
START    EQU      %
         LI,1     DAEND-DABEGIN     ZERO DATA AREA.
         LI,2     0
         STW,2    DABEGIN-1,1
         BDR,1    %-1
         LI,0     STACK+1           SET UP STACK POINTER DOUBLEWORD.
         LW,1     STK2
         STD,0    STACK
         LI,0     STACK             R0 POINTS TO STACK POINTER
         LW,1     J:JIT
         STW,1    ONLINE
         BLZ      TYHERE
         LI,1     CMDBUF            DO THE FIRST READ FROM THE C DEVICE
         LI,2     1                 TO GET RID OF
         LI,12    CMDBUFSZ          !DRSP CARD IN
         CAL1,1   READCMD1          BATCH MODE.
         B        PRIV
TYHERE   EQU      %
*                                   TYPE 'DRSP HERE' IF ON-LINE.
         LI,1     DRSPHERE          BUFFER
         LI,12    9                 BYTE COUNT
         LI,2     0                 BDT
         CAL1,1   LISTCMD
         CAL1,8   SETBRK
         CAL1,1   SETPC
PRIV     EQU      %
         LB,1     JB:PRIV
         CI,1     X'80'
         BGE      START1
         LI,14    X'17'             INSUF. PRIV. FOR DRSP
         STW,14   ERRFLAG
         BAL,15   FULLERR
         B        ABORT
START1   EQU      %
         BAL,15   INITIAL
RESTART  EQU      %
         LW,0     R0SAVE            RESTORE STACK
         LD,2     SPDSAVE
         STD,2    *0
         LW,1     XTRA              RESET ADDRESS OF NEXT VIRTUAL PAGE.
         STW,1    W500
         LI,1     0                 RESET BREAK FLAG
         STW,1    BREAKWD
         LI,1     8                 RESET 'EH' MESSAGE
         STW,1    EHHCNT            .LENGTH TO FULL (=8).
         MTW,0    J:JIT             PRINT
         BLZ      RESTART1          .COMMAND
         LI,1     STARLINE          ..SEPARATOR
         LI,12    12                ...LINE
         LI,2     0                 ....FOR BATCH
         CAL1,1   LISTCMD           .....ONLY.
RESTART1 EQU      %
         LI,1     CMDBUF            BUFFER ADDRESS
         LI,2     1                 BTD
           LI,12  CMDBUFSZ        SIZE
         CAL1,1   READCMD
         LW,6     M:SI+4            GET ARS
         SLS,6    -17
         CI,6     1                 START OVER IF ONLY ONE BYTE
         BE       RESTART
         STW,6    ARS
         LI,3     ' '               WAS THE LAST CHARACTER A TELETYPE
         CB,3     CMDBUF,6          TERMINATOR.
         BLE      %+2
         STB,3    CMDBUF,6         NO, STORE BLANK
         MTW,0    J:JIT
         BLZ      CMND
         CAL1,1   LISTCMD           LIST COMMAND IF BATCH
CMND     EQU      %
         LI,1     1
         STW,1    BYTE
         LI,8     COMD
         LI,9     DLMTS
         LI,10    0                 FIRST SCAN IS SPECIAL, #DEL=0
         LI,11    8                 MAX NO. OF CHARS.
         BAL,15   SCAN
         MTW,0    12
         BEZ      CMND1
ILLCMD   EQU      %
         LI,14    X'1A'             ILLEGAL COMMAND
         BAL,15   POST
         B        RESTART
CMND1    EQU      %
         LB,1     COMD
         LI,3     #CMNDS
         CB,1     CMNDS,3
         BE       CMDVCT
         BDR,3    %-2
         B        ILLCMD
CMDVCT   EQU      %
         AI,3     -3
         STW,3    CFLAG
         LB,1     COMD
         CI,1     '?'               IS IT A QUESTION.
         BNE      CMDVCT1
         BAL,15   FULLERR           YES, REPORT CURRENT ERROR.
         B        RESTART
CMDVCT1  EQU      %
         LI,9     0                 RESET ERRFLAG FOR PREVIOUS COMMAND
         STW,9    ERRFLAG
         CI,1     'L'               IS IT LIST
         BE       GO
         LW,1     COMD
         CW,1     END
         BE       ENDIT
         DO       INTEG=1
         LB,1     JB:PRIV
         CI,1     X'C0'
         BGE      PRIVOK
         LI,14    X'01'             INSUFFICIENT PRIVILEGE FOR THIS CMD.
         BAL,15   POST
         B        RESTART
PRIVOK   EQU      %
*                                   DISCONNECT DRSP FROM A NON-EXISTANT
*                                   USER. E.G. A USER HAS HUNG UP
*                                   WITHOUT LOGGING OFF
         LW,1     *XDRSP
         BEZ      PRIVOK1
         LI,10    TXDRSP            FIND DRSPIN TABLE
         LW,8     XP:NAME
         LW,9     XP:NAMEND
         BAL,11   SEARCH
         B        CRASH             HELP
         LI,2     0
         BAL,12   MASTER            IS THE USER OF DRSP
         WD,0     X'37'             ASSOCIATED WITH DRSP
         CB,10    *XUB:APR,1
         BE       %+2
         STW,2    *XDRSP            NO, RESET DRSPFLAG
         WD,0     X'27'
         BAL,12   SLAVE
PRIVOK1  EQU      %
*                                   SET DRSP FLAG TO INHIBIT OTHER
*                                   USERS FOR THE DURATION OF THIS COMD.
         LI,3     0
TESTDRSP BAL,12   MASTER
         WD,0     X'37'             *** INHIBIT INTERRUPTS ***
         LW,1     *XDRSP
         BEZ      SETDRSP
         WD,0     X'27'             *** ENABLE INTERRUPTS ***
         BAL,12   SLAVE
         CW,1     *XS:CUN
         BE       GO                BRANCH IF ALREADY SET.
         MTW,0    3
         BNEZ     NOMESS
         LI,1     DRSPMESS
         LI,12    16
         LI,2     0
         CAL1,1   LISTCMD           TYPE  'DRSP INHIBIT SET'
         MTW,1    3                 SET MESSAGE INHIBIT FLAG.
NOMESS   MTW,0    J:JIT
         BLZ      RESTART
*                                   DRSP IS SET TO ANOTHER USER AND THIS
*                                   IS A BATCH JOB. WAIT UNTIL DRSP IS
*                                   AVAILABLE OR JOB TIMEOUT.
         M:WAIT   4
         B        TESTDRSP
SETDRSP  EQU      %
         LW,1     *XS:CUN
         STW,1    *XDRSP            STORE USER NUMBER IN DRSP
         WD,0     X'27'
         BAL,12   SLAVE             *** ENABLE INTERRUPTS ***
         FIN
GO       EQU      %
         B        DRSPMAIN
ENDIT    EQU      %
         BAL,15   RESET
         M:EXIT
ABORT    EQU      %
         BAL,15   RESET
         M:ERR
RESET    EQU      %
         DO       INTEG=1
         LW,1     *XS:CUN           RESET DRSP FLAG IF SET TO CURRENT
         CW,1     *XDRSP            USER.
         BNE      *15
         LI,1     0
         STW,1    *XDRSP
         FIN
         B        *15
CRASH    EQU      %
         LI,14    3
         STW,14   ERRFLAG
         BAL,15   FULLERR
         B        RESTART
         PAGE
*                                   DRSPMAIN SERVES AS A DRIVER FOR THE
*                                   MAJOR SECTIONS
DRSPMAIN EQU      %
         BAL,15   SYNTAX
         LB,1     COMD
         CI,1     'L'
         BNE      NOTLIST           BRANCH IF NOT 'LIST'
         BAL,15   LIST
         B        CLOSE
NOTLIST  EQU      %
         LB,1     COMD
         CI,1     'D'
         BE       PRM               BRANCH IF 'DELETE'
         BAL,15   RADNEED
         BAL,15   GETRADSLOT
         BAL,15   TELCCIONLY
         BAL,15   WRITESWAP
PRM      EQU      %
         BAL,15   PERM
         BAL,15   SWITCH
CLOSE    EQU      %
         BAL,15   CLOSEOUT
EXITDRSP EQU      %
         B        RESTART
ERREXIT  EQU      %
         B        CLOSE
         PAGE
*                                   MASTER AND SLAVE ROUTINES
*                                     BAL,12  MASTER
*                                     BAL,12  SLAVE
*
*                                   SET MASTER MODE AND RETURN
MASTER   EQU      %
         LCI      15                SAVE
         PSM,1    *0                .REGISTERS.
         M:SYS
         BCR,8    MASTER1
         LCI      15                RESTORE
         PLM,1    *0                .REGISTERS
         LI,14    3                 PRIVILEGE LEVEL HAS DROPPED.THIS IS
         BAL,15   POST              IMPOSSIBLE.
         B        ERREXIT
MASTER1  EQU      %
         LCI      15                RESTORE
         PLM,1    *0                .REGISTERS
         B        *12               EXIT.
SLAVE    EQU      %
         PSW,13   *0                SAVE REGISTER.
         LI,13    X'1FFFF'          SET UP
         STS,12   SPSD              .RETURN ADDRESS.
         PLW,13   *0                RESTORE REGISTER.
         EXU      SLV               EXECUTE LPSD TO SET SLAVE MODE
         PAGE
*        POST ERROR ROUTINE FOR I/O ERR/ABN BRANCHES
POST1    EQU      %
         STW,15   SR1SR3PO          STORE EXIT, SET FLAG
         PSW,15   *0
         BAL,15   POST              POST ERROR CODE.
         PLW,15   *0
         B        *15               EXIT
         PAGE
*                                   POST STORES ERROR NUMBER FOR FUTURE
*                                   REFERENCE AND TYPES EH @ N WHERE
*                                   N = CURRENT BYTE POSITION IN COMMAND
*                                           R14 = ERROR NUMBER
*                                           BAL,15   POST
POST     EQU      %
         STW,14   ERRFLAG
         STW,SR1  SR1SAVE           SAVE LOCATION AND ERROR CODE
         STW,SR3  SR3SAVE           .FOR POSSIBLE I/O ERROR EXIT
         MTW,0    J:JIT
         BGEZ     FULLERR           PRINT ERROR IF BATCH.
         LCI      0
         PSM,0    *0
         LW,4     BYTE
         BAL,15   HEX2PRNT          CONVERT TO BCD
*                                   SUPPRESS LEADING BLANKS.
         LI,1     -4
         LI,2     X'40'
LEAD     EQU      %
         LB,3     12,1              GET NEXT BYTE.
         CI,3     X'F0'
         BNE      LEAD1             DONE IF NOT ZERO.
         STB,2    12,1              STORE BLANK.
         BIR,1    LEAD
LEAD1    EQU      %
         STW,11   EHH+1             STORE IN EH FIELD
         LI,1     EHH
         LW,12    EHHCNT            PICK UP VAR. MESSAGE LENGTH.
         LI,2     0
         CAL1,1   LISTCMD           LIST  EH @ N
         LCI      0
         PLM,0    *0
         B        *15
         PAGE
*                                   FULLERR LISTS THE MOST RECENT ERROR
*                                   AS A RESPONSE TO QUESTION MARK
*                                   OR ERROR IF BATCH
*                                    BAL,15  FULLERR
FULLERR  EQU      %
         LCI      0
         PSM,0    *0
         LW,1     ERRFLAG           FORM KEY
         OR,1     Y0306
         STW,1    ERRKEY
         M:READ   M:MSG,(BUF,ERRBUF),(SIZE,80),(ABN,BADERMSG),;
                        (ERR,BADERMSG),(KEY,ERRKEY),;
                      (BTD,1)
         LW,1     M:MSG+4           GET ARS OF EROR RECORD
         SLS,1    -17
         LI,2     X'40'
         STB,2    ERRBUF,1
         STB,2    ERRBUF
         LW,12    1
         LI,2     0
         LI,1     ERRBUF
LISTERR  CAL1,1   LISTCMD
         MTW,0    SR1SR3PO          ARE REGISTERS TO
         BNEZ     REGSTOO           .BE PRINTED. -YES.
FULLEXIT EQU      %                 -NO.
         LCI      0
         PLM,0    *0
         B        *15
BADERMSG EQU      %
         LW,4     ERRKEY
         BAL,15   HEX2PRNT
         STW,10   BADKEY+7
         STW,11   BADKEY+8
         LI,1     BADKEY
         LI,2     0
         LI,12    9*4
         B        LISTERR
REGSTOO  EQU      %
         LW,13    SR1SAVE           CONVERT
         LI,14    SR1TEXT           .SR1 TO
         BAL,15   L400              ..EBCDIC.
         LW,13    SR3SAVE           CONVERT
         LI,14    SR3TEXT           .SR3 TO
         BAL,15   L400              ..EBCDIC.
         LI,12    32                PRINT
         LI,2     0                 .CONTENTS
         LI,1     REGSMESS          ..OF REGISTERS
         CAL1,1   LISTCMD           ...SR1 AND SR3.
         LI,1     0                 RESET REGISTER
         STW,1    SR1SR3PO          .PRINTOUT FLAG.
         B        FULLEXIT
         PAGE
*                                        BAL,15  HEX2PRNT
*                                   INPUT:  R4 = NUMBER TO BE CONVERTED
*                                   OUTPUT  R10,R11 = RESULTS
*
HEX2PRNT EQU      %
         LI,1     8
         LI,3     0
HEX1     EQU      %
         LI,5     0
         SCD,4    4
         LB,5     HEX,5
         STB,5    10,3
         AI,3     1
         BDR,1    HEX1
         B        *15
         PAGE
INITIAL  EQU      %
         STW,15   RETURN
*                                   SAVE TEMP STACK DOUBLE-WORD.
         STW,0    R0SAVE
         LD,2     *0
         STD,2    SPDSAVE
*                                   INITIALIZE
         DO       INTEG=1
         LD,2     SPSDI
         STD,2    SPSD
         LW,2     Y07
         STW,2    SADFPT            SADCAL FPT
*                                   CHANGE VIRTUAL MAP IN ORDER TO
*                                   ACCESS MONITOR
         LI,3     -NAD              SET UP TABLE LENGTH
         LI,2     -1                .AND HIGH ADDRESS.
VMEM1    EQU      %
         LW,4     ADLO+NAD,3        SELECT
         CW,4     2                 .HIGHEST
         BL       VMEM2             ..MONITOR
         STW,4    2                 ...ADDRESS
VMEM2    EQU      %
         BIR,3    VMEM1             ....ACCESSED.
         AI,2     X'200'            CALCULATE
         SLS,2    -9                .NUMBER
         STW,2    MONPGS            ..OF PAGES.
         STW,2    XCOUNT            SAVE COUNT OF PAGES.
         M:GP     *MONPGS           GET PAGES.
         BCR,8    NUFF
         LI,14    X'15'             NOT ENOUGH VIRTUAL MEMORY TO
         STW,14   ERRFLAG           .EXECUTE DRSP.
         BAL,15   FULLERR           PRINT MESSAGE.
         M:EXIT
NUFF     EQU      %
         STW,9    VA
         STW,9    MADDR             SAVE ADRS FOR RELATIVE ADDRESS BASE,
         M:FP     *MONPGS           FREE ALL PAGES.
SAD      EQU      %
         CAL1,8   SADFPT
         LI,1     512
         AWM,1    RPA               UPDATE SADCAL'S FPT.
         AWM,1    VA
         MTW,-1   XCOUNT
         BGZ      SAD
*                                   SAVE NEXT AVAILABLE VIRTUAL PAGE
         LW,1     MONPGS
         SLS,1    9
         AW,1     MADDR
         STW,1    PAGES
         ELSE
         M:GP     1
         STW,9    PAGES
         M:FP     1
         FIN
*                                   COMPUTE ADDRESSES
         LI,1     -NAD
ADRSES   EQU      %
         LW,2     MADDR
         AW,2     ADLO+NAD,1
         STW,2    XP:NAME+NAD,1
         BIR,1    ADRSES
*
*                                   GET TWO PAGES (FOR SUBSEQUENT
*                                   READING OF TREE)
         LI,1     0                 PRESET 2 PAGE ERROR
         STW,1    3PGERR            .FLAG TO ZERO
         LW,1     PAGES
         LI,2     -3
GET      M:GVP    *1
         BCR,8    GOT
         LI,14    2
         STW,14   3PGERR            ERROR: INSUFFICIENT MEMORY
         B        NOGOT             .      TO READ TREE.
*                                   ..SET ERROR FLAG FOR TEST
*                                   ..LATER IN RADNEED
         B        CLOSE
GOT      EQU      %
         AI,1     512
         BIR,2    GET
NOGOT    EQU      %
         STW,1    XTRA
         STW,1    W500              STORE NEXT VIRTUAL ADDR FOR MAXRCD.
         B        *RETURN
         PAGE
*                                   CONVERT DISC ADDRESS TO GRANULE
*                                     INPUT=R8= DISC ADDRESS
*                                     OUTPUT=R9= GRANULE
DAGRAN   EQU      %
         LH,8     *13,1             GET DDA OR PDA
         CI,7     MAXOVLY           IS IT PDA
         BL       DG1               YES
         LW,14    *XS:DP            PACK SWAPPER
         BEZ      %+3               NO
         LB,14    *XPB:DC#,1        YES, GET DATA CYL
         STH,14   8                 BUILD SEEK ADR
         CI,8     0                 DATA DA EXISTS
         BNE      DG2               YES
         LH,8     *XPH:PDA,1        NO,GET PROCEDURE DA
DG1      EQU      %
         LW,14    *XS:DP            PACK SWAPPER
         BEZ      DG2               NO
         LB,14    *XPB:C#,1         YES, GET CYL
         STH,14   8                 BUILD SEEK ADR
DG2      EQU      %
         LB,14    *XMB:SDI
         STB,14   8
         BAL,11   SEEKCVT           CONVERT SEEK TO REL SECT
         SLS,8    -1                REL GRAN
         B        *15
         PAGE
*        GETSLOTRAD FIND A NEW SLOT, COMPUTES THE RAD SPACE ASSOCIATED
*        WITH IT AND COMPARES RAD AVAILABLE WITH RAD NEEDED. POST ERROR
*        IF INSUFFICIENT.
GETRADSLOT   EQU    %
         STW,15   RETURN
         BAL,11   FINDSLOT
         B        *RETURN
         PAGE
*                                   FINDGRAN COMPUTES THE RAD GRANULES
*                                   ASSOCIATED WITH A SLOT.
*                                           BAL,15  FINDGRAN
*                                           INPUT:  R6 = ADDRESS OF P:NAME
*                                                   R7 = SLOT NUMBER
*                                           OUTPUT  R8 = # OF GRANULES.
FINDGRAN EQU      %
         LCI      0
         PSM,0    *0
*                                   COMPUTE TABLE ADDRESS INTO R13.
*                                   USE PH:PDA IF MON. OVERLAY.
*                                   USE PH:DDA IF PROCESSOR.
         CI,7     MAXOVLY
         BL       GETPDA
         LI,13    PH:DDA            ITS A PROCESSOR
         B        %+2
GETPDA   EQU      %
         LI,13    PH:PDA            ITS MON. OVERLAY
         AI,13    -P:NAME
         AW,13    6
*                                   COMPUTE INDEX OF 'NEXT' SLOT
*                                   FOR HIGH DISC ADDRESS.
*                                   USE SLOT 0 IF INPUT INDEX IS LAST
*                                   PROC. OR LAST MON. OVERLAY
*
         LW,1     7
         CI,7     MAXOVLY
         BL       FMON
         AI,1     1                 SET GRTR TO SLOT+1
         CI,7     PNAMEND-1
         BE       ITSLAST
         BG       FERR              CANT BE GREATER
         B        GETGRAN
FMON     EQU      %
         AI,1     -1                SET GRTR TO SLOT-1
         CI,7     0
         BG       GETGRAN
         B        FERR
ITSLAST  EQU      %
         LI,1     0
GETGRAN  EQU      %
         LW,9     1                 SAVE R1
         LW,1     7
         BAL,15   DAGRAN            GET LOW DISK ADR
         STW,8    LOW
         LW,1     9                 RESTORE R1
         BAL,15   DAGRAN            GET HIGH DISK ADR
         SW,8     LOW               COMPUTE DIFFERENCE
         STW,8    HIGH              # OF GRANULES FOR SLOT
         LCI      0
         PLM,0    *0
         LW,8     HIGH
         B        *15
FERR     EQU      %
         LCI      0                 RESTORE
         PLM,0    *0                .REGISTERS.
         LI,14    3
         BAL,15   POST
         B        CLOSE
         PAGE
*                                   FINDSLOT LOCATES A DUMMY SLOT IN
*                                   THE APPROPRIATE PART OF THE P:NAME
*                                   TABLE.
*                                   THE DUMMY SLOT WITH THE LEAST NUMBER
*                                   OF GRANULES NECESSARY IS CHOSEN. IF
*                                   WAIT HAD BEEN SPECIFIED, AND A
*                                   DUMMY SLOT WAS NOT FOUND, CLEANUP
*                                   IS PERFORMED, AND THE SCAN IS REPEATED
*                                        BAL,11 FINDSLOT
FINDSLOT  EQU     %
         STW,11   TEMP
FS10     EQU      %
         BREAK    X'54',FS20
FS20     EQU      %
         BAL,11   CLEANUP           RELEASE PROCESSOR SLOTS, IF POSSIBLE
         LI,11    0
         STW,11   NINDEX
         LI,11    X'7FFFF'          LARGE POSITIVE NUMBER
         STW,11   MIN               TO PRESET MIN.
*                                   SET UP SEARCH BOUNDS PER TYPE.
         MTW,0    TYPE
         BLZ      FS25
         LI,7     1                 BOUNDS FOR MONITOR OVERLAY.
         LI,13    MAXOVLY
         B        FSSCAN
FS25     EQU      %
         LI,7     MAXOVLY           BOUNDS FOR PROCESSOR.
         LI,13    PNAMEND
FSSCAN   EQU      %
         LD,2     DUMLM
FSCONTU  EQU      %
         CD,2     *XP:NAME,7
         BNE      FSNXT
         LW,6     XP:NAME
         BAL,15   FINDGRAN          COMPUTE GRANULES ASSOCIATED
         CW,8     GRANEED           ENOUGH
         BL       FSNXT             BRANCH IF NOT ENOUGH
         CW,8     MIN
         BG       FSNXT
         STW,7    NINDEX
         STW,8    MIN
FSNXT    EQU      %                 GET NEXT SLOT
         MTW,1    7
         CW,7     13
         BL       FSCONTU
         MTW,0    NINDEX            DID WE GET A SLOT
         BGZ      FSGOTSLOT
         MTW,0    WAIT              NO, DO IT AGAIN IF WAIT SPECIFIED.
         BEZ      NODUM
         BAL,15   WORTH
         MTW,0    MAYBE             NO MORE SLOTS. IS IT WORTHWHILE TO
         BGZ      FS10              WAIT. BRANCH IF YES.
NODUM    EQU      %
         LI,14    X'11'
         BAL,15   POST              NO SLOTS AVAILABLE WITH SUFFICIENT
*                                   RAD.
*                                   MESSAGE: FID REQUIRES -- GRANULES.
FIDREQ   EQU      %
         LB,1     FILE              SPACE-FILL
         SLS,1    -2                .LAST WORD
         LW,2     SPACES            ..OF FID
         STW,2    ERRBUF,1          ...FIELD.
         LB,1     FILE              MOVE FID TO MESSAGE BUFFER.
         LB,2     FILE,1
         STB,2    ERRBUF,1
         BDR,1    %-2
         LW,4     GRANEED
         BAL,15   HEX2PRNT
         STW,11   NEEDS+2
         LB,1     FILE
         AI,1     4
         SLS,1    -2
         LCI      6                 MOVE MESSAGE TO BUFFER.
         LM,2     NEEDS
         STM,2    ERRBUF,1
         LB,12    FILE
         AI,12    NNEEDS
         LI,1     ERRBUF            BUFFER
         LI,2     1                 BTD
         CAL1,1   LISTCMD
         B        CLOSE             EXIT
FSGOTSLOT EQU     %
         MTW,0    TYPE
         BGZ      *TEMP             ALL DONE IF MONITOR OVERLAY
*
*
*                                   IF THE PROCESSOR IS OVERLAID, SEE
*                                   IF THERE ARE OVERLAY
*                                   SLOTS AVAILABLE.
         MTW,0    NOLAYS
         BEZ      *TEMP             RETURN IF NOT OVERLAID
*
         LI,10    0
         LI,11    0
         LI,9     0
         LI,2     PPROCS
         AI,2     -PNAMEND          NUMBER OF SLOTS TO LOOK AT.
         LW,8     XP:NAME           COMPUTE ADDRESS OF FIRST OVERLAY
         AI,8     PNAMEND           SLOT.
         AI,8     PNAMEND
         AI,8     -2                -2 FOR D.W. BDR LOOP
FS30     EQU      %
         CD,10    *8,2
         BNE      %+2
         AI,9     1                 FOUND AN EMPTY (ZERO) SLOT.
         BDR,2    FS30
         CW,9     NOLAYS            ARE THERE ENOUGH.
         BGE      *TEMP             YES, EXIT
         MTW,0    WAIT
         BEZ      NOOV
         BAL,15   WORTH
         AW,9     MAYBESLOTS        WOULD ENOUGH BECOME AVAILABLE IF
         CW,9     NOLAYS            WE WAIT.
         BLE      FS10              BRANCH IF YES.
*
NOOV     LI,14    X'12'             NOT ENOUGH
         BAL,15   POST              OVERLAY SLOTS.
         B        CLOSE
         PAGE
*                                   CHECK IF SLOTS CAN BECOME AVAILABLE
*                                   DURING THIS SESSION.
WORTH    EQU      %
         PSW,9    *0
         LI,1     0
         STW,1    MAYBE
         STW,1    MAYBESLOTS
         MTW,0    TYPE
         BGZ      CHANCE1
         LI,7     MAXOVLY           SET PROCESSOR BOUNDS
         LI,14    PNAMEND
         B        CHANCE2
CHANCE1  EQU      %
         LI,7     1                 SET MON. OVLY BOUNDS
         LI,14    MAXOVLY
CHANCE2  EQU      %
         LD,2     *XP:NAME,7        IS THIS SLOT IN THE PROCESS
         CW,2     7                 OF BEING RELEASED.
         BNE      CHANCE5
         MTW,0    NOLAYS            YES. WILL THE NEW ITEM REQUIRE
         BEZ      CHANCE4           OVERLAY SLOTS.
         LW,1     7                 YES. COMPUTE NO. SLOTS FREED
CHANCE3  EQU      %
         LB,1     *XPB:LNK,1
         BEZ      CHANCE4
         MTW,1    MAYBESLOTS
         B        CHANCE3
CHANCE4  EQU      %
         LW,6     XP:NAME
         BAL,15   FINDGRAN
         CW,8     GRANEED           WOULD THIS SLOT PROVIDE ENOUGH
         BL       CHANCE5           GRANULES
         MTW,1    MAYBE             YES. SET FLAG
CHANCE5  EQU      %
         AI,7     1
         CW,7     14
         BL       CHANCE2
         PLW,9    *0
         B        *15
         PAGE
*                                   SWITCH PUTS THE PRONAME INTO THE
*                                   NEW SLOT AND DISABLES THE OLD SLOT
*                                   FOR SUBSEQUENT USERS BY INSERTING
*                                            BAL,15   SWITCH
SWITCH   EQU      %
         STW,15   RETURN
         LB,1     COMD
         CI,1     'R'
         BE       SW60              BRANCH IF REPLACE
         CI,1     'E'
         BE       SW70              BRANCH IF ENTOR
         LW,2     OINDEX            IT IS DELETE
         LW,3     OINDEX
SW10     STD,2    *XP:NAME,2        ZAP PRONAME WITH OLD INDEX
         B        SW80
SW70     EQU      %
         LD,2     PRONAME           ITS ENTER.
         LW,4     NINDEX            STORE PRONAME
         STD,2    *XP:NAME,4
         B        *15
SW60     EQU      %                 ITS REPLACE
         LD,2     PRONAME
         LW,4     NINDEX
         LW,6     OINDEX
         LW,7     4                 LINK SLOTS TOGETHER
         DO       INTEG=1
         BAL,12   MASTER
         WD,0     X'37'             DISABLE INTERRUPTS
         FIN
         STD,2    *XP:NAME,4        STORE PRONAME IN NEW SLOT.
         STD,6    *XP:NAME,6        ZAP OLD SLOT.
         DO       INTEG=1
         WD,0     X'27'             ENABLE INTERRUPTS
         BAL,12   SLAVE
         FIN
SW80     BAL,11   CLEANUP           IMMEDIATELY SET SLOT TO M:DUMLM
*                                   .IF NO USERS ARE ASSOCIATED.
         B        *15
         PAGE
SYNTAX   EQU      %                 SCAN COMMAND LINE FOR OPTIONS SPECD.
         STW,15   S500              STORE EXIT
         STW,15   RETURN            .ADDRESS.
         LI,8     0                 PRESET
         STW,8    PFLAG             .COMMAND-
         STW,8    TYPE              ..SET
         STW,8    NEWFLAGS          ...FLAGS
         STW,8    WAIT              .....ZERO.
         LW,8     CFLAG             TEST FLAG FOR
         CI,8     1                 .LIST OPTION.
         BE       S020              -YES.
         CI,8     X'0'              -NO. TEST FOR
         BEZ      S040              .DELETE OPTION. -YES.
         CI,8     -1                -NO.   TEST FLAG FOR ENTER OPTION.
         BE       S110              -YES.
         CI,8     -2                -NO.   TEST FLAG FOR REPLACE OPTION.
         BE       S110              -YES.
S014     LI,14    X'3'              -NO. ERROR:'PROGRAM ERROR'.
S015     BAL,15   POST              POST ERROR.
         B        CLOSE             ERROR EXIT.
* PROCESS LIST OPTION
S020     LI,7     -1                PRESET FLAG FOR LIST.
         LD,8     COMD              TEST COMMAND ENTERED
         CD,8     S700              .FOR LISTALL.
         BNE      S021              -NO.
         LI,7     0                 PRESET FLAG FOR LISTALL
S021     STW,7    LTYPE             .AND STORE.
         LI,8     PRONAME           SCAN
         LI,9     S515              .FOR
         LI,10    4                 ..POSSIBLE
         LI,11    8                 ...PRONAME
         BAL,15   SCANT             ....(TEXTC).
         LW,12    12                DOES PRONAME
         BNEZ     S030              .EXCEED MAX CHRS. -YES.
         LW,8     LCF               -NO. IS PRONAME FIELD
         BNEZ     S024              .EMPTY. -NO.
         LI,8     0                 -YES. SET RANGE FLAG
         STW,8    LRANGE            .TO 'NONE SPECIFIED'.
         STW,8    LFIRST            SET.INITIAL INDEX TO ZERO.
         LI,8     PPROCS-1          SET LAST INDEX
         STW,8    LLAST             .TO MAXIMUM IN TABLE.
         LI,7     0                 PRESET FLAG TO 'PRINT TABLE NAMES'.
         LW,8     LTYPE             TEST FOR
         BEZ      S023              .LISTALL. -YES.
         LI,7     -1                -NO. SET FLAG TO
         STW,7    LNAMES            .IGNORE TABLE NAMES.
S022     STW,7    LTITLE            SET TITLE FLAG FOR 'P:NAME TABLE'.
SYNEXIT  LI,1     3                 SET 'EH' MESSAGE LENGTH
         STW,1    EHHCNT            .TO SHORT VERSION (=3).
         B        *S500             EXIT.
S023     STW,8    LNAMES            SET FLAG TO PRINT TABLE NAMES.
         LI,7     1                 SET TITLE FLAG FOR
         B        S022              .'PROCESSOR TABLES'.
S024     LW,8     XP:NAME           SEARCH
         LW,9     XP:NAME           .P:NAME
         AI,9     PPROCS            ..TABLE
         AI,9     PPROCS            ...FOR
         LI,10    PRONAME           ....LEGAL
         BAL,11   SEARCH            .....PRONAME.
         B        S025              -NOT FOUND.
         LI,7     0                 -FOUND. SET TITLE
         STW,7    LTITLE            .FLAG FOR NONE.
         LI,7     -1                SET FLAG FOR
         STW,7    LNAMES            .NO TABLE NAMES PRINTED.
         STW,10   LFIRST            SET INITIAL AND LAST
         STW,10   LLAST             .INDEX TO INDEX FOUND IN SEARCH.
         LI,7     1                 SET RANGE FLAG
         STW,7    LRANGE            .TO 'PRONAME SPECIFIED'.
         B        SYNEXIT           EXIT.
S025     LI,1     1                 TEST IF
         LB,8     PRONAME,1         .INDEX RANGE
         CI,8     '#'               ..IS SPECIFIED.
         BNE      S035              -NO.
         LI,6     0                 -YES.
         BAL,15   S400              CONVERT FIRST INDEX. TERM CHR IN R8.
         B        S036              -ERROR.
         STW,6    LFIRST            -OK. SET FIRST
         STW,6    LLAST             .AND LAST INDEX.
         LI,6     0                 SET TITLE FLAG
         STW,6    LTITLE            .TO PRINT NONE.
         CI,1     7                 IS THERE
         BG       S027              .A LAST
         CI,8     X'40'             ..INDEX
         BE       S027              ...SPECIFIED. -NO.
         CI,8     '.'               -MAYBE. WAS TERMINATOR
         BE       S027              .CHR A PERIOD. -YES.
         CI,8     X'60'             -NO. WAS TERMINATOR
         BNE      S036              .CHR A DASH. -NO, ERROR.
         LI,6     0                 CONVERT
         BAL,15   S400              .LAST INDEX
         B        S036              -ERROR.
         STW,6    LLAST             -OK. SET LAST INDEX.
         LI,7     2                 SET RANGE FLAG TO
         STW,7    LRANGE            .'BOTH INDICES SPECIFIED'.
         LI,7     0                 PRESET PRINT TABLE NAMES FLAG TO YES
         LW,8     LTYPE             TEST FOR
         CI,8     0                 .LISTALL
         BE       S026              ..COMMAND. -YES.
         LI,7     -1                -NO. SET PRINT TABLE
S026     STW,7    LNAMES            .NAMES FLAG TO NO.
         B        SYNEXIT           EXIT.
S027     LI,7     3                 SET RANGE FLAG TO
         STW,7    LRANGE            .'ONE INDEX SPECIFIED'.
         LI,7     -1                SET PRINT TABLE
         B        S026              .NAMES FLAG TO NO.
S030     LI,1     1                 WAS
         LB,8     PRONAME,1         .INDEX
         CI,8     '#'               ..RANGE
         BE       S036              ...SPECIFIED. -YES.
S035     LI,14    X'5'              -NO. ERROR:'NO SUCH OVERLAY/PROCESSOR'
         B        S015              POST AND EXIT.
S036     LI,14    X'1D'             ERROR: 'ILLEGAL INDEX RANGE'.
         B        S015              POST AND EXIT
* PROCESS DELETE OPTION
S040     LI,8     PRONAME           SCAN
         LI,9     S515              .FOR
         LI,10    4                 ..REQUIRED
         LI,11    8                 ...PRONAME
         BAL,15   SCANT             ....(TEXTC).
         LW,12    12                DOES PRONAME
         BNEZ     S030              .EXCEED MAX CHRS. -YES.
         LW,8     LCF               -NO. IS PRONAME
         BNEZ     S060              .FIELD EMPTY? -NO.
S050     LI,14    X'4'              -YES. ERROR:'PRONAME REQUIRED'
         B        S015              POST AND EXIT.
S060     BAL,11   XGRTEST           CHECK FOR XDELTA, RECOVER, GHOST1.
*                                   -IF YES, TAKES ERROR EXIT.
         BAL,11   TCTEST            -NO. CHECK FOR TEL/CCI.
         LW,8     TEL:CCI           TEST FLAG FOR TEL OR CCI.
         BEZ      S080              -NO.
S070     LI,14    X'A'              -YES. ERROR: 'DONT USE COMMAND
*                                                ON TEL/CCI'
         B        S015              POST AND EXIT.
S080     LW,8     XP:NAME           SEARCH
         LW,9     XP:NAMEND         .P:NAME TABLE
         LI,10    PRONAME           ..FOR LEGAL
         BAL,11   SEARCH            ...PRONAME.
         B        S030              -NOT FOUND. ERROR.
         STW,10   OINDEX            FOUND. STORE INDEX.
         LW,8     ENDC              IS TERMINATOR
         CI,8     X'6B'             .A COMMA?
         BNE      SYNEXIT           -NO.  END OF SCAN, EXIT.
         LI,8     BUF               -YES. SCAN
         LI,9     S515              .NEXT
         LI,10    3                 ..FIELD
         LI,11    4                 ...FOR PERM
         BAL,15   SCAN              ....OPTION.
         LW,12    12                IS FIELD CHARACTER
         BNEZ     S090              .MAX EXCEEDED. -YES, ERROR.
         LW,8     LCF               -NO. IS OPTION
         BNEZ     S100              .FIELD EMPTY? -NO.
S090     LI,14    X'6'              -YES. ERROR: ILLEGAL COMMAND OPTION.
         B        S015              POST AND EXIT.
S100     LW,8     S502              IS OPTION FIELD
         CW,8     BUF               .EQUAL TO 'PERM'.
         BNE      S090              -NO. ERROR.
         STW,8    PFLAG             -YES. SET PERM FLAG ON.
         B        SYNEXIT           END OF SCAN, EXIT.
* PROCESS ENTER AND REPLACE OPTIONS
S110     LI,8     PRONAME           SCAN
         LI,9     S515              .FOR
         LI,10    4                 ..REQUIRED
         LI,11    8                 ...PRONAME
         BAL,15   SCANT             ....(TEXTC).
         LW,12    12                DOES PRONAME
         BNEZ     S030              .EXCEED MAX CHRS. -YES.
         LW,8     LCF               -NO. IS PRONAME FIELD
         BEZ      S050              .EMPTY?  -YES. ERROR, REQUIRED.
         BAL,11   XGRTEST           -NO. CHECK XDELTA, RECOVER, GHOST1.
*                                   -IF YES, TAKES ERROR EXIT.
         BAL,11   TCTEST            -NO. CHECK FOR TEL OR CCI.
         LW,8     TEL:CCI           TEST FLAG FOR TEL OR CCI.
         BEZ      S130              -NO.
         LW,8     CFLAG             -YES. TEST FOR
         CI,8     -1                .ENTER OPTION.
         BE       S070              -YES. ERROR.
S130     LW,8     J:ACCN            -NO. SET
         STW,8    ACCN              .FID TO
         LW,8     J:ACCN+1          ..USER'S
         STW,8    ACCN+1            ...ACCOUNT.
         LD,8     PRONAME           SET
         STW,8    FILE              .FID
         STW,9    FILE+1            ..TO
         LI,8     0                 ...PRONAME.
         STW,8    FILE+2            SET REMAINING
         STW,8    FILE+3            .FILE NAME TO ZEROS.
         STW,8    PSWD              SET PASSWORD
         STW,8    PSWD+1            .TO ZERO.
         LI,8     -1                PRESET TYPE FLAG
         STW,8    TYPE              .TO 'PROCESSOR'.
         LW,8     XP:NAME           SEARCH
         LW,9     XP:NAMEND         .P:NAME TABLE
         LI,10    PRONAME           ..FOR
         BAL,11   SEARCH            ...PRONAME.
         B        S140              -NOT FOUND.
         STW,10   OINDEX            -FOUND. STORE 'OLD' INDEX.
         LW,8     CFLAG             TEST FOR
         CI,8     -1                .ENTER OPTION.
         BNE      S150              -NO.
         LI,14    X'9'              -YES. ERROR:'PROCESSOR/OVERLAY
*                                                ALREADY EXISTS'.
         B        S015              POST AND EXIT.
S140     LW,8     CFLAG             TEST FOR
         CI,8     -2                .REPLACE OPTION.
         BE       S030              -YES, ERROR. PRONAME SHOULD EXIST.
         B        S170              -NO. OK FOR ENTER OPTION.
S150     CI,10    MAXOVLY           SET TYPE
         BGE      S160              .FLAG FROM
         LI,8     1                 ..POSITION IN
         STW,8    TYPE              ...P:NAME TABLE.
S160     LW,7     OINDEX            SET 'NEW'
         LW,9     YFF8              .PROCESSOR FLAGS
         LS,8     *XP:SA,7          .. TO 'OLD'
         STS,8    NEWFLAGS          ...PROCESSOR FLAGS.
S170     LW,8     ENDC              IS
         CI,8     X'40'             .TERMINATOR
         BE       S180              ..A SPACE.  -YES.
         CI,8     X'6B'             -NO. IS TERMINATOR
         BE       S210              .A COMMA?  -YES.
         B        S014              -NO. PROGRAM ERROR. POST AND EXIT.
S180     LI,8     BUF               SCAN NEXT
         LI,9     S515              .FIELD FOR
         LI,10    3                 ..'WITH' OR
         LI,11    4                 ...OR
         BAL,15   SCAN              ....'FROM'.
         LW,12    12                DOES FIELD
         BNEZ     S090              .EXCEED MAX CHRS. -YES.
         LW,8     LCF               -NO. IS FIELD
         BEZ      S235              .EMPTY. -YES.
         LW,8     BUF               -NO. TEST
         CW,8     S503              .FOR 'WITH'.
         BE       S190              -YES.
         CW,8     S504              -NO. TEST
         BNE      S090              .FOR 'FROM'.  -NO.
S190     EQU      %
         LW,12    ENDC              TEST IF
         CI,12    '.'               .'WITH' OR
         BE       S195              ..'FROM' TERM'D
         CW,12    EOI               ...BY PERIOD
         BE       S195              ....OR END-OF-LINE. -YES
         LI,12    FILE              -NO. SCAN
         LI,13    ACCN              .INPUT
         LI,14    PSWD              ..FOR
         BAL,15   GFID              ...FID.
         LW,8     G505              IS ANY FIELD
         BEZ      S200              .GRTR THAN MAX. -NO.
S195     EQU      %
         LI,14    X'30'             -YES. ERROR: 'INCORRECT FID'.
         B        S015              POST AND EXIT.
S200     LW,8     FILE              IS FILE
         BEZ      S195              .NAME ZERO. -YES, ERROR.
         LW,8     ENDC              -NO, TEST FOR
         CW,8     EOI               .END-OF-INPUT.
         BE       S235              -YES.
         CI,8     X'6B'             -NO. IS TERMINATOR
         BE       S210              .A COMMA?  -YES.
         CI,8     X'40'             -NO. IS TERMINATOR
         BE       S235              .A SPACE. -YES.
         B        S090              -NO. ERROR.
S210     LI,8     0                 PRESET ACCUMULATED
         STW,8    FFLAGS            .FLAGS TO ZERO.
S220     LI,8     BUF               SCAN
         LI,9     S516              .TO
         LI,10    4                 ..GET
         LI,11    6
         BAL,15   SCAN              ....FIELD.
         LW,12    12                IS FIELD GRTR
         BNEZ     S090              .THAN MAX. -YES.
         LW,8     LCF               -NO. IS FIELD
         BEZ      S090              .EMPTY? -YES, ERROR.
         LB,8     BUF               LOAD OPTION CHAR
         B        S240
S231     EQU      %
         LW,8     TYPE              TEST TYPE FLAG
         CI,8     1                 .FOR OVERLAY.
         BNE      S235              -NO.
         LW,8     FFLAGS            -YES. TEST IF FLAGS
         BEZ      S235              .EVER SET. -NO.
         LI,14    X'8'              -YES. ERROR:'DONT SET FLAGS WITH
*                                                MONITOR OVERLAY'.
         B        S015              POST AND EXIT.
S235     LI,8     X'50'             PRESET FLAGS FOR PUBLIC LIBRARY.
         BAL,15   S360              TEST FOR PUBLIC LIBRARY :PNN.
         LI,8     0                 -NO. PRESET FLAGS FOR 'NOT'.
         SLS,8    24                -YES. SET
         OR,8     NEWFLAGS          .NEW FLAGS
         STW,8    NEWFLAGS          ..ACCORDINGLY.
         LB,8     NEWFLAGS          TEST IF
         LI,9     X'30'             .BOTH 'P'
         CS,9     8                 ..AND 'D'
         BE       S270              ...FLAGS SET. -YES, ERROR.
         LI,8     0                 -NO. TEST
         CW,8     WAIT              .IF WAIT OPTION
         BE       SYNEXIT           ..SPECIFIED. -NO.
         MTW,0    TYPE              -YES. IS PRONAME
         BLZ      SYNEXIT           .A MONIOR OVERLAY. -NO.
         STW,8    WAIT              -YES. RESET WAIT FLAG.
*                                   MESSAGE: WAIT OPTION IGNORED
         M:PRINT  (MESS,S530)       .        FOR MONITOR OVERLAYS.
         B        SYNEXIT
S240     CI,8     X'D6'             TEST FOR
         BNE      S250              .OVERLAY OPTION.  -NO.
         LI,8     1                 -YES. SET TYPE
         STW,8    TYPE              ..FLAG TO +1.
         LW,8     CFLAG             TEST COMMAND
         CI,8     -2                .OPTION FOR REPLACE.
         BE       S090              -YES, ERROR.
         B        S315              -NO. OK FOR ENTER COMMAND.
S250     CI,8     X'E6'             TEST FOR
         BNE      S255              .'WAIT' OPTION. -NO.
         STB,8    WAIT              -YES. SET 'WAIT' FLAG NON-ZERO.
         B        S315              GO TEST FOR EOI.
S255     LW,8     BUF               TEST FOR
         CW,8     S502              .'PERM' OPTION.
         BNE      S260              -NO.
         STW,8    PFLAG             -YES. SET PERM FLAG ON.
         B        S315              GO TEST FOR EOI.
S260     LW,6     FFLAGS            PRESET ACCUMULATED FLAGS TO ZERO.
         LI,7     0                 SET CHARACTER OFFSET TO ZERO.
         LW,8     LCF               TEST CHARACTER
         CI,8     X'6'              COUNT GRTR THAN 6.
         BLE      S290              -NO. OK.
S270     LI,14    X'7'              -YES. ERROR:'ILLEGAL FLAG
*                                                COMBINATION'.
         B        S015              POST AND EXIT.
S290     LB,9     BUF,7             TEST CURRENT
         CI,9     X'D1'             .CHARACTER FOR 'J'.
         BE       S320              -YES.
         CI,9     X'E2'             -NO. TEST CURRENT
         BE       S330              .CHARACTER FOR 'S'.  -YES.
         CI,9     X'C4'             -NO. TEST CURRENT
         BE       S340              .CHARACTER FOR 'D'.  -YES.
         CI,9     X'D7'             -NO. TEST CURRENT
         BE       S350              .CHARACTER FOR 'P'.  -YES.
         CI,9     X'D4'             -NO. TEST CURRENT
         BE       S380              .CHARACTER FOR 'M'.  -YES.
         CI,9     X'C3'             -NO. TEST CURRENT
         BE       S381              .CHARACTER FOR 'C'. -YES-
         CI,9     X'E3'             -NO. TEST CURRENT
         BE       S382              .CHARACTER FOR 'T'. -YES-
         CI,9     X'C2'             -NO. TEST CURRENT
         BE       S383              .CHARACTER FOR 'B'. -YES-
         CI,9     X'C7'             -NO. TEST CURRENT
         BE       S384              .CHARACTER FOR 'G'. -YES-
         CI,9     X'40'             -NO. TEST CURRENT
         BNE      S270              .CHARACTER FOR SPACE.-NO, ERROR.
S310     AI,7     1                 -YES. INCREMENT CHARACTER OFFSET.
         CW,7     LCF               TEST FOR
         BL       S290              .LAST CHR. -NO.
*                                   LEAVE FFLAGS NON-ZERO.
         STB,6    NEWFLAGS          -YES. SET 'NEW' FLAGS.
S315     EQU      %
         LW,12    ENDC              TEST IF FIELD
         CI,12    ','               .TERMINATED BY
         BE       S220              ..COMMA. -YES, GET NEXT FIELD.
         B        S231              -NO. STOP SCANNING.
S320     LI,10    X'80'             SET 'J' BIT
S321     OR,6     10                .IN ACCUMULATED FLAGS.
         STW,6    FFLAGS
         B        S310              GO TEST FOR LAST CHARACTER.
S330     LI,10    X'40'             SET 'S' BIT IN
         B        S321              .ACCUMULATED FLAGS.
S340     LI,10    X'20'             SET 'D' BIT IN
         OR,6     10                .ACCUMULATED FLAGS.
         B        S330              GO SET 'S' TOO.
S350     LI,10    X'10'             SET 'P' BIT IN
         OR,6     10                .ACCUMULATED FLAGS.
         BAL,15   S360              TEST PRONAME FOR :PNN FORMAT.
         B        S375              -NOT PUBLIC LIBRARY.
         B        S330              -PUBLIC LIBRARY. SET 'S' BIT TOO.
S375     LI,14    X'B'              ERROR:'ILLEGAL PRONAME,
*                                          NOT :PNN FORMAT'.
         B        S015              POST AND EXIT.
*TEST IF PRONAME OF :PNN FORMAT
S360     STW,15   S360X             STORE RETURN.
         PSW,3    *0                SAVE WORKING
         PSW,11   *0                .REGISTERS.
         LI,3     3                 TEST FIRST
         LB,11    PRONAME,3         .N CHARACTER
         CI,11    X'F9'             ..FOR GRTR THAN 9.
         BLE      S370              -NO.
S365     PLW,11   *0                -YES. RESTORE
         PLW,3    *0                .WORKING REGISTERS.
         B        *S360X            EXIT.
S370     CI,11    X'F0'             TEST FIRST N CHARACTER
         BL       S365              .FOR LESS THAN ZERO. -YES.
         CB,11    PRONAME+1         -NO. IS N EQUAL TO N.
         BNE      S365              -NO.
         LW,11    PRONAME           -YES. TEST PRONAME
         SLS,11   -8                .FOR C:P
         CW,11    S506              ..FORMAT.
         BNE      S365              -NO.
         MTW,1    S360X             -YES. SET 'IS PUBLIC
         B        S365              .LIBRARY' EXIT.
S380     LI,10    X'8'              SET 'M' BIT IN
         B        S321              .ACCUMULATED FLAGS.
S381     LI,10    X'7'              SET 'C' BITS IN
         B        S321              ACCUMULATED FLAGS
S382     LI,10    X'4'              SET 'T' BIT IN
         B        S321              ACCUMULATED FLAGS
S383     LI,10    X'2'              SET 'B' BIT IN
         B        S321              ACCUMULATED FLAGS
S384     LI,10    1                 SET 'G' BIT IN
         B        S321              ACCUMULATED FLAGS
*  CONVERT INDEX TO HEX             PRESET R6=X, R1=BYTE POINTER
*                                   BAL,15 S400
*                                   R6-RESULT (MAX-LAST 7 DIGITS)
*                                   R8-TERMINATING BYTE
*                                   R1-BYTE POINTER
S400     STW,15   S400X             SAVE RETURN ADDRESS.
S401     AI,1     1                 INCREMENT BYTE COUNT.
         CI,1     8                 TEST IF
         BLE      S407              .MAX REACHED. -NO.
         LI,8     X'40'             -YES. SET DUMMY TERMINATOR CHR.
S405     MTW,1    S400X             SET SECOND EXIT.
S406     B        *S400X            EXIT.
S407     LB,8     PRONAME,1         IS CURRENT CHR
         CI,8     X'40'             .A SPACE TERMINATOR.
         BE       S405              -YES, EXIT.
         CI,8     X'60'             -NO. IS CHR A
         BE       S405              .DASH TERMINATOR. -YES, EXIT.
         CI,8     '.'               -NO. IS CHR A
         BE       S405              .PERIOD TERMINATOR. -YES, EXIT.
         BAL,15   S430              CONVERT CHR TO DIGIT.
         BLZ      S406              IS ERROR FLAG SET. -YES, EXIT.
         SLS,7    28                POSITION DIGIT X0000000.
         SLD,6    4                 MOVE DIGIT INTO RESULT REGISTER.
         B        S401              REPEAT.
*   CONVERT EBCDIC CHARACTER TO HEX DIGIT    R8=INPUT CHR=000X
*                                            R7=OUTPUT DIGIT=0000000X.
S430     STW,15   S430X             STORE RETURN.
         LI,7     X'F'              EXTRACT
         AND,7    8                 .HEX DIGIT.
         CI,8     'A'               IS CHR LESS
         BL       S435              .THAN 'A'.  -YES, ERROR.
         CI,8     'G'               -NO. IS CHR LESS
         BL       S437              .THAN 'G'.  -YES, OK.
         CI,8     X'F0'             -NO. IS CHR LESS
         BL       S435              .THAN '0'. -YES, ERROR.
         CI,8     X'FA'             -NO. IS CHR GRTR
         BL       S438              .THAN '9'.  -NO.
S435     LI,7     -1                -YES. SET ERROR FLAG ON.
S436     B        *S430X            EXIT.
S437     AI,7     X'9'              ADD ALPHA FACTOR.
S438     LW,7     7                 SET ERROR FLAG OFF.
         B        S436              EXIT.
         PAGE
*        SEARCH MEMORY FOR TWO-WORD FIELD. ASSUME DOUBLE WORD BOUNDS.
*                 REG 8: BEGINNING TABLE ADDRESS.
*                 REG 9: END TABLE ADDRESS +1.
*                 REG 10: ADDRESS OF TWO-WORD FIELD
*                 BAL,11  SEARCH
*                 RETURN 1: FIELD NOT FOUND
*                 RETURN 2: FIELD FOUND
*                 REG 8: TABLE ADDRESS OF FIELD FOUND
*                 REG 9: END TABLE ADDRESS +1
*                 REG 10: INDEX OF FIELD FOUND
SEARCH   LCI      6                 SAVE WORKING
         STM,6    S507A             .PARAMETER, AND EXIT REGISTERS.
         LI,10    0                 SET INDEX COUNT TO ZERO.
         LD,6     *S511             LOAD 2-WORD FIELD FOR TEST.
SE00     CW,8     S510              TEST CURRENT TABLE
         BGE      SE10              .AGAINST END ADDRESS+1. -GRTR/EQ.
         CD,6     *8                -LT. COMPARE 2-WORD FIELD
         BE       SE30              .AGAINST CURRENT TABLE D-WORD. -EQ.
         AI,10    1                 -NOT EQ. INCREMENT INDEX BY ONE.
         AI,8     2                 INCR CURRENT TABLE ADDRESS BY TWO.
         B        SE00              LOOP.
SE10     LI,10    0                 SET INDEX TO ZERO.
*                                   LEAVE EXIT TO NOT-FOUND.
SE20     LCI      2                 RESTORE WORKING
         LM,6     S507A             .REGISTERS.
         B        *11               EXIT
SE30     AI,11    1                 SET EXIT TO FOUND.
         B        SE20              GO TO RESTORE REGISTERS.
         PAGE
*        TEST IF PRONAME IS TEL OR CCI.
TCTEST   STW,11   S513              STORE EXIT.
         LD,6     PRONAME           COMPARE
         CD,6     S702              .PRONAME TO
         BNE      TC20              ..'TEL' (TEXTC). -NOT EQ.
         LI,6     -1                -EQUAL.  SET TEL/CCI
TC10     STW,6    TEL:CCI           .FLAG TO -1.
         B        *S513             EXIT.
TC20     CD,6     S703              COMPARE PRONAME TO
         BE       TC30              -'CCI' (TEXTC). -EQUAL.
         LI,6     0                 -NOT EQUAL. SET TEL/CCI
         B        TC10              .FLAG TO ZERO.  EXIT.
TC30     LI,6     1                 SET TEL/CCI FLAG
         B        TC10              .TO ONE. EXIT.
         PAGE
*        PURPOSE: TEST IF PRONAME IS ONE OF ILLEGAL NAMES IN LIST.
*        USE:     BAL,11 XGR TEST
*                 RETURN IF NOT.
*                 EXIT AS ERROR IF MATCH FOUND.
XGRTEST  EQU      %
         STW,11   S514              STORE EXIT.
         LCI      3                 STORE WORKING
         PSM,5    *0                .REGISTERS.
         LI,5     -S710             TEST PRONAME
         LD,6     PRONAME           .AGAINST
XGR10    CD,6     S709,5            ..TABLE OF
         BE       XGR20             ...ILLEGAL    -EQ.
         BIR,5    XGR10             ....NAMES.    -NOTEQ.
         LCI      3                 -END. RESTORE
         PLM,5    *0                .WORKING REGISTERS.
         B        *S514             OK EXIT.
XGR20    LI,14    X'20'             ERROR: PRONAME IS ILLEGAL.
         B        S015              POST AND EXIT.
         PAGE
LIST     EQU      %                 PROCESS LIST COMMAND.
         STW,15   L500              STORE EXIT
         STW,15   RETURN            .ADDRESS.
         LW,8     LRANGE            IF BATCH AND
         BEZ      L003              .PRINTOUT IS EXPECTED
         CI,8     2                 ..TO BE EXTENSIVE
         BNEZ     L005              ...(LRANGE = 0 OR 2),
L003     MTW,0    J:JIT             ....SKIP
         BLZ      L005              .....TO TOP
         M:DEVICE M:LL,(PAGE)       ......OF PAGE.
L005     EQU      %
         LW,8     LTITLE            TEST IF TITLE
         BEZ      L015              .LINE TO BE PRINTED. -NO.
         BLZ      L010              -YES. IS IT 'PROCESSOR TABLES'. -NO.
         M:PRINT  (MESS,L540)       -YES. PRINT TITLE.
         B        L015
L010     M:PRINT  (MESS,L501)       PRINT TITLE: 'P:NAME TABLE'.
L015     LW,8     LNAMES            ARE TABLE NAMES
         BLZ      L029              .TO BE PRINTED. -NO.
         LI,12    31                PRESET COUNT FOR SHORT LINE.
         LW,1     LFIRST            DOES FIRST INDEX
         CI,1     PNAMEND-1         .POINT TO
         BG       L017              ..PROCESSOR OVERLAY. -YES.
         LI,12    63                -NO. PRESET COUNT
L017     STB,12   L510              .TO FULL TITLE LINE.
         M:PRINT  (MESS,L510)       -YES. PRINT TABLE NAMES.
L029     LW,1     LFIRST            SET COUNT TO INITIAL INDEX.
         CI,1     0                 SPECIAL TEST FOR
         BE       L049              .SLOT # 0.  -EQUAL.
L030     CW,1     LLAST             -NOT EQ.TEST FOR
         BG       LISTEXIT          .END OF RANGE. -YES.
         CI,1     PPROCS            TEST FOR
         BGE      LISTEXIT          .END OF TABLE. -YES.
         LD,8     *XP:NAME,1        -NO. TEST IF NAME
         CW,8     1                 .SLOT EQUALS INDEX.
         BE       L050              -YES.
         CI,8     0                 -NO. TEST IF NAME
         BEZ      L050              .SLOT EQUALS ZERO. -YES.
L033     LD,8     *XP:NAME,1        -NO. STORE P:NAME
         STD,8    L503              .IN MESSAGE.
         LW,13    SPACES            BLANK OUT
         STW,13   L503+3            .NUMBER OF
         STW,13   L503+4            ..GRANULES.
         LI,8     30                SET LINE
         STB,8    L503              .COUNT TO 30 CHARACTERS.
         LW,13    1                 CONVERT
         LI,14    8                 .INDEX TO
         BAL,15   L400              ..EBCDIC.
         LW,8     L503A             STORE CONVERTED
         SLS,9    16                .INDEX
         SLD,8    -16               ..NUMBER
         STW,9    L503+2            ...IN MESSAGE.
         LW,6     XP:NAME           SET UP TO FIND GRANULES
         LW,7     1                 .AVAILABLE TO CURRENT SLOT.
         CI,7     MAXOVLY+2         NO GR CALC FOR GHOST1
         BE       L034
         CI,7     MAXOVLY+3         NO GR CALC FOR ALLOCAT
         BE       L034
         CI,7     PNAMEND-1         DOES INDEX POINT
         BG       L034              .TO PROCESSOR OVERLAYS. -YES.
         BAL,15   FINDGRAN          -NO. FIND RAD GRANULES FOR SLOT.
         LI,14    L503+3            CONVERT NUMBER
         LW,13    8                 .OF GRANULES
         BAL,15   L400              ..TO EBCDIC IN MESSAGE.
         LW,2     L503B             STORE FIELD TITLE
         STW,2    L503+3            .IN MESSAGE LINE.
L034     LB,13    *XPB:REP,1        CONVERT # OF
         BAL,15   L450              .ASSOCIATED USERS
         STW,13   L503+5            ..TO EBCDIC AND STORE.
         M:PRINT  (MESS,L503)       PRINT FIRST LINE (LL DEVICE).
L035     LW,8     LTYPE             TEST FOR
         BEZ      L100              .LISTALL. -YES.
L040     EQU      %
         LD,8     DUMLM             TEST IF PRONAME
         CD,8     PRONAME           .SPECIFIED IS
         BE       L042              ..M:DUMLM. -YES.
L049     AI,1     1                 -NO. INCREMENT INDEX.
*                                   IF BREAK NOT SET, GO GET NEXT SLOT.
L041     EQU      %
         BREAK    X'50',L030
L042     AI,1     1                 INCREMENT INDEX.
         LW,8     XP:NAME           SEARCH
         AW,8     1                 .REMAINDER
         AW,8     1                 ..OF TABLE
         LW,9     XP:NAME           ...FOR NEXT
         AI,9     PPROCS            ....DUMMY
         AI,9     PPROCS            .....SLOT.
         LI,10    DUMLM             .
         BAL,11   SEARCH            .
         B        L041              -NOT FOUND.
         AW,1     10                -FOUND. SET COUNTS TO PRINT
         STW,1    LLAST             .NEXT DUMMY SLOT.
         B        L041
L050     LW,13    8                 CONVERT NAME
         LI,14    L502+1            .SLOT TO
         BAL,15   L400              ..EBCDIC.
         LW,13    1                 CONVERT
         LI,14    8                 .INDEX TO
         BAL,15   L400              ..EBCDIC.
         LW,8     L503A             STORE CONVERTED
         SLS,9    16                .INDEX
         SLD,8    -16               ..NUMBER
         STW,9    L502+3            ...IN MESSAGE.
         LI,8     15                PRESET COUNT FOR SHORT LINE.
         CI,1     PNAMEND-1         DOES INDEX POINT TO
         BG       L060              .PROCESSOR OVERLAYS. -YES.
         LI,8     25                -NO. PRESET MESSAGE
L060     STB,8    L502              .FOR FULL LINE.
         LB,13    *XPB:REP,1        CONVERT # OF
         BAL,15   L450              .ASSOCIATED USERS
         STW,13   L502+4            ..TO EBCDIC AND STORE.
         M:PRINT  (MESS,L502)       PRINT MESSAGE.
         B        L035
LISTEXIT B        *L500             EXIT.
*        FORMAT AND PRINT LINE OF TABLE VALUES.
L100     LOAD,13 *XPX:HPP,1         CONVERT HEAD OF
         LI,14    2                 PHYSICAL PAGE CHAIN
         BAL,15   L400              TO EBCDIC.
         LW,2     BLANKS
         SCD,2    16
         CI,2     X'F0F'
         BANZ     %+2
         AI,2     -X'B0B0'
         STW,2    L520
         STW,3    L520+1
         LI,12    31                PRESET MESSAGE FOR PARTIAL LINE.
         CI,1     PNAMEND-1         DOES INDEX POINT
         BG       L110              .TO PROCESSOR OVERLAY. -YES.
         LI,12    67                -NO. PRESET MESSAGE
L110     STB,12   L520              .FOR FULL LINE.
         LOAD,13  *XPX:TPP,1        CONVERT TAIL OF
         LI,14    2
         BAL,15   L400              PHYSICAL PAGE CHAIN
         LH,2     3
         CI,2     X'F0F'
         BANZ     %+2
         AI,2     -X'B0B0'
         STW,3    L521
         STH,2    L521
         LB,13    *XPB:PSZ,1        CONVERT PURE PROCEDURE
         BAL,15   L450              .SIZE TO EBCDIC
         STW,13   L522              ..AND STORE.
         LB,13    *XPB:DSZ,1        CONVERT DATA
         BAL,15   L450              .SIZE TO EBCDIC
         STW,13   L523              ..AND STORE.
         LB,13    *XPB:DCBSZ,1      CONVERT DCB
         BAL,15   L450              .SIZE TO EBCDIC
         STW,13   L524              ..AND STORE.
         LH,13    *XPH:PDA,1        CONVERT PROCEDURE
         LI,14    2                 .DISC ADDRESS
         BAL,15   L400              ..TO EBCDIC
         LW,2     BLANKS
         SCD,2    16
         STW,2    L525
         STW,3    L525+1            AND STORE
         LH,13    *XPH:DDA,1        CONVERT DATA DISC
         BAL,15   L400              .ADDRESS TO EBCDIC
         STW,3    L527              ..AND STORE.
         LB,13    *XPB:UC,1         CONVERT NUMBER OF
         BAL,15   L450              ..USERS TO EBCDIC
         STW,13   L528              ..AND STORE.
         LB,13    *XPB:LNK,1        CONVERT NUMBER OF
         BAL,15   L450              .NEXT OVERLAY TO
         STW,13   L529              .EBCDIC AND STORE.
         LB,13  *XPB:PVA,1          CONVERT FIRST VIRTUAL
         BAL,15   L450              .PAGE TO EBCDIC
         STW,13   L530              ..AND STORE.
         LB,13    *XPB:HVA,1        CONVERT FIRST UNUSED
         BAL,15   L450              .PAGE TO EBCDIC
         STW,13   L531              .AND STORE.
         LW,13    *XP:SA,1          CONVERT FLAGS AND
         LI,14    L532              .START ADDRESS
         BAL,15   L400              ..TO EBCDIC.
         M:PRINT  (MESS,L520)       PRINT TABLE VALUES.
         B        L040              GO INCREMENT COUNT.
         PAGE
*        CONVERT WORD IN R13 TO EBCDIC.
*        STORE RESULT AT ADDRESS SPECIFIED IN R14.
L400     LCI      3                 SAVE
         PSM,12   *0                .WORKING
         PSW,7    *0                ..REGISTERS.
         AI,14    2                 SET DESTINATION ADDRESS.
         LI,7     -8                PRESET STORE OFFSET.
L410     LI,12    X'F'              CONVERT CURRENT
         SLD,12   4                 .CHARACTER TO EBCDIC.
         CI,12    X'F9'             TEST IF
         BLE      L420              .NUMERIC.-YES.
         AI,12    X'C1'-X'FA'       -NO. CONVERT ALPHA.
L420     STB,12   *14,7             STORE CURRENT CHARACTER.
         BIR,7    L410              TEST ALL CHRS CONVERTED. -NO.
         PLW,7    *0                -YES. RESTORE
         LCI      3                 .WORKING
         PLM,12   *0                ..REGISTERS.
         B        *15               EXIT.
*        CONVERT RIGHT-MOST BYTE TO EBCDIC W/LEADING SPACES
*        BYTE IN R13
*        BAL,15   L450
*        RESULT IN R13
L450     LCI      2                 SAVE WORKING
         PSM,2    *0                .REGISTERS USED.
         PSW,15   *0                SAVE EXIT.
         LI,14    2                 CONVERT (R13)
         BAL,15   L400              .TO EBCDIC.
         SLS,3    16                INSERT
         LI,2     '  '              .LEADING
         SLD,2    -16               ..SPACES.
         LW,13    3                 RETURN RESULT IN R13.
         PLW,15   *0                RESTORE EXIT.
         LCI      2                 RESTORE
         PLM,2    *0                .REGISTERS.
         B        *15               EXIT.
         PAGE
* SET UP ENVIRONMENT NECESSARY TO REPLACE TEL OR CCI.
TELCCIONLY  EQU   %
         STW,15   T500
         DO       INTEG=0
         B        *T500
         FIN
T010     EQU      %
         LI,8     0
         STW,8    UAMESS
         BREAK    X'51',T012
T012     BAL,12   MASTER
T020     B        *T500
         PAGE
* PURPOSE: TO READ THE TREE RECORD OF THE FID TO DETERMINE
*          THE NUMBER OF RAD GRANULES REQUIRED.
RADNEED  EQU      %
         STW,15   R502              STORE EXIT
         STW,15   RETURN            .ADDRESS.
         LW,14    3PGERR            TEST IF 3 PAGES WERE
         BEZ      R005              .AVAILABLE FOR READ TREE. -YES.
         STW,14   ERRFLAG           -NO. ERROR: INSUFFICIENT MEMORY
         BAL,15   FULLERR           .           TO READ TREE.
         B        EXITDRSP          RESTART.
R005     EQU      %
         LI,7     -R501+R500        MOVE M:EI
R010     LW,8     R501,7            .PLIST TO
         STW,8    EIPLIST+R501-R500,7 ..DATA
         BIR,7    R010              ...AREA.
         LCI      4                 MOVE FILE
         LM,1     FILE              .NAME TO
         STM,1    EIFILE            ..M:EI PLIST.
         LW,1     ACCN              PICK UP ACCOUNT NUMBER.
         BEZ      R250              HAS ONE BEEN SPECIFIED. -NO.
         STW,1    EIACCN            -YES. MOVE.
         LW,1     ACCN+1            .IT TO
         STW,1    EIACCN+1          ..M:EI PLIST.
R020     LW,1     PSWD              PICK UP PASSWORD
         BEZ      R260              HAS ONE BEEN SPECIFIED. -NO.
         STW,1    EIPSWD            -YES. MOVE
         LW,1     PSWD+1            .IT TO
         STW,1    EIPSWD+1          ..M:EI PLIST
R030     CAL1,1   EIPLIST           OPEN M:EI DCB
*                                   READ M:EI WITH KEY=TREE.
         M:SETDCB M:EI,(ERR,R200),(ABN,R200) SET ERROR EXITS FOR M:EI
         M:READ   M:EI,(BUF,*PAGES),(SIZE,2048),(ERR,R200),(ABN,R200),;
                  (KEY,TCHEAD)      READ HEAD
         LI,7     2                 L/WD TO BIAS IN HEAD
         INT,9    *PAGES,7          L/BIAS FROM HEAD
         M:READ   M:EI,(ERR,R200),(ABN,R200),(KEY,R508),;
                  (SIZE,2048)       READ TREE
         LW,7     PAGES             PRESET WORD ADDRESS
         AI,7     1                 .OF TREE TABLE.
         LW,8     5,7               BOUND UP
         SLS,8    -16               .ROOT'S DATA
         INT,1    5,7               L/DATA ORIGIN
         SW,1     9                 (DATA ORIGIN) - (BIAS)
         AW,8     1                 G/TOTAL # OF DBL WDS OF DATA
         SLS,8    1                 ..SIZE AND
         AI,8     X'1FF'            ...STORE INTO
         SLS,8    -9                ....MAXIMUM
         STW,8    MAXRCD            .....RECORD.
         STW,8    R503              STORE CURRENT DATA SIZE.
         LW,8     TYPE              TEST IF
         CI,8     1                 .MONITOR OVERLAY
         BE       R150              ..SPECIFIED.  -YES.
         LW,8     7,7               -NO. BOUND
         SLS,8    -16               .UP
         SLS,8    1                 ..
         AI,8     X'1FF'            ..PROCEDURE
         SLS,8    -9                ...SIZE AND
         STW,8    R504              ....STORE.
         CW,8     MAXRCD            TEST IF GRTR
         BLE      R040              .THAN MAX. -NO.
         STW,8    MAXRCD            -YES. STORE AS MAX RECORD.
R040     LW,8     9,7               BOUND
         SLS,8    -16               .UP
         SLS,8    1                 ..
         AI,8     X'1FF'            ..DCB
         SLS,8    -9                ...SIZE AND
         STW,8    R505              ....STORE.
         CW,8     MAXRCD            TEST IF GRTR
         BLE      R060              .THAN MAX. -NO.
         STW,8    MAXRCD            -YES. STORE AS MAX RECORD.
R060     LI,8     0                 SET NUMBER OF PROCESSOR
         STW,8    NOLAYS            .OVERLAYS TO ZERO.
         LW,8     *PAGES            IS PROCESSOR OVERLAID.
         CI,8     X'C'
         BG       R065
         LB,8     NEWFLAGS          NO.
         CI,8     X'10'             IS THIS A PUBLIC LIBRARY.
         BAZ      R140
         MTW,0    R503              YES. DCB AND DATA MUST BE ZERO.
         BNEZ     PLERR
         MTW,0    R505
         BNEZ     PLERR
         B        R140
PLERR    EQU      %
         LI,14    X'1E'
         BAL,15   POST              PUBLIC LIBRARY ERROR. LM MUST BE
         B        CLOSE             ROOT ONLY AND PROCEDURE ONLY.
R065     EQU      %                 PROCESSOR IS OVERLAID
         LB,8     NEWFLAGS
         CI,8     X'10'             IS IT A PUBLIC LIBRARY.
         BANZ     PLERR             ERROR IF YES.
R070     EQU      %
         AI,7     11                -YES. POINT TO FIRST OVERLAY.
         LI,8     X'FFFF'           ISOLATE OVERLAY
         AND,8    7,7               .BEGINNING DOUBLE-
         SLS,8    1                 ..WORD ADDRESS.
         LI,9     0                 SET WORD
         STW,9    R507              .DIFFERENCE TO ZERO.
         LW,9     *PAGES            GET NUMBER OF TREE
         AI,9     -12               .TABLE SIZE MINUS THOSE
         STW,9    R506              ..FOR THE ROOT AND N.
         LI,6     X'1FE00'          TEST IF PROCEDURE
         AND,6    8                 .OF PROCESSOR OVERLAY
         CW,6     8                 ..ON PAGE BOUNDARY.
         BE       R090              -YES.
         SW,8     6                 -NO. CALCULATE WORD
         STW,8    R507              .DIFFERENCE AND STORE.
         LI,8     -1                DECREMENT ROOT'S
         AWM,8    R504              .PROCEDURE ONE PAGE.
R090     MTW,1    NOLAYS            INCREMENT # OF OVERLAYS.
         LW,6     7                 PRESET HALF-WORD
         SLS,6    1                 .ADDRESS OF TREE TABLE.
         LW,8     4,7               IS THERE
         SLS,8    -16               .A FORWARD LINK
         LW,8     8                 ..(ANOTHER LEVEL OF OVERLAY).
         BEZ      R095              -NO.
         LI,14    X'E'              -YES. ERROR: ONLY ONE LEVEL OF
         B        S015                    OVERLAYS FOR SHARED PROCESSORS.
R095     LH,8     5,6               IS DATA
         BEZ      R110              .SIZE ZERO? -YES.
R100     LI,14    X'10'             -NO. ERROR: ONLY PROCEDURE ALLOWED
*                                               IN A PROCESSOR OVERLAY.
         B        S015              POST AND EXIT.
R110     LH,8     9,6               IS DCB
         BNEZ     R100              .SIZE ZERO? -NO, ERROR.
         LW,8     7,7               -YES. ISOLATE
         SLS,8    -16               .NUMBER OF PROCEDURE
         SLS,8    1                 ..DOUBLE-WORDS *2.
         AW,8     R507              ADD WORD-DIFFERENCE.
         AI,8     X'1FF'            BOUND UP
         SLS,8    -9                .PROCEDURE SIZE.
         AWM,8    R504              ADD PAGES TO ACCUM. PROC. PAGES.
         CW,8     MAXRCD            TEST IF GRTR
         BLE      R130              .THAN MAX. -NO.
         STW,8    MAXRCD            -YES. STORE AS MAX RECORD.
R130     AI,7     11                BUMP ADDRESS TO NEXT TREE TABLE.
         LI,8     -11               SUBTRACT 11 FROM
         AWM,8    R506              .CURRENT NUMBER OF TREE WORDS.
         BNEZ     R090              TEST ZERO. -NO.
R140     LW,8     R503              -YES. GET DATA PAGES.
         LW,7     TYPE              TEST IF MONITOR
         CI,7     1                 .OVERLAY
         BE       R142              ..SPECIFIED.  -YES.
         AW,8     R504              -NO. ADD DCB
         AW,8     R505              .AND PROCEDURE.
R142     STW,8    GRANEED           STORE GRANULES REQUIRED.
         LW,1     XTRA              GET VIRTUAL
         LCW,2    MAXRCD            .PAGES AS
R143     M:GVP    *1                ..REQUIRED BY
         BCR,8    R144              ...MAXIMUM RECORD SIZE.
         LI,14    X'16'             -NO. ERROR: INSUFFICIENT MEMORY
*                                        TO READ MAX RECORD OF FID.
         B        S015              POST AND EXIT.
R144     AI,1     512               INCREMENT VIRTUAL ADDRESSX512.
         BIR,2    R143              TEST COMPLETE.  -NO.
*                                   -YES.
         STW,1    W500              SAVE NEXT AVAILABLE VIRTUAL PAGE.
R145     M:SETDCB M:EI,(ERR,W050),(ABN,W050) SET ERROR EXITS FOR M:EI
         B        *R502             EXIT.
R150     LW,8     *PAGES            TEST IF MORE THAN
         CI,8     12                .ONE LEVEL OF MONITOR OVERLAY
         BLE      R170              ..INDICATED. -NO.
R160     LI,14    X'21'             -YES. ERROR: MONITOR OVERLAY
*                                                CANNOT HAVE OVERLAYS.
         B        S015              POST AND EXIT.
R170     LW,6     7                 PRESET HALF-WORD
         SLS,6    1                 .ADDRESS OF TREE TABLE.
         LH,8     5,6               GET DATA
         SLS,8    1                 .LENGTH.
         AI,6     1                 POINT TO 2ND HALF.
         LH,9     5,6               GET START
         SLS,9    1                 .ADDRESS.
         AW,8     9                 TEST IF
         CI,8     X'8000'           .DATA IN RANGE.
         BL       R180              -NO.
         CI,8     X'8C00'           -MAYBE. TEST UPPER LIMIT.
         BL       R140              -OK.
R180     LI,14    X'F'              -NO. ERROR: OVLY DATA EXCEEDS
         B        S015              .RANGE 8000-8BFF. POST ANE EXIT
*  ERROR AND ABNORMAL RETURN FROM READ TREE RECORD.
R200     LI,14    X'D'              ERROR:FID IS NOT A LOAD MODULE.
         BAL,15   POST1             POST ERROR.
         B        CLOSE             EXIT.
*  ERROR AND ABNORMAL RETURN FROM OPEN M:EI DCB.
R210     LI,14    X'C'              ERROR: CANNOT OPEN FID.
         BAL,15   POST1             POST ERROR.
         B        CLOSE             EXIT
*
R250     LW,1     S521              MODIFY CONTROL WORD
         STW,1    EIACCN-1          .FOR NO ACCT SPECIFIED.
         B        R020
*
R260     LW,1     S522              MODIFY CONTROL WORD
         STW,1    EIPSWD-1          .FOR NO PASSWORD SPECIFIED.
         B        R030
         PAGE
*  WRITE FID TO THE SWAPPER AND MODIFY THE CORE PROCESSOR TABLES.
WRITESWAP EQU     %
         STW,15   W501              STORE EXIT
         STW,15   RETURN            .ADDRESS.
         DO       INTEG=0
         B        *W501
         FIN
W020     LW,7     NINDEX            SET TABLE INDEX.
         LW,8     TYPE              TEST FOR
         BGEZ     W030              .OVERLAY. -YES.
         AW,7     XP:SA             -NO.
         LW,9     YFF8              STORE
         LS,8     NEWFLAGS          ..FLAGS IN
         STS,8    *7                ...PSA TABLES
W030     LW,7     *XS:CUN           SET
         LH,9     *XUH:FLG,7        .SPECIAL
         LI,5     X'1000'           ..JIT
         STS,5    9                 ...ACCESS FOR
         STH,9    *XUH:FLG,7        ....SYSMAK1.
         LW,6     PAGES             SET UP BUFFER ADDRESS.
         LW,7     NINDEX            SET UP SLOT INDEX.
         LW,8     W500              SET UP BUFFER END ADDRESS.
         BAL,11   SYSMAK1           WRITE FID AND MODIFY TABLES.
         STW,5    MAKERR            STORE CODE FOR POSSIBLE ERROR.
         LW,0     R0SAVE            RESTORE FOR TEMP STACK
         BAL,12   SLAVE             ****SET SLAVE MODE****
         LW,7     *XS:CUN           RESET
         LH,9     *XUH:FLG,7        .SPECIAL
         LI,8     X'EFFF'           ..JIT
         AND,8    9                 ...ACCESS
         STH,8    *XUH:FLG,7        ....BIT.
W040     MTW,0    MAKERR            TEST IF SYSMAK HAD
         BEZ      W041              .ANY ERRORS. -NO.
         LW,14    MAKERR            -YES. POST
         B        S015              .AND EXIT.
W041     B        *W501             EXIT.
*  ERROR AND ABNORMAL RETURN FROM SYSMAK1.
W050     LI,14    X'22'             ERROR: DRSP M:EI ERROR (WRITESWAP).
         BAL,15   POST1             POST ERROR.
         B        CLOSE             EXIT.
         PAGE
*                                   MODRAD READS THE PROCESSOR TABLES
MODRAD   EQU      %
         STW,15   MODRET
*                                   GET DISC ADDRESS OF ROOT FOUND IN
*                                   BOOTSTRAP (TRACK/SECTOR 0,ROOTSA-.2A)
         LI,1     0                 FUNCTION TO READ
         STW,1    FC
         LI,1     1                 READ 1 GRANULE
         STW,1    NGRAN
         LI,1     0                 READ GRANULE 0
         STW,1    GRAN1
         BAL,15   RWRAD             READ IN BOOTSTRAP
*                                   COMPUTE RAD GRANULES FROM BEGINNING
*                                   TO END OF PROCESSOR TABLES.
         LI,3     -NPTABS
         LI,1     X'FFFF'           SET LO
         LI,2     -1                SET HI
MD60     EQU      %
         LW,4     ADLO+NPTABS,3
         CW,4     1
         BG       %+2
         STW,4    1
         CW,4     2
         BL       %+2
         STW,4    2                UPDATE HI
         BIR,3    MD60
         AI,1     -90
         SLS,1    -9
         STW,1    GRAN1             LOWEST CORE GRANULE NUMBER.
         SLS,1    9
         AI,1     90
         STW,1    FSTWDBUF          REMEMBER CORE/BUFFER CORRESPONDENCE
         AI,2     -90
         SLS,2    -9
         SW,2     GRAN1
         STW,2    NGRAN             DIFFERENCE = NUMBER OF GRANULES
         LI,1     ROOTSA-X'2A'      BUILD SEEK ADDRESS
         LW,8     *PAGES,1
         LW,1     *XS:DP            PACK SWAPPER
         BNEZ     MD62              YES
         SLS,8    -16               NO
MD62     EQU      %
         LB,1     *XMB:SDI
         STB,1    8
         BAL,11   SEEKCVT           CONVERT TO REL SECTOR
         SLS,8    -1                REL GRAN
         AWM,8    GRAN1             LOWEST RAD GRANULE NUMBER
         LI,1     0
         STW,1    FC                SET FUNCTION CODE TO READ
         BAL,15   RWRAD
         LI,8     P:NAME
         BAL,15   BUFAD             GET ADDRESS OF P:NAME
         LW,8     9
         AI,9     PNAMEND
         AI,9     PNAMEND
         LI,10    PRONAME
         BAL,11   SEARCH
         B        MD30
         MTW,0    TEL:CCI           IF TEL/CCI, USE OLD INDEX
         BNEZ     MD90              .AS NEW INDEX.    -YES.
         LW,1     10
        LD,2     DUMLM             PUT M:DUMLM IN OLD SLOT
         STD,2    *8
         LB,2     COMD
         CI,2     'D'               IS IT DELETE
         BE       MD20              YES, HAVE DONE ALL THAT'S NECESSARY.
MD30     EQU      %
*                                   LOCATE M:DUMLM IN RAD BUFFER
         LI,8     P:NAME
         BAL,15   BUFAD
         LW,8     9
*                                   SET BOUNDS OF SEARCH PER TYPE
         MTW,0    TYPE
         BLZ      MD70              BRANCH IF PROCESSOR
         AW,8     NINDEX            TEST IF PARALLEL
         AW,8     NINDEX            .SLOT IN RAD
         LW,10    NINDEX            ..TABLES
         STW,10   NINDEXR           ...AVAILABLE
         LD,2     *8                ....FOR
         CD,2     DUMLM             .....CURRENT
         BE       MD91              ......'PERM'. -YES.
         STD,2    MD500             -NO. STORE PRONAME FOUND.
         LI,9     33                RESET MESSAGE
         STB,9    MD500             .CHR COUNT.
         LW,13    10                CONVERT NINDEX
         BAL,15   L450              .TO EBCDIC
         SLS,13   16                ..FOR MESSAGE
         STW,13   MD501             ...PRINTOUT.
*                                   MESSAGE:PRONAME REPLACED IN RAD
         M:PRINT  (MESS,MD500)      .       SLOT # XX.
         B        MD91              COMPLETE PERM PROCESSING
MD70     EQU      %
         AI,8     MAXOVLY
         AI,8     MAXOVLY
         AI,9     PNAMEND
         AI,9     PNAMEND
MD80     EQU      %
         LI,10    DUMLM
         BAL,11   SEARCH
         B        NODUMRAD          NO DUMMY SLOTS ON RAD
         MTW,0    TYPE
         BGEZ     %+2
         AI,10    MAXOVLY
MD90     EQU      %
         STW,10   NINDEXR
MD91     EQU      %
         LI,8     P:NAME
        BAL,15   BUFAD
         LW,1     NINDEXR
         LD,2     PRONAME
         STD,2    *9,1
        MTW,0    TYPE
        BLEZ     MD40              BRANCH IF PROCESSOR
*                                   ITS A MONITOR OVERLAY
*                                       MOVE PB:PSZ AND PB:PVA
*                                       FROM CORE TO RAD BUFFER.
         LI,8     PB:PSZ
         BAL,15   BUFAD
         LW,1     NINDEXR
         STB,2    *9,1
         LI,8     PB:PVA
         BAL,15   BUFAD
         LB,2     *XPB:PVA,1
         LW,1     NINDEXR
         STB,2    *9,1
*                                   MOVE P:SA FROM CORE TO RAD
MD40     EQU      %
         LI,8     P:SA
         BAL,15   BUFAD
         LW,1     NINDEX
         LW,2     *XP:SA,1
         LW,1     NINDEXR
         STW,2    *9,1
MD20    EQU      %
         LW,1     Y01               GO WRITE THE RAD.
         STW,1    FC                    FC = 01 = WRITE
         BAL,15   RWRAD
         B        *MODRET          ***RETURN TO PERM***
NODUMRAD EQU      %
         LI,14    X'2A'
         BAL,15   POST              CANT MAKE THIS ITEM PERM BECAUSE
*                                   NO DUMMY SLOTS ON RAD.
         B        *MODRET           BUT CONTINUE
*                                   BUFAD COMPUTES THE ADDRESS OF A TABLE
*                                   WITHING THE I/O BUFFER
*                                       BAL,15  BUFAD
*                                   INPUT = R8 = MONITOR ADDRESS
*                                   OUTPUT = R9 = BUFFER ADDRESS
BUFAD    EQU      %
        LW,9     8
         SW,9     FSTWDBUF
         AW,9     PAGES
         B        *15
         PAGE
*                                   RWRAD USES NEWQ TO READ OR WRITE THE
*                                   PROCESSOR TABLES (FROM,TO) THE
*                                   SWAPPING RAD. END ACTION ROUTINE IS
*                                   MOVED TO A MONITOR BUFFER SINCE
*                                   END ACTION OPERATES UNMAPPED.
*                                            BAL,15   RWRAD
*                                    INPUT=  FC    = FUNCTION CODE
*                                            GRAN1 = FIRST GRAN TO RD/WT
*                                            NGRAN = NUMBER OF GRANS
*                                            PAGES = I/O BUFFER
RWRAD    EQU      %
         STW,15   RWRET
*                                   SAVE INPUT
         LCI      0
         PSM,0    *0
         LW,1     NGRAN
         STW,1    XNGRAN
         LW,1     GRAN1
         STW,1    XGRAN1
         LW,1     PAGES
         STW,1    XPAGES
RW10     EQU      %
         BAL,12   MASTER            SET MASTER MODE
         BAL,11   GMB               GET MONITOR BUFFER
         BNEZ     RW20              BRANCH IF WE GOT A BUFFER
*
*                                   WAIT FOR A BUFFER.
         BAL,12   SLAVE
BUFWAIT  M:WAIT   4
         B        RW10
RW20     EQU      %
         STW,14   MONBUF            SAVE BUFFER ADDRESS
         AI,14    EASIZE            MOVE
         LI,1     -EASIZE             END ACTION
         LW,2     EAEND,1               ROUTINE
         STW,2    *14,1                   TO
         BIR,1    %-2                      MONITOR BUFFER
MOREGRAN EQU      %
*                                   I/O LOOP. ONCE FOR EACH GRANULE.
         LW,8     XGRAN1            CONVERT GRANULE TO D.A.
         LW,0     R0SAVE
         SLS,8    1
         LB,15    *XMB:SDI
         SLS,15   16
         OR,15    8                 R15=SEEK (8,8,16)=(0,DCT,REL SECT.)
         LI,14    512*4             R14 = SIZE IN BYTES
         LW,13    XPAGES            R13 = BUFFER IN BYTES
         SLS,13   2
*                                   R12 = FC,PRI,NRT,DCT
         LB,12    *XMB:SDI                GET DCT
         OR,12    FC                FUNCTION CODE
         OR,12    Y00FF10           PRI,NRT
         LW,0     MONBUF            END ACTION
         LW,1     MONBUF            EAI
*
         BAL,11   NEWQ
         B        IMPOSS            MANUAL SAYS THIS IS NOT IMPLEMENTED
         LW,1     MONBUF
         LW,2     TYC-EABEGIN,1     PICK UP TYC FROM MONITOR BUFFER.
         LB,3     2
         CI,3     1
         BG       BADRAD
         MTW,1    XGRAN1            INCR. GRAN. NO.
         LI,1     512
         AWM,1    XPAGES            INCR  I/O BUFFER
         MTW,-1   XNGRAN            ARE THERE MORE GRANULES
         BGEZ     MOREGRAN
DONE     EQU      %
         LW,14    MONBUF
         BAL,11   RMB               RELEASE MONITOR BUFFER
         LW,0     R0SAVE            RESTORE R0 AND STACK.
         BAL,12   SLAVE             **** SET SLAVE MODE ****
         LCI      0
         PLM,0    *0
         B        *RWRET
BADRAD   EQU      %
IMPOSS   EQU      %
         LW,14    MONBUF
         BAL,11   RMB
         LW,0     R0SAVE            RESTORE R0.
         BAL,12   SLAVE             **** SET SLAVE MODE ****
         LI,14    X'19'
         BAL,15   POST
         LCI      0
         PLM,0    *0
         B        *RWRET            CONTINUE ANYWAY.
*                                   END ACTION ROUTINE
EABEGIN  EQU      %
         LW,1     14
         STW,12   TYC-EABEGIN,1
         B        *11
TYC      RES      1
EAEND    EQU      %
EASIZE   EQU      EAEND-EABEGIN
         PAGE
*                                   CLOSEOUT RESTORES
*                                   ORIGINAL CONDITIONS PRIOR TO
*                                   RETURNING.
                                         BAL,15 CLOSEOUT
*
*                                   COMPUTE NUMBER OF VIRTUAL PAGES
*                                   TO FREE.
CLOSEOUT   EQU    %
         STW,15   RETURN
         LCW,1   MAXRCD
         LW,2     XTRA              FIRST EXTRA PAGE
FVP      M:FVP    *2
         AI,2     512
         BIR,1    FVP
*                                   CLOSE DCBS
         M:SETDCB M:EI,(ERR,CLOSERR),(ABN,CLOSERR)
         M:SETDCB M:BO,(ERR,CLOSERR),(ABN,CLOSERR)
         M:CLOSE  M:EI,(SAVE)
         M:CLOSE  M:BO,(SAVE)
         B        *RETURN
CLOSERR  EQU      %
         LB,1     10
         CI,1     X'0A'             DCB ALREADY CLOSED
         BE       *8                YES, O.K.
         LI,14    X'18'             NO, SOMETHING PECULIAR.
         BAL,15   POST1             POST ERROR.
         B        *RETURN
         PAGE
*   COPY FID TO THE :SYS ACCOUNT AND
*  MODIFY THE RAD VERSIONS OF THE SHARED PROCESSOR TABLES IF
*  PERM WAS SPECIFIED.
PERM     EQU      %
         STW,15   P500              STORE EXIT
         STW,15   RETURN            .ADDRESS.
         BREAK    X'52',P005
P005     EQU      %
         LW,8     PFLAG             -NO. TEST IF PERM
         BNEZ     MODIFY            .OPTION REQUESTED. -YES.
P010     B        *P500             -NO. EXIT.
MODIFY   EQU      %
         BAL,15   MODRAD            MODIFY SHARED PROCESSOR
*                                   .TABLES ON THE RAD.
         MTW,0    TYPE
         BGZ      P010              EXIT IF MONITOR OVERLAY
*                                   PREPARE DCBS FOR COPY INTO :SYS
P150     LI,7     -P505+P504        MOVE M:BO PLIST
P151     LW,8     P505,7            .FOR COPY
         STW,8    BOPLIST+P505-P504,7 ..TO DATA
         BIR,7    P151                ...AREA.
         LD,8     PRONAME           STORE PRONAME
         STW,8    BOFILE            .IN M:BO
         STW,9    BOFILE+1          ..PLIST.
         LW,8     CFLAG             TEST FOR
         BNEZ     P180              .DELETE OPTION. -NO.
         B        P010              -YES. ALL DONE. EXIT.
*  ASSUME DCB M:EI STILL OPEN.
P180     EQU      %
         M:SETDCB M:EI,(ERR,P200),(ABN,P200) SET ERROR EXITS FOR M:EI
         LI,1     -13
         STW,1    OPENWAIT
         M:CLOSE  M:EI,(SAVE)       CLOSE M:EI DCB
P181     EQU      %
         CAL1,1   BOPLIST           OPEN M:BO DCB
         LI,1     1                 SET ACCESS TO SEQUENTIAL
         STW,1    EIPLIST+5
         LI,1     P200              RESET ERROR EXITS
         STW,1    EIPLIST+2
         STW,1    EIPLIST+3
         CAL1,1   EIPLIST
         M:PFIL   M:EI,(BOF)        POSITION M:EI TO BEGINNING.
         PAGE
*                                   COPYLOOP COPIES THE FID TO THE 'SYS
*                                   ACCOUNT. THE KEYS ARE ALTERED TO
*                                   CONTAIN THE PRONAME RATHER THAN
*                                   THE FID. THE ROOT TREE TABLE ALSO
*                                   REFLECTS THE PRONAME.
COPYLOOP EQU      %
         LW,1     MAXRCD
         AI,1     2
         SLS,1    11                GET BYTE COUNT
COPY1    EQU      %
         M:READ   M:EI,(BUF,*PAGES),(SIZE,*1),(ERR,RERR),(ABN,RERR)
*                                   MOVE KEY
         LI,1     -3
        LW,2     M:EI+10           PICK UP KBUF
         AI,2     3
         LW,3     *2,1              MOVE THE KEY
         STW,3    KEY+3,1
         BIR,1   %-2
*
*                                   WRITE THE RECORD
WRITE    EQU      %
         LW,1     M:EI+13           L/RWS (REC SIZE) FROM M:EI
         M:WRITE  M:BO,(BUF,*PAGES),(SIZE,*1),(ERR,WERR),(ABN,WERR),;
                 (KEY,KEY),(NEWKEY)
         LW,1     BREAKWD
         BGEZ     COPYLOOP
         M:CLOSE  M:BO,(REL)        YES, CLOSE PRONAME FILE WITH REL
         LI,14    X'53'
         STW,14   ERRFLAG
         BAL,15   FULLERR
         B        CLOSE
RERR     EQU      %
         LB,2     10
         CI,2     X'06'             BRANCH IF
         BE       EOF               END OF FILE.
         CI,2     X'07'             IS RECORD TOO BIG FOR BUFFER
         BNE      BADRD
         MTW,0    XMEM              YES RECORD TOO BIG OR PARITY
         BNEZ     BADRD
         LI,7     1
         LW,6     W500              NEXT VIRTUAL PAGE
XMORE    EQU      %
         M:GVP    *6
         BCS,8    XNONE
         AI,6     512               NEXT PAGE
         AI,1     512*4             SIZE
         AI,7     1
         B        XMORE
XNONE    EQU      %
         AI,7     -1
         STW,7    XMEM              SAVE NUMBER OF XTRA PAGES
         M:PRECORD M:EI,(N,1),(REV),(ABN,RERR)
         B        COPY1
BADRD    EQU      %
         MTW,0    XMEM
         BEZ      BADRD1
         BAL,15   XRID
BADRD1   EQU      %
         LI,14    X'25'             INSUFFICIENT MEMORY OR PARITY ERROR
*                                   ON READ IN COPY
         BAL,15   POST1
         B        P010
XRID     LCW,1    XMEM              RELEASE XTRA PAGES.
         LW,2     W500
         M:FVP    *2
         AI,2     512
         BIR,1    %-2
         B        *15
EOF      EQU      %                 COPYING IS DONE.
         BAL,15   XRID
         M:SETDCB M:BO,(ERR,P210),(ABN,P210) SET ERROR EXITS FOR M:BO.
         M:SETDCB M:EI,(ERR,P200),(ABN,P200) SET ERROR EXITS FOR M:EI.
         M:CLOSE  M:EI,(SAVE)
         M:CLOSE  M:BO,(SAVE)
         B        *RETURN           *** EXIT PERM***
WERR     EQU      %
         LB,1     10
         CI,1     X'57'             WAS THIS ERROR DUE TO NO MORE
         BNE      NOTSP             RAD SPACE IN 'SYS.
         LI,14    X'14'             YES
         BAL,15   POST1
         B        P010
NOTSP    LI,14    X'26'             A PLAIN OLD BAD WRITE
         B        P211              GO TO POST ERROR.
         PAGE
*  ERROR/ABN RETURN FROM WRITE/CLOSE M:BO
P210     LI,14    X'28'             ERROR: DRSP M:BO ERROR (PERM).
P211     EQU      %
         BAL,15   POST1             POST ERROR.
         M:SETDCB M:BO,(ERR,P215),(ABN,P215)
         M:CLOSE  M:BO,(REL)        TRY TO CLOSE/REL FILE.
P215     EQU      %
         B        P010              EXIT.
*  ERROR/ABN RETURN FROM OPEN M:BO
P220     EQU      %
         STW,SR1  SR1SAVE           SAVE LOCATION
         STW,SR3  SR3SAVE           .AND ERROR CODE.
         LW,11    P507              IS THE FILE
         CS,10    P506              .ALREADY OPEN.
         BNE      P221              -NO. ERROR.
         MTW,1    OPENWAIT          -YES.  HAS WAIT COUNTER
         BGEZ     P221              .COUNTED DOWN. -YES. ERROR.
         M:WAIT   4                 -NO. PROGRAM PAUSE.
         B        P181              TRY OPEN AGAIN.
P221     LI,14    X'29'             ERROR: CAN'T OPEN M:BO IN :SYS(PERM)
         BAL,15   POST1             POST ERROR BUT CONTINUE
         B        P010              .PROCESS WITHOUT PERM FUNCTION.
*  ERROR/ABN RETURN FROM M:EI I/O IN PERM
P200     LI,14    X'1C'             ERROR: DRSP M:EI ERROR (PERM)
         B        P211              POST AND EXIT.
         PAGE
*                                   USAGE:
*                                        BAL,15  SCAN
*                                    OR  BAL,15  SCANT
*                                   INPUT:
*                                        R8 = DEPOSIT ADDRESS
*                                        R9 = DELIMITER TABLE ADDRESS
*                                        R10= # OF DELIMITERS
*                                        R11= MAX NUMBER OF CHARACTERS
*                                   OUTPUT:
*                                        R12 = 0 IF FIELD WAS WITHIN MAX
*                                             >0 IF GREATER
SCANT    EQU      %
         LI,2     1
         LW,5     11                PRESET MAX CHR POSITION IN R5.
         B        SCAN0
SCAN     EQU      %
         LI,2     0
         LW,5     11                PRESET MAX CHR
         MTW,-1   5                 .POSITION IN R5
SCAN0    EQU      %
         STW,2    BDT
B        LI,12    ' '               BLANK OUT DEPOSIT FIELD
         LCW,3    11
         LW,1     8
         SLS,1    2
B1       STB,12   0,1
         AI,1     1
         BIR,3    B1
         STW,2    BDT
         LI,14    STORECHR          PRESET SWITCH TO STORE
*                                   .FIRST NON-DELIMITER CHARACTERS.
         LW,1     BYTE              GET POINTER TO FIRST BYTE OF FIELD
         LI,12    0                 INIT MAX FIELD FLAG
SCAN1    EQU      %
         MTW,-1   ARS               HAVE WE REACHED END OF INPUT
         BLZ      SCANEXIT
SCAN2    EQU      %
         LB,4     CMDBUF,1          GET A CHARACTER
         AI,1     1                 POINT TO NEXT
         CI,4     ' '
         BE       BLNK              GO HANDLE BLANKS/TABS
         CI,4     X'05'
         BE       BLNK              GO HANDLE BLANKS/TABS
         LW,3     10                NUMBER OF DELIMITERS
         CB,4     *9,3
         BE       SCANEXIT          OUT IF CHARACTER IS A DELIMITER.
         BDR,3    %-2
         B        *14        SWITCH: EITHER 1)STORE CURR CHR (STORECHR
*                                    OR     2)BACK UP SCAN (BACKUP) AND
*                                   TERMINATE ON FOLLOWING SPACES, TABS.
*        PROCESS  LEADING AND FOLLOWING SPACES AND TABS
BLNK     EQU      %
         CW,2     BDT               IGNORE LEADING
         BE       SCAN1             .SPACES AND TABS.
         LI,14    BACKUP            SET SWITCH TO BACKUP SCAN IF FIELD
*                                   .TERMINATES WITH FOLLOWING SPACES
*                                   ..TO A NON-DELIMITER CHARACTER.
         LW,3     10                IS CURRENT CGARACTER
         CB,4     *9,3              .ONE OF THE
         BE       SCANEXIT          ..DELIMITERS -YES.
         BDR,3    %-2               -NO.
         B        SCAN1             IGNORE FOLLOWING SPACES (WHEN NOT
*                                   .A SPECIFIED DELIMITER)
STORECHR EQU      %
         CW,2     5                 IS MAX CHR POSITION
         BLE      YESSTORE          .EXCEEDED.  -NO.
         AI,12    1                 -YES. COUNT OVER-RUN CHRS IN REG 12.
         B        SCAN1             GO GET NEXT CHR.
YESSTORE EQU      %
         STB,4    *8,2              MOVE CHARACTER TO DEPOSIT AREA.
         AI,2     1                 BUMP NUMBER MOVED
         B        SCAN1
BACKUP   EQU      %
         MTW,1    ARS
         AI,1     -1
         LI,4     ' '
SCANEXIT  EQU     %
         STW,1    BYTE              SAVE POINTER
         STW,4    ENDC              SAVE END CHARACTER
         SW,2     BDT
         STW,2    LCF               SAVE FIELD LENGTH
         MTW,0    BDT
         BEZ      %+2
         STB,2    *8                STORE CHARACTER COUNT IF SCANT
         B        *15
         PAGE
*        GFID     CALLING SEQUENCE: R12-ADDRESS OF FILE NAME (4 WORDS)
*                                   R13-ADDRESS OF ACCOUNT (2 WORDS)
*                                   R14-ADDRESS OF PASSWORD (2 WORDS)
*                                   BAL,15 GFID
*                                   ON RETURN CELL G505 SET NON-ZERO
*                                     IF ANY FIELD EXCEEDS THE NUMBER
*                                       OF CHARACTERS ALLOWED.
GFID     LCI      4                 SAVE PARAMETERS
         STM,12   G500              AND EXIT ADDRESS.
         LCI      4                 SET PARAMETERS: R8=G504 (DESTINATION)
         LM,8     G510                              R9=G514 (TERMINATORS)
         LI,11    15                                R10=G515 (LENGTH)
*                                                   R11=15  (MAX CHARS)
         BAL,15   SCANT             GET NEXT FIELD.
         STW,12   G505              STORE 'MAX EXCEEDED' FLAG.
         LW,8     LCF               IS FIELD
         BEZ      G030              .EMPTY. -YES.
         STB,8    G504              -NO. STORE FIELD LENGTH.
         LCI      4                 MOVE FIELD
         LM,12    G504              .TO FILE NAME
         STM,12   *G500             ..LOCATIONS.
         B        G040
G030     LI,9     0                 ZERO
         LD,10    8                 .FILL
         LCI      4                 ..FILE
         STM,8    *G500             ...NAME.
G040     LW,8     ENDC              IS
         CI,8     '.'               .TERMINATOR
         BE       G050              ..A PERIOD. -YES.
GFIDEXIT LCI      4                 -NO. RESTORE
         LM,12    G500              .REGISTERS.
*                                   (G505 FLAG REMAINS SET IF IT
         B        *15               .EVER WAS). EXIT.
G050     LCI      4                 SET PARAMETERS: R8=G504 (DESTINATION)
         LM,8     G510                              R9=G514 (TERMINATORS)
*                                                   R10=G515 (LENGTH)
*                                                   R11=8 (MAX CHARS)
         BAL,15   SCAN              GET NEXT FIELD.
         OR,12    G505              STORE 'MAX
         STW,12   G505              .EXCEEDED' FLAG.
         LW,8     LCF               IS FIELD
         BEZ      G060              .EMPTY.  -YES, IGNORE ACCT FIELD.
         LCI      2                 -NO. MOVE
         LM,12    G504              .ACCOUNT
         STM,12   *G501             ..FIELD.
G060     LW,8     ENDC              IS
         CI,8     '.'               .TERMINATOR
         BNE      GFIDEXIT          ..A PERIOD. -NO. EXIT.
         LCI      4                 -YES.
         LM,8     G510              SET PARAMETERS:R8=G504 (DESTINATION)
*                                                  R9=G514 (TERMINATORS)
*                                                  R10=G515 (LENGTH)
*                                                  R11=8 (MAX CHARS)
         BAL,15   SCAN              GET NEXT FIELD.
         OR,12    G505              STORE 'MAX
         STW,12   G505              .EXCEEDED' FLAG.
         LW,8     LCF               IS FIELD
         BEZ      GFIDEXIT          .EMPTY. -YES, EXIT.
         LCI      2                 -NO. MOVE
         LM,12    G504              .PASSWORD
         STM,12   *G502             ..FIELD.
         B        GFIDEXIT          EXIT.
         PAGE
*    PURPOSE: RELEASE INACTIVE PROCESSOR P:NAME SLOTS
*             BACK TO THE SYSTEM.
*    BAL,11 CLEANUP      SCANS THE P:NAME TABLE FOR SLOTS CONTAINING
*                        AN INDEX.  IF THE CORRESPONDING PB:REP TABLE
*                        ENTRY HAS BEEN COUNTED DOWN TO ZERO, M:DUMLM
*                        IS STORED IN THE P:NAME ENTRY AND ANY
*                        ASSOCIATED OVERLAY SLOTS ARE SET TO ZERO.
CLEANUP  EQU      %
         STW,11   CL500             STORE EXIT.
         LCI      8                 SAVE WORKING
         PSM,1    *0                .REGISTERS.
         LI,1     MAXOVLY           PRESET INDEX COUNT TO
*                                   .CHECK PROCESSOR SLOTS ONLY.
CL010    CI,1     PNAMEND           HAS ENTIRE P:NAME
         BL       CL030             .TABLE BEEN CHECKED. -NO.
         LCI      8                 -YES. RESTORE
         PLM,1    *0                .WORKING REGISTERS.
         B        *CL500            EXIT.
CL030    LD,2     *XP:NAME,1        DOES PROCESSOR
         CW,2     1                 .SLOT CONTAIN
         BE       CL050             ..SLOT INDEX. -YES.
CL040    AI,1     1                 -NO. INCREMENT
         B        CL010             .INDEX AND LOOP.
CL050    LB,2     *XPB:REP,1        HAS 'USERS ASSOCIATED'
         BEZ      CL057             .COUNT GONE TO ZERO. -YES.
         DO       DEBUG=1
         CI,2     X'80'             -NO. TEST COUNT
         BANZ     CL053             .NEGATIVE.   -YES.
         FIN
         CI,2     SMUIS             -NO. IS COUNT GRTR THAN
         BLE      CL040             .NUMBER OF USERS. -NO.
CL053    LCI      3                 -YES. SAVE
         PSM,13   *0                .REGISTERS.
         LW,13    1                 CONVERT INDEX
         BAL,15   L450              .NUMBER FOR
         STW,13   CL502+1           ..MESSAGE.
         LW,13    2                 CONVERT USER
         BAL,15   L450              .COUNT FOR
         STW,13   CL502+2           ..MESSAGE.
         M:PRINT  (MESS,CL502)      MESSAGE: # XX XX USERS.
         LCI      3                 RESTORE
         PLM,13   *0                .REGISTERS.
         B        CL040             TREAT AS NON-ZERO COUNT.
CL057    EQU      %
         PSW,12   *0                SAVE REGISTER.
         BAL,12   MASTER            **** SET MASTER MODE ****
         LD,2     DUMLM             STORE DUMMY
         STD,2    *XP:NAME,1        .NAME IN SLOT.
         LOAD,8   *XPX:HPP,1        ARE THERE PAGES
         BEZ      CL058             .TO BE RELEASED. -NO.
         LW,6     1                 -YES.
         BAL,12   CL100             RELEASE PAGES BACK TO MONITOR.
CL058    EQU      %
         LI,3     0                 START LINKING WITH
         LW,4     1                 .PROCESSOR PB:LNK.
CL060    EQU      %
         LB,2     *XPB:LNK,4        PICK UP OVERLAY LINK.
         STB,3    *XPB:LNK,4        SET CURRENT PB:LNK TO ZERO.
         BEZ      CL070             IS THIS THE LAST OVERLAY LINK. -YES.
         STD,3    *XP:NAME,2        -NO. ZERO OVERLAY SLOT IN P:NAME.
         LOAD,8   *XPX:HPP,2        ARE THERE PAGES
         BEZ      CL065             .TO BE RELEASED. -NO.
         LW,6     2                 -YES. RELEASE PAGES
         BAL,12   CL100             .BACK TO MONITOR.
CL065    EQU      %
         LW,4     2                 LINK TO NEXT OVERLAY.
         CI,4     PPROCS            IS TABLE LIMIT
         BL       CL060             .EXCEEDED. -NO.
         BAL,12   SLAVE             -YES. **** SET SLAVE MODE ****
         PLW,12   *0                RESTORE REGISTER.
*                                   ERROR: OVLY LINK EXCEEDS
         M:PRINT  (MESS,CL501)             TABLE LIMIT.
         LI,14    3                              TABLE LIMIT
         BAL,15   POST              ERROR: PROGRAM ERROR (SHOULDN'T
*                                          HAPPEN)'
         B        CLOSE             ERROR EXIT.
CL070    EQU      %
         BAL,12   SLAVE             **** SET SLAVE MODE ****
         PLW,12   *0                RESTORE REGISTER.
         B        CL040
*
*        PURPOSE: RELEASE PAGES TO MONITOR
*        REG 6=  SLOT INDEX
*        BAL,12   CL100
*                                   REQUIRES MASTER MODE
*                                   WILL INHIBIT INTERRUPTS
CL100    EQU      %
         WD,0     X'37'             **** INHIBIT INTERRUPTS ****
         LOAD,8   *XPX:HPP,6        TEST HEAD AGAIN IF PAGES
         BEZ      CL150             .CAN BE RELEASED. -NO, EXIT
         LW,7     *XM:FPPT          GET BYTE LOC OF MONITOR TAIL.
         STORE,8  *XMX:PPUT,7       STORE HEAD IN MONITOR TAIL
         LOAD,8   *XPX:TPP,6        GET CHAIN TAIL
         STW,8    *XM:FPPT          STORE IN MONITOR TAIL.
         LB,8     *XPB:PSZ,6        GET SIZE AND ADD
         AWM,8    *XM:FPPC          .TO MONITOR FREE PAGE COUNT.
         LI,8     0                 SET HEAD
         STORE,8  *XPX:HPP,6        .AND TAIL
         STORE,8  *XPX:TPP,6        ..TO ZERO.
CL150    EQU      %
         WD,0     X'27'             **** ENABLE INTERRUPTS ****
         B        *12               EXIT.
*
*        CONVERT DISC ADR TO RELATIVE SECTOR NUMBER
*  I 8  = DCT INDEX IN BYTE0  DISC ADR IN REST
*  O 8  = RELATIVE SECTOR NUMBER
*
*
*   REAL SEEK ADR. TO RELATIVE SECTOR
*
*         (**=DOUBLE REGISTER SHIFT) REAL SEEK=CYL.TRK.SEC
*   DISK PACK:|(CYL.TRK.SEC)**(32-CYL%SHFT)~*NSPC
*         + |(TRK.SEC)**(CYL%SHFT-TRK%SHFT)~*NSPT
*                   + |(SEC)**(TRK%SHFT-SEC%SHFT)~
*
*   RAD: |(TRK.SEC)**(48-TRK%SHFT)~*NSPT
*         + |(SEC)**(TRK%SHFT-SEC%SHFT)~
*
*
SEEKCVT  EQU      %
          LCI       6
          PSM,R2    *R0                 SAVE REGS R2-R7
          LB,R4     R8                  R4=DCT INDEX
          BEZ       SEEK%CVT%ERR        ZERO=NO DCT INDEX=ERROR
          LB,R4     *XDCT22,R4          R4=SUBTYPE TABLE INDEX
          BEZ       SEEK%CVT%ERR        ZERO=NO TYPE GIVEN=ERROR
          LI,R7     0
          LW,R3     R8                  MOVE REAL DSK ADDRESS TO R3
          AND,R3    M24                 CYL# RESTRICTED TO 0-255
          LI,R2     0
          LI,R5     32                  R5=SHIFT OFFSET FOR DISK PACK
          MTW,0     *XNCYL,R4           CK CYL ALLOCATED DEV.
          BNEZ      CYL%CVT             YES PACK SPECIFIED
          LI,R6     48                  R6=SHIFT OFFSET FOR RAD
          B         TRK%SEEK%CVT
CYL%CVT   EQU       %
          LI,R6     X'7F'
          AND,R6    *XCYL%SHFT,R4       GET CYL SHIFT FACTOR IN R6
          SW,R5     R6                  R5=CYL SIZE
          SLD,R2    0,R5                R2=CYL # RIGHT JUSTIFIED
          LW,R7     R2                  MOVE CYL # TO R7
          MW,R7     *XNSPC,R4           CYL # * NSPC
TRK%SEEK%CVT EQU    %
          LI,R2     0
          LI,R5     X'7F'
          AND,R5    *XTRK%SHFT,R4       GET TRK SHFT FACTOR
          SW,R6     R5
          SLD,R2    0,R6                R2=TRACK ADDR.
          LI,R6     X'7F'
          AND,R6    *XSEC%SHFT,R4       GET SECTOR SHIFT FACTOR
          SW,R5     R6
          SCS,R3    0,R5                MOVE SECTOR TO R3
          AW,R7     R3                  CYL*NSPC+SEC
          LW,R3     R2
          MW,R3     *XNSPT,R4           TRK*NSPT
          AW,R7     R3                  R7=RELATIVE SECTOR #
          LW,R8     R7                  MOVE REL.SEC.# TO R8
          LCI       3
SEEK%CVT%EXIT EQU   %
          STCF      11
          LCI       6
          PLM,R2    *R0                 RESTORE REGISTERS
          LCF       11                  RESTORE CONDITION CODES
          B         *11                 RETURN
SEEK%CVT%ERR EQU    %
          LCI       0                   SET CC FOR ERROR RETURN
          B         SEEK%CVT%EXIT
         END      START

