*        METASYM    MAPINIT         MULTI-ACCOUNT PACK VOLINIT PROCESSOR
*
*
*
*
*
CODE     CSECT    1                 PROTECTED MEMORY
DATA     CSECT    0                 WRITEABLE MEMORY
         SYSTEM   SIG7FDP           ALL SIGMA 7 INSTRUCTIONS
         SYSTEM   BPM               CP-V PROCEDURES
         SYSTEM   RTPROCS           REAL TIME PROCEDURES
,,01FPTS M:PT     1                 ASSEMBLE FPT'S IN PROTECTED MEMORY
*
ADENTLEN EQU      21                ACCOUNT DIRECTORY ENTRY LENGTH
MAX#ACNT EQU      (2048-12)/ADENTLEN MAXIMUM NUMBER OF ACCOUNTS
*
DEBUG    SET      -1
*                                     <0  NO DEBUG OUTPUT - WRITE DISK
*                                     =0  DEBUG OUTPUT - WRITE DISK
*                                     >0  DEBUG OUTPUT - DON'T WRITE DSK
*
         TITLE    'E Q U A T E S'
*
*
*        E Q U A T E S
*
*
X0       EQU      0
X1       EQU      1
X2       EQU      2
X3       EQU      3
X4       EQU      4
X5       EQU      5
X6       EQU      6
X7       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
*
SR1      EQU      8
SR2      EQU      9
SR3      EQU      10
SR4      EQU      11
*
D1       EQU      12
D2       EQU      13
D3       EQU      14
D4       EQU      15
         TITLE    'P R O C E D U R E S'
*
*
*
TXTC     CNAME
         PROC
LF       DATA     S:NUMC(AF)
         LIST     0
         TEXT     AF
         LIST     1
         PEND
*
*
*
PULL     CNAME          X'08'
PUSH     CNAME          X'09'
         PROC
         DO             AF(2)<2
LF       GEN,1,7,4,3,17 AFA(1),NAME,CF(2),0,AF(1)
         ELSE
         DO             AF(2)>15
LF       LCI            0
         ELSE
LF       LCI            AF(2)
         FIN
         GEN,1,7,4,3,17 AFA(1),NAME+2,CF(2),0,AF(1)
         FIN
         PEND
*
*
*
GOBACK   CNAME
         PROC
         PULL,R15 *X0,1             RESTORE RETURN ADDRESS
         B        *R15                AND RETURN.
         PEND
**
**
**
SAVRTN   CNAME
         PROC
         PUSH,R15 *X0,1             SAVE RETURN ADDRESS.
         PEND
**
**
**
CALL     CNAME
         PROC
         BAL,R15  AF(1)
         PEND
**
**
**
ENABLE   CNAME    X'27'
DISABLE  CNAME    X'37'
         PROC
LF       WD,0     NAME
         PEND
         USECT    CODE
***********************************************************************
         TITLE    'M A P I N I T  --  PRIVATE PACK INIT'
***********************************************************************
**********           M A P I N I T                          ***********
***********************************************************************
**
MAPINIT  EQU      %
         DEF      MAPINIT
*
         CALL     INITIALIZE        INITIALIZE.
         CALL     LOCDEV            GET DEVICE SPECIFICATION.
         CALL     GETNGC            GET NUMBER GRANS PER CYL.
         CALL     GETVSN            GET PACK SERIAL NUMBER.
         CALL     GETACN            GET ACCOUNT INFO.
         CALL     SETVTOC           SET UP VTOC.
         CALL     SETAD             SET UP ACCOUNT DIRECTORY.
         CALL     WRTVTOC           WRITE VTOC AND AD.
         CALL     WRTFD             WRITE FILE DIRECTORIES.
         LI,R14   TXTC:SUCCESS      TELL USER THAT ALL'S WELL
         BAL,R15  #POSTMES            THAT ENDS WELL.
         M:EXIT
*
***********************************************************************
         TITLE    'I N I T I A L I Z A T I O N'
***********************************************************************
*
*
*                      I N I T I A L I Z A T I O N
*
*
*
*  GIVE THE EXIT CONTROL ROUTINE THE ENTRY ENVIROMENT
*  AND SET UP THE CRITICAL CELLS FOR OUR EXIT CONTROL
*  SUBROUTINE.  FINALLY GO OFF TO THE EXIT CONTROL ROUTINES
*  TO PUT EXIT CONTROL IN EFFECT.
***********************************************************************
INITIALIZE EQU    %
         SAVRTN                     SAVE RETURN ADDRESS.
         LI,R8    0
         STW,R8   MORE%TO%GO        INIT INPUT REMAINING FLAG.
*
         M:PC     0                 RESET PROMPT CHARACTER.
*
*  DETERMINE THE USER'S MODE OF OPERATION AND MARK THE CURRENT
*  POSITION IN THE PROGRAM.
*
         LB,R8    J:JIT             (R8) = MODE BITS FROM JIT
         SLS,R8   -6                CONVERT TO >>=  -1 BATCH
         AI,R8    -1                                 0 GHOST
         STW,R8   MODE                              +1 ON-LINE
         BGEZ     GREET%USER        IF BATCH,
         LI,R15   ' '               SUPPLEMENTARY DELIMITER
         STW,R15  OTHER%TERM          PASSED TO GETREPLY.
         BAL,R15  GETREPLY          FLUSH "!MAPINIT ".
         LI,R15   X'FF'             RESET DELIMITER.
         STW,R15  OTHER%TERM
*
GREET%USER EQU    %
         BAL,R15  GREETINGS         SALUTORY MESSAGE TO USER.
*
         LI,R14   TXTC:DW           ASSUME DEBUG WITH DISK WRITE.
         MTW,0    DEBUGSW           CHECK DEBUG MODE.
         BLZ      %+4               NEGATIVE--NO DEBUG.
         BEZ      %+2               ZERO--DEBUG WITH DISK WRITE.
         LI,R14   TXTC:DNW          POSITIVE--DEBUG WITH NO DISK WRITE.
         BAL,R15  #POSTMES
*
         BAL,R15  BLANK%LINE        SKIP A LINE.
         MTW,0    DEBUGSW           IF DEBUG MODE WITH NO DISK WRITE,
         BGZ      INIT999             DON'T DO MASTER MODE TRICKS.
*
*  CHECK THE USERS PRIVILEGE
*
         LB,R8    JB:PRIV           (R8) = USER'S PRIVILEGE
         CI,R8    X'C0'             DOES HE HAVE ENOUGH PRIVILEGE
         BGE      INIT01            YES--CONTINUE
*                                   NO---GO POST ERROR MESSAGE
INIT00   LI,R14   MESS01            (R14) = ADDRESS OF ERROR MESSAGE
         BAL,R15  #POSTMES          GO REPORT THE PROBLEM
         M:XXX                      ABORT THE JOB
*
*  CHECK FOR CORRECT MONSTK
*
INIT01   M:SYS                      GET MASTER MODE
*                                   (SR1) = ADDRESS OF <QUEUE>
*                                   (SR2)  = ADDRESS OF <QUEUE1>
*                                   (SR3)  = ADDRESS FO <NEWQ>
         BCS,8    INIT00            NOT ENOUGH PRIVILEGE - GO BACK
         CI,SR1   QUEUE             IS <QUEUE> ADDRESS OK
         BNE      INIT02            NO---GO GIVE MESSAGE AND ABORT
         CI,SR2   QUEUE1            IS <QUEUE1> ADDRESS OK
         BNE      INIT02            NO---GO GIVE MESSAGE AND ABORT
         CI,SR3   NEWQ              IS <NEWQ> ADDRESS OK
         BE       INIT10            YES--CONTINUE
*                                   NO---GIVE MESSAGE AND ABORT
INIT02   BAL,R15  SLAVE             RETURN TO SLAVE MODE
         LI,R14   MESS02            (R14) = ADDRESS OF ERROR MESSAGE
         BAL,R15  #POSTMES          GO TELL THE USER
         M:XXX                      ABORT THE JOB
*
*  RETURN TO SLAVE
*
INIT10   BAL,R15  SLAVE             RETURN TO SLAVE MODE
*
INIT999  EQU      %
         GOBACK                     RETURN TO CALLER.
*
***********************************************************************
         TITLE 'P R O C E S S   D E V I C E   S P E C I F I C A T I O N'
***********************************************************************
*
*
*                   L O C A T E   T H E   D E V I C E
*
*
***********************************************************************
*
LOCDEV   EQU      %
         SAVRTN                     SAVE RETURN ADDRESS.
LOCDEV00 LI,R14   MESS03            (R14) = ADDRESS OF DEVICE QUESTION
         BAL,R15  QUERY             GO ASK THE USER
         BAL,R15  GETREPLY          GO GET USER'S ANSWER
*                                   (R14) = # OF CHARACTERS IN ANSWER
         CI,R14   0                 IF NO INPUT,
         BNE      %+3
         LI,R14   MESS46              COM-
         B        LOCDEV02            PLAIN.
*
         CI,R14   3                 IS IT A LEGAL SIZE RESPONSE
         BE       LOCDEV20          YES--GO USE IT
         BL       LOCDEV01          NO---TOO FEW.
         LI,R14   MESS05            NO---TOO MANY.
         B        LOCDEV02
*                                   NO---TELL THE POOR USER
LOCDEV01 LI,R14   MESS04            (R14) = ADDRESS OF ERROR MESSAGE
LOCDEV02 BAL,R15  #POSTMES          GO OUTPUT THE MESSAGE
         LI,R15   LOCDEV00          (R15) = RETURN ADDRESS IF RETRY OK.
         B        CHKRETRY          GO ABORT OR RETURN FOR RETRY
*                                   (X2) = INDEX OF FIRST NON-BLANK
*
*  FIND THE DEVICES DCT INDEX
*
LOCDEV20 EQU      %
         AI,X2    BA(INBUF)         MAKE INDEX INTO BYTE ADDRESS.
         LW,X3    =X'03000001'+R8*4   DESTINATION POINTER FOR
         MBS,X2   0                   MOVING DEVICE ID.
*
         MTW,0    DEBUGSW           IF DEBUG MODE WITH NO DISK WRITE,
         BLEZ     LOCDEV205
         LI,R9    48000               FAKE # SECTORS ON DEVICE;
         STW,R9   %DISCLIM
         LI,R9    X'DADA'             FAKE DCTX.
         STW,R9   %DCTX
         LI,R9    30                FAKE # GRAN/CYL.
         STW,R9   %NGC
         STW,R9   %MINHGPNGC
         B        LOCDEV50
*
LOCDEV205 EQU     %
         LW,R9    MSK123            (R9) = MASK FOR BYTES 123      ...
         LI,X1    BATAPE            COMPUTE DCTX
         AI,X1    AVRTBLNE-1                     OF LAST PACK
         LI,R12   AVRTBLNE          COMPUTE NUMBER
         AI,R12   -AVRTBLSIZ                       OF PACKS
         BAL,R15  MASTER            GO GET MASTER MODE
LOCDEV21 LD,R10   DCT16,X1          (R11) = PACK ADDRESS IN EBCDIC
         CS,R8    R11               IS THIS THE ONE THE USER WANTED
         BE       LOCDEV25          YES--GO SEE IF ITS PARTITIONED
         AI,X1    -1                NO---MOVE TO NEXT DEVICE
         BDR,R12  LOCDEV21          GO CHECK NEXT PACK - IF ANY
         LI,R14   MESS06            USER ADDRESS NOT VALID
         B        LOCDEV90          GO SHED MASTER MODE AND TELL USER
*
*  MAKE SURE DEVICE IS NOT PARTITIONED
*
LOCDEV25 LB,R8    DCT3,X1           (R8) = DEVICE SWITCHES
         CI,R8    X'20'             IS THIS DEVICE PARTITIONED
         BAZ      LOCDEV30          NO---GO FILE ITS DCT INDEX AWAY
         LI,R14   MESS48            YES--(R14) = ADDR OF ERROR MESSAGE
         B        LOCDEV90          GO SHED MASTER MODE AND TELL USER
*
*  FILE AWAY DEVICE SPECIFIC DATA
*
LOCDEV30 STW,X1   %DCTX             SAVE DCT INDEX
         LB,X2    DCT22,X1          (X2) = DISC TYPE
         LW,R8    DISCLIMS,X2       (R8) = # SECTORS ON DEVICE
         STW,R8   %DISCLIM          SAVE IT
*
         LI,X3    HGP               GET ADDR OF HGP TABLE.
         SLS,X1   16                DCTX TO LEFT HW FOR CS.
         LW,X2    =X'FF0000'
*
LOCDEV303 EQU     %
         CS,X1    1,X3              CHECK IF SAME DCTX.
         BE       LOCDEV306
         LW,X3    0,X3              GET FLINK.
         BGZ      LOCDEV303         IF MORE, KEEP LOOKING.
         LI,R14   MESS18            TELL USER NO HGP FOR DCTX.
         B        LOCDEV02          REPORT ERROR.
**
LOCDEV306 EQU     %
         STD,R10  ASKOPMSG+8        SAVE DEV ADDRESS FOR OP MESSAGE.
         LW,X2    1,X3              GET NGC.
         AND,X2   =X'FF'
         STW,X2   %NGC
*
         LI,X1    X'FFFF'           GET # WDS IN
         AND,X1   4,X3                HGP BIT MAP.
         SLS,X1   6                 CALC # BITS * 2.
         LW,X3    %DISCLIM          # SECTORS / # BITS * 1 BIT/CYL
         LI,X2    0                   * 1 GRAN/2 SECTORS = MIN NGC.
         DW,X2    X1
         AI,X2    0                 CHECK IF ANY SECTORS LEFTOVER.
         BEZ      %+2
         AI,X3    1
         STW,X3   %MINHGPNGC
*
         LW,X1    %DCTX             RESTORE DCTX.
         AI,X1    -BATAPE           COMPUTE INDEX FOR AVR TABLES
         STW,X1   %AVRX             SAVE IT
*
*  CHECK TO MAKE SURE DEVICE IS AVAILABLE
*
         LD,R8    AVRTBL,X1         GET
         LH,R10   AVRID,X1              AVR
         LB,R11   SOLICIT,X1                TABLE
         LH,R12   AVRNOU,X1                       ENTRIES
LOCDEV31 EQU      %
         BAL,R15  SLAVE             DON'T NEED MASTER ANYMORE.
         LI,R14   MESS08
         CW,R9    SP:PUB            PUBLIC?
         BANZ     LOCDEV02
         LI,R14   MESS13
         CI,R10   0                 EXCLUSIVE?
         BNE      LOCDEV02
         LI,R14   MESS14
         CI,R12   0                 CURRENTLY SHARED?
         BNE      LOCDEV02
         LI,R14   MESS15
         CI,R11   0                 SOLICITED?
         BNE      LOCDEV02
         LI,R14   MESS12
         CW,R9    SP:MTD            MOUNT PENDING?
         BANZ     LOCDEV02
         LI,R14   MESS11
         CW,R9    SP:VER            VERIFICATION IN PROGRESS?
         BANZ     LOCDEV02
         LI,R14   MESS09
         CW,R9    SP:AVR            ALREADY VERIFIED?
         BANZ     LOCDEV02
         LI,R14   MESS10
         CW,R9    SP:INIT           BEING INITIALIZED?
         BANZ     LOCDEV02
         LI,R14   MESS07
         CI,R8    0                 OPERATOR PREMOUNT?
         BNE      LOCDEV02
**
**  PACK IS AVAILABLE.
**
*
*   HAVE DCTX.
*
LOCDEV50 EQU      %
**   CALCULATE MINIMUM NGC.
         LW,R9    %DISCLIM          # SECTORS ON DEVICE.
         LI,R8    0                 READY FOR DIVIDE BY
         DW,R8    =503*2*32           MAX # WORDS IN BIT MAP *
         CI,R8    0                   # SECTORS / GRAN * # BITS /
         BEZ      %+2                 WORD THEN ROUND UP FOR
         AI,R9    1                   MINUMUM NGC.
         STW,R9   NGCLIM            SET NGC LIMITS.
         LI,R9    255               BYTE WIDTH.
         STW,R9   NGCLIM+1
*
         LI,X2    BA(MESS49)        TELL USER HOW MANY
         LW,X3    MESS49              SECTORS ARE ON
         AI,X3    4                   THE DEVICE.
         SCS,X3   -8                SHIFT # BYTES IN MSG TO
         AI,X3    BA(MSGLEN)          CREATE DESTINATION POINTER.
         MBS,X2   0                 MOVE MESSAGE TO DATA SECTION.
*
         LW,X1    NGCLIM            SHOW MIN NGC.
         LI,X2    BA(MSGBUF)+50
         LI,X3    3
         BAL,R15  BINTODEC
*
         LW,X1    %NGC              PASS # GRAN PER CYL.
         LI,X2    BA(MSGBUF)+27
         LI,X3    3
         BAL,R15  BINTODEC          CONVERT TO TEXT.
*
         LW,X1    %MINHGPNGC        TELL MIN HGP NGC.
         LI,X2    BA(MSGBUF)+63
         LI,X3    3
         BAL,R15  BINTODEC
*
         LW,X1    %DISCLIM          GET # SECTORS.
         LI,X2    BA(MSGBUF)+3      PASS DECIMAL TEXT DESTINATION.
         LI,X3    6                 PASS # CHARS MAX IN FIELD.
         BAL,R15  BINTODEC          CONVERT # SECTORS TO TEXT.
         LI,R14   MSGLEN            (R14) = ADDRESS OF MESSAGE
         BAL,R15  #POSTMES            AND TELL USER.
*
         BAL,R15  BLANK%LINE        PRINT BLANK LINE.
         GOBACK                     RETURN TO CALLER.
*
*  SHED MASTER MODE AND GO REPORT ERROR
*
LOCDEV90 BAL,R15  SLAVE             SHED MASTER MODE
         B        LOCDEV02          GO REPORT THE ERROR
***********************************************************************
***********************************************************************
         TITLE    ' P R O C E S S   N G C'
***********************************************************************
**
**                 GETNGC
**
**
***********************************************************************
*
GETNGC   EQU      %
         SAVRTN   SAVE RETURN ADDRESS.
*
GETNGC00 EQU      %
         LI,R14   TXTC:ENTNGC       PROMPT USER
         BAL,R15  QUERY               FOR NGC.
         BAL,R15  GETREPLY          GET ANSWER.
*
         CI,R14   0                 IF NO REPLY,
         BE       GETNGC50            USE DEFAULT.
*
         LI,R9    0                 ZERO ACCUMULATOR.
GETNGC05 EQU      %
         LB,R8    INBUF,X2          GET NEXT CHARACTER.
         CLM,R8   DIGLIM            IF NOT A DIGIT,
         BCR,9    GETNGC10
         LI,R8    '/'                 MARK BAD CHAR,
         STB,R8   INBUF,X2
         LI,R14   MESS19
GETNGC07 EQU      %
         BAL,R15  #POSTMES            TELL USER AND
         LI,R15   GETNGC00
         B        CHKRETRY            CHECK IF RETRY IS OK.
*
GETNGC10 EQU %
         AI,R8    -'0'              CONVERT EBCDIC TO INTEGER.
         MI,R9    10                MAKE ROOM FOR NEXT DECIMAL DIGIT.
         AW,R9    R8
         AI,X2    1                 INCREMENT CHARACTER INDEX.
         BDR,R14  GETNGC05          PROCESS NEXT CHAR IF THERE.
**
         LI,R14   TXTC:NGCLIMERR    ASSUME VALUE ERROR.
         CLM,R9   NGCLIM            IF NOT WITHIN PROPER RANGE,
         BCS,9    GETNGC07            TELL USER.
*
         CW,R9    %MINHGPNGC        COMPARE OUR NGC TO MINIMUM.
         BGE      %+3               IF LESS THAN,
         LI,R14   TXTC:NGCLOW         NOTE TO USER.
         BAL,R15  #POSTMES
         STW,R9   %NGC              SAVE NGC.
*
GETNGC50 EQU      %
         BAL,R15  BLANK%LINE
         GOBACK                     RETURN TO CALLER.
*
***********************************************************************
         TITLE    'P R O C E S S   S E R I A L   N U M B E R'
***********************************************************************
*
*
*               G E T   T H E   S E R I A L   N U M B E R
*
*
***********************************************************************
*
GETVSN   EQU      %
         SAVRTN                     SAVE RETURN ADDRESS.
*
GETVSN00 EQU      %
         LW,R15   BLANKS            INITIALIZE SN.
         STW,R15  %VSN
*
         LI,R14   MESS16            (R14) = ADDRESS OF QUESTION
         BAL,R15  QUERY             GO ASK THE USER
         BAL,R15  GETREPLY          GO GET USER'S ANSWER
*                                   (R14) = # CHARACTERS IN ANSWER
*                                   (X2) = INDEX OF FIRST CHARACTER
*
*   MAKE SURE WE GOT A RESPONSE.
*
         CI,R14   0                 IF NOTHING,
         BG       GETVSN10
         LI,R14   MESS46              INFORM USER.
         B        GETVSN12
*
**   CHEK VALIDITY OF SERIAL NUMBER.
*
GETVSN10 EQU      %
         CI,R14   4                 IF MORE THAN 4 CHARACTERS,
         BLE      GETVSN105
         LI,R14   MESS17              INFORM USER.
         B        GETVSN12
*
GETVSN105 EQU     %
         LI,X1    0                 INITIALIZE DESTINATION INDEX.
*
GETVSN11 EQU      %
         LB,R10   INBUF,X2          GET BYTE FROM BUFFER.
         CLM,R10  DIGLIM            DIGIT?
         BCR,9    GETVSN18          YES--USE IT!
         CLM,R10  AILIM             'A' TO 'I'?
         BCR,9    GETVSN18          YES--USE IT!
         CLM,R10  JRLIM             'J' TO 'R'?
         BCR,9    GETVSN18          YES--USE IT!
         CLM,R10  SZLIM             'S' TO 'Z'?
         BCR,9    GETVSN18          YES--USE IT!
*
         LI,R10   '/'               MARK POSITION OF ILLEGAL CHAR.
         STB,R10  INBUF,X2
         LI,R14   MESS19            NO---ILLEGAL CHARACTER.
GETVSN12 BAL,R15  #POSTMES          TELL USER.
         LI,R15   GETVSN00          (R15) = RETURN ADDRESS IF RETRY OK.
         B        CHKRETRY          GO ABORT OR RETURN TO RETRY POINT.
*
GETVSN18 EQU      %
         STB,R10  %VSN,X1           PLACE NEXT BYTE OF SN.
         AI,X1    1                 BUMP POINTER TO NEXT BYTE.
         AI,X2    1
         BDR,R14  GETVSN11          CHECK NEXT IF IT EXISTS.
         BAL,R15  BLANK%LINE        PRINT BLANK LINE.
         LW,R15   %VSN              SET UP REST OF OP MESSAGE.
         STW,R15  ASKOPMSG+6
         M:KEYIN  (MESS,ASKOPMSG),(REPLY,OPREPLY),(SIZE,4),;
                  (ECB,ECB),(OC)
         M:WAIT   1
         MTW,0    ECB               WAIT 'TIL OPR ANSWERS.
         BLZ      %-1
         LH,R15   OPREPLY
         AND,R15  =X'FF'
         CI,R15   'Y'               SAYS YES?
         BE       GETVSN99
         LI,R14   MESS55            OP WON'T LET PACK BE INITED.
         BAL,R15  #POSTMES
         M:XXX
GETVSN99 EQU      %
         GOBACK                     RETURN TO CALLER.
*
***********************************************************************
         TITLE    'G E T   T H E   A C C O U N T S'
***********************************************************************
*
*
*                    G E T   T H E   A C C O U N T S
*
*
***********************************************************************
*
GETACN   EQU      %
         SAVRTN                     SAVE RETURN ADDRESS.
*
GETACN00 EQU      %
         LI,R15   MAX#ACNT          INITIALIZE COUNTDOWN.
         STW,R15  #ACNLEFT
         LW,R15   ECHO%PENDING      SAVE ECHO PENDING INPUT STATUS.
         STW,R15  SAVE%ECHO%PENDING
         LI,R15   0                 ZERO NUMBER OF ACCOUNTS.
         STW,R15  #ACCOUNT
*
         MTW,0    ECHO%PENDING      IF PENDING INPUT IS TO BE ECHOED,
         BGZ      %+3                 PRINT ACCOUNT PROMPT LINES.
         MTW,0    MORE%TO%GO        O.W., IF THERE IS PENDING INPUT,
         BGZ      GETACN05            ASSUME USER KNOWS--NO PROMPT.
*
*  TELL USER HOW MANY ACCOUNT ENTRIES ARE AVAILABLE.
         LI,X2    BA(MESS24)        (X2) = SOURCE MESSAGE ADDRESS.
         LW,X3    MESS24            (X3) = # BYTES IN MESSAGE.
         AI,X3    4                 INCLUDE COUNT WORD.
         SCS,X3   -8                SHIFT COUNT AND
         AI,X3    BA(MSGLEN)          ADD IN DESTINATION ADDRESS.
         MBS,X2   0                 MOVE MESSAGE TO DATA SECTION.
*
         LW,X1    #ACNLEFT          GET # ACCOUNT SLOTS AVAILABLE.
         LI,X2    BA(MSGBUF)+17     TARGET ADDRESS OF DECIMAL STRING.
         LI,X3    2                 FIELD IS TWO CHARS LONG.
         BAL,R15  BINTODEC          CONVERT BINARY TO DECIMAL.
*
         LI,R14   MSGLEN            (R14) = ADDRESS OF MESSAGE.
         BAL,R15  #POSTMES          GO TELL USER
*
*  INITIALIZE LOOP
*
GETACN05 LI,X1    0                 (X1) = # OF ACCOUNTS ALREADY INPUT
*
*  GET AN ACCOUNT FROM THE USER
*
GETACN10 EQU      %
         MTW,0    MODE              CHECK MODE.
         BLZ      GETACN125         IF NOT BATCH USER,
*
         LI,X2    0                 DON'T ECHO PENDING INPUT.
         STW,X2   ECHO%PENDING
*
         LI,X2    BA(MESS47)        (X2) = MESSAGE SOURCE ADDRESS.
         LW,X3    MESS47            (X3) = # BYTES IN MESSAGE.
         AI,X3    4                 INCLUDE COUNT WORD.
         SCS,X3   -8                SHIFT FOR BYTE COUNT AND
         AI,X3    BA(MSGLEN)          ADD IN DESTINATION ADDRESS.
         MBS,X2   0                 MOVE MESSAGE TO DATA SECTION.
*
         XW,X1    #ACNLEFT            SHOW COUNTDOWN.
         LI,X2    BA(MSGBUF)+3      BA DESTINATION OF DECIMAL STRING.
         LI,X3    2                 FIELD IS TWO CHARS LONG.
         BAL,R15  BINTODEC          CONVERT BINARY TO DECIMAL.
         XW,X1    #ACNLEFT          RESTORE RESPECTIVE FIELDS.
         LI,R14   MSGLEN            TELL # SLOTS LEFT
         BAL,R15  QUERY               FOR ACCOUNTS.
*
GETACN125 EQU     %
         BAL,R15  GETREPLY          GO GET USER INPUT
GETACN0600OK EQU %                  06-00 OK IF BATCH.
         LW,R15   SAVE%ECHO%PENDING RESTORE ECHO PENDING INPUT STATUS.
         STW,R15  ECHO%PENDING
*
*   CHECK IF DELETE ACCOUNT COMMAND.
*
         LI,R15   0                 ASSUME NOT DELETE COMMAND.
         STW,R15  SW%DEL%ACN
*
         CI,R14   3                 MUST BE AT LEAST THREE
         BL       GETACN20            CHARACTERS.
*
         LB,R15   INBUF,X2          IF FIRST INPUT CHAR IS NOT 'D',
         CI,R15   'D'
         BNE      GETACN225           COULDN'T BE DELETE.
*
         LW,X3    X2                IF NEXT
         AI,X3    1                   CHAR IS NOT BLANK,
         LB,R15   INBUF,X3
         CI,R15   ' '
         BNE      GETACN225           COULDN'T BE DELETE COMMAND.
*
         MTW,1    SW%DEL%ACN        DELETE COMMAND--SET SWITCH.
         AI,X2    2                 (X2) = IX FIRST PSBL ACN CHAR.
         AI,R14   -2                (R14) = COUNT - 'D '.
*
         LB,R15   INBUF,X2          GET FIRST NON-BLANK.
         CI,R15   ' '
         BNE      GETACN127
         AI,X2    1                 INCREMENT BUFFER IX
         BDR,R14  %-4                 AND KEEP LOOKING.
*
GETACN127 EQU     %
         CI,R14   1                 IF ACCOUNT GIVEN IS '.',
         BNE      GETACN20
         CI,R15   '.'                 SIGNAL TO LIST ACCOUNTS.
         BNE      GETACN20
         LI,R15   GETACN10          SET RETURN ADDRESS AND
         B        LIST%ACCOUNTS       LIST ACCOUNTS.
*
*  VERIFY USERS RESPONSE
*
GETACN20 EQU      %
         CI,R14   0                 IF SOMETHING WAS INPUT,
         BG       GETACN225           CHECK IT.
         B        GETACN40          NULL RESPONSE -> END OF LIST.
*
GETACN225  EQU    %
         CI,R14   8                 CAN'T HAVE MORE THAN 8 CHARACTERS.
         BLE      GETACN227
         LI,R14   MESS27            ERROR IF MORE THAN 8 ARE PRESENT.
         B        GETACN325
*
GETACN227  EQU    %
         LW,R8    BLANKS            BLANK OUT ACN DEST.
         LW,R9    BLANKS
         LI,X3    0                 INDEX TO DESTINATION.
GETACN23 EQU      %
         LB,R15   INBUF,X2          GET ACCOUNT NUMBER BYTE.
         CI,R15   ' '               CAN'T HAVE IMBEDDED BLANKS.
         BNE      GETACN235
         LI,R14   MESS20            DISPLAY ERROR MESSAGE IF ONE FOUND.
         B        GETACN325
*
GETACN235 EQU %
         BG       GETACN237         IF LESS THAN BLANK,
*
GETACN236 EQU     %
         LI,R14   '/'               MARK POSITION OF ILLEGAL CHAR.
         STB,R14  INBUF,X2
         LI,R14   MESS19            GIVE ILLEGAL CHAR MESSAGE.
         B        GETACN325
*
GETACN237 EQU     %
         LB,X4    BADACNCHR         GET # OF BAD ACN CHARACTERS.
         CB,R15   BADACNCHR,X4      IF CHAR IS BAD,
         BE       GETACN236           TELL USER.
         BDR,X4   %-2               CHECK NEXT.
*
         STB,R15  R8,X3             STORE BYTE.
         AI,X3    1                 INCREMENT INDICES.
         AI,X2    1
         BDR,R14  GETACN23          CHECK AND MOVE ANOTHER.
*
*   STORE INFORMATION IN THE TABLES (INSERTION SORT).
*
GETACN30 EQU      %
         MTW,0    #ACNLEFT          IF NO SLOTS LEFT,
         BGZ      GETACN307
         MTW,0    SW%DEL%ACN          THIS MUST BE A DELETE.
         BGZ      GETACN307
         LI,R14   MESS53            TELL USER ONLY DELETE ALLOWED.
         LI,R15   GETACN41          RETURN TO 'ALL OK' EXIT.
         B        #POSTMES
*
GETACN307 EQU     %
         LW,X2    X1                IS THIS THE FIRST ACCOUNT
         BEZ      GETACN34          YES--DON'T SEARCH FOR DUPLICATES
*
GETACN32 EQU      %
         ANLZ,X4  ANLZACTLOC        (X4) = DW ADDR OF ACNT.
         SLS,X4   3                 MAKE INTO BA.
         LW,X5    =X'08000000'+R8*4
         CBS,X4   0                 COMPARE LIST ACNT WITH INPUT.
         BG       GETACN33          NOT YET--CHECK NEXT ENTRY.
         BL       GETACN335         NO---BUT IT SHOULD GO HERE!
         LI,R14   MESS29            (R14) = ADDRESS OF ERROR MESSAGE
         MTW,0    SW%DEL%ACN        IF DELETE ACCOUNT IN EFFECT,
         BEZ      GETACN325
*
         CW,X2    X1                  REMOVE ENTRY.
         BGE      GETACN323
         LD,R8    ACNTNAME,X2       GET NEXT ACCOUNT AND
ANLZACTLOC STD,R8  ACNTNAME-2,X2      PLACE OVER PREVIOUS ENTRY.
         AI,X2    1                 INCREMENT INDEX AND
         B        %-5                 MOVE NEXT IF NECESSARY.
*
GETACN323 EQU     %
         AI,X1    -1                DECREMENT # OF ACCOUNTS.
         MTW,1    #ACNLEFT          INCREMENT # SLOTS LEFT.
         B        GETACN10
GETACN325 EQU     %
         BAL,R15  #POSTMES          GO TELL USER
         LI,R15   GETACN10          (R15) = RETURN ADDRESS IF RETRY OK
         B        CHKRETRY          GO ABORT OR RETURN TO RETRY POINT
*
GETACN33 EQU      %
         BDR,X2   GETACN32          CHECK NEXT ENTRY IF THERE.
GETACN335 EQU     %
         MTW,0    SW%DEL%ACN        IF DELETE ACCOUNT IN EFFECT,
         BEZ      %+3
         LI,R14   MESS51              TELL USER CAN'T FIND THAT ONE.
         B        GETACN325
*
*
*   MAKE ROOM FOR NEW ENTRY.
*
         LW,R10   X1                (R10) = NUMBER OF ENTRIES TO
         SW,R10   X2                  MOVE DOWN.
         BEZ      GETACN34
*
         LW,X4    X1                (X4) = NUMBER OF ENTRIES IN TABLE.
*  NOTE: (X2) = INDEX OF ENTRY TO BE VACATED.
         LD,R14   ACNTNAME-2,X4     GET ENTRY AND
         STD,R14  ACNTNAME,X4         MOVE IT TO NEXT HIGHER ENTRY.
         AI,X4    -1                MOVE TO NEXT ENTRY.
         BDR,R10  %-3               MOVE NEXT ENTRY IF NEEDED.
*
GETACN34 EQU      %
         MTW,0    SW%DEL%ACN        IF DELETE ACCOUNT IN EFFECT,
         BEZ      %+3
         LI,R14   MESS50              TELL USER NO ACCOUNTS YET.
         B        GETACN325
*
         STD,R8   ACNTNAME,X2       INSERT NEW ENTRY INTO TABLE.
         AI,X1    1                 INCREMENT NUMBER OF ENTRIES.
         MTW,-1   #ACNLEFT          COUNTDOWN!
         BGZ      GETACN10          IF MORE SLOTS LEFT, GET ANOTHER.
*   THERE IS NO MORE ROOM FOR NEW ACCOUNTS.
         LI,R14   MESS28            TELL USER,
         BAL,R15  #POSTMES            AND CONTINUE.
*
*  USER HAS FINISHED HIS LIST - DO WE HAVE ENOUGH
*
GETACN40 EQU      %
GETACN41 STW,X1   #ACCOUNT          SAVE # OF ACCOUNTS
         LW,X3    X1                CALC # GRANS USED.
         MW,X3    %NGC
         LI,R14   MESS54            ERROR: # ACC * # GRAN >= 30.
         CI,X3    30
         BL       GETACN325
         MTW,0    MODE
         BGEZ     %+5               IF GHOST OR ON-LINE, VERIFY.
*
         MTW,2    MODE              DON'T WANT TO ABORT BATCH.
         BAL,R15  CHKRETRY          FAKE ONLINE TO LIST PENDING INPUT.
         MTW,-2   MODE              BACK TO BATCH.
         B        GETACN999         DON'T ASK TO VERIFY.
*
         LI,R14   MESS52            ASK IF LIST IS OK.
         BAL,R15  QUERY
         BAL,R15  GETREPLY          GET HIS REPLY.
         BAL,R15  CHKYORN
         B        %-4               NOT 'Y' OR 'N'--REPEAT QUERY.
*
         AI,R14   0                 CHECK RESPONSE.
         BEZ      GETACN10          NO RESPONSE--BACK FOR MORE ACN.
GETACN999 EQU     %
         LW,R15   #ACCOUNT          IF NO ACCOUNTS WERE ENTERED,
         BGZ      %+3
         STD,R15  ACNTNAME            FAKE NULL ACCOUNT
         MTW,1    #ACCOUNT            AND INCREMENT COUNT.
         BAL,R15  BLANK%LINE        PRINT BLANK LINE.
         GOBACK                     RETURN TO CALLER
*
***********************************************************************
         TITLE    'S E T U P   V T O C'
***********************************************************************
*
*
*                 S E T   U P   V T O C
*
*
***********************************************************************
*
SETVTOC  EQU      %
         SAVRTN                     SAVE RETURN ADDRESS.
*
         LCI      7                 MOVE
         LM,R8    EMPTYVTC               THE
         STM,R8   VTOC                       SKELETON
*
*  SET UP THE SERIAL NUMBER
*
         LW,R8    %VSN              MOVE THE
         STW,R8   VTOC+1                     USER'S SN
*
*  SET UP NVAT
*
STVTOC10 LW,R8    NVATALL           (R8) = NVAT VALUE.
         STW,R8   VTOC+5            SAVE THE NVAT VALUE.
*
         LW,R9    %DISCLIM          CALC MAP PARAMETERS.
         SLS,R9   -1                (R9) = # GRANULES ON DEVICE.
         LI,R8    0                 READY FOR DIVIDE.
         DW,R8    %NGC              (R9) = # CYLINDERS.
         LI,R8    0
         DW,R8    D32
         STW,R8   #BITLWRD          # BITS LEFTOVER.
         STW,R9   #FMAPWRD          # FULLY SET MAP WORDS.
*
*  SET UP THE BIT MAP
*
STVTOC20 LW,X7    #FMAPWRD          (X7) = # OF FULL MAP WORDS
         MTW,0    #BITLWRD          ARE THERE ANY PARTIAL WORDS
         BEZ      STVTOC21          NO---CONTINUE
         AI,X7    1                 YES--INCREMENT # OF WORDS
STVTOC21 STW,X7   VTOC+4            SAVE MAPWL IN VTOC
         LW,R8    %NGC              SET VTOC.NGC.
         STH,R8   VTOC+4
         AWM,X7   VTOC+3            SET UP SNTD IN VTOC
         LI,R8    -1                (R8) = ALL BITS SET WORD
STVTOC22 STW,R8   VTOC+6,X7         SET THE
         BDR,X7   %-1                       WHOLE MAP
         LW,X6    VTOC+3            (X6) = SN TABLE OFFSET IN VTOC
         LI,R8    -1                (R8) = ALL BITS SET WORD
         LW,X7    #BITLWRD          (X7) = # OF BITS IN LAST WORD
         BEZ      STVTOC30          LAST WORD IS FULL - SKIP PARTIAL CRP
         AI,X7    -32               (X7) = -(# OF UNUSED BITS)
         AND,X7   X7F               SCRUB OFF HIGH ORDER BITS
         S,R8     0,X7              SHIFT UNUSED BITS PAST BIT 31
         LCW,X7   X7                MAKE COUNT
         AND,X7   X7F                          POSITIVE
         S,R8     0,X7              SHIFT ZEROES IN FOR UNUSED BITS
         STW,R8   VTOC-1,X6         PUT IT IN THE BIT MAP
*
*  SET UP SERIAL NUMBER TABLE
*
STVTOC30 LI,R8    0                 FLAG
         LI,R9    0                      PACK
         LCI      2                           AS
         STM,R8   VTOC,X6                        UNUSED
*
*  ZAP REMAINDER OF VTOC
*
STVTOC40 AI,X6    -510              (X6) = -(# OF WORDS TO ZAP)
         LW,R8    86DEAD86          (R8) = ZAP CONSTANT
STVTOC41 STW,R8   VTOC+512,X6       ZAP THE
         BIR,X6   STVTOC41                  UNUSED WORDS
         GOBACK                     RETURN TO CALLER.
*
***********************************************************************
         TITLE    'S E T U P   A C C O U N T   D I R E C T O R Y'
***********************************************************************
*
*
*             S E T U P   A C C O U N T   D I R E C T O R Y
*
*
***********************************************************************
*
SETAD    EQU      %
         SAVRTN                     SAVE RETURN ADDRESS.
*
*  SET UP TABLE OF FILE DIRECTORY FDA'S
*
SETAD10  LW,R9    %NGC              (R9) = USER'S # OF GRANULES CYLINDER
         SLS,R9   1                 MAKE IT INTO SECTORS
         LI,R8    -4                MAKE SURE SECTOR 4 CAN
         AW,R8    R9                  BE USED AS
         BLEZ     %-1                 THE LAST FD FDA.
         AI,R8    X'10004'
         LW,R10   #ACCOUNT          COMPUTE ADDRESS
         AI,R10   FDFDA                             FOR INDEXING
         LCW,X7   #ACCOUNT          (X7) = - (# OF ACCOUNTS)
SETAD11  STW,R8   *R10,X7           PUT ONE AWAY
         AW,R8    R9                UPDATE FDA ADDRESS (+1 CYLINDER)
         BIR,X7   SETAD11           GO SET UP NEXT ONE - IF ANY
SETAD15  EQU      %
         LI,R8    X'10004'          ALLOW FOR VTOC
         AI,R10   -1                  WITH LAST ACCOUNT'S FD.
         STW,R8   *R10
*
*  UPDATE THE VTOC NOW
*
SETAD20  LW,R9    #ACCOUNT          (R9) = # OF CYLINDERS TO ALLOCATE
         LI,X6    VTOC+7            (X6) = ADDR OF FIRST HGP MAP WORD
SETAD21  LCW,X7   R9                (X7) = -(# CYL TO BE ALLOCATED)
         CI,X7    -32               IS IT A FULL WORD (OR MORE)
         BG       SETAD22           NO---GO ALLOCATE A PARTIAL WORD
         LI,R8    0                 YES--0 MEANS ALL IN USE
         B        SETAD23           GO STORE IT
SETAD22  AND,X7   X7F               MAKE IT A GOOD SHIFT COUNT
         LW,R8    0,X6              (R8) = WORD FROM BIT MAP
         S,R8     0,X7              ZERO THE CORRECT # OF BITS
SETAD23  STW,R8   0,X6              PUT THE NEW WORD AWAY
         AI,X6    1                 BUMP BIT MAP POINTER TO NEXT WORD
         AI,R9    -32               DECREMENT # TO ALLOCATE
         BGZ      SETAD21           MORE TO DO - GO DO IT
*
*  BUILD THE ACCOUNT DIRECTORY NOW
*
SETAD30  EQU      %
         LW,R9    86DEAD86          CLEAR
         LI,X1    -252                   THE
         STD,R9   AD+512,X1                    <AD>
         BIR,X1   %-1                              BUFFER
         LCI      3                 MOVE
         LM,R13   EMPTYAD                HEADER
         STM,R13  AD                            SKELETON
         LH,R15   AD+2              (R15) = NEXT AVAILABLE BYTE (OFFSET)
         LCI      (ADENTLEN+3)**-2  LOAD ACNT DIRECTORY
         LM,R9    ADESKEL                               ENTRY SKELETON
         LD,X4    MBS2              (X4,5) = INITIAL MBS CONTROL WORD
         LI,X3    FDFDA             COMPUTE FDFDA
         AW,X3    #ACCOUNT                        INDEXING ADDRESS
         LI,X2    ACNTNAME          COMPUTE
         AW,X2    #ACCOUNT                  ACNTNAME
         AW,X2    #ACCOUNT                           INDEXING ADDRESS
         LCW,X1   #ACCOUNT          (X1) = - INDEXING ACCOUNT
SETAD31  LD,R10   *X2,X1            GET AN ACCOUNT NAME
         LW,R12   *X3,X1            GET ITS FILE DIRECTORY FDA
         CI,X1    -1                IS THIS THE LAST ACCOUNT
         BNE      SETAD32           NO---GO ON
         AI,R13   X'0200'           YES--SET EOF BIT
SETAD32  MBS,X4   0                 PUT ENTIRE ENTRY IN THE AD
         AI,R15   ADENTLEN          UPDATE NAV
         LW,X4    MBS2              RESET   .. SOURE ADDRESS
         LI,R8    ADENTLEN          MBS     ..
         STB,R8   X5                CONTROL .. COUNT
         BIR,X1   SETAD31           GO PROCESS NEXT ACCOUNT - IF ANY
         STH,R15  AD+2              PUT ACTUAL NAV IN AD
         GOBACK                     RETURN TO CALLER.
*
***********************************************************************
         TITLE    'O U T P U T   < V T O C >   A N D   < A D >'
***********************************************************************
*
*
*              O U T P U T   < V T O C >   A N D   < A D >
*
*
***********************************************************************
*
WRTVTOC  EQU      %
         SAVRTN                     SAVE RETURN ADDRESS.
*
         LW,R8    %DCTX             (R8) = DCT INDEX OF OUR DEVICE.
         SLS,R8   16                LINE UP FOR GENERALIZED DISK ADDRESS
         LI,R9    BA(VTOC)          (R9) = BYTE ADDRESS OF BUFFER
         LI,R10   512*4             (R10) = BYTE COUNT (1 PAGES WORTH)
         LI,R11   1                 (R11) = SEEK-WRITE ORDER CODE
         LI,R14   MESS42            PASS ADDRESS OF ERROR MESSAGE.
         MTW,0    DEBUGSW           ARE WE DOING DEBUG OUTPUT
         BLZ      WRTVTOC1          NO---GO ON
*                                   YES--SNAP REGISTERS AND VTOC
         M:SNAP   'VTOCWRIT',(VTOC,VTOC+511)
WRTVTOC1 BAL,R15  QDIO              GO QUEUE THE WRITE
*
*  OUTPUT THE ACCOUNT DIRECTORY
*
         AI,R8    2                 BUMP GENERALIZED DISK ADDRESS
         LI,R9    BA(AD)            (R9) = BYTE ADDRESS OF BUFFER
         LI,R14   MESS39            PASS ADDRESS OF ERROR MESSAGE.
         MTW,0    DEBUGSW           ARE WE DOING DEBUG OUTPUT
         BLZ      WRTVTOC2          NO---GO ON
*                                   YES--SNAP REGISTERS AND <AD>
         M:SNAP   'ADWRIT',(AD,AD+511)
WRTVTOC2 BAL,R15  QDIO              GO QUEUE THE WRITE
         GOBACK                     RETURN TO CALLER.
*
***********************************************************************
         TITLE    'O U T P U T   T H E   < F D > '' S'
***********************************************************************
*
*
*                   O U T P U T   T H E   < F D > ' S
*
*
*
*  INITIALIZE THE <FD> CORE BUFFER
*
***********************************************************************
*
WRTFD    EQU      %
         SAVRTN                     SAVE RETURN ADDRESS.
         LW,R9    86DEAD86          ZAP
         LI,X7    -256                  THE
         STD,R9   FD+512,X7                 ENTIRE
         BIR,X7   %-1                              BUFFER
         LD,R8    MBS5              SET
         MBS,R8   0                     UP
         LD,R8    MBS6                     AN
         MBS,R8   0                           FD
         LW,R8    %NGC              (R8) = # GRANULES PER CYLINDER
         AI,R8    -3                SUBTRACT OFF <VTOC>, <AD>, <FD>
         BGZ      %+3               IF NOTHING LEFT,
         LI,R8    0                   INDICATE SO.
         STW,R8   FD+509
         STB,R8   FD+509            PUT NGAVAL IN FILE DIRECTORY
*
*  OUTPUT THE FIRST <FD>
*
         LW,R8    %DCTX             (R8) = DCT INDEX FOR OUR DEVICE
         SLS,R8   16                LINE UP FOR GENERALIZED DISK ADDRESS
         AI,R8    4                 (R8) = DA GRANULE 3 (5TH SECTOR).
         LI,R9    BA(FD)            (R9) = BYTE ADDRESS OF BUFFER
         LI,R10   512*4             (R10) = BYTE COUNT (1 PAGES WORTH)
         LI,R11   1                 (R11) = SEEK-WRITE ORDER CODE
         LI,R14   MESS40            PASS ADDRESS OF ERROR MESSAGE.
         MTW,0    DEBUGSW           ARE WE DOING DEBUG OUTPUT
         BLZ      WRTFD01           NO---GO ON
*                                   YES--SNAP REGISTERS AND <FD>
         M:SNAP   '1FDWRIT',(FD,FD+511)
WRTFD01  BAL,R15  QDIO              GO QUEUE THE WRITE
*
*   SHOULD MORE <FD>S BE WRITTEN?
*
         LW,X1    #ACCOUNT          YES--(X1) = # OF ACCOUNTS TO DO
         AI,X1    -1                ALREADY DID LAST ONE.
WRTFD02  AI,X1    -1                (X1) = # OF <FD>'S LEFT TO WRITE
         BLZ      WRTFD999          NONE LEFT TO DO--GO BACK.
*
*  SET UP A CORRECT <FD> FOR THIS ACCOUNT
*
WRTFD20  LW,R8    FDFDA,X1          (R8) = GDA FOR THIS <FD>
         AI,R8    2                 (R8) = GDA OF GAVAL FOR THIS <FD>.
         LI,X7    509*2+1           (X7) = HW DISP (IN <FD>) FOR GAVAL
         STH,R8   FD,X7             PUT CORRECT GAVAL IN <FD>
         LW,R9    %NGC              (R9) = # GRANULES PER CYLINDER
         AI,R9    -1                SUBTRACT OFF <FD>.
         BGZ      %+3               IF NOTHING LEFT,
         LI,R8    0                   INDICATE SO.
         STW,R8   FD+509
         STB,R9   FD+509            PUT NGAVAL IN FILE DIRECTORY
**
**   WRITE OUT ANOTHER <FD>
**
WRTFD30  EQU      %
         AI,R8    -2                GET BACK GDA OF THIS <FD>.
         LW,R9    %DCTX             MAKE THIS GDA INTO A REAL DA.
         STH,R9   R8
         LI,R11   1                 SEEK-WRITE ORDER CODE.
         LI,R14   MESS40            ADDRESS OF ERROR MESSAGE.
         LI,R9    BA(FD)            (R9) = BYTE ADDRESS OF BUFFER
         MTW,0    DEBUGSW           ARE WE DOING DEBUG OUTPUT
         BLZ      WRTFD32           NO---GO ON
*                                   YES--SNAP REGISTERS AND <FD>
         M:SNAP   'NFDWRIT',(FD,FD+511)
WRTFD32  BAL,R15  QDIO              GO QUEUE THE WRITE
         B        WRTFD02           GO BACK FOR MORE
**
**   GO BACK TO CALLER.
**
WRTFD999 EQU      %
         GOBACK                     RETURN TO CALLER.
*
***********************************************************************
         TITLE    'S U P P O R T   R O U T I N E S'
         SPACE    20
***********************************************************************
**********          S U P P O R T   R O U T I N E S         ***********
***********************************************************************
         TITLE    'MASTER/SLAVE - ENTER MASTER/SLAVE MODE'
***********************************************************************
*
*
*             E N T E R   M A S T E R / S L A V E   M O D E
*
*
***********************************************************************
MASTER   PUSH,SR1 *X0,3             SAVE SR1-SR3
         M:SYS                      GO MASTER MODE - DESTROYS SR1-SR3
         PULL,SR1 *X0,3             RESTORE SR1-SR3
         B        *R15              RETURN
*
*
*
SLAVE    M:SLAVE                    SLAVE.
         B        *R15              RETURN TO CALLER.
*
***********************************************************************
***********************************************************************
         TITLE    'LIST%ACCOUNTS - LIST ENTERED ACCOUNTS'
***********************************************************************
**********               LIST%ACCOUNTS                       **********
***********************************************************************
***      NAME:    LIST%ACCOUNTS - LIST ENTERED ACCOUNTS
***
***      CALL:    BAL,R15   LIST%ACCOUNTS
***               <RETURN>
***
***      DESCRIPTION: LISTS ACCOUNTS ENTERED INTO ACNTNAME TABLE.
***
***      INPUT:   (X1) = NUMBER OF ACCOUNTS IN TABLE
***               ACNTNAME = ADDRESS OF DOUBLEWORD ACCOUNT TABLE
***               (R15) = RETURN ADDRESS
***
***      OUTPUT:  (X1) = (X1) INPUT
***               (R15) = (R15) INPUT
***
***      REGISTERS: X3-X7, R14 VOLATILE
***
***********************************************************************
*
LIST%ACCOUNTS EQU %
*
         LW,X3    X1                MOVE #ACNTS INTO WORK REG.
         BNEZ     START%LIST        IF NONE,
         LI,R14   MESS34              TELL USER.
         B        #POSTMES
*
START%LIST EQU    %
         PUSH,R15 *X0,1             SAVE RETURN ADDRESS.
         LI,X4    BA(ACNTNAME)      INITIALIZE ACCOUNT POINTER.
*
SETUP%NEXT%LINE EQU %
         LI,X7    BA(MSGBUF)        INITIALIZE OUTPUT BUFFER POINTER.
*
SETUP%NEXT%ACN EQU %
         LI,X6    BA(BLANKS)        INITIALIZE SOURCE POINTER.
         AW,X7    =X'02000000'      SET # BYTES TO MOVE.
         MBS,X6   0                 MOVE SPACING TO BUFFER.
*
         LW,X5    X7                GET PTR TO NEXT OUTPUT BUF BYTE.
         AW,X5    =X'08000000'      SET # BYTES TO MOVE.
         MBS,X4   0                 MOVE NEXT ACCOUNT TO BUFFER.
*
         LW,X7    X5                GET PTR TO NEXT OUTPUT BUF BYTE.
         CI,X7    BA(MSGBUF)+72-10-1 IF BUFFER FULL,
         BGE      LIST%NEXT%LINE      LIST THE NEXT LINE.
*
         BDR,X3   SETUP%NEXT%ACN    IF ANOTHER ACCOUNT, PUT IN BUFFER.
*
LIST%NEXT%LINE EQU %
         AI,X7    -BA(MSGBUF)       (X7) = # CHARACTERS TO PRINT.
         STW,X7   MSGLEN
         LI,R14   MSGLEN            PASS ADDRESS OF TXTC MESSAGE.
         BAL,R15  #POSTMES          PRINT THE NEXT LINE.
         BDR,X3   SETUP%NEXT%LINE   IF ANOTHER, GET PTRS READY.
*
         PULL,R15 *X0,1             RESTORE RETURN ADDRESS.
         B        *R15              RETURN.
*
***********************************************************************
         TITLE    'P O S T   A   M E S S A G E'
***********************************************************************
*
*  OUTPUT A MESSAGE.  DIFFERENT ACTIONS ARE TAKEN DEPENDING ON MODE OF
*  OPERATION.
*
*        BATCH    OUTPUT THE MESSAGE THROUGH M:LO NO SPECIAL ACTION IS
*                 TAKEN.
*
*        GHOST    OUTPUT THE MESSAGE THROUGH M:UC NO SPECIAL ACTION IS
*                 TAKEN.
*
*        ON-LINE  OUTPUT THE MESSAGE THROUGH M:LO.  IF M:LO IS CLOSED
*                 IT IS SPECIFICALLY OPENED TO (DEVICE,'ME') BEFORE
*                 THE OUTPUT.
*
*
*        (R14)                      ADDRESS OF WORD CONTAINING THE COUNT
*                                     OF CHARACTERS IN MESSAGE
*        (R14)+1                    MESSAGE IN TEXT FORMAT
*        BAL,R15  #POSTMES
*
*  REGISTERS PRESERVED:   ALL
*
*   REGISTERS DESTROYED:   NONE
*
*
*
***********************************************************************
*
#POSTMES EQU      %
         PUSH,R13 *X0,3             SAVE 12-14.
*
         LI,R12   M:LO              ASSUME ON-LINE OR BATCH.
         MTW,0    MODE              CHECK.
         BLZ      POSTMS10          BATCH--JUST WRITE.
         BGZ      %+3               ONLINE--OPEN M:LO IF NECESSARY.
         LI,R12   M:UC              GHOST--WRITE THROUGH M:UC.
         B        POSTMS10
*                                   --ONLINE
         LW,R13   M:LO              IS THE
         CW,R13   FCDBIT                   DCB OPEN
         BANZ     POSTMS10          YES--GO OUTPUT
         M:OPEN   M:LO,(DEVICE,'ME'),(OUT),(CONSEC),(SEQUEN),(BTD,0)
         M:DEVICE M:LO,(NODRC)
         M:DEVICE M:LO,(BCD)
*
**   OUTPUT THE MESSAGE
*
POSTMS10 LW,R13   *R14              (R13) = # OF BYTES IN MESSAGE
         AI,R14   1                 (R14) = ADDRESS OF MESSAGE TEXT
         M:WRITE  *R12,(BUF,*R14),; OUTPUT
                       (SIZE,*R13),;       THE
                       (WAIT)                  MESSAGE
POSTMS11 PULL,R12 *X0,3             RESTORE 12-14.
         B        *R15              RETURN TO CALLER
*
***********************************************************************
         TITLE    'A S K   U S E R   A   Q U E S T I O N'
***********************************************************************
*
*  OUTPUT A QUESTION TO THE USER.  DIFFERENT ACTIONS ARE TAKEN DEPENDING
*  ON THE MODE OF OPERATION.
*
*        BATCH    OUTPUT THE MESSAGE THROUGH M:LO.  NO SPECIAL ACTIONS
*                 ARE TAKEN.
*
*        GHOST    MOVE THE MESSAGE TO THE GHOST QUESTION BUFFER <GQBUF>
*                 IN TEXTC FORMAT
*
*        ON-LINE  OUTPUT THE MESSAGE THROUGH M:UC.
*
*
*        (R14)                      ADDRESS OF WORD CONTAINING THE COUNT
*                                     OF CHARACTERS IN MESSAGE
*        (R14)+1                    ADDRESS OF MESSAGE IN TEXT FORMAT
*        BAL,R15  QUERY
*
*
*
*   REGISTERS PRESERVED:   ALL
*
*   REGISTERS DESTROYED:   NONE
*
*
*
***********************************************************************
*
QUERY    EQU      %
         MTW,0    MODE              IF BATCH OR GHOST,
         BLEZ     QUERY05             PRINT QUESTION ANYWAY.
*
         MTW,0    ECHO%PENDING      IF PENDING INPUT TO BE ECHOED,
         BGZ      QUERY05             PRINT QUESTION.
         MTW,0    MORE%TO%GO        IF PENDING INPUT,
         BGZ      *R15                DON'T PRINT QUERY.
*
QUERY05  EQU      %
         MTW,0    MODE              DETERMINE MODE.
         BLZ      QUERY20           --BATCH
         BGZ      QUERY30           --ONLINE
*                                   --GHOST
*
*  DO GHOST PROCESSING
*
QUERY10  PUSH,R12 *X0,2             SAVE REGISTERS 12-13
         LI,R13   BA(GQBUF)+1       (R13) = BA OF DESTINATION BUFFER
         LW,R12   *R14              (R12) = # OF BYTES IN MESSAGE
         STB,R12  R13               PUT COUNT IN MBS CONTROL WORD
         STB,R12  GQBUF             PUT COUNT IN TEXTC MESSAGE
         LW,R12   R14               (R12) = MESSAGE ADDRESS
         SLS,R12  2                 CONVERT WA TO BYTE ADDRESS
         AI,R12   4                 SKIP THE COUNT WORD
         MBS,R12  0                 MOVE-EM-OUT
         PULL,R12 *X0,2             RESTORE REGISTERS 12-13
         B        *R15              RETURN TO CALLER
*
*  DO BATCH PROCESSING
*
QUERY20  PUSH,R13 *X0,2             SAVE REGISTERS 13-14
         LW,R13   *R14              (R13) = # OF CHARACTERS IN MESSAGE
         AI,R14   1                 (R14) = ADDRESS OF MESSAGE TEXT
         M:WRITE  M:LO,(BUF,*R14),; OUTPUT
                       (SIZE,*R13),;       THE
                       (WAIT)                  QUESTION
QUERY21  PULL,R13 *X0,2             RESTORE REGISTERS 13-14
         B        *R15              RETURN TO CALLER
*
*  ON-LINE PROCESSING
*
QUERY30  PUSH,R13 *X0,2             SAVE REGISTERS 13-14
         LW,R13   *R14              (R13) = # OF BYTES IN MESSAGE
         AI,R14   1                 (R14) = ADDRESS OF MESSAGE TEXT
         M:WRITE  M:UC,(BUF,*R14),; OUTPUT
                       (SIZE,*R13),;       THE
                       (WAIT)                  QUESTION
         B        QUERY21           GO CLEAN-UP AND RETURN TO CALLER
*
***********************************************************************
         TITLE    'GETREPLY - GET USER REPLY'
***********************************************************************
*
*  GET THE USER'S REPLY.  DIFFERENT ACTIONS ARE TAKEN DEPENDING ON THE
*  MODE OF OPERATION.
*
*        BATCH    READ THE USER'S RESPONSE THROUGH M:C AND THEN WRITE
*                 IT VIA M:LO.
*
*        GHOST    ISSUE AN M:KEYIN CAL SPECIFYING THE QUESTION
*                 PREVIOUSLY SAVED BY THE CALL TO QUERY.  THE RESPONSE
*                 IS RECEIVED IN A SEPARATE BUFFER AND MOVED INTO THE
*                 INPUT BUFFER TO CLEAR THE TEXTC COUNT.
*
*        ON-LINE  READ THE USER'S INPUT VIA M:UC
*
*           ***  IN ANY CASE, ALL TAIL CHARACTERS WITH CODE NOT
*                 GREATER THAN X'15' ARE REPLACED BY BLANKS.
*
*
*        BAL,R15  GETREPLY
*        (R14)                      # OF CHARACTERS IN USER'S RESPONSE
*                            (NOT INCLUDING TRAILING OR LEADING BLANKS)
*        (X2) = INBUF IX OF FIRST NON-BLANK
*
*
*
*   REGISTERS PRESERVED:   0,1,2,3,4,5,6,7,8,9,10,11,12,13,15
*
*   REGISTERS DESTROYED:   14
*
*
***********************************************************************
*
GETREPLY PUSH,R12 *X0,2             SAVE REGISTERS 12-13
GETREP05 EQU      %
         LW,X2    MORE%TO%GO        IF WE'RE STILL WORKING ON SOME
         STW,X2   HAD%REPLY           PREVIOUS INPUT, FLAG ECHO.
*
         BEZ      %+4               IF NOT, DON'T
         LW,X2    LAST%COMMA%IX       INITIALIZE
         AI,X2    1                   START IX.
         B        HAVE%REPLY
*
         MTW,0    MODE              DETERMINE PROGRAM MODE
         BEZ      GTREP20           --GHOST
         BGZ      GTREP30           --ON-LINE
*                                   --BATCH
*
*  HANDLE BATCH INPUT
*
GTREP10  LW,R14   ='  * '
         STW,R14  INBUF-1
         PUSH,SR1 *X0,4             SAVE SR1-SR4 IN CASE OF I/O ERROR.
         M:READ   M:C,(BUF,INBUF),(SIZE,80),(WAIT),;
                      (ABN,GTREP15),(ERR,GTREP15)
         LH,R14   M:C+4             (R14) =
         SLS,R14  -1                  RECORD SIZE.
         AI,R14   4                 ACCOUNT FOR LEADING BLANKS ON ECHO
         M:WRITE  M:LO,(BUF,INBUF-1),(SIZE,*R14),(WAIT)
         AI,R14   -4                RESTORE RECORD SIZE
GTREP13  EQU      %
         PULL,SR1 *X0,4             RESTORE SR1-SR4.
         B        GTREP40           ISOLATE NON-BLANK INPUT.
*
GTREP15  EQU      %                 BATCH I/O ERRORS.
         LB,R14   SR3               MUST BE 06-00 (EOF).
         CI,R14   6
         BNE      GTREP90           ERROR MESSAGE WITH ABORT IF NOT.
         CI,R15   GETACN0600OK      ONLY CALLER WHERE THIS ERROR OK.
         BNE      GTREP90
         LI,R14   0                 NULL INPUT.
         STW,R14  MORE%TO%GO        NO MORE TO GO.
         PULL,SR1 *X0,6             RESTORE 12-13.
         B        GETACN0600OK
*
*
*  HANDLE GHOST INPUT
*
GTREP20  M:KEYIN  (MESS,GQBUF),(REPLY,GQBUFI),(SIZE,79),(ECB,ECB)
         M:WAIT   1                 WAIT 'TIL OPR WAKES UP...
GTREP205 EQU      %                 WAIT 'TIL
         MTW,0    ECB                 OPR
         BLZ      GTREP205            REPLIES.
         LB,R14   GQBUFI            (R14) = # CHARACTERS IN ANSWER
         BEZ      GTREP40           NOTHING INPUT - AVOID BUFFER MOVE
         LD,R12   MBS3              (R12,R13) = MBS CTL FOR GQBUFI-INBUF
         STB,R14  R13               PUT COUNT IN CONTROL WORD
         MBS,R12  0                 MOVE-EM-OUT
         B        GTREP40           ISOLATE NON-BLANK INPUT.
*
*  HANDLE ON-LINE INPUT
*
GTREP30  M:READ   M:UC,(BUF,INBUF),(SIZE,80),(WAIT),(ABN,GTREP90),;
                       (ERR,GTREP90)
         LH,R14   M:UC+4            (R14) =
         SLS,R14  -1                  RECORD SIZE.
**
**   ISOLATE NON-BLANK INPUT STRING.
**
GTREP40  EQU      %
GOT%REPLY EQU     %
         LW,X2    R14               (X2) = # CHARACTERS INPUT.
         AI,X2    -1                COMPUTE INDEX OF
         STW,X2   LAST%GOOD%IX        LAST CHARACTER.
         BLZ      END%REPLY         IF NOTHING, NULL REPLY.
         LI,X2    0                 INIT START INDEX.
**
**
HAVE%REPLY EQU    %
         LI,R14   0                 ASSUME NO CHARS IN STRING
         STW,R14  MORE%TO%GO          AND NO COMMA WILL BE FOUND.
**
**   IGNORE LEADING BLANKS AND CONTROL CHARACTERS.  WE'RE LOOKING
**   FOR THE FIRST COMMA OR "REAL" INPUT CHARACTER.
**
IGNORE%LEADING%BLANKS EQU %
         CW,X2    LAST%GOOD%IX      IF CURRENT POSITION IS PAST
         BLE      %+4                 INPUT END,
         MTW,0    HAD%REPLY           AND THIS FOLLOWS A COMMA,
         BNEZ     GETREP05            GET No INPUT STRING.
         B        END%REPLY         ELSE THIS IS A NULL REPLY.
*
         LB,R12   INBUF,X2          GET NEXT CHARACTER.
         CI,R12   ','               IF COMMA,
         BNE      %+4
         MTW,1    MORE%TO%GO          MORE SHOULD FOLLOW;
         STW,X2   LAST%COMMA%IX       AFTER THIS IX;
         B        END%REPLY           BUT NOTHING FROM THIS PORTION.
*
         CI,R12   ' '               IF BLANK,
         BE       %+3                 KEEP LOOKING.
         CI,R12   X'15'             IF "REAL" CHARACTER,
         BG       FOUND%GOOD%CHAR     HANDLE IT.
         AI,X2    1                 LOOK AT NEXT CHARACTER.
         B        IGNORE%LEADING%BLANKS
**
**   WE FOUND A REAL CHARACTER.  NOW LOOK FOR THIS STRING'S END.
**
FOUND%GOOD%CHAR EQU %
         STW,X2   NEXT%GOOD%IX      SAVE IX OF GOOD CHAR.
         LW,R12   LAST%GOOD%IX      ASSUME END OF STRING NEXT.
         AI,R12   -1
         STW,R12  LAST%COMMA%IX
*
LOOK%FOR%TERMINATOR EQU %
         AI,X2    1                 LOOK AT NEXT CHAR.
         CW,X2    LAST%GOOD%IX      BUT ONLY IF THERE
         BG       FOUND%TERMINATOR    IS ONE.
*
         LB,R12   INBUF,X2          GET CHARACTER.
         CW,R12   OTHER%TERM        CHECK FOR CALLER GIVEN
         BE       %+3                 TERMINATOR.
         CI,R12   ','               IF NOT A COMMA,
         BNE      LOOK%FOR%TERMINATOR KEEP LOOKING.
*
         MTW,1    MORE%TO%GO        FLAG THAT MORE FOLLOWS THIS POINT.
         STW,X2   LAST%COMMA%IX     SAVE IX OF COMMA.
**
**   TERMINATOR HAS BEEN FOUND.  SCAN BACKWARDS TO FIND LAST "REAL"
**   (NON-BLANK, NON-ACTIVATION) CHARACTER.
**
FOUND%TERMINATOR EQU %
         AI,X2    -1                LOOK AT PREVIOUS CHAR.
         CW,X2    NEXT%GOOD%IX      BUT ONLY IS THERE
         BE       STRING%DELIMITED    IS ONE.
*
         LB,R12   INBUF,X2          GET CHARACTER.
         CI,R12   ' '               IF BLANK,
         BE       FOUND%TERMINATOR    IGNORE IT.
         CI,R12   X'15'             IF ACTIVATION CHAR,
         BLE      FOUND%TERMINATOR    IGNORE IT.
**
**   STRING HAS BEEN DELIMITED.  CALCULATE LENGTH.
**
STRING%DELIMITED EQU %
         XW,X2    NEXT%GOOD%IX      SWAP STRING START IX WITH END IX.
         LW,R14   NEXT%GOOD%IX      LOAD STRING END IX.
         SW,R14   X2                MINUS STRING START
         AI,R14   1                   PLUS 1 GIVES LENGTH.
**
**   IF RETURNED STRING WAS A LEFTOVER SECTION OF A PREVIOUS INPUT,
**   PRINT IT.
**
END%REPLY EQU     %
         PUSH,R14 *X0,2             SAVE 14-15 ALSO.
         MTW,0    ECHO%PENDING      IF PENDING INPUT IS NOT
         BEZ      GETREPLY999         TO BE ECHOED, DON'T.
         MTW,0    HAD%REPLY         IF WE DIDN'T ALREADY HAVE REPLY,
         BEZ      GETREPLY999         NO NEED TO ECHO.
*
         LW,R13   R14               LENGTH TO COUNT FIELD.
         BNEZ     %+3               IF ZERO LENGTH,
         LI,R14   MESSBLNK            OUTPUT BLANKS.
         B        ECHO%REPLY
         LW,R12   X2                MOVE STRING TO OUTPUT BUFFER.
         AI,R12   BA(INBUF)
         STW,R13  MSGLEN
         SCS,R13  -8
         AI,R13   BA(MSGBUF)
         MBS,R12  0
         LI,R14   MSGLEN            PASS ADDRESS OF MESSAGE.
ECHO%REPLY EQU    %
         BAL,R15  #POSTMES
*
GETREPLY999 EQU %
         PULL,R12 *X0,4             RESTORE 12-15.
         B        *R15              RETURN TO CALLER.
GTREP42  M:EXIT
*
*  ERR/ABN ON INPUT - POST MESSAGE AND ABORT
*
GTREP90  EQU      %
         LI,R14   MESS37            (R14) = ADDRESS OF ERROR SUFFIX
         BAL,R15  #POSTMES          GO TELL USER
         M:XXX                      ABORT HIM
*
***********************************************************************
         TITLE    'C H E C K   I F   R E T R Y   I S   A L L O W E D'
***********************************************************************
*
*  CHECK TO SEE IF A RETRY CAN BE ATTEMPTED.  RETURN TO USER IF GHOST
*  OR ON-LINE.  IF BATCH ABORT THE JOB.
*
***********************************************************************
*
CHKRETRY EQU      %
         MTW,0    HAD%REPLY         IF DIDN'T HAVE REPLY
         BNEZ     %+3
         MTW,0    MORE%TO%GO          AND NO PENDING INPUT,
         BEZ      CHKRETRY999         NOTHING TO ECHO.
*
         PUSH,X1  *X0               SAVE 1.
         PUSH,R14 *X0,2             SAVE 14-15.
         LI,X1    0                 RESET MORE%TO%GO FLAG.
         STW,X1   MORE%TO%GO
         LW,X1    LAST%COMMA%IX     ECHO POSTION OF STRING USED.
         LI,R14   ')'
         AI,X1    1
         STB,R14  INBUF,X1
         LW,R14   ='   ('
         AI,X1    5
         STW,R14  INBUF-1
         STW,X1   INBUF-2
         LI,R14   INBUF-2
         BAL,R15  #POSTMES
         PULL,R14 *X0,2
         PULL,X1  *X0
*
CHKRETRY999 EQU   %
         MTW,0    MODE              IF BATCH USER,
         BGEZ     %+2
         M:XXX                        NO RETRY.
         B        *R15              RETURN.
*
***********************************************************************
         TITLE    'C H E C K   F O R   '' Y ''   O R   '' N '' '
***********************************************************************
*
*  CHECK USERS RESPONSE FOR BEGINNING WITH A 'Y' OR 'N'.  ANYTHING
*  BEGINNING WITH A 'Y' IS INTERPRETED AS A YES; ANYTHING BEGINNING WITH
*  AN 'N' IS INTERPRETED AS A NO.
*
*        (X2) = INBUF INDEX OF USER'S FIRST BYTE
*        BAL,R15  CHKYORN
*         ..                        RETURN HERE IF NOT 'Y' OR 'N'
*         ..                        RETURN HERE IF 'Y' OR 'N'
*                                   (R14) <0  USER GAVE YES
*                                         =0  USER GAVE NO
***********************************************************************
*
CHKYORN  CI,R14   0                 WAS ANY THING INPUT
         BLE      CHKYORN3          NO---GO COMPLAIN
         LB,R14   INBUF,X2          (R14) = USER'S FIRST BYTE.
         CI,R14   'Y'               IS IT A 'Y'
         BNE      CHKYORN1          NO---LETS HOPE ITS AN 'N'
         LI,R14   -1                YES--SET SWITCH
         B        CHKYORN2          GO RETURN TO CALLER
CHKYORN1 CI,R14   'N'               IS IT AN 'N'
         BNE      CHKYORN3          NO---GO COMPLAIN
         LI,R14   0                 YES--SET SWITCH
CHKYORN2 AI,R15   1                 RETURN TO BAL+1
         B        *R15              RETURN TO USER
CHKYORN3 PUSH,R15 *X0,1             SAVE REGISTER 15
         LI,R14   MESS32            (R14) = ADDRESS OF ERROR MESSAGE
         BAL,R15  #POSTMES          GO GRIPE AT USER
         PULL,R15 *X0,1             RESTORE REGISTER 15
         B        CHKRETRY          EXIT AFTER CHECKING FOR RETRY
*
***********************************************************************
         TITLE    'B I N A R Y   T O   D E C I M A L'
***********************************************************************
**********                 BINTODEC                          **********
***********************************************************************
*D*      NAME:    BINTODEC - BINARY TO DECIMAL CONVERSION
*,*
*,*      CALL:    BAL,R15 BINTODEC
*,*               <RETURN>
*,*
*,*      INPUT:   (X1) = VALUE TO CONVERT
*,*               (X2) = BYTE ADDRESS OF DESTINATION
*,*               (X3) = SIZE OF DESTINATION FIELD
*,*               (R15)= RETURN ADDESS
*,*
*,*      OUTPUT:  ((X2) THROUGH (X2)+(X3)) = DECIMAL STRING
*,*
*,*      REGISTERS: ALL SAFE BUT X2 AND X3
*D*
***********************************************************************
*
BINTODEC EQU      %
*
*   INITIALIZE:  SAVE VOLATILE REGISTERS; SET UP POINTERS; ETC.
*
         PUSH,R12 *X0,2             SAVE R12 AND R13.
         LW,R13   X1                MOVE VALUE TO WORK REGISTER.
         AW,X2    X3                POINT PAST LAST BYTE TO BE USED.
*
*   SUCCESSIVELY CONVERT VALUE TO DECIMAL DIGITS.
*
BTD020%NEXT%DIGIT EQU %
         AI,X3    -1                ANY LEFT?
         BLZ      BTD999%EXIT       NO---CLEAN UP AND EXIT.
*
         LI,R12   0                 ZERO HIGH ORDER DIVIDEND.
         DW,R12   =10               ONES TO R12; TENS TO R13.
*
         AI,R12   '0'               CONVERT BINARY TO DECIMAL,
         AI,X2    -1                  POINT TO PROPER BYTE.
         STB,R12  0,X2                AND STORE DIGIT.
*
         AI,R13   0                 DON'T WANT LEADING ZEROS.
         BG       BTD020%NEXT%DIGIT
*
*  SYNC FILL REMAINDER OF FIELD.
*
         LI,R12   22
BTD050%BLANK%FILL EQU %
         AI,X3    -1                ANY MORE TO FILL?
         BLZ      BTD999%EXIT     IF NOT, CLEAN UP AND EXIT.
*
         AI,X2    -1                POINT TO PROPER BYTE
         STB,R12  0,X2                AND STORE BLANK
*
         B        BTD050%BLANK%FILL GO BACK FOR MORE.
*
*   CLEAN UP AND EXIT.
*
BTD999%EXIT EQU   %
         PULL,R12 *X0,2             RESTORE R12 AND R13.
         B        *R15              RETURN.
*
***********************************************************************
         TITLE    'BLANK%LINE - PRINT BLANK LINE'
***********************************************************************
**********                  BLANK%LINE                       **********
***********************************************************************
***      NAME:    BLANK%LINE - PRINT BLANK LINE
***
***      CALL:    BAL,R15   BLANK%LINE
***               <RETURN>
***
***      INPUT:   (R15)  = RETURN ADDRESS
***
***      OUTPUT:  (R15)  = (R15) INPUT
***
***      DESCRIPTION: WRITE BLANK LINE BY CALLINT #POSTMES
***
***********************************************************************
*
BLANK%LINE EQU    %
         MTW,0    MODE              NO BLANK LINES
         BEZ      *R15                IF GHOST USER.
*
         LI,R14   MESSBLNK          (R14) = ADDR OF TXTC STRING BLANK.
         B        #POSTMES          PRINT IT.
*
***********************************************************************
         TITLE    'GREETINGS - SALUTORY MESSAGE TO USER'
***********************************************************************
**********                 GREETINGS                         **********
***********************************************************************
***      NAME:    GREETINGS - SALUTORY MESSAGE TO USER
***
***      CALL:    BAL,R15   GREETINGS
***               <RETURN>
***
***      INPUT:   (R15)  = RETURN ADDRESS
***
***      OUTPUT:  (R15)  = (R15) INPUT
***
***      DESCRIPTION: PRINT SALUTORY MESSAGE AND OTHER INFO AT
***               PROGRAM STARTUP.
***
***********************************************************************
*
GREETINGS EQU     %
         MTW,0    MODE              OPR DOESN'T
         BEZ      *R15                NEED GREETING.
**
**   MOVE PROGRAM ID TO BUFFER.
**
         LI,X4    BA(TX:MAPHERE)+4  BYTE ADDRESS OF PROGRAM ID.
         LW,X5    TX:MAPHERE        (X5) = # BYTES IN ID.
         SCS,X5   -8                MOVE COUNT TO MAKE
         AI,X5    BA(MSGBUF)          DESTINATION POINTER.
         MBS,X4   0                 MOVE PROG ID TO OUTPUT BUFFER.
**
**   GET TIME AND DATE INFO.
**
         LW,R14   ='  **'           FIRST INITIALIZE T&D BUF FOR LATER.
         STW,R14  MSGBUF+15+4
         SCS,R14  -8
         STW,R14  MSGBUF+15+5
*
         M:TIME   MSGBUF+15,TMS     GET TIME & DATE.
*
         LI,X4    BA(MSGBUF)+15*4   PTR TO TIME STRING.
         AW,X5    =X'06000000'      # BYTES IN STRING.
         MBS,X4   0                 MOVE TIME TO BUFFER.
         LW,R14   X4                SAVE PTR TO DATE INFO.
*
         LH,R9    SR1               (R9) = YEAR.
         LW,X2    SR1               (X2) =
         AND,X2   =X'FFFF'            JULIAN DAY.
         LW,X3    R9                SAVE YEAR.
*
         AI,R9    -1                (R9) = # YEARS NOT INCLUDING THIS.
         LI,R8    0
         DW,R8    =4                (R9) = # LEAP YEARS.
*
         MI,X3    365               (X3) = # DAYS IN YEARS.
         AW,X3    R9                PLUS # DAYS DUE TO LEAP YEARS.
         AW,X3    X2                ADD IN # DAYS THIS YEAR.
         LI,X2    0
         DW,X2    =7                (X2) = DAY NAME INDEX.
*
         LW,X4    DAYNAM,2          GET PTR TO TEXTC DAY NAME.
         LB,X3    *X4               (X3) = # BYTES IN NAME.
         SCS,X3   -8                MAKE BYTE COUNT AND
         AW,X5    X3                  ADD TO DESTINATION PTR.
         SLS,X4   2                 (X4) = BA OF
         AI,X4    1                   NAME TEXT.
         MBS,X4   0                 MOVE DAY NAME TEXT TO OUTPUT BUF.
**
**   MOVE DATE INTO TO BUFFER.
**
         LW,X4    R14               RESTORE DATE INFO PTR.
         AW,X5    =X'0F000000'      INCLUDE TRAILING BYTES W/DATE.
         MBS,X4   0                 MOVE TO BUFFER.
**
**   OUTPUT STRING.
**
         AI,X5    -BA(MSGBUF)       (X5) = # BYTES TO OUTPUT.
         STW,X5   MSGLEN
         LI,R14   MSGLEN            PASS ADDR OF MESSAGE.
         B        #POSTMES
*
***********************************************************************
         TITLE    'Q U E U E   D I S K   I / O'
***********************************************************************
*
*
*                      Q U E U E   D I S K   I / O
*
*
*        (R8)                       GENERALIZED DISK ADDRESS
*        (R9)                       BYTE ADDRESS OF BUFFER
*        (R10)                      # OF BYTES TO PROCESS
*        (R11)                      FUNCTION CODE
*                                     =0 SEEK AND READ
*                                     =1 SEEK AND WRITE
*                                     =7 RESTORE
*        BAL,R15  QDIO
*
***********************************************************************
*
QDIO     EQU      %
         MTW,0    DEBUGSW           IF DEBUGSW IS > 0,
         BGZ      *R15                NO DISK WRITES.
*
         PUSH,X0  *X0,16            SAVE ALL REGISTERS.
         LW,X7    *X0               (X7) = TOP-OF-STACK ADDRESS
         AI,X7    -15               (X7) = ADDRESS OF X0 IN TCB STACK
         STW,X7   QR0ADDR           SAVE IT FOR LATER
*
*   GET MASTER MODE AND SET UP REGISTERS FOR <NEWQ>    CALL.
*
QDIO20   EQU      %
         BAL,R15  MASTER            GET MASTER MODE.
*
         LW,R12   PRINRT            (R12) = -,PRI,NRT,-
         SLS,R11  24                GET FC IN BYTE 0
         OR,R12   R11               PUT IT IN THE WORD
         LW,X4    R11               PUT IT WORD 0 OF TABLE ENTRY
         LH,R11   R8                (R11) = DCTX AND 'E' BIT
         AND,R11  X7F               (R11) = DCTX
         OR,R12   R11               (R12) = FC,PRI,NRT,DCTX
         OR,X4    R8                PUT GDA IN WORD 0 OF TABLE ENTRY
         LW,R13   R9                (R13) = BYTE ADDRESS OF BUFFER
         LW,R14   R10               (R14) = BYTE COUNT FOR I/O
         LW,R15   R8                (R15) = GDA (GENERALIZED DISK ADDR)
         LI,X0    0                 NO END ACTION FOR NEWQ.
         LI,X1    0
*
*  TRY TO START THE I/O
*
         MTW,0    DEBUGSW           SHOULD WE SNAP REGISTERS
         BLZ      QDIO41            NO---GO ON
*                                   YES--SNAP REGISTERS AND QUEUE TABLE
         M:SNAP   'QDIO REG',(QR0ADDR,QR0ADDR)
QDIO41   MTW,0    DEBUGSW           SHOULD WE GIVE IT TO CP-V
         BGZ      QDIO50            NO---'C H I C K E N'
         BAL,R11  NEWQ              PERFORM I/O.
         B        QDIO60            OOPS - DEVICE IS DOWN
*
*   I/O HAS BEEN QUEUED.
*
QDIO50   EQU      %
         BAL,R15  SLAVE             SHED MASTER MODE.
         LW,X0    *QR0ADDR          RESTORE TCB STACK ADDRESS AND
         PULL,X0  *X0,16              ALL REGISTERS.
         B        *R15              RETURN.
*
*  DEVICE IS DOWN - SEVERE TROUBLE
*
QDIO60   BAL,R15  SLAVE             DISPOSE OF MASTER MODE
         LW,X0    *QR0ADDR          RESTORE POINTER TO TCB STACK
         BAL,R15  #POSTMES          PRINT USER PASSED MESSAGE.
         LI,R14   MESS38            (R14) = ADDRESS OF ERROR MESSAGE
         BAL,R15  #POSTMES          GO TELL USER ABOUT IT
         M:XXX                      ABORT IT NOW
*
***********************************************************************
         TITLE    'F I L E   M A N A G E M E N T   E N T R I E S'
***********************************************************************
*
*
*             F I L E   M A N A G E M E N T   E N T R I E S
*
*
*                                   EMPTY ACCOUNT DIRECTORY
EMPTYAD  DATA     0                   BLINK=0
         DATA     0                   FLINK=0
         DATA     X'000C400C'       NAV=12, S=1, SCR=12
*
*                                   EMPTY FILE DIRECTORY - BEGINNING
EMPTYFDB DATA     0                   BLINK=0
         DATA     0                   FLINK=0
         DATA     X'000C4020'       NAV=12,S=1,SCR=32
*
*                                   EMPTY FILE DIRECTORY - END
EMPTYFDE DATA     X'80000000'       E=1 (EMPTY DIRECTORY)
         DATA     0,X'1B010006'     NGAVAL=27,GAVAL=X'10006' (CHANGED)
         DATA     0                   A WORD OF ZEROES
         DATA     0                   SMI=0
*                                   EMPTY VTOC
EMPTYVTC TEXT     ':LBL'              A SENTINEL WORD
         TEXT     'VSN ','    '       VOLUME SERIAL NUMBER
         DATA     7                   SNTD=7 (CHANGED)
         DATA     13                  MAPWL=13 (CHANGED)
         DATA     X'7FFFFFFC'         NVAT-ASSUMING NGC=30 (CHANGED)
         DATA     X'00070000'         MAPWD=7, FIRST SECTOR NUMBER = 0
*
*                                   ACCOUNT DIRECTORY ENTRY SKELETON
ADESKEL  DATA     X'0B404040'         TEXTC COUNT AND 3 BLANKS
         TEXT     'SOME'              ACCOUNT
         TEXT     'ACNT'                      NAME
         DATA     X'00010004'         FILE DIRECTORY FDA (CHANGED)
         DATA     X'00000400'         BLK=0, FAK=1, EOF=0
         DATA     0                   1 MORE BYTE OF ZEROES
*
*                                   FILE DIRECTORY FIT
         TITLE    'C O N S T A N T S'
*
*
*                           C O N S T A N T S
*
*
MSK123   DATA     X'00FFFFFF'       MASK FOR BYTES 1,2, AND 3
SP:PUB   DATA     X'80000000'       AVRTBL - DEVICE IS PUBLIC BIT
SP:MTD   DATA     X'04000000'       AVRTBL - MOUNT IS PENDING BIT
SP:VER   DATA     X'08000000'       AVRTBL - VERIFICATION IN PROGRESS
SP:AVR   DATA     X'20000000'       AVRTBL - PACK ALREADY VERIFIED BIT
SP:INIT  DATA     X'10000000'       AVRTBL - PACK IS BEING INITIALIZED
BLANKS   DATA     '    '            FOUR BLANKS
D32      DATA     32                DECIMAL 32
X7F      DATA     X'7F'             SHIFT COUNT MASK
86DEAD86 DATA     0                 CLEAR BUFFER CONSTANT.  WANTED TO
*                                     TO USE X'86DEAD86' BUT THAT ONE
*                                     CONFUSES FILE MANAGEMENT!!!!!!!
*
NVATALL  DATA     X'7FFFFFFC'       MAX VALUE FOR NVAT
FCDBIT   DATA     X'00200000'       FILE CLOSED BIT
PRINRT   GEN,8,8,8,8 0,X'FF',10,0   I/O PRIORITY AND RETRIES
DEBUGSW  DATA     DEBUG             CONTROLS OPERATION OF CODE
         BOUND    8
DIGLIM   DATA     '0','9'           LEGAL DIGIT LIMITS
AILIM    DATA     'A','I'           LEGAL
JRLIM    DATA     'J','R'                 ALPHABETIC
SZLIM    DATA     'S','Z'                            CHARACTERS
BADACNCHR TEXTC   '|,;<>./=?'       LIST OF ILLEGAL ACN CHARS.
DAYNAM   DATA     DAY0,DAY1,DAY2,DAY3,DAY4,DAY5,DAY6
DAY0     TEXTC    'ON SUNDAY, '
DAY1     TEXTC    'ON MONDAY, '
DAY2     TEXTC    'ON TUESDAY, '
DAY3     TEXTC    'ON WEDNESDAY, '
DAY4     TEXTC    'ON THURSDAY, '
DAY5     TEXTC    'ON FRIDAY, '
DAY6     TEXTC    'ON SATURDAY, '
         BOUND    8
MBS1     DATA     BA(ACNTNAME)-8
         GEN,8,24 0,BA(ACNTNAME)
MBS2     DATA     R9**2
         GEN,8,24 ADENTLEN,BA(AD)+12
MBS3     DATA     BA(GQBUFI)+1
         DATA     BA(INBUF)
MBS5     DATA     BA(EMPTYFDB)
         GEN,8,24 12,BA(FD)
MBS6     DATA     BA(EMPTYFDE)
         GEN,8,24 20,BA(FD+507)
         TITLE    'M E S S A G E   T E X T'
*
*
*                        M E S S A G E   T E X T
*
*
TXTC:DW  TXTC     ' ---  DEBUGGING WITH DISK WRITE  ---'
TXTC:DNW TXTC     ' ---  DEBUGGING WITH NO DISK WRITE  ---'
MESS01   TXTC     ' ***  PRIVILEGE MUST BE C0 OR GREATER  ***'
MESS02   TXTC     ' ***  MAPINIT IS LOADED WITH THE WRONG MONSTK  ***'
MESS03   TXTC     ' ENTER DEVICE ADDRESS - '
MESS04   EQU      %
MESS05   TXTC     ' ***  USE ''NDD'' FORMAT TO SPECIFY A DEVICE'
MESS06   TXTC     ' ***  THAT DEVICE IS NOT IN THE AVR TABLES'
MESS07   TXTC     ' ***  THAT DEVICE IS CURRENTLY IN USE'
MESS08   TXTC     ' ***  THAT DEVICE IS PUBLIC'
MESS09   TXTC     ' ***  THAT DEVICE HAS BEEN MOUNTED AND VERIFIED'
MESS10   TXTC     ' ***  THAT DEVICE IS BEING INITIALIZED'
MESS11   TXTC     ' ***  THAT DEVICE HAS VERIFICATION IN PROGRESS'
MESS12   TXTC     ' ***  THAT DEVICE HAS A PENDING MOUNT REQUEST'
MESS13   TXTC     ' ***  THAT DEVICE IS FLAGGED FOR EXCLUSIVE USE'
MESS14   TXTC     ' ***  THAT DEVICE HAS SHARED USERS ASSOCIATED'
MESS15   TXTC     ' ***  THAT DEVICE HAS A SOLICIT PENDING'
MESS16   TXTC     ' ENTER SERIAL NUMBER - '
MESS17   TXTC     ' ***  SERIAL NUMBER CAN NOT EXCEED 4 CHARACTERS'
MESS18   TXTC     ' ***  THERE''S NO HGP FOR THAT DEVICE  ***'
TXTC:ENTNGC TXTC  ' ENTER NUMBER OF GRANULES PER CYLINDER IF ',;
                  'DEFAULT NOT DESIRED - '
TXTC:NGCLIMERR TXTC ' ***  MUST BE WITHIN PACK MIN AND 255'
TXTC:NGCLOW TXTC  '   VTOC WILL BE TOO BIG FOR THIS ',;
                  'DEVICE''S HGP'
MESS19   TXTC     ' ***  ONE OR MORE CHARACTERS ARE ILLEGAL'
MESS20   TXTC     ' ***  IMBEDDED BLANKS ARE NOT ALLOWED'
MESS24   TXTC     ' ENTER ACCOUNTS--XX MAXIMUM--NULL INPUT ENDS LIST'
MESS27   TXTC     ' ***  ACCOUNT NUMBER CAN NOT EXCEED 8 CHARACTERS'
MESS28   TXTC     ' ***  ALL AVAILABLE ACCOUNT ENTRIES ARE FILLED'
MESS29   TXTC     ' ***  YOU ALREADY ENTERED THAT ACCOUNT NUMBER'
MESS32   TXTC     ' ***  PLEASE ANSWER ''Y'' OR ''N'''
MESS34   TXTC     ' ***  NOTHING TO LIST'
MESS37   TXTC     ' ***  ERROR ON COMMAND INPUT  ***'
MESS38   TXTC     ' ***  THE DEVICE HAS GONE DOWN  ***'
MESS39   TXTC     ' ***  THE ACCOUNT DIRECTORY WRITE FAILED  ***'
MESS40   TXTC     ' ***  A FILE DIRECTORY WRITE FAILED  ***'
MESS42   TXTC     ' ***  THE VTOC WRITE FAILED  ***'
MESS46   TXTC     ' ***  INPUT IS EXPECTED'
MESS47   TXTC     '   XX - '
MESS48   TXTC     ' ***  THAT DEVICE IS PARTITIONED'
MESS49   TXTC     '    XXXXX SECTORS, DEFAULT XXX GRAN/CYL,',;
                  ' PACK MIN XXX, SYS MIN XXX'
MESSBLNK TXTC     ' '
TX:MAPHERE TXTC   ' ***  MAPINIT E01 AT '
MESS50   TXTC     ' ***  NOTHING TO DELETE'
MESS51   TXTC     ' ***  CAN''T FIND THAT ACCOUNT'
MESS52   TXTC     ' IS ACCOUNT LIST OK - '
MESS53   TXTC     ' ***  ALL ENTRIES ARE FILLED--ONLY DELETE ALLOWED'
MESS54   TXTC     ' ***  THE NGC * THE NUMBER OF ACCOUNTS MUST BE',;
                  ' GREATER THAN 30'
MESS55   TXTC     ' ***  OPERATOR WON''T LET YOU INIT THIS PACK'
TXTC:SUCCESS TXTC ' * SUCCESSFUL COMPLETION *'
         TITLE    'T E M P O R A R Y   S T O R A G E'
*
*
*                   T E M P O R A R Y   S T O R A G E
*
*
         USECT    DATA
*
MODE     RES      1                 PROGRAM MODE SWITCH   = -1 BATCH
*                                                            0 GHOST
*                                                           +1 ON-LINE
*
%DCTX    RES      1                 DCT INDEX FOR DEVICE USER SPECIFIED
*
%DISCLIM RES      1                 # OF SECTORS ON USERS DEVICE
*
%NGC     RES      1                 USER'S VALUE FOR GRANULES PER CYLIN.
*
%MINHGPNGC RES    1                 MIN NGC FOR VTOC TO FIT INTO HGP.
*
%AVRX    RES      1                 AVR INDEX FOR DEVICE USER SPECIFIED
*
%VSN     RES      1                 USER'S VALUE FOR VOLUME SERIAL #
*
#FMAPWRD RES      1                 # OF FULL WORDS IN VTOC BIT MAP
*
#BITLWRD RES      1                 # OF BITS TO USE IN LAST VTOC BIT
*                                     MAP WORD.
*
#ACCOUNT RES      1                 # OF ACCOUNTS USER SPECIFIED
*
#ACNLEFT RES      1                 # OF ACCOUNT SLOTS LEFT
*
ECB      RES      1                 EVENT-CONTROL-BLOCK FOR M:KEYIN
*
MSGLEN   RES      1                 TXTC MESSAGE LENGTH.
MSGBUF   RES      20                TXTC MESSAGE BUFFER.
*
QR0ADDR  RES      1                 ADDRESS OF R0 IN THE TEMP STACK WHEN
*                                     WRITE OPERATION
MORE%TO%GO RES    1                 BUFFERED INPUT PENDING FLAG.
SAVE%ECHO%PENDING RES 1             SAVE OF ECHO%PENDING.
ECHO%PENDING DATA 1                 ECHO PENDING INPUT FLAG.
HAD%REPLY RES     1                 HAD BUFFERED INPUT PENDING FLAG.
LAST%COMMA%IX RES 1                 IX OF NEXT PENDING INPUT - 1.
LAST%GOOD%IX RES  1                 IX OF LAST CHAR IN BUFFER.
NEXT%GOOD%IX RES  1                 IX OF FIRST CHR OF NEXT INPUT.
OTHER%TERM RES    1                 POSSIBLE OTHER TERMINATOR CHAR.
*
         BOUND    8
ACNTNAME RES,8    MAX#ACNT          TABLE OF USER ACCOUNT NAMES
         BOUND    8
NGCLIM   RES      2                 LEGAL NGC LIMITS
*
SW%DEL%ACN RES    1                 DELETE ACCOUNT SWITCH.
*
ASKOPMSG TEXTC    'OK TO INITIALIZE PACK ''XXXX'' / DPXXXBBB (Y/N)?'
OPREPLY  RES      1                 OPERATOR REPLY.
*
FDFDA    RES      MAX#ACNT          TABLE OF FDA'S FOR FILE DIRECTORIES
*
         BOUND    4*8               TO NEXT 8 WORD BOUNDARY FOR SNAPS.
VTOC     RES      512               BUFFER FOR VOLUME TABLE OF CONTENTS
*
         BOUND    4*8
AD       RES      512               BUFFER FOR ACCOUNT DIRECTORY
*
         BOUND    4*8
FD       RES      512               BUFFER FOR FILE DIRECTORY
*
         RES      2                 USED WITH INBUF TO ECHO BATCH INPUT
INBUF    RES      20                INPUT BUFFER
         RES      1                 POSSIBLE ECHO SPILLOVER
*
GQBUF    RES      20                GHOST QUERY OUTPUT BUFFER
*
GQBUFI   RES      20                GHOST QUERY INPUT BUFFER
*                                     THE EXIT CONTROL ROUTINE GIVES
*                                     US CONTROL FOR OUR CLEANUP.
*
*
PATCH    EQU      %                 PATCHING AREA
         DO1      10
         DATA     0,0,0,0,0
         DEF      PATCH
         TITLE    'E X T E R N A L   R E F E R E N C E S'
*
*
*                 E X T E R N A L   R E F E R E N C E S
*
*
         REF      JB:PRIV           USERS PRIVILEGE                (:J1)
         REF      J:JIT             WORD 0 OF JIT (MODE FLAGS - B,O,G)
         REF      BATAPE            DCTX OF FIRST TAPE             (:J1)
         REF      AVRTBLNE          # OF TAPES AND PACKS           (:J1)
         REF      AVRTBLSIZ         # OF TAPES                     (:J1)
         REF      DCT3              DEVICE SWITCHES
         REF      DCT16             DEVICE NAMES EBCDIC            (:J1)
         REF      DCT22             DISK TYPE                      (:J1)
         REF      DISCLIMS          DISK SIZE                      (:J1)
         REF      AVRTBL            SN AND FLAGS                   (:J1)
         REF      AVRID             EXCLUSIVE USER                 (:J1)
         REF      SOLICIT           AUTOMATIC AVR PLEASE           (:J1)
         REF      AVRNOU            # OF DCBS OPEN TO THIS PACK    (:J1)
         REF      QUEUE             I/O WITH DCB-NO END ACTION     (:J1)
         REF      HGP               HEADING GRANULE POOL
         REF      QUEUE1            I/O WITH DCB-END ACTION        (:J1)
         REF      NEWQ              I/O WITH NO DCB-END ACTION     (:J1)
         REF      M:LO              BATCH/ON-LINE MESSAGE OUTPUT
         REF      M:UC              GHOST USER I/O
         REF      M:C               BATCH INPUT
         TITLE    'E X T E R N A L   D E F I N I T I O N S'
*
*
*                E X T E R N A L   D E F I N I T I O N S
*
*
         DEF      CODE
Z        SET      CODE
         DEF      DATA
Z        SET      DATA
         DEF      01FPTS
Z        SET      01FPTS
*
*
         TITLE    'D E B U G   D E F S'
***********************************************************************
**********                DEBUG DEFS                         **********
***********************************************************************
         DO       DEBUG>-1
*
         DEF      INITIALIZE
         DEF      LOCDEV
         DEF      GETVSN
         DEF      GETNGC
         DEF      GETACN
         DEF      SETVTOC
         DEF      SETAD
         DEF      WRTVTOC
         DEF      WRTFD
         DEF      MASTER
         DEF      SLAVE
         DEF      QUERY
         DEF      #POSTMES
         DEF      GETREPLY
         DEF      CHKRETRY
         DEF      CHKYORN
         DEF      BINTODEC
         DEF      BLANK%LINE
         DEF      GREETINGS
         DEF      LIST%ACCOUNTS
         DEF      QDIO
         DEF      ECHO%PENDING
         DEF      DEBUGSW           MAKE THIS EASY TO FIND.
         DEF      %NGC
         DEF      %VSN
         DEF      #ACCOUNT
         DEF      #ACNLEFT
         DEF      MSGLEN
         DEF      MSGBUF
         DEF      ACNTNAME
         DEF      FDFDA
         DEF      VTOC
         DEF      AD
         DEF      FD
         DEF      INBUF
         FIN
*
         END      MAPINIT
