*M*      FIXHGP   PERFORM HGP RECON AND FREPORT FUNCTIONS FOR FIX
         PCC      0
         CSECT    1
UTSPROC  SET      1
S69PROC  SET      1
MONPROC  SET      1
DISCBPROC SET     1
BITS     SET      1
UFLAGS   SET      1
         SYSTEM   UTS
         SYSTEM   BPM
         SPACE    2
,,HFPT1  M:PT     1                 FPT'S IN PROTEXTED MEMORY
         SPACE    2
FIXHGP:  EQU      %
         SPACE    2
TXTSECT  CSECT    1
TBLSECT  CSECT    1
         USECT    FIXHGP:
         TITLE    '****  CONSTANTS  ****'
         SPACE    2
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
         SPACE    3
PC       EQU      '<'
         SPACE    1
HOU      EQU      3
         SPACE    1
DFDA     EQU      8
DDA      EQU      X'1FD'
DBLINK   EQU      X'1FE'
DFLINK   EQU      X'1FF'
         SPACE    1
OCRDCNT  EQU      80
         SPACE    1
RBUFEND  EQU      X'1FFFF'          LAST WORD OF RECOVERY BUFFER
JITBUF   EQU      RBUFEND-511-512
AJITBUF  EQU      JITBUF+512
         SPACE    1
ADSCR    EQU      9
ADKSIZE  EQU      ADSCR+3+3+1
FDSCR    EQU      32
FDKSIZE  EQU      FDSCR+4+5
         SPACE    3
*  INDICES INTO RBBAT DATA OF TABLE POINTERS
BBDEV    EQU      6                 BB:DEV
BBRID    EQU      8                 BB:RID
BHSID    EQU      X'D'              BH:SID
BWSDA    EQU      X'13'             BW:SDA
         TITLE    '****  ASSEMBLY SWITCHES  ****'
         SPACE    2
TAB      SET      X'05'             TAB CHAR FOR TXTC PROC
CR       SET      X'15'             CARRIAGE RETURN
         SPACE    3
*P*      NAME:         FIXHGP
*P*
*P*      PURPOSE:      PROVIDE SOME SYSTEM INITIALIZATION FUNCTIONS,
*P*                    PUBLIC FILE HGP RECONSTRUCTION, AND PRIVATE
*P*                    PACK HGP RECONSTRUCTION.
*P*
*P*      DESCRIPTION:  AT INITIAL TAPE BOOT, BUILD COPY OF HGPS AND
*P*                    WRITE TO ALLOCAT DATA.  ALLOCATE GRANULES FOR
*P*                    ACCOUNT DIRECTORY FDA AND DUAL, INITIALIZE AND
*P*                    WRITE THEM.
*P*
*P*                    AT SYSTEM BOOT (WHETHER CRASH RECOVERY, COLD
*P*                    BOOT OR BOOT AFTER ZAP) FIX IS ENTERED BEFORE
*P*                    GHOST1.  IF A RECOVERY BUFFER EXISTS, SOME
*P*                    ITEMS ARE PROCESSED (THE OTHERS WILL BE DONE
*P*                    IN RECOVER2 IN GHOST1).  IF CRASH WAS X'89'
*P*                    (ALLOCAT) OR OPERATOR REQUESTS IT, AN HGP
*P*                    RECONSTRUCTION OF THE PUBLIC FILE SYSTEM IS
*P*                    PERFORMED.
*P*                    IF A RBBAT RECOVERY FILE EXISTS, NO RBBAT RECOVERY
*P*                    IS DONE.  OTHERWISE, IF RBBAT WAS ACTIVE AT
*P*                    THE TIME OF THE CRASH, HIS DATA IS WRITTEN TO
*P*                    THE RBBAT RECOVERY FILE (:RBBRVR).
*P*
*P*                    FIX EXITS TO GHOST1 BY SETTING GHOST1'S USER
*P*                    NUMBER INTO FIX'S UB:ACP (COMMAND PROCESSOR)
*P*                    AND ISSUES AN M:EXIT CAL.
         TITLE    '****  EXTERNAL DEFINITIONS  ****'
         SPACE    2
         DEF      ALLOCG            ALLOCATE A GRANULE
         DEF      ALLOCKD           ALLOCATE KEYED DATA GRANULE
         DEF      FILEND            END OF PROCESSING FILE
         DEF      FIXHD:            SYMBOL FOR PATCHING DATA
         DEF      FIXHGP:           PROCEDURE
         DEF      HFPT1             FPT LOCATION FOR PATCHING
         DEF      MADKEY            TEXTC 'ACCOUNT ='
         DEF      FREPORT           REPORT 75 ERRORS
         DEF      HGPR              HGP RECONSTRUCTION
         DEF      DUMPHGP           DUMP PUB OR PRIV HGPS
         DEF      SYSINIT           SYSTEM INITIALIZATION
         DEF      DATERR            TYPE MESSAGE TO OC
         DEF      SAVBUF            USERS WAITING FOR FREPORT
         DEF      BUFWRT            WRITE I/O BUFFER, NO RELEASE
         DEF      FNDHGP            LOCATE HGP IN FIX DATA
         DEF      FNDHGP1           LOCATE HGP GIVEN POINTER TO HGPS
         DEF      ADINIT            SET UP DATA FOR READING AD
         DEF      FDINIT            SET UP DATA FOR READING FD
         DEF      KEYIN             PERFORM M:KEYIN FINCTION TO OC
         DEF      NORECON           GIVE UP ON HGP RECON
         DEF      RELFIT            GET RID OF FIT
         DEF      RELPACKS          GIVE UP EXCLUSIVE PACK USE
         DEF      RBUF              ADDRESS OF RECOVERY BUFFER IN CORE
         DEF      BADDA             BAD DISC ADDRESS
         TITLE    '****  EXTERNAL REFERENCES  ****'
         SPACE    2
         REF      :BIGX512          = 512 IF BIG MEMORY SYSTEM
         REF      ACCTSUM           PRINT SUMMARY FOR AN ACCOUNT
         REF      ACNCFU            ACCOUNT DIR CFU
         REF      AIF               RBBAT COMBUF CODE
         REF      AIFJE             RBBAT COMBUF CODE
         REF      AIFNC             RBBAT COMBUF CODE
         REF      ALLOCBUF          ALLOCATE I/O BUFFERS
         REF      ALLODIRA          REMNANT CYLS FOR DIRECTORY ALLOCATION
         REF      ALLOQ             QUEUE ALLOCAT REQUEST
         REF      ALLOREG           WAIT FOR ALLOCAT TO RUN
         REF      AOF               RBBAT COMBUF CODE
         REF      AOFL              RBBAT COMBUF CODE
         REF      AOFNB             RBBAT COMBUF CODE
         REF      AOFP              RBBAT COMBUF CODE
         REF      AVRID             PACK SET EXCLUSIVE USER #
         REF      AVRNOU            # USERS OF PACK
         REF      AVRTBL            BASE OF AVR TABLE
         REF      AVRTBLNE          AVRTBL INDEX OF FIRST PACK
         REF      AVRTBLSIZ         SIZE OF AVRTBL TABLES
         REF      B:ACCT            FLAG FOR ACCOUNT PRESENT
         REF      B:F               FLAG FOR FORMATTED OPTION PRESENT
         REF      B:SN              FLAG FOR SN PRESENT
         REF      BATAPE            DCTX OF FIRST TAPE
         REF      BGRAN             ERRLOG DISC ADDR
         REF      BGRCFU            FIRST USER CFU
         REF      BIN2HEX           CONVERT BINARY TO HEX EBCDIC
         REF      BOOTFLG           FLAG FOR SYSTEM UP YET
         REF      BUFADR            I/O BUFFER ADDRESS
         REF      BUFDA             I/O BUFFER DISC ADDRESS & FLAGS
         REF      BUFDACHK          I/O BUFFER LINK CHECK DISC ADDR
         REF      BUFDUAL           I/O BUFFER DUAL DISC ADDR
         REF      BUFINFO           TYPE OF COMPLETION OF I/O
         REF      BUFLAGS           ALLYCAT BUFFER FLAGS
         REF      BUFLINK           LINK TO NEXT BUFFER
         REF      BUFMAX            # I/O BUFFERS ALLOCATED
         REF      BUFTSIZ           SIZE OF ERRLOG BUFFERS
         REF      BUFTYPE           TYPE OF BUFFER END-ACTION
         REF      C:MSM             TICS SINCE START-UP AT MIDNIGHT
         REF      CALLNEWQ          QUEUE I/O VIA NEWQNWM, NO END-ACTION
         REF      CBUFS             FIRST BUFFER POINTER
         REF      CHKDA             INTERNAL VALIDATE DISC ADDR
         REF      CHKDAQ            VALIDATE DISC ADDRESS
         REF      CFUSIZE           # WORDS PER CFU
         REF      CLEANUP           ABORT EXIT
         REF      CMDL              CURRENT MI INDEX
         REF      CORESDCB          ZERO IF M:LO, ECHODCB SAME DEVICE
         REF      CURACCT           CURRENT ACCOUNT
         REF      CURBUF            CURRENT ERRLOG BUFFER
         REF      CURFILE           CURRENT FILE NAME
         REF      CURGRAN           ERRLOG DISC ADDR
         REF      CURMES            CURRENT ERROR MESSAGE
         REF      CUROPT            OPTIONS ON CURRENT COMMAND
         REF      CYL%SHFT          SHIFT AMMOUNT, SEEK TO REL SECT
         REF      DATE              EBCDIC DATE
         REF      DCTSET            MOUNT VOLUMES IF PRIVATE
         REF      DCTSET1           SET UP VOL # TO DCTX CONVERSION TBL
         REF      DCTSIZ            # DCT TABLE ENTRIES
         REF      DCTX              CONVERT VOL # TO DCT INDEX
         REF      DCT1              DEVICE ADDRESS
         REF      DCT3              DEVICE FLAGS
         REF      DCT4              DEVICE TYPE
         REF      DCT5              DEVIE BUSY FLAG
         REF      DCT7              DA OF COMMAND LIST
         REF      DCT9              DIAGNOSTIC FLAG
         REF      DCT15             USER # OF REAL-TIME USER
         REF      DCT22             DISC TYPE
         REF      DCT23             HGP DISPLACEMENT
         REF      DCT24             RMA FLAGS
         REF      DELKEY            DELETE CURRENT KEY
         REF      DIRBUF            DIRECTORY BUFFER
         REF      DISCLIMS          # SECTORS ON DEVICE
         REF      DISCRD            READ DISC GRANULE
         REF      DISCWRT           WRITE DISC GRANULE
         REF      DISPFLG
         REF      DOPRINT           WRITE MESSAGE TO USER
         REF      DOUBLEONE         DOUBLEWORD, 2 WORDS OF X'1'
         REF      DOUBLEZERO        TWO WORDS OF ZEROS
         REF      DRDWAIT           READ DISC WITH WAIT
         REF      DUALRD            CHECK IF DUAL READ
         REF      DUMPB             DUMP PRBUF TO USER TERMINAL
         REF      DUMPBUF           DUMP PRBUF TO LINE PRINTER
         REF      DUMPFILE          SUA CONTROL WORD
         REF      DWRWAIT           WRITE DISC WITH WAIT
         REF      E:WU              EVENT:  AWAKEN SLEEPING USER
         REF      EOFDA             REAL EOF LOC
         REF      ENDPROC2          FINISH PROCESSING OF THIS COMMAND
         REF      ERBLOCK           ERRLOG
         REF      ERRCNT            # ERRORS ENCOUNTERED
         REF      ERRCODE           ERROR CODE FOR ERRMSG
         REF      ERR#02            ERROR FLAG
         REF      ERR#07
         REF      ERR#51
         REF      ERR#52
         REF      ERR#53
         REF      ERR#54
         REF      ERR#99            HARDWARE I/O ERROR
         REF      ERRMSG1           PRINT PARTIAL ERROR MESSAGE
         REF      F:MONDMP          DCB FOR READING MONDUMP FILE
         REF      F:PV              DCB FOR MOUNTING PACK SETS
         REF      F:RB              DCB FOR READING RBBAT RECOVERY FILE
         REF      BIN2DEC           OUTPUT IN DECIMAL
         REF      FDHDFLG           >= 0 IF ACCOUNT HEADING PRINTED
         REF      FGRAN1            ERRLOG GRANULE
         REF      FGRAN2            ERRLOG GRANULE
         REF      FGRAN3            ERRLOG GRANULE
         REF      FILCFU            FILE DIRECTORY CFU
         REF      FILE20            PROCESS FILE
         REF      FITBUF            BUFFER CONTAINING FIT
         REF      FITFLAG           SET IF CHECKING FIT
         REF      FITVLPX           DISPL OF FIT IN FITBUF
         REF      FIXERR            CAL ERR/ABN ADDRESS
         REF      FIXFLAG           SET IF FIXING ERRORS
         REF      FL:DUAL           DUAL HAS BEEN READ FLAG
         REF      FL:UPDT           BUFFER UPDATED FLAG
         REF      FLAGSDSP          TO STUFF AD/FD DISP TO FLAG BYTE
         REF      FLR:DUAL          RESET DUAL READ FLAG
         REF      FNDKEY            LOCATE KEY IN MI
         REF      GAVALL            CALCULATED GAVAL FOR FILES
         REF      GAVALC            #GRAN/CYL IN FITS GAVAL DEVICE
         REF      GETBUF            GET I/O BUFFER
         REF      GI:SDA            FIRST DISC ADDR OF INPUT SYMB FILE
         REF      GIB:UN            USER # OF SYMB FILE
         REF      GRANERR           RETRY I/O, PRINT MESS IF ERROR
         REF      HEXDUMP           DUMP IN HEX
         REF      HEXDUMPB          DUMP IN HEX
         REF      HGP               ADDR OF IN-CORE HGP HEADERS
         REF      HGPRFLAG          SET IF HGR RECON IN PROGRESS
         REF      HGPSIZE           # WORDS RESERVED IN ALLOCAT FOR HGPS
         REF      INBUF             INPUT BUFFER
         REF      INCREMENT%SECTOR  INCR SECTOR ADDRESS
         REF      INITBUF           SET PRBUF POINTERS TO EMPTY
         REF      IOQUEUE           QUEUE AN I/O
         REF      IOSPIN            WAIT FOR BUFFER I/O TO COMPLETE
         REF      J:ACCN            ACCOUNT IN JIT
         REF      J:BASE            J:BASE+7 - TCFU DURING FILE OPEN
         REF      J:JIT             JIT ADDRESS
         REF,1    JB:FBUL           HIGHEST FPOOL BUFFER #
         REF,1    JB:PNR            GHOST TABLE INDEX
         REF      JBUPVPA           FIRST USER ADDRESS
         REF      JCLE              COMMAND LIST
         REF      JCMAP             USER'S MAP IMAGE
         REF      JDA               SWAPPER DISC ADDR TABLE
         REF      JDCBLL            LOWEST DCB PAGE
         REF      JDDLL             LOWEST DYN DATA PAGE
         REF      JDLL              LOWEST DATA PAGE
         REF      JLMAP             LMAP
         REF      JTSTACKSZ         # WORDS RESERVED FOR TSTACK
         REF      JVLH              FIRST ENTRY IN LMAP
         REF      JXBUFVP           CMAP INDEX OF FIRST SPARE
         SREF     KBTCU             * OC POST HANDLER ADDRESS
         REF      KEYLEVEL          EXPECTED MI LEVEL
         REF      KEYSIZE           SIZE OF KEY ENTRY
         REF      LASTCFU           END OF CFU AREA
         REF      LDAL              LAST DISC ADDRESS OF FILE
         REF      LFGUN             USER # OF FREPORT
         REF      LINKFLAG          LINK CHECK FLAG
         REF      LLNDD             ADDR OF LP USED TO BOOT
         SREF     LNOL              # ENTRIES IN COC TABLES
         REF      LOCCODE           FIND VLP
         REF      LOCDA             DISC ADDR FOUND BY FNDKEY
         REF      LOCDUAL           DUAL FOUND BY FNDKEY
         REF      LOGACCT           ORIGINAL LOGON ACCOUNT
         REF      LPART             SIZE OF PART TABLES
         REF      LPBUF             BUFFER FOR LINE PRINTER
         REF      LPCNT             TO WAIT FOR LP OUTPUT TO FINISH
         REF      NEWQ              DO IO TO CHECK ALLODDA FOR FLAWS
         REF      ALLODDA           ADDRESS OF ALLOCAT'S DATA DUAL
         REF      DCT13             TDV STATUS FOR FLAW CHECKING
         REF      GMB               GET MONITOR BUFFER FOR END ACTION
         REF      RMB               GIVE IT BACK
         REF      LPDCTX            DCT INDEX OF LP
         REF      LPFLAG            USE M:WRITE, LP OR NO I/O
         REF      LPTAPE            SET IF OUTPUT IS TO TAPE
         REF      LSWAP             HIGHEST LEGAL SWAP TABLE INDEX
         REF      M:ADRINCR         TABLE TO INCR SWAPPER DISC ADDR
         REF      M:DO
         REF      M:GASLIM
         REF      M:LO
         REF      M:XX              DCB IN JIT
         REF      MAXOVLY           # MONITOR OVERLAYS
         REF      MB:GAM6
         REF      MB:SDI            DCT INDICES OF SWAPPERS
         REF      MESSOUT           PRINT MESSAGE AND ABORT
         REF      MOC2              MESSAGE FOR OPTIONS PROMPT
         SREF     MODE5             COC TABLE
         REF      MOVDEC            CONV BIN TO DEC, MOVE TO PRBUF
         REF      MOVHEX            CONV BIN TO HEX, MOVE TO PRBUF
         REF      MOVTXT            MOVE TEXT TO PRBUF
         REF      MOVTXTC           MOVE TEXTC TO PRBUF
         REF      NB31TO0
         REF      NCYL              # CYLS ON DISC DEVICE
         REF      NODUAL            NON-ZERO IF DUALS ARE DESIRED
         REF      NSPC              # SECTORS PER CYL ON DISC DEVICE
         REF      NSPT              # SECTORS PER TRACK ON DISC
         REF      NXTCHAR           GET NEXT CHAR FROM INBUF
         REF      OCDCT             DCT INDEX OF OP CONSOLE
         REF      OCIOCNT           # OC I/O'S OUTSTANDING
         REF      OH:NM             DEVICE TEXT NAMES
         REF      OPNCLSUS          CURRENT OPN/CLS USER
         REF      P:NAME            SHARED PROCESSOR NAMES
         REF      PL:CHG
         REF      PL:JIF
         REF      PLH:FLG
         REF      PRBUF             PRINT BUFFER
         REF      PRFILE            PRINT FILE NAME
         REF      PRINT             PRINT MESSAGE ON LP
         REF      PRKEY             PRINT KEY ON LP
         REF      PUTDECR           DEC NUMBER IN PRBUF RIGHT JUSTIFIED
         REF      PUTHEXR           HEX NUMBER IN PRBUF RIGHT JUSTIFIED
         REF      PUTMES            PUT MESSAGE INTO PRBUF
         REF      PUTMESC           PUT TEXTC MESSAGE IN PRBUF
         SREF     RB:FLAG
         REF      RBG               RELEASE GRANULE
         SREF     RBLIMSIX
         SREF     RBLIMSZ
         REF      RBUFSIZE          # PAGES IN RECOVERY BUFFER
         REF      RCVCODE           LAST CRASH SCREECH CODE
         REF      RCVRAD            DISC ADDR OF RECOVERY BUFFER
         REF      RCVRCNT           # RECOVERIES
         REF      RCVRGFC
         REF      RCYL              RELEASE CYLINDER
         REF      RDF:              ADDRESS OF MODULE RDF
         REF      REL               RELEASE MPOOL, BUFFER PAGES
         REF      RELBUF            RELEASE I/O BUFFER
         REF      RSG               RELEASE SYMB GRANULE
         REF      S:CUN             CURRENT USER #
         REF      S:DP              PACK SWAPPER FLAG
         REF      S:GJOBTBL         GHOST NAME TABLE
         REF      S:MBSF
         REF      S:QUIET           RBBAT STATE FLAG
         REF      S:RBBRN
         REF      SB:RTY            INDEX BY RESOURCE TO FIND DEV TYPE
         REF      SCRL              # BYTES IN CURRENT KEY
         REF      SEC%SHFT          SHIFT SECTOR ADDR
         REF      SGCHD             HEAD OF SYMB COMM BUF CHAIN
         REF      SGRAN             ERRLOG DISC ADDRESS
         REF      SH:RGCU           CURRENT # RESOURCES OF THIS TYPE
         SREF     SITEID            INSTALLATION ID
         REF      SMAKFLG           ZERO IF TO DO SYSMAK
         REF      SMUIS             MAX # USERS
         REF      SN                PRIMARY SERIAL #
         REF      SNAPDAT           SNAP FIX DATA PAGES
         REF      SNAPFLAG          SET IF FREPORT IS TO DUMP
         REF      SNAPGRN           DUMP LOST GRANULES AFTER HGPRECON.
         REF      SPD               INTERNAL STACK
         REF      SRCHKEY           KEY FNDKEY IS TO FIND
         REF      SSIG              SYMBIONT SIGNAL CHARS
         REF      SV:RSIZ           SIZE OF SB:RTY (# RESOURCES)
         REF      SW                STATE:  SLEEPING
         REF      SYSACCT           TEXT *SYS
         REF      SYSACTL           :SYS FD FDA
         REF      T:GJOBSTRT        START GHOST JOB
         REF      T:RUE             REPORT USER EVENT
         REF      TABLE             RECOVERY SAVE/RESTORE TABLE
         REF      TABLESZ           SIZE OF TABLE
         REF      TBLXPSD           BUILD OUTPUT BUFFER VIA TABLE
         REF      TEMP              16 WORDS OF MISC STORAGE
         REF      TIME              EBCDIC TIME OF DAY
         REF      TRK%SHFT          SHIFT TRACK ADDRESS
         REF      TSTACK            TEMP STACK IN JIT
         REF      TYPEFLAG          AD, FD OR FILE
         REF      TYPMAX            MAX # EACH BUFFER TYPE ALLOWED
         SREF     UB:C#             USER'S CYL # ON SWAPPER
         REF      UB:MF             I/O COUNT
         REF      UB:SWAPI          SWAP DEVICE INDEX
         REF      UB:US             USER STATE
         REF      UH:AJIT           SEEK ADDR OF AJIT
         REF      UH:FLG            USER FLAGS
         REF      UH:JIT            SEEK ADDR OF JIT
         REF      VALBUF            VALIDATE WORDS 0-2 OF MI
         REF      WRTF:             ADDRESS OF MODULE WRTF
         REF      XOCRD             END-ACT FLAG FOR OC READ
         REF      XOCWRT            END-ACT FLAG FOR OC WRITE
         REF      1MIN              TO CALCULATE C:MSM
         REF      75BUF             USERS QUEUED FOR FREPORT
         REF      75TABLE           LAST 6 75 ERRORS
         REF      #CBUFS            # BUFFER POINTERS
         REF      #FDGRAN           # GRANULES IN FILE DIRECTORY
         REF      #FILGRAN          TOTAL # FILE GRANULES IN ACCOUNT
         REF      #GRAN             # GRANULES IN ONE FILE
         REF      #PAGES            # PAGES ALLOCATED
         REF      #RANFIT           # RANDOM FILE FITS
         TITLE    '****  PROCS  ****'
         SPACE    2
         CLOSE    PUSH,PULL
PUSH     CNAME    X'09',X'0B'
PULL     CNAME    X'08',X'0A'
         PROC
LF       EQU      %
         DO1      NUM(AF)>1
         LCI      AF(1)&X'F'
         GEN,8,4,20  NAME(NUM(AF)),AF(NUM(AF)),SPD
         PEND
         SPACE    2
SNAP     CNAME    0
SNAPX    CNAME    1
         PROC
LF       PUSH     R4
         BAL,R4   SNAPDAT
         DO       TCOR(AF,S:C)=1
         TEXTC    AF
         ELSE
         DATA     AF
         FIN
         DO1      NAME=1
         M:XXX
         PEND
         SPACE    2
TXTC     CNAME
         PROC
         LOCAL    I,VEC
LF       SET      %
VEC      SET      NUM(S:UT(AF)),S:UT(AF),' ',' ',' '
I        DO       NUM(VEC)/4
         GEN,8,8,8,8  VEC(I*4-3),VEC(I*4-2),VEC(I*4-1),VEC(I*4)
         FIN
         PEND
         SPACE    2
BUILD    CNAME
         PROC
         LOCAL    MAIN,TBL,TYPE,ADDR
LF(1)    SET      %
MAIN     SET      %
         DO       SCOR(CF(2),E)
TBL      SET      AF
         ELSE
         USECT    TBLSECT
TBL      SET      %
LF(2-SCOR(CF(2),L))  SET  %
*
I        DO       NUM(AF)           PROCESS ALL AF ENTRIES
TYPE     SET      SCOR(AF(I,1),TEXT,HEX,DEC,RHEX,RDEC,SPACE,;
                  TXT,FILL,DUMPBUF,DUMPB,DUMPECHO)
ADDR     SET      S:UFV(AF(I,2))
         DO       TYPE=1&TCOR(AF(I,2),S:C)=1
         USECT    TXTSECT
ADDR     SET      %
         TEXTC    AF(I,2)           GENERATE THE SPECIFIED TEXT
         USECT    TBLSECT
         FIN
         DO1      TYPE=8
ADDR     SET      AF(I,2)+(AF(I,4)-AF(I,3))**8
*
         GEN,1,7,4,1,19  AFA(I,2),AF(I,3),TYPE,I=NUM(AF),ADDR
*
         FIN
*
         USECT    MAIN
         FIN
         DO       SCOR(CF(2),L)=0
         XPSD,2   TBLXPSD
         DATA     TBL
         FIN
         PEND
         SPACE    1
UTSTACK  EQU      TSTACK-J:JIT+JITBUF
FITCFU   EQU      FILCFU+4          FITCFU+CDAM = FILCFU+SREC
         TITLE    '****  SYSTEM INITIALIZATION  ****'
         SPACE    2
*F*      NAME:         SYSINIT
*F*
*F*      PURPOSE:      PROVIDE SYSTEM INITIALIZATION FUNCTIONS.
*F*
*F*      DESCRIPTION:  INITIALIZE CFU AREA.
*F*                    READ AND PROCESS RECOVERY BUFFER.
*F*                    IF INITIAL TAPE BOOT, INITIALIZE ALLOCAT DATA
*F*                      AND ALLOCATE ACCOUNT DIRECTORY.
*F*                    PERFORM PUBLIC HGP RECON IF DESIRED.
*F*                    WRITE RBBAT RECOVERY FILE.
         SPACE         1
*D*      NAME:         SYSINIT
*D*
*D*      REGISTERS:    ALL VOLATILE
*D*
*D*      CALL:         BRANCH.  COMES HERE IF FIX ENTERED BEFORE
*D*                    SYSTEM IS UP (BOOTFLG NON-ZERO).
*D*
*D*      DESCRIPTION:
         SPACE    2
SYSINIT  EQU      %
         SPACE    2
*D*
*D*                    OPEN M:LO AND M:DO TO LINE PRINTER
*D*                    IN DIAGNOSTIC MODE (NON-SYMBIONT).
*D*
         LI,R1    M:DO
         LI,R2    X'3FFF'
         AND,R2   LLNDD             LINE PRINTER ADDRESS
         AI,R2    X'4000'           DIAGNOSTIC FLAG
         M:OPEN,E DEVOPN
         LI,R1    M:LO
         M:OPEN,E DEVOPN
*D*
*D*                    OBTAIN BUFFER FOR DIRECT I/O TO LP.
*D*
         LW,R2    RBUF
         AI,R2    -512              PAGE FOR LP BUFFER IS BELOW RBUF
         M:GVP    *R2
         BCS,8    NOCORE
         AI,R2    384               ADD DISPLACEMENT
         STW,R2   LPBUF             INIT LPBUFFER
         LW,R5    LLNDD             LP ADDRESS
         LI,R4    DCTSIZ
         CH,R5    DCT1,R4
         BE       %+2
         BDR,R4   %-2
         STW,R4   LPDCTX            SAVE LP DCT INDEX
*
         LI,R9    0
         STW,R9   LPFLAG            PRINT ERRORS ONLY BY DEFAULT
         LC       DCT3,R4
         BCR,2    %+2
         STW,R9   LPDCTX            LP PARTITIONED - PRINT NOTHING
         SPACE    2
*D*
*D*                    INITIALIZE ACCOUNT AND NAME POINTERS IN
*D*                    CFU AREA.  SET UP ONE ACCOUNT (:SYS).
*D*
*
         LW,R11   ACNCFU+13         IF ALREADY INITIALIZED, GET OUT
         BNEZ     EXIT2
         LI,R0    LASTCFU+21-BGRCFU
         SLS,R0   1
         AI,R0    LASTCFU+21-BGRCFU
         SLS,R0   -3                3/8 OF CFU SPACE
         AI,R0    BGRCFU
         LI,R1    BGRCFU
         LI,R2    X'FF00'
CFUIN1   CW,R1    R0
         BG       CFUIN2            DONE WITH 8 WORD BLOCKS
         STW,R2   0,R1              SET UP WORD ZERO
         AI,R1    CFUSIZE           INCR TO NEXT
         B        CFUIN1
*
CFUIN2   AI,R1    -1
         AND,R1   =X'FFFFFFFE'      ROUND DOWN
         STW,R1   ACNCFU+13         START OF ACCOUNT AREA
         LI,R1    X'10000'
         STW,R1   ACNCFU+14         1 ACTIVE ACCOUNT
         LI,R1    1
         LD,R2    SYSACCT           ':SYS'
         STD,R2   *ACNCFU+13,R1
         LI,R1    LASTCFU+23
         SW,R1    ACNCFU+13         SPACE REMAINING
         SLS,R1   -3                1/8 SPACE REMAINING FOR ACCOUNTS
         AW,R1    ACNCFU+13
         AND,R1   =X'FFFFFFFE'      ROUND DOWN
         STW,R1   ACNCFU+16         NEXT AVAIL LOC FOR NAME
         STW,R1   ACNCFU+15         BASE OF NAME AREA
*
         SPACE    2
*D*
*D*                    IF COLD TAPE BOOT, GO TO ALLYINIT.
*D*
         BAL,R7   GETRBUF           GET PAGES FOR RECOVERY BUFFER
         B        INITERR           CAN'T GET THE PAGES
*
         BAL,R11  ACNCALC           CALCULATE ACNCFUFDA, ALLODDA
         LB,R8    X'2A'
         CI,R8    X'22'             IS IT COLD TAPE BOOT
         BE       ALLYINIT          YES - INITIALIZE ALLYCAT DATA
*D*
*D*                    CHECK TO SEE IF A RECOVERY BUFFER EXISTS.
*D*                    IF SO, PROCESS SOME OF THE ITEMS IN IT.
*D*                    THE OTHERS WILL BE PROCESSED IN GHOST1.
*D*
         LI,R2    512               READ THE RECOVERY BUFFER
         LI,R3    RBUFSIZE
         LW,R7    RBUF
         LW,R8    RCVRAD            DISC ADDR
         MTB,0    X'2A'             IF NOT CHASH, GET ZAP FILE FROM DUMPFILE
         BEZ      RDRB2             CRASH
         MTW,0    S:DP              IF DP SWAPPER, USE SWAP AREA
         BNEZ     RDRB2
         M:OPEN   F:RB,IN,(FILE,'DUMPFILE'),;
                  (ABN,ZAPZAPDUMP),(ERR,ZAPZAPDUMP)
         LW,R1    F:RB+1            GET DISC ADDR FROM CFU
         LW,R8    1,R1
         CAL1,1   CLSRB             CLOSE THE DCB
         STW,R8   ZAPDUMP
RDRB2    BAL,R11  ZAPINC            CHECK FOR DUMPFILE INPUT
         BNEZ     ZAPZAPDUMP        ERROR
         AI,R7    512
         AI,R8    2
         BDR,R3   RDRB2
         LH,R3    RBUFEND           CHECK VALIDITY OF BUFFER
         CI,R3    X'400'
         BAZ      ZAPZAPDUMP        NO GOOD
         CI,R3    X'FBFC'           HOW MANY TIMES HAVE WE BEEN HERE
         BANZ     ZAPZAPDUMP        MORE THAN FOUR, OR GARBAGE ANYWAY
         MTH,1    RBUFEND           CHANGE
         AI,R8    -2                REWRITE TO PREVENT REUSE
         AI,R7    -512
         BAL,R11  DWRWAIT
         LI,R2    RBUFEND-1         SET POINTER FOR PROCBUF
         LI,R11   X'40404'          AND CHECK FOR ZAP
         LB,R3    X'2A'             WHEN WE SHOULD HAVE IT
         BEZ      PROCBUF           ZAP WILL CAUSE BADRBUF IF RECOVERY
         CW,R11   0,R2
         BNE      ZAPZAPDUMP        BOOT, SHOULD BE ZAP
         AI,R2    -1                BUT SKIP CODE WORD
*
PROCBUF  LW,R3    0,R2              GET NEXT CONTROL WORD
         LB,R4    R3                CODE
         BEZ      BADRBUF           ERROR
         CI,R4    MAXCODE
         BGE      BADRBUF           ERROR
         LI,R1    1
         SH,R2    R3,R1             POINT TO START OF BUFFER
         PUSH     2,R2
         B        RCVRBR,R4
*
ZAPZAPDUMP RES
         LI,R5    0                 DONT LOOK FOR RBBAT IN DUMPFILE
         STW,R5   ZAPDUMP           IF RECOVERY BUFFER IS BAD (ANYWHERE)
         MTB,0    X'2A'             IF NOT RECOVERY,
         BNEZ     DATIME            NO MESSAGE NECESSARY
         B        BADRBUF
*
RCVRBR   EQU      %-1
         B        ERLOG              1  ERROR LOG
         B        RETURN             2  MAP, ACCESS, LOCK REGS
         B        RETURN             3  RECOVERY DUMP
         B        BADRBUF            4  RECOVERY BUFFER SIZE
         B        TAPDMP             5  TAPE DUMP
         B        RETURN             6  FILE COPY FOR OPEN CFU
         B        SYMFR              7  SYMFILES
         B        RETURN             8  JITS FOR ACCOUNTING
         B        LIMIT              9  SYSTEM LIMITS
         B        RETURN             A  **UNUSED**
         B        RETURN             B  HGP RECON (UNUSED BUT RESERVED)
         B        RETURN             C  **UNUSED**
         B        RELGRAN            D  RELEASE GRANULES
         B        RETURN             E  **UNUSED**
         B        SYMGDATA           F  RBBAT DATA
         B        SGCOMB            10  RBBAT COMMUNICATION BUFFERS
         B        SYMGERR           11  RBBAT ERROR WORD PLUS MISC.
MAXCODE  EQU      %-RCVRBR
         SPACE    3
*
*  RESTORE ERRLOG POINTERS
*
ERLOG    DISABLE                    ****  DISABLE
         LCI      8
         LM,R4    0,R2
         LCI      6
         STM,R4   ELOGSAV           SAVE ERRLOG DISK ADDRESSES
         STW,R10  ERBLOCK
         STW,R11  CURBUF
         LI,R6    -1
ERLOG10  LW,R0    8,R2              RESTORE CURRENT BUFFER
         STW,R0   *CURBUF,R6
         AI,R6    1
         AI,R2    1
         CI,R6    BUFTSIZ-1
         BLE      ERLOG10           NOT DONE YET
         ENABLE                     ****  ENABLE
         B        RETURN
         SPACE    3
*
*  TAPE DUMP
*
TAPDMP   MTW,1    TAPDUMP           SET FLAG
         B        RETURN
         SPACE    3
*
*  SYMBIONT LOCKED FLAGS
*
SYMFR    AND,R3   M16               # ENTRIES
SYMFR2   LW,R4    0,R2              GET NEXT ENTRY
         LH,R7    R4
         AND,R7   M8                SYMBIONT INDEX
         STB,R4   SSIG,R7           STORE SIGNAL
         AI,R2    1
         BDR,R3   SYMFR2
         B        RETURN
         SPACE    3
*
*  RESTORE SYSTEM LIMITS
*
LIMIT    EQU      %
         LI,R7    -TABLESZ          TABLE SIZE
         SLS,R2   2                 BYTE ADDRESS
*
LIM10    LW,R5    M31
         CW,R5    SMAKFLG           IS SYSMAK TO BE DONE
         BANZ     LIM12             NO - RESTORE ALL TABLES
         LI,R5    -1                YES - IGNORE PROCESSOR TABLES
LIM12    AND,R5   TABLE+TABLESZ,R7
         BLZ      LIM40             IGNORE THIS ENTRY
         LI,R4    0
         SLD,R4   15                R4 = COUNT
         SLS,R5   -15               R5 = ADDRESS
         LW,R3    R5
         BEZ      LIM40             TABLE NOT IN SYSTEM
LIM20    CI,R4    255
         BLE      LIM30             DO IT IN ONE MBS
         LI,R6    252
         STB,R6   R3                BREAK IT INTO 252 BYTE BLOCKS
         MBS,R2   0
         AI,R4    -252
         B        LIM20
*
LIM30    STB,R4   R3                BYTE COUNT
         MBS,R2   0
         AI,R2    3                 ROUND UP
         AND,R2   =X'FFFFFFFC'
LIM40    BIR,R7   LIM10
         SPACE    2
*
*        GUARANTEE OC POST-HANDLER IS IN RIGHT PLACE
*
         LI,R5    X'1FFFF'          * ADDRESS MASK
         LI,R4    KBTCU             * ADDRESS OF KSR POST HANDLER
         LI,R3    OCDCT             * DCTX OF OC
         STS,R4   DCT9,R3           * PUT RIGHT HANDLER ADDRESS BACK
         SPACE
*
*  DIDDLE REMOTE BATCH TABLES
*
         LI,R5    -RBLIMSZ
         BEZ      LIM60             NO REMOTE BATCH
         LI,R3    RBLIMSIX
         LW,R8    Y02
         LI,R9    2
LIM50    LW,R6    RB:FLAG+RBLIMSIX+RBLIMSZ,R5
         AND,R6   =X'FFFFFFEA'
         CI,R6    8
         BANZ     %+2
         AND,R6   =X'DFFFFFEA'
         OR,R6    X20
         CI,R6    X'208'
         BAZ      %+2
         OR,R6    X100
         STW,R6   RB:FLAG+RBLIMSIX+RBLIMSZ,R5
         LH,R6    DCT7,R3           DA OF COMMAND LIST
         STD,R8   0,R6              INITIALIZE COMMAND LIST
         AI,R3    1
         BIR,R5   LIM50
*
*  PARTITION TABLES
*
LIM60    LI,R5    0
         STW,R5   S:MBSF            ALLOW JOBS TO BE SCHEDULED
         LI,R5    X'FFFF'
         STW,R5   PL:CHG            SET ALL PARTITIONS CHANGED
*
         LI,R5    LPART             # PARTITIONS
LIM70    LH,R4    PLH:FLG,R5
         AND,R4   PL:JIF            RESET ALL BUT JOB INDEPENDENT
         STH,R4   PLH:FLG,R5
         AI,R5    -1
         BGEZ     LIM70
*
         LI,R12   0                 DCT5 & DCT15 ULTIMATE CONTENTS
         LI,R1    DCTSIZ
NXT:DCT  EQU      %
         LW,R10   DCT9,R1           SAVE ALL
         AND,R10  M29                 FLAGS/INFO EXCEPT
         STW,R10  DCT9,R1             BITS-0-1-2
         LB,R10   DCT3,R1           SAVE FLAGS FOR
         AND,R10  =X'E3'              I/O,DOWN,SC1,& SC2
         CI,R10   X'20'
         BAZ      ST:DCT3     NO--- IS DEV.DOWN (PARTITIONED)
         MTB,0    DCT15,R1    YES--
         BEZ      ST:DCT3     NO--- WAS ANYTHING QUEUED
         LB,R9    DCT5,R1     YES--
         CI,R9    X'80'
         BANZ     ST:DCT3     YES-- WAS DEV.BUSY
         AND,R10  NB31TO0+6   NO--- RESET DEV.DOWN, WAS IN REALTIME
ST:DCT3  EQU      %
         STB,R10  DCT3,R1           RESTORE DCT3
         STB,R12  DCT15,R1          SET ENTRIES
         STB,R12  DCT5,R1             TO 0
         BDR,R1   NXT:DCT
*
         LI,R2    LNOL
         BEZ      LIM99             NO COC
         LI,R2    0                 INDEX TO MODE5
MODE5X   LB,R4    MODE5,R2
         AND,R4   M2                SCRUB ALL BUT BITS 6,7
         LW,R5    R4
         SLS,R5   6
         OR,R4    R5                DUPLICATE BITS 6,7 IN BITS 0,1
         STB,R4   MODE5,R2
         AI,R2    1                 INCR TO NEXT BYTE
         CI,R2    LNOL
         BL       MODE5X            MORE TO DO
*
LIM99    B        RETURN
         SPACE    3
*
*  SAVE POINTER TO GRANULES TO RELEASE
*
RELGRAN  LH,R10   RBUFEND
         CI,R10   X'FE'
         BANZ     RETURN            IGNORE IF BEEN HERE BEFORE
         LW,R10   0,R2              GET DISC ADDR OF BUFFER
         STW,R10  RELFDA            SAVE DISC ADDRESS OF BUFFER
         B        RETURN
         SPACE    3
*
*  RBBAT COMMUNICATION BUFFERS
*
SGCOMB   STW,R2   RBCOMADR          ADDRESS OF BUFFERS
         AND,R3   M16
         STW,R3   RBCOMSIZ          # WORDS
         B        RETURN
         SPACE    3
*
*  GET RBBAT JIT AND AJIT DISC ADDRESSES
*
SYMGDATA LW,R4    1,R2              JIT DISC ADDRESS
         STW,R4   RBJIT
         LW,R4    0,R2              AJIT
         STW,R4   RBAJIT
         B        RETURN
         SPACE    3
*
*  RBBAT ERROR WORD PLUS MISCELLANEOUS ITEMS
*
SYMGERR  STW,R2   SYMGADR           SAVE ADDRESS OF ENTRY
         B        RETURN
         SPACE    3
RETURN   PULL     2,R2
         AI,R2    -1
         INT,R3   RBUFEND
         AW,R3    R2
         CI,R3    RBUFEND
         BG       PROCBUF           NOT DONE YET
*
*  END OF RECOVERY BUFFER REACHED
*
         LW,R2    SYMGADR           ADDRESS OF ERROR WORD ENTRY
         BLEZ     RET1              THERE ISN'T ONE
         LCI      2
         LM,R4    0,R2
         STW,R4   SGCHD+3           RBBAT ERROR WORD
         LI,R8    0
         CI,R4    2
         BAZ      %+2               RECOVERY FOUND NO RBBAT ERRORS
         STW,R8   RBJIT             ZAP POINTER IF RECOVERY FOUND ERROR
         AND,R5   M24
         STW,R5   RCVRCNT           CURRENT MONDMP FILE #
         LW,R5    =X'05013901'
         STW,R5   SGCHD             TELL RBBAT INFO IS IN COMBUFS
         LW,R4    RBUFEND-1
         CI,R4    X'40404'
         BE       SYMG10            BOOT AFTER ZAP
         MTW,0    TAPDUMP
         BNEZ     SYMG10            TAPE DUMP - DON'T MESS WITH RCVRCNT
         MTW,1    RCVRCNT           INCR # RECOVERIES
         LW,R5    RCVRCNT
         STB,R5   RCVRCNT           MONDMP # FOR ANLZ TO LOOK AT
         LW,R4    DUMPFILE
         BLEZ     SYMG08            DUMP FILE NOT BUSY OR NOT THERE
         LB,R4    DUMPFILE          DOES IT ALREADY HAVE MONDMP #
         BNEZ     SYMG08            YES
         STB,R5   DUMPFILE          NO - FAST PATH RECOVERY
*
SYMG08   AND,R5   M3                MONDMP FILE #
         STS,R5   DMPNAME+1         PUT IN FPT
         LW,R5    =X'01000202'
         STW,R5   DMPNAME-1         ALLOW OPEN TO WORK
*
SYMG10   LW,R4    2,R2
         BEZ      SYMG20            NO SUA PENDING
         LI,R5    X'FFFF'
         STS,R4   DUMPFILE+1        RESTORE # JITS
SYMG20   LB,R5    X'2A'
         BNEZ     SYMG30            ONLY RESTORE DATE/TIME IF CRASH
         LCI      2
         LM,R4    3,R2              EBCDIC DATE
         STM,R4   DATE
         LW,R4    5,R2
         STW,R4   TIME
SYMG30   LW,R4    6,R2              SCREECH CODE
         STW,R4   RCVCODE
         LH,R4    RCVCODE
         CI,R4    X'89'
         BNE      REMOUNT           NOT ALLYCAT SCREECH
         MTW,1    HGPRFLAG          FORCE HGP RECONSTRUCTION
*
*  FIX UP AVR TABLES FOR AUTO PRIVATE PACK REMOUNT
*
REMOUNT  LI,R6    AVRTBLNE-AVRTBLSIZ     # SPINDLES
         BLEZ     RET1              NONE
         LI,R5    AVRTBLNE-1        INDEX TO FIRST ENTRY
         LI,R8    0                 ASSUME NO AUTO REMOUNT
         LH,R9    X'2A'
         BNEZ     RMOUNT15          NO REMOUNT IF NOT CRASH
         LH,R9    RCVCODE
         CI,R9    X'46'               OR SCREECH 46-21
         BE       RMOUNT15
         CI,R9    X'22'             OR 22S
         BE       RMOUNT15
         LI,R8    10000             PERFORM AUTO REMOUNT
*
RMOUNT15 LD,R2    AVRTBL,R5         GET NEXT ENTRY
         INT,R1   R3                HGP DISPLACEMENT
         LW,R4    HGP+1,R1
         CI,R4    ATPRIVBIT
         BAZ      RMOUNT25          PUBLIC SPINDLE - IGNORE IT
         AND,R3   =X'8000FFFF'      SCRUB ALL BUT 'PUB' AND HGPDISP
         BDR,R8   RMOUNT18
         LI,R2    0                 NO REMOUNT - ZAP SERIAL #
         AND,R3   M16               SCRUB PUB BIT
RMOUNT18 STD,R2   AVRTBL,R5
         LC       R3
         BCR,8    RMOUNT25          BR IF NOT 'PUBLIC'
         LW,R1    R5
         AI,R1    BATAPE            DCT INDEX
         LB,R4    DCT4,R1           DEVICE TYPE
         LI,R2    SV:RSIZ
         CB,R4    SB:RTY,R2         FIND RESOURCE TYPE
         BE       RMOUNT20
         BDR,R2   %-2
*
RMOUNT20 MTH,1    SH:RGCU,R2        INCR # GHOST RESOURCES
         MTH,1    AVRNOU,R5         INCR # USERS
*
RMOUNT25 AI,R5    -1                DECREMENT INDEX
         BDR,R6   RMOUNT15
*
RET1     LW,R2    RBCOMADR          WERE THERE COMBUFS
         BEZ      DATIME            NO
         LW,R3    RBUF
         STW,R3   RBCOMADR          YES - MOVE THEM OUT OF WAY OF JITBUF
         LW,R4    RBCOMSIZ          # WORDS TO MOVE
RET2     LW,R8    0,R2
         STW,R8   0,R3
         AD,R2    DOUBLEONE
         BDR,R4   RET2
         SPACE    3
*D*
*D*                    VALIDATE DATE AND TIME CELLS.  IF NO GOOD,
*D*                    ASK OPERATOR FOR NEW VALUES.
*D*
DATIME   EQU      %
         BAL,R7   CHKDATE           VALIDATE IN-CORE DATE
         B        GETDATE           BAD - ASK FOR IT
         BAL,R7   CHKTIME           VALIDATE IN-CORE TIME
         B        GETDATE           BAD
*
*  SET UP C:MSM (TICS SINCE MIDNIGHT) FOR ERRLOG
*
         LI,R5    0
         LI,R2    -4
         DISABLE                    **** DISABLE
DATIM5   LB,R4    TIME+1,R2         GET NEXT EBCDIC TIME DIGIT
         AI,R4    -'0'              CONVERT TO BINARY
         AW,R5    R4                ADD TO RUNNING TOTAL
         MH,R5    MTBL+2,R2         CONVERT
         BIR,R2   DATIM5
         LI,R3    50                CALCULATE DISPL INTO CURRENT MINUTE
         SW,R3    1MIN              *
         MI,R3    600               CONVERT TO TICS
         AW,R5    R3                ADD TO TOTAL
         STW,R5   C:MSM
         ENABLE                     **** ENABLE
         B        CHKHGPR           DATE AND TIME OK
*
GETDATE  LI,R4    BA(MDATE)
         BAL,R11  OCKEYIN           ASK OPERATOR FOR DATE
         LI,R4    HA(DATE)
         LI,R5    3                 # FIELDS EXPECTED
         LI,R10   GETDATE           ERROR RETURN
         BAL,R11  MOVDAT            MOVE DATE FROM INPUT BUFFER TO CORE
         LH,R11   DATE+1            MOVE OVER YEAR
         LI,R7    X'4040'           INSERT BLANKS
         STH,R7   R11
         STW,R11  DATE+1
         BAL,R7   CHKDATE           VALIDATE IT
         B        DATERR            ERROR
*O*  MESSAGE:      DATE(MM/DD/YY)=
*O*  ACTION:       TYPE IN THE CURRENT DATE
*O*  MEANING:      THE DATE HAS BEEN LOST DURING A RECOVERY
*
GETIME   LI,R4    BA(MTIME)
         BAL,R11  OCKEYIN           PROMPT FOR TIME
         LI,R4    HA(TIME)
         LI,R5    2                 # FIELDS EXPECTED
         LI,R10   GETIME            ERROR RETURN
         BAL,R11  MOVDAT
         BAL,R7   CHKTIME           VALIDATE TIME
         B        DATERR            ERROR
*O*  MESSAGE:      TIME(HH:MM)=
*O*  ACTION:       TYPE IN THE CURRENT TIME
*O*  MEANING:      THE TIME HAS BEEN LOST DURING A RECOVERY
         SPACE    3
*D*
*D*                    IF RAD BOOT AND NOT BOOT UNDER FILES, OR BOOT
*D*                    UNDER FILES AND OPERATOR SAID 'I', ASK IF
*D*                    HGP RECONSTRUCTION IS TO BE DONE.
*D*                    IN ANY EVENT, HGP RECONSTRUCTION IS FORCED
*D*                    IF THIS IS CRASH RECOVERY AND S.C. CODE
*D*                    WAS X'89' (ALLOCAT).
*D*
CHKHGPR  LB,R0    X'2A'
         STW,R0   INBUF             ZAP OLD INBUF CONTENTS
         BEZ      CHKHGP8           CRASH - DON'T ASK
         LW,R0    X'2A'
         BGEZ     HGPRASK           NOT BOOT UNDER FILES - ASK
         LW,R0    BOOTFLG
         BGEZ     CHKHGP8           BOOT UNDER, 'I' NOT SPECIFIED
HGPRASK  LI,R4    BA(MHGPR)
         BAL,R11  OCKEYIN
*O*  MESSAGE:      DO YOU WANT HGP RECONSTRUCTION (Y/N)?
*O*  ACTION:       TYPING 'Y' CAUSES AN HGP RECONSTRUCTION, ANY
*O*                OTHER RESPONSE DOES NOT.  IF NO RESPONSE IS
*O*                RECEIVED IN 1 MINUTE, 'N' IS ASSUMED.
*O*  MEANING:      THIS MESSAGE APPEARS WHENEVER A BOOT FROM RAD OR
*O*                A BOOT UNDER FILES WITH THE 'I' OPTION IS PERFORMED.
*O*                IT DOES NOT INDICATE THAT AN HGP RECONSTRUCTION IS
*O*                NECESSARY, BUT IS SIMPLY GIVING THE OPERATOR THE
*O*                CHANCE TO HAVE ONE PERFORMED.  IN GENERAL, THE ANSWER
*O*                'Y' SHOULD ONLY BE GIVEN IF IT IS KNOWN THAT
*O*                THE HGPS (ALLOCAT DATA) IS INCORRECT.
         BNE      CHKHGP8           HGP RECON NOT WANTED
         MTW,1    HGPRFLAG
*
CHKHGP8  LW,R1    HGPRFLAG
         BNEZ     PUBHGPR           PERFORM PUBLIC HGP RECONSTRUCTION
         BAL,R2   REMDEV            REMOVE RECONFIGURED DISK DEVICES
         SPACE    3
*
*  RELEASE GRANULES SAVED BY FIRST PHASE OF RECOVERY
*
         DISABLE                    ****  DISABLE
         LCI      6
         LM,R4    ELOGSAV           RESTORE ERRLOG POINTERS
         STW,R4   SGRAN
         STW,R5   BGRAN
         STW,R6   CURGRAN
         STW,R7   FGRAN1
         STW,R8   FGRAN2
         STW,R9   FGRAN3
         ENABLE                     ****  ENABLE
         LW,R8    ALLODCKDA         IF DUALLING ALLYDATA,
         BLEZ     RELG00            AND NOT A CRASH,
         MTB,0    X'2A'
         BEZ      RELG00            COMPARE DUAL AND SWAPPER
         LI,R2    512
         LI,R7    AJITBUF           AND IF DIFFERENT,
         BAL,R11  DRDWAIT           ASK OPERATOR TO CLOBBER THE SWAPPER
         BNEZ     RELG00
         LB,R8    MB:SDI
         SLS,R8   24
         AI,R8    HGPSIZE+20-1+8**8
         SLS,R8   -9
         SLS,R8   1
         LI,R7    JITBUF
         BAL,R11  DRDWAIT
ALLYDCHK LW,R1    AJITBUF-1,R2
         CW,R1    JITBUF-1,R2
         BE       ALLYDCHKX
         LI,R11   ALLYDCHK1
         LI,R7    MSTMP+3
         LCI      4
         LM,R0    JITBUF+507
ALLYDCHKS OR,R0   0,R7              YY
         STW,R0   0,R7
         STW,R1   1,R7
         STW,R2   2,R7
         SLS,R3   1                 1MS UNITS
         BAL,R15  BIN2DEC
         MI,R5    8                 LEFT ADJUST
         SLD,R12  -40,R5
         OR,R12   3,R7
         STW,R12  3,R7
         STS,R13  4,R7
         B        *R11
ALLYDCHK1 LI,R7   MSTMP+10          NOW THE DUAL STAMP
         LCI      4
         LM,R0    AJITBUF+507
         BAL,R11  ALLYDCHKS
         LI,R4    BA(MSTMP)
         BAL,R15  OCMESS
         LI,R4    BA(MALLYSWX)
         BAL,R11  OCKEYIN
         BNE      RELG00
         LI,R7    %                 CLOBBER THE CHECKSUM
         LI,R2    512
         BAL,R11  DWRWAIT
         NOP
         LI,R2    0
ALLYDCHKX BDR,R2  ALLYDCHK
RELG00   RES
         LI,R0    0
         LW,R1    =X'80008000'
         STW,R0   LFGUN             TELL ALLYCAT IT'S OK TO RUN
         STS,R0   BUFLAGS           ALLOW GRANULES TO BE ALLOCATED
         STS,R0   BUFLAGS+1
         LW,R8    RELFDA            DISC ADDRESS OF FIRST GRANULE
         BEZ      RBFILE            NONE TO RELEASE
RELG10   LI,R2    512               # WORDS TO READ
         LI,R7    AJITBUF           BUFFER ADDRESS
         BAL,R11  DRDWAIT           READ DISC WITH WAIT
         BNEZ     RELGERR           ERROR - GIVE UP
         LI,R12   AJITBUF
         LI,R13   512
         LI,R14   AJITBUF
         B        %+2
         BAL,R11  HEXDUMP
         BAL,R10  R2:RG             RELEASE IT
         BEZ      RELGERR           ERROR - GIVE UP
         LW,R8    AJITBUF+3
         CW,R8    RELFDA            FDA MUST MATCH
         BNE      RELGERR
         LW,R4    AJITBUF+1         # DISC ADDRESSES IN GRANULE
         BLZ      RELGERR
         BEZ      RELG30            EMPTY GRANULE
         CI,R4    252
         BG       RELGERR           TOO BIG
         LI,R3    3
RELG20   AI,R3    1
         LW,R8    AJITBUF,R3        GET NEXT DISC ADDRESS
         BAL,R10  R2:RG             RELEASE IT
         BEZ      RELGERR           ERROR - QUIT
         BDR,R4   RELG20
RELG30   LW,R8    AJITBUF+2         FLINK
         BNEZ     RELG10            MORE TO GO
RELGERR  EQU      %
RELXIT   LI,R14   X'50000'          FORCE ALLYCAT STACKS TO BE
         BAL,R4   ALLOQ               EMPTIED IN CASE SAME DA
         BAL,R0   ALLOREG             RELEASED MORE THAN ONCE
*D*
*D*                    IF RBBAT RECOVERY FILE EXISTS, READ STATIC
*D*                    DATA RECORD AND COMBUF RECORD.  FILE IS BAD IF
*D*                    IT CAN'T BE OPENED OR IF THERE IS NO STATIC
*D*                    DATA RECORD.
*D*
*
RBFILE   LI,R2    0
         STB,R2   PAGE              NO PAGES GOTTEN YET
         M:OPEN   F:RB,INOUT,(FILE,':RBBRVR',':SYS'),(ABN,NORB),;
                      (ERR,NORB)
*  FILE EXISTS.  CHECK FOR STATIC DATA RECORD
*
         M:GP     255
         STB,R8   PAGE              SAVE # PAGES GOTTEN
         SLS,R8   9+2               # BYTES TO READ
         M:READ   F:RB,(BUF,*R9),(SIZE,*R8),(KEY,TXRBSD),;
                    (ABN,NORB),(ERR,NORB)
         STW,R9   RBDATA            SAVE ADDRESS OF STATIC DATA
         LW,R2    F:RB+RWS          GET # BYTES ACTUALLY READ
         AI,R2    2047
         SLS,R2   -9-2              # PAGES NEEDED TO HOLD RECORD
         SLS,R8   -9-2              # PAGES GOTTEN
         SW,R8    R2                # EXTRA PAGES
         STB,R2   PAGE              # PAGES IN USE
         M:FP     *R8               GIVE BACK UNNEEDED PAGES
*
         LI,R2    0
         STW,R2   *RBUF             NO COMBUFS PRESENT
         MTW,0    S:QUIET           CHECK RBBAT'S STATE.
         BGZ      RBCOMB1           TRUST EXISTING :RBBRVR BUT WRITE
*                                   COM BUFF RECORD.
         M:SETDCB,E  RBSET          IGNORE I/O ERRORS
         LI,R2    RBUFSIZE
         SLS,R2   9+2               # BYTES IN RECOVERY BUFFER
         M:READ   F:RB,(BUF,*RBUF),(SIZE,*R2),(KEY,TXRBCM),;
                    (ABN,FIXERR),(ERR,NORB)     CHECK FOR 43-00
         MTW,1    RBFILOK           INDICATE THAT FILE EXISTS
         LW,R2    RBUF
         STW,R2   RBCOMADR          SET LOCATION OF COMBUFS
*
         LI,R1    -1                TELL RBBAT # DYNAMIC PAGES UNKNOWN
         STW,R1   SGCHD+2
         LI,R1    X'F'
         LI,R0    0
         STS,R0   SGCHD+3           RESET RBBAT ERROR FLAGS
         MTW,0    HGPRFLAG
         BNEZ     HGPRSYM           RECONSTRUCT SYMBIONT FILES
         LI,R2    2                 OPEN MONDMP FILE OUT
         M:OPEN,E OPN:MON
         B        RBFIL42           CLOSE FILES AND EXIT
*
*  I/O ERROR ON RBBAT RECOVERY FILE
*
NORB     LB,R1    R10               GET I/O ERROR CODE
         CI,R1    X'03'
         BE       NORB10            NO SUCH FILE
         CI,R1    X'43'
         BE       NORB10            NO STATIC DATA, FILE IS NO GOOD
RBERR    SNAP     'RBERR'
         LI,R11   2
         STW,R11  SGCHD+3           TELL RBBAT THAT STATIC DATA IS NO GOOD
         LI,R11   0
         STW,R11  RBJIT             INDICATE RBBAT NOT FOUND
         MTW,0    HGPRFLAG
         BNEZ     HGPRDONE          EXIT FROM HGP RECON
         LI,R14   X'60000'
         LI,R15   0                 TELL ALLOCAT TO RELEASE
         BAL,R4   ALLOQ               ALL SYMBIONT SPACE
         M:SETDCB,E  RBSET          IGNORE I/O ERRORS
         LI,R2    1                 CLOSE WITH RELEASE
         M:CLOSE,E  CLSRB           RELEASE RBBAT RECOVERY FILE
         B        RBOPN             CREATE MONDMP FILE, THEN EXIT
*
*  A GOOD RBBAT RECOVERY FILE DOES NOT EXIST
*
NORB10   LB,R8    PAGE              # PAGES GOTTEN TO READ STATIC DATA
         M:FP     *R8               FREE THEM
         M:SETDCB,E  RBSET          IGNORE ERRORS ON F:RB
         LI,R2    1                 RELEASE OPTION
         MTW,0    HGPRFLAG
         BNEZ     %+2
         M:CLOSE,E  CLSRB           CLOSE F:RB
*
         LW,R8    RBJIT             RBBAT JIT DISC ADDRESS
         BEZ      RBALLY            NO POINTERS - CHECK ALLOCAT DATA
         LW,R9    RBAJIT            AJIT DISC ADDRESS
*
*
*  RBBAT JIT/AJIT DISC ADDRESS FORMATS:
*
*                 RAD SWAPPER              PACK SWAPPER
*  R8
*     BYTE 0       ********                   *****
*          1       UB:SWAPI                   *****
*          2        UH:JIT                    UB:C#
*          3        UH:JIT                    *****
*
*  R9
*     BYTE 0-1     ********                   *****
*          2-3      UH:AJIT                   *****
*
*
RBFIL10  LI,R7    -1                SPECIAL USER #
         LH,R1    R8
         AND,R8   M16               SCRUB ALL BUT DISC ADDR
         AND,R9   M16
         AND,R1   M8                SWAP TABLE INDEX
         STW,R1   UBSWAPI           SET FOR SEEKCONV
         LW,R2    S:DP
         BEZ      RBFIL20           BR IF RAD SWAPPER
         LW,R8    UB:C#
         AND,R8   M8                RBBAT HAS PRE-ALLOCATED CYL #
         STW,R8   UBC#              SAVE THE CYL #
         SLS,R8   16
         LW,R9    R8
         AI,R8    2                 JIT ON SECTOR 2 OF CYLINDER
*
RBFIL20  BAL,R11  RDJIT             READ RBBAT JIT
         BNEZ     RBBADJIT          ERROR
         STW,R8   RBJIT             SET NON-ZERO TO WRITE :RBBRVR
         INT,R3   JITBUF            GET SYSID
         CI,R3    3
         BE       RBSTAT            MUST BE USER #3
RBBADJIT PUSH     16,R0
         LI,R4    BA(MRBJIT)
RBBADX   RES
         BAL,R10  MOVTXTC
         BAL,R15  DUMPB
*O*  MESSAGE:      RBBAT JIT BAD
*O*  ACTION:       NONE
*O*  MEANING:      THE RBBAT JIT ON THE SWAPPER IS BAD.  ALL
*O*                SYMBIONT FILES HAVE BEEN LOST.
         PULL     16,R0
         MTW,0    ALLYFLG
         BGZ      RBALLYX           NO SNAP IF COLD BOOT
         B        RBERR
*
*  READ STATIC DATA
*
RBSTAT   LI,R0    JDLL+JITBUF
         LI,R7    -1                SPECIAL USER #
         BAL,R11  PGDISC            SET UP PAGE/DISC TABLES
         BEZ      RBSTATER          MUST FIND SOME STATIC DATA
         LW,R8    ZAPDUMP           GET TO DATA IF IN DUMPFILE
         BEZ      %+5
         LI,R2    %+1
         STW,R8   ZAPDUMP
         SW,R8    Y02
         BGEZ     INCREMENT%SECTOR
         BAL,R11  RDPAGES           READ IT
         BEZ      RBSTAT2           OK
*
RBSTATER PUSH     16,R0
         LI,R4    BA(MRBSTAT)
*O*  MESSAGE:      RBBAT STATIC DATA BAD
*O*  ACTION:       NONE
*O*  MEANING:      VALIDATION OF RBBAT DATA ON THE SWAPPER HAS
*O*                FAILED.  ALL SYMBIONT FILES HAVE BEEN LOST.
         B        RBBADX
*
RBSTAT2  STW,R5   RBDATA            ADDRESS OF RBBAT STATIC DATA
         SLS,R3   9+2               # BYTES IN DATA
         STW,R3   RBDATSIZ
*  VALIDATE STATIC DATA
         LW,R8    =X'8A814A40'
         CW,R8    X'23',R5
         BNE      RBSTATER
         LW,R8    BWSDA,R5
         CW,R8    0,R5
         BNE      RBSTATER
         LW,R3    1,R5              # SDA SLOTS
         LW,R4    R5
         AW,R4    BWSDA,R4          POINT TO BW:SDA
RBSTAT10 LW,R8    *R4,R3            GET NEXT DISC ADDRESS
         AND,R8   M24
         BEZ      RBSTAT15          NOTHING HERE
         BAL,R11  CHKDA
         BCR,15   RBSTATER
RBSTAT15 BDR,R3   RBSTAT10          CHECK THEM ALL
*
         MTW,0    HGPRFLAG
         BNEZ     HGPRSYM           RECOVER SYMBIONT FILES
*
RBOPN    LI,R2    2
         M:OPEN,E OPN:MON           OPEN MONDMP FILE OUT
         MTW,0    RBJIT
         BEZ      RBFIL50           DO NOTHING IF NO RBBAT JIT
         M:OPEN   F:RB,OUT,KEYED,SAVE,DIRECT,(KEYM,7),;
                    (ABN,RBERR),(ERR,RBERR)
         LI,R2    2
         M:OPEN,E  OPN:MON          OPEN MONDMP FILE OUT
         LW,R5    RBDATA            ADDRESS OF STATIC DATA
         LW,R4    RBDATSIZ          # BYTES IN STATIC DATA
         LI,R8    TXRBSD            KEY
,RBFPT   M:WRITE  F:RB,(BUF,*R5),(SIZE,*R4),(KEY,*R8),NEWKEY,;
                    (ABN,RBERR),(ERR,RBERR)    GIVE UP IF ANY ERROR
,MDFPT   M:WRITE  F:MONDMP,(BUF,*R5),(SIZE,*R4),(KEY,*R8),NEWKEY,;
                    (ABN,FIXERR),(ERR,FIXERR)    IGNORE ERRORS
*
*  WRITE DYNAMIC DATA
*
RBFIL30  LB,R3    PAGE              # PAGES GOTTEN TO READ STATIC DATA
         M:FP     *R3               FREE THEM
*
         LI,R0    JDDLL+JITBUF
         LI,R7    -1                SPECIAL USER #
         BAL,R11  PGDISC            BUILD PAGE/DISC TABLES
         STW,R3   SGCHD+2           SAVE # DYN PAGES FOR RBBAT
         BEZ      RBFIL40           NONE - DON'T WRITE
         BAL,R11  RDPAGES           READ THEM
         BNEZ     RBERR             ERROR - GIVE UP
         LB,R4    PAGE              # PAGES READ
         SLS,R4   11                # BYTES
         LI,R8    TXRBDD            ADDRESS OF KEY
         M:WRITE,E  RBFPT
         M:WRITE,E  MDFPT
*
RBFIL40  LB,R3    PAGE              # PAGES GOTTEN
         M:FP     *R3               GIVE THEM BACK
*
*  WRITE ENVIRONMENT RECORD
*
         INT,R5   UTSTACK+1         # WORDS USED IN STACK
         CI,R5    19
         BL       RBCOMB            NO ENVIRONMENT
         LCI      2
         LM,R4    UTSTACK+2         MOVE PSD UP ONE WORD TO REMOVE
         STM,R4   UTSTACK+3           HOLE BETWEEN PSD AND REGS
         M:WRITE  F:MONDMP,(BUF,UTSTACK+3),(SIZE,18*4),(KEY,TXRBIV),;
                    NEWKEY,(ABN,FIXERR),(ERR,FIXERR)
         M:WRITE  F:RB,(BUF,UTSTACK+3),(SIZE,18*4),(KEY,TXRBIV),;
                    NEWKEY,(ABN,FIXERR),(ERR,FIXERR)
*
*  WRITE COMBUF RECORD
*
*
*
RBCOMB1  M:OPEN,E OPN:MON           OPEN F:MONDUMP
*
*
RBCOMB   LW,R5    RBCOMADR          ADDRESS OF COMBUFS
         LW,R4    RBCOMSIZ          # WORDS TO WRITE
         BNEZ     RBCOMB3           THERE IS SOMETHING THERE
         STW,R4   *RBUF             ZAP FIRST WORD WRITTEN
         LW,R5    RBUF              ADDRESS TO WRITE FROM
         LI,R4    10                ALWAYS WRITE SOMETHING
RBCOMB3  SLS,R4   2
         LI,R8    TXRBCM            KEY
         M:WRITE,E  RBFPT
         M:WRITE,E  MDFPT
*
RBFIL42  LI,R3    RCVRGFC
         STW,R3   SGCHD+1           TELL RBBAT THAT FILE EXISTS
         LW,R5    =X'05013901'
         STW,R5   SGCHD             COMBUF HEADER FOR RBBAT
,RBSET   M:SETDCB F:RB,(ERR,FIXERR),(ABN,FIXERR)  IGNORE ERRORS
         LI,R2    2                 SAVE OPTION
         M:CLOSE,E  CLSRB           CLOSE RBBAT RECOVERY FILE
RBFIL50  M:CLOSE  F:MONDMP,SAVE     SAVE MONDMP FILE
RBFILEND EQU      %
         LI,R15   0                 TELL GHOST1 EVERYTHING OK
         SPACE    3
*D*      NAME:         INITXIT
*D*
*D*      INPUT:        R15 = VALUE TO PUT IN 75BUF (SEE OUTPUT).
*D*
*D*      OUTPUT:       CELL 75BUF SET TO ONE OF FOLLOWING:
*D*                    0 = NO ERRORS
*D*                    -1 = HGP RECONSTRUCTION FAILURE
*D*                    -2 = BAD RECOVERY BUFFER
*D*
*D*      DESCRIPTION:  EXIT FROM FIX TOM GHOST1 AFTER SYSINIT.
*D*                    VIA M:LDTRC.
*D*
INITXIT  STW,R15  75BUF
         M:XCON   0                 TURN OFF EXIT CONTROL
         BAL,R11  RELRBUF           RELEASE RBUF PAGES
         BAL,R11  REL               RELEASE MPOOL, BUFFER PAGES
         LW,R2    RBUF
         AI,R2    -512
         M:FVP    *R2               RELEASE LP BUFFER PAGE
         LB,R5    SGCHD
         CI,R5    5
         BE       %+2               SET SYMBIONT GRANULE ALLOCATION
         MTW,1    S:RBBRN             FLAG IF NO RBBAT COMBUFS
*
         LI,R1    JB:PNR
         LB,R1    0,R1              GHOST JOB TABLE INDEX
         LD,R6    TXTGHST1
         STD,R6   S:GJOBTBL,R1      SET GHOST NAME TO 'GHOST1'
*
         M:LDTRC  'GHOST1',':SYS'   EXIT TO GHOST1
EXIT2    M:EXIT                     EXIT TO COMMAND PROCESSOR
*
RELRBUF  LI,R3    RBUFSIZE          # PAGES TO RELEASE
         LW,R2    RBUF              ADDR OF FIRST PAGE
RELRB2   M:FVP    *R2
         AI,R2    512
         BDR,R3   RELRB2
         B        *R11
*
GETRBUF  LW,R2    RBUF              ADDRESS OF FIRST PAGE TO GET
         LI,R3    RBUFSIZE          # PAGES TO GET
GETRB2   M:GVP    *R2
         BCS,8    0,R7              COULDN'T GET IT
         AI,R2    512
         BDR,R3   GETRB2
         B        1,R7
*
*D*
*D*                    NO POINTER TO RBBAT WERE PASSED THROUGH BY RECOVERY.
*D*                    ASK OPERATOR IF BATCH RECOVERY IS TO BE
*D*                    ATTEMPTED.  IF SO, READ ALLOCAT TO GET RBBAT
*D*                    JIT AND AJIT POINTERS.
*D*
RBALLY   LI,R1    RBALLY
         MTW,0    ALLYFLG
         BEZ      RBALLYX1          ALREADY ASKED, ANSWER WAS NO
         BGZ      RBALLY5           ALREADY ASKED, ANSWER WAS YES
RBALLY2  MTW,1    ALLYFLG           ASSUME NO
         LI,R4    BA(MRBRECOV)
         STW,R4   INBUF             ZAP INPUT BUFFER
         BAL,R11  OCKEYIN
*O*  MESSAGE:      ATTEMPT BATCH QUEUE RECOVERY(Y/N)?
*O*  ACTION:       TYPE 'Y' TO ATTEMPT TO RECOVER SYMBIONT FILES.
*O*  MEANING:      THE POINTERS TO RBBAT (WHICH CONTAINS THE SYMBIONT
*O*                FILE DIRECTORY) HAVE BEEN LOST.  IF 'Y' IS NOT
*O*                SPECIFIED, ALL SYMBIONT FILES WILL BE LOST.  IF
*O*                'Y' IS SPECIFIED, AN ATTEMPT (WHICH MAY NOT BE
*O*                SUCCESSFUL) WILL BE MADE TO LOCATE RBBAT AND SAVE
*O*                THE SYMBIONT FILES.  THE MOST COMMON REASON FOR
*O*                THIS MESSAGE TO APPEAR IS DUE TO BOOTING
*O*                FROM RAD WITHOUT PREVIOUSLY HAVING DONE A ZAP.
         BNE      0,R1              OPERATOR DOESN'T WANT IT
         MTW,1    ALLYFLG
         B        0,R1
*
RBALLY5  MTW,0    S:DP
         BNEZ     RBALLYX5          RBBAT IN FIXED LOC ON PACK SWAPPER
*
*  READ ALLOCAT DATA TO GET RBBAT JIT AND AJIT DISC ADDRESSES
*
         LI,R8    HGPSIZE+1         WORD DISPLACEMENT TO RBBAT JIT DA
         AND,R8   =X'FFFFFFFE'      ROUND UP TO DW BOUNDARY
         SLD,R8   -8                R8=SECTOR DISPL TO JIT DA
         SLS,R9   8-32              R9=WORD DISPL TO JIT DA IN LAST SECTOR
         AI,R8    8                 ADD STARTING SECTOR
         LB,R1    MB:SDI
         STH,R1   R8                ADD DCT INDEX
         LI,R2    256               # WORDS TO READ
         LI,R7    AJITBUF           BUFFER ADDRESS
         BAL,R11  DRDWAIT           READ IT
         BNEZ     RBALLYX           IGNORE IF I/O ERROR
         LW,R2    R9
         LW,R9    AJITBUF+1,R2      AJIT POINTER
         LW,R8    AJITBUF,R2        JIT POINTER
         BEZ      RBALLYX           NOTHING THERE - GET OUT
         LH,R1    R8
         AND,R1   M8                SWAPI
         CI,R1    LSWAP             CHECK LEGAL SWAP DEVICE INDEX
         BG       RBALLYX           ERROR
*
RBALLYX5 LI,R1    X'F'
         LI,R0    0
         STS,R0   SGCHD+3           RESET RBBAT ERROR FLAGS
         B        RBFIL10           GO PROCESS THE JIT
*
RBALLYX  LI,R4    BA(MNORBRCV)
         BAL,R11  OCMESS
*O*  MESSAGE:      UNABLE TO RECOVER BATCH QUEUE
*O*  ACTION:       NONE
*O*  MEANING:      THE OPERATOR PREVIOUSLY REPLIED 'Y' TO THE MESSAGE
*O*                'ATTEMPT BATCH QUEUE RECOVERY', BUT THE RECOVERY
*O*                ATTEMPT WAS UNSUCCESSFUL.  ALL SYMBIONT FILES
*O*                HAVE BEEN LOST.
RBALLYX1 MTW,0    HGPRFLAG
         BNEZ     HGPRDONE
         B        RBFIL50
         TITLE    '****  PUBLIC HGP RECONSTUCTION  ****'
         SPACE    2
*F*      NAME:         PUBHGPR
*F*
*F*      PURPOSE:      PERFORM PUBLIC FILE HGP RECONSTRUCTION.
*F*
*F*      DESCRIPTION:  ALL DIRECTORIES AND FILES IN THE SYSTEM ARE
*F*                    ACCESSED.  A DISC ALLOCATION TABLE (HGP) IS
*F*                    BUILT TO INDICATE WHICH DISC GRANULES ARE IN USE.
*F*                    WHEN ALL DIRECTORIES AND FILES HAVE BEEN PROCESSEED,
*F*                    THE HGP'S ARE WRITTEN TO ALLOCAT DATA, AND
*F*                    CONTROL RETURNS TO SYSINIT TO PERFORM
*F*                    RBBAT RECOVERY.
         SPACE         1
*D*      NAME:         PUBHGPR
*D*
*D*      ENTRY:        HGPR10
*D*
*D*      CALL:         BRANCH FROM SYSINIT.  RETURN IS TO RBFILE
*D*                    (RBBAT RECOVERY).
*D*
*D*      DESCRIPTION:
PUBHGPR  EQU      %
*
         LW,R2    RBUF
         AI,R2    -512
         STW,R2   DATADA
         AI,R2    350               LEAVE 350 WORDS FOR DATADA
         STW,R2   DIRDA
         AI,R2    34
         STW,R2   LPBUF             AND 34 FOR DIRECTORIES
         LI,R9    350
         STW,R9   DATAMAX
         LI,R9    34
         STW,R9   DIRMAX
*
         LI,R5    #CBUFS
         STW,R9   CBUFS-1,R5        ZERO BUFFER POINTERS
         BDR,R5   %-1
         STW,R9   DIRBUF
         STW,R9   CUROPT            NO CURRENT OPTIONS
*
*
         STW,R9   INBUF             ZAP ANYTHING IN INPUT BUFFER
         LI,R4    BA(MOC2)
         BAL,R11  OCKEYIN           PROMPT FOR OPTIONS
*O*  MESSAGE:      PRINT ALL, ERRORS ONLY, OR NOTHING(A,E,N)?
*O*  ACTION:       TYPE A, E, OR N
*O*  MEANING:      HGP RECONSTRUCTION IS ASKING WHAT IS TO BE
*O*                PRINTED ON THE LINE PRINTER.
*O*                A - FOR EACH FILE, PRINT NAME, ORGANIZATION,
*O*                    # RECORDS AND # GRANULES
*O*               F - LIKE 'A', EXCEPT THAT GRANULES IN ERROR WILL
*O*                   NOT BE DUMPED TO THE PRINTER.
*O*                E - PRINT ONLY ERROR MESSAGES (THE DEFAULT)
*O*                N - PRINT NOTHING.  SHOULD ONLY BE USED IF THE
*O*                    LINE PRINTER IS NOT OPERATIONAL, SINCE ALL
*O*                    ERROR MESSAGES WILL BE LOST.
         LB,R1    HGPANS            # POSSIBLE RESPONSES
HGPR1A   CB,R2    HGPANS,R1         LOOK FOR 'A', 'F', 'N', OR 'E'
         BE       HGPR1B            FOUND ONE
         BDR,R1   HGPR1A
         LI,R1    3                 DEFAULT IS 'E'
HGPR1B   AI,R1    -3
         STW,R1   LPFLAG
*
         LW,R11   RBJIT
         BNEZ     %+2
         BAL,R1   RBALLY2           RBBAT LOST - ASK IF ATTEMPT TO FIND
*
         LI,R14   MPAGE
         BAL,R15  PRINT
*
         M:TIME   TEMP
         LI,R4    BA(MHGPUB)
         BAL,R10  MOVTXTC
*O*  MESSAGE:      PUBLIC HGP RECONSTRUCTION INITIATED AT (DATE/TIME)
*O*  ACTION:       NONE
*O*  MEANING:      HGP RECONSTRUCTION OF THE FILE SYSTEM HAS BEEN
*O*                INITIATED EITHER BY THE OPERATOR, OR AUTOMATICALLY
*O*                FOLLOWING A SOFTWARE CHECK 89.
         LI,R4    BA(TEMP)
         LI,R5    4*4
         BAL,R10  MOVTXT            MOVE DATE/TIME TO BUFFER
         BAL,R15  DUMPB             PRINT ON OC AND LP
*D*
*D*                    READ AND DUMP TO LINE PRINTER ALLOCAT DATA
*D*                    BEFORE THE RECONSTRUCTION BEGINS.
*D*
         LI,R14   MHGPS
         BAL,R15  PRINT
         MTW,1    CORESDCB          DONT COUNT TO OC.
         BAL,R11  DUMPHGP
HGPR10   BAL,R11  PUBHGPS           BUILD ONE HGP COPY
         B        NOHGP1            NOT ENOUGH CORE
*
         LW,R11   HGP2
         STW,R11  HGP1
*
         BAL,R11  ALLOCBUF          ALLOCATE I/O BUFFERS
         B        NOCORE            NOT ENOUGH CORE
         MTB,6    TYPMAX            6 TYPE 0 BUFFERS
         LW,R11   BUFMAX
         AI,R11   -6
         LI,R2    3                 REST ARE TYPE 3
         STB,R11  TYPMAX,R2
*
         BAL,R11  PUBHGPS           BUILD SECOND COPY
         B        NOHGP2            NOT ENOUGH SPACE
*
SETPOINT LI,R9    0
         STW,R9   CURDATA
*
         LW,R4    HGP2
         SW,R4    HGP1
         STW,R4   HGPDISP           SET UP DISPLACEMENT BETWEEN HGPS
         BAL,R2   REMDEV            REMOVE RECONFIGURED DISK DEVICES
*
*  SET UP BUFFER POINTERS FOR STATIC BUFFERS
*
         LI,R2    0                 BUFFER TYPE
         BAL,R15  GETBUF
         STW,R7   ADBUF1
         BAL,R15  GETBUF
         STW,R7   ADBUF2
         BAL,R15  GETBUF
         STW,R7   FDBUF1
         BAL,R15  GETBUF
         STW,R7   FDBUF2
         BAL,R15  GETBUF
         STW,R7   FITBUF
*
         LI,R2    0
         LI,R3    #CBUFS
         STW,R2   CBUFS,R3          ZERO BUFFER POINTERS
         BDR,R3   %-1
         STW,R2   DIRBUF
         STW,R2   DISPFLG           DON'T PRINT ACCOUNT/FILE NAME
*
         MTW,1    FIXFLAG           FIX ANY ERRORS ENCOUNTERED
*
*  LOCATE ACCOUNT DIRECTORY
*
         BAL,R11  ADINIT            SET UP FOR ACCOUNT DIRECTORY
         LCI      2
         LM,R2    ADBUF1            MOVE AD BUFFER POINTERS
         STM,R2   DBUF1               TO CURRENT POINTER CELLS
         LI,R8    DPADFDA           PRIVATE AD FDA
         LI,R9    0
         LW,R11   BOOTFLG
         BEZ      BEGINDIR          BR IF PRIVATE HGP RECON
         BAL,R11  ACNCALC
         AND,R8   M24
         AND,R9   M24
         STW,R8   ACNCFU+FDA        SAVE MAIN AND
         STW,R9   ACNCFU+8            DUAL FDA
*
BEGINDIR LW,R7    DBUF2
         STW,R8   BUFDA,R7          MAIN FDA
         STW,R9   BUFDUAL,R7        AND DUAL FDA
         LI,R11   0
         STW,R11  BUFDACHK,R7       LINK CHECK DISC ADDRESS
         STW,R11  #FILGRAN
         STW,R11  #FDGRAN
         STW,R11  #RANFIT
         LW,R2    TYPEFLAG          CLEAR EOF LOC
         STW,R11  EOFDA,R2
         BAL,R11  DISCRD            START THE READ
DCHK08   LI,R8    MIDIS
         STW,R8   FDCMD             INITIALIZE FD DISPLACEMENT
         LW,R11   TYPEFLAG
         BGEZ     %+2
         STW,R8   ADCMD             INITIALIZE AD DISPLACEMENT
         LI,R8    0
         STW,R8   LINKFLAG          PERFORM LINK CHECKING
         STW,R8   FITFLAG           FIT NOT PRESENT
         STW,R8   KEYLEVEL          LEVEL 0
         LI,R8    -1
         STW,R8   SRCHKEY           STOP SEARCH AT NEXT KEY
         LW,R7    DBUF1
         XW,R7    DBUF2             EXCHANGE BUFFER POINTERS
         STW,R7   DBUF1
         BAL,R11  IOSPIN            WAIT FOR NEXT I/O TO COMPLETE
         LW,R6    BUFADR,R7
*
DCHK10   BAL,R10  VALBUF            CHECK FIRST 3 WORDS
         BEZ      DCHK20            OK
DIRERR1  BAL,R11  GRANERR           RETRY
         BEZ      DCHK10
*
*  UNRECOVERABLE ERROR IN DIRECTORY
*
DIRERR   LW,R2    DBUF2             PREVIOUS BUFFER
         LW,R8    BUFDA,R2
         AND,R8   M24               DISC ADDRESS OF PREV BUFFER
         BEZ      DIRER10           NO PREV, FDA IS BAD
         LW,R6    BUFADR,R2
         LI,R8    0
         STW,R8   FLINK,R6          NOT FDA- SET FLINK OF PREV
         STW,R8   DFLINK,R6           AND DUAL FLINK OF PREV
         LW,R9    FL:UPDT             GRANULE TO ZERO
         STS,R9   BUFDA,R2
         B        ENDBLK2           END OF DIRECTORY
*
DIRER10  LW,R8    TYPEFLAG
         BLZ      DIRER20           BR IF ACCOUNT DIRECTORY
         BAL,R11  ADINIT
         LW,R3    ADCMD
         STW,R3   CMDL
         LCI      2
         LM,R7    ADBUF1            CHANGE BUFFER POINTERS
         STM,R7   DBUF1
         BAL,R11  DELKEY            DELETE ACCOUNT DIRECTORY KEY
         B        DCHK40
*
DIRER20  LI,R14   MADBAD
         BAL,R11  DOPRINT           TELL OPERATOR AND LINE PRINTER
         B        NORECON           TELL OPERATOR CAN'T DO RECON
*
RELFIT   BAL,R11  FDINIT
         LW,R3    FDCMD
         STW,R3   CMDL
         LW,R7    DBUF1
         BAL,R11  DELKEY            DELETE KEY FROM FILE DIRECTORY
         B        DCHK40
*
DCHK20   LI,R8    0
         STW,R8   HGPDISP           LOOK ONLY AT FIRST HGP
         LCI      3
         LM,R8    DATADA            SWITCH FILE AND DIRECTORY POINTERS
         LM,R13   DIRDA
         STM,R8   DIRDA
         STM,R13  DATADA
         LW,R8    BUFDA,R7
         BAL,R11  ALLOCG            ALLOCATE MAIN DA
         STCF     TEMP
         LCI      3
         LM,R8    DIRDA             SWITCH THEM BACK
         LM,R11   DATADA
         STM,R8   DATADA
         STM,R11  DIRDA
         LCF      TEMP
         BCS,11   DIRERR1           ERROR
         MTW,1    #FDGRAN           COUNT MAIN
         LW,R8    BUFDUAL,R7
         AND,R8   M24
         BEZ      DCHK30            NO DUAL
         MTW,1    #FDGRAN           COUNT THE DUAL
         LCI      3
         LM,R2    DATADA
         LM,R13   DIRDA
         STM,R2   DIRDA
         STM,R13  DATADA
         BAL,R11  ALLOCG            ALLOCATE DUAL
         STCF     TEMP
         LCI      3
         LM,R2    DIRDA
         LM,R11   DATADA
         STM,R2   DATADA
         STM,R11  DIRDA
         LCF      TEMP
         BCR,11   DCHK30            OK
*  DUAL IS DUALLY ALLOCATED
         MTW,-1   #FDGRAN           DUAL BAD - DON'T COUNT IT
         BAL,R11  GRANERR
         LI,R14   MRELDUAL          'DUAL REMOVED FROM DIRECTORY'
         BAL,R15  PRINT
         LW,R6    BUFADR,R7
         LI,R8    0
         STW,R8   BUFDUAL,R7
         LW,R8    BUFDA,R7
         AND,R8   FLR:DUAL          RESET DUAL READ FLAG
         STW,R8   BUFDA,R7
         LW,R8    BLINK,R6
         BEZ      DCHK22            NO BLINK - THIS IS FDA
         LW,R2    DBUF2
         LW,R3    BUFADR,R2
         LI,R8    0
         STW,R8   DFLINK,R3         SET PREV DUAL FLINK TO ZERO
         STW,R8   DDA,R6            SET CURRENT DUAL TO ZERO
         LW,R9    FL:UPDT
         STS,R9   BUFDA,R7
         STS,R9   BUFDA,R2
         B        DCHK30
*
*  DUAL OF FDA IS BAD
*
DCHK22   LW,R8    TYPEFLAG
         BGEZ     DCHK24            BR IF FILE DIRECTORY
         LI,R8    0
         STW,R8   ACNCFU+8
         B        DCHK30
*  ZAP DUAL DA IN AD KEY
DCHK24   LI,R8    0
         LW,R4    ADBUF1
         LW,R5    BUFADR,R4
         SLS,R5   2                 BA OF AD BUFFER
         AW,R5    ADCMD             BA OF AD KEY
         AI,R5    ADSCR+3           DUAL DA IN KEY
         LI,R3    3
         STB,R8   0,R5
         AI,R5    1
         BDR,R3   %-2
         LW,R9    FL:UPDT
         STS,R9   BUFDA,R4
*
DCHK30   LW,R7    HGP2
         SW,R7    HGP1
         STW,R7   HGPDISP           RESTORE HGP DISPLACEMENT
         LW,R7    DBUF1
         BAL,R2   DUALRD            SET DBUF1 UPDATED IF DUAL READ
         LW,R7    DBUF2
         BAL,R11  BUFWRT            WRITE OUT DBUF2 IF UPDATED
         LW,R2    DBUF1
         LW,R6    BUFADR,R2
         LW,R8    BUFDA,R2          DA OF CURRENT BUFFER
         AND,R8   M24
         STW,R8   BUFDACHK,R7       BECOMES LINK CHECK DA
         LW,R8    FLINK,R6
         BEZ      DCHK40            NO FLINK - END
         STW,R8   BUFDA,R7
         LW,R8    DFLINK,R6
         STW,R8   BUFDUAL,R7
         BAL,R11  DISCRD            START NEXT READ
*
DCHK40   LW,R7    DBUF1
         LW,R3    ADCMD             CURRENT DISPL INTO ACCOUNT DIR
         LW,R8    TYPEFLAG
         BLZ      %+2
         LW,R3    FDCMD             CURRENT DISPL INTO FILE DIR
         STW,R3   CMDL
         LI,R11   -1
         STW,R11  SRCHKEY           SEARCH FOR NEXT KEY
         BAL,R11  FNDKEY            LOCATE NEXT KEY
         B        %+2               FOUND ONE
         B        ENDBLOCK          NO MORE KEYS
         LW,R3    CMDL
         LI,R4    ADCMD
         LW,R8    TYPEFLAG
         BLZ      %+2
         LI,R4    FDCMD
         STW,R3   0,R4              PUT AWAY CMD
         LW,R11   LPFLAG
         BLEZ     DCHK45            PRINT ERRORS ONLY
         LW,R11   TYPEFLAG
         BGEZ     DCHK45            BR IF FILE OR FILE DIRECTORY
         LI,R4    BA(MADKEY)
         BAL,R10  MOVTXTC
         LW,R4    BUFADR,R7
         SLS,R4   2
         AW,R4    CMDL              BA OF CURRENT KEY
         BAL,R11  PRKEY
         BAL,R15  DUMPBUF
*
DCHK45   LW,R4    BUFADR,R7
         SLS,R4   2
         AW,R4    CMDL              BA OF CURRENT KEY
         LW,R5    =X'20000000'+BA(CURFILE)
         MBS,R4   0                 MOVE KEY TO CURFILE
         LW,R2    TYPEFLAG
         BGEZ     DCHK50            FILE DIRECTORY - ALL OK
         AI,R4    -X'20'            ACCOUNT DIR - BA OF KEY AGAIN
         LW,R5    =X'08000000'+BA(CURACCT)
         LW,R8    SN
         BEZ      %+2
         AI,R4    3                 DIFFERENT FORMAT KEY FOR PRIVATE
         MBS,R4   1                 MOVE KEY TO CURACCT
*
DCHK50   LI,R8    0
         XW,R8    DISPFLG
         BEZ      DCHK55            NO OPERATOR KEYIN
         BAL,R11  PRFILE            TELL OPERATOR CURRENT NAME/ACCNT
*
DCHK55   LW,R8    LOCDA
         LW,R2    TYPEFLAG
         BGEZ     FILE20            BR IF FILE
*
*  PROCESS FILE DIRECTORY
*
         BAL,R11  FDINIT
         LCI      2
         LM,R2    DBUF1
         STM,R2   ADBUF1
         LM,R2    FDBUF1
         STM,R2   DBUF1             CHANGE BUFFER PONTERS
         LI,R8    0
         STW,R8   BUFDA,R2          ZAP DISC ADDR OF SECOND BUFFER
         LI,R8    -1
         STW,R8   FDHDFLG           FILE DIRECTORY HEADER NOT PRINTED YET
         LW,R8    LOCDA
         LW,R9    LOCDUAL
         BGEZ     BEGINDIR
         LI,R9    0
         B        BEGINDIR
*
*  PROCESS NEXT FILE IN DIRECTORY
*
FILEND   LW,R7    FITBUF
         BAL,R11  BUFWRT            WRITE OUT FIT IF UPDATED
*
         LW,R5    CURDATA
         BLEZ     FILEND6           NO DISC ADDRESSES
         LW,R4    CURDATA
FILEND2  AI,R4    -1
         LW,R2    *DATADA,R4        GET NEXT ENTRY
         LB,R3    R2
         AI,R3    X'FFF00'          FORM NEGATIVE INDEX
         LW,R3    BT31TO0+32,R3     GET BIT MASK
         STS,R3   0,R2              SET BIT IN HGP
         BDR,R5   FILEND2
         STW,R5   CURDATA           ZAP COUNT
*
FILEND6  LW,R7    HGP2
         CW,R7    HGP1
         BE       %+2               ONLY 1 HGP COPY
         BAL,R11  HGPZAP            2 COPIES - ZERO SECOND
         LI,R3    FDKSIZE
         AWM,R3   FDCMD
         BAL,R11  FDINIT            SET FILE DIR VALUES
         B        DCHK40
*
*  END OF DIRECTORY
*
ENDBLOCK LW,R11   BOOTFLG
         BNEZ     ENDBLK1           NOT PRIVATE HGP RECON
         LW,R11   TYPEFLAG
         BLZ      ENDBLK1           BR IF ACCOUNT DIRECTORY
         LW,R7    DBUF1
         LW,R11   BLINK,R6
         BNEZ     ENDBLK1           NOT FIRST FD GRANULE
         LI,R2    X'1FE'            INDEX TO FREE SECTOR POOL
         LW,R10   NAVX,R6
         CI,R10   X'4000'
         BANZ     %+2               BR IF FULL GRANULE
         AI,R2    -X'100'           HALF GRANULE
         STW,R11  *R2,R6            ZAP FSP POINTER
         AI,R2    -1                POINT TO NGAVAL/GAVAL
         LW,R11   *R2,R6
         LB,R11   R11               NGAVAL
         AWM,R11  #FDGRAN           COUNT THEM AS FILE DIRECTORY
         LW,R11   FL:UPDT
         STS,R11  BUFDA,R7          SET BUFFER UPDATED
*
ENDBLK1  LW,R11   FLINK,R6
         BNEZ     DCHK08
ENDBLK2  LW,R7    DBUF1
         BAL,R11  BUFWRT            WRITE OUT BUFFERS IF UPDATED
         LW,R7    DBUF2
         BAL,R11  BUFWRT
         LW,R11   TYPEFLAG
         BLZ      PFAEND            END OF ACCOUNT DIRECTORY
         BAL,R11  ACCTSUM           PRINT SUMMARY FOR THIS ACCOUNT
         BAL,R11  ADINIT
         AWM,R5   ADCMD             INCREMENT CURRENT POSITION
         LCI      2
         LM,R2    ADBUF1
         STM,R2   DBUF1
         B        DCHK40
         SPACE    2
*
*  END OF PFA - ALLOCATE ANY LEFT OVER DIRCTORY GRANULES
*
PFAEND   LW,R5    CURDIR
         BLEZ     PFAEND20          NONE
         LW,R4    CURDIR
PFAEND10 AI,R4    -1
         LW,R2    *DIRDA,R4
         LB,R3    R2
         AI,R3    X'FFF00'          FORM NEGATIVE INDEX
         LW,R3    BT31TO0+32,R3     GET BIT MASK
         STS,R3   0,R2              SET BIT
         BDR,R5   PFAEND10
         STW,R5   CURDIR
*
PFAEND20 LW,R7    ADBUF1            RELEASE ALL BUFFERS
         BAL,R15  RELBUF
         LW,R7    ADBUF2
         BAL,R15  RELBUF
         LW,R7    FDBUF1
         BAL,R15  RELBUF
         LW,R7    FDBUF2
         BAL,R15  RELBUF
         LW,R7    FITBUF
         BAL,R15  RELBUF
*
         LW,R7    HGP1
         SW,R7    HGP2
         BGEZ     PFAEND25          ONLY ONE HGP COPY
         AWM,R7   NXTHGP            CORRECT NXTHGP TO POINT TO HGP1 COPY
         LW,R7    #PAGES
         SLS,R7   -1                RELEASE HALF THE PAGES
         STW,R7   #PAGES              (THE SECOND HGP COPY)
         M:FP     *R7               FREE SECOND HGP COPY
PFAEND25 LW,R4    S:CUN
         LB,R7    UB:MF,R4
         BNEZ     %-1               WAIT FOR ALL I/O TO COMPLETE
         XW,R7    BUFMAX
         M:FP     *R7               RELEASE BUFFER PAGES
         LI,R7    0
         STW,R7   HGPDISP
         LW,R7    HGP1
         STW,R7   HGP2
*
         LW,R11   BOOTFLG
         BEZ      PRIVHGPEND        PRIVATE
         B        RBFILE            PUBLIC - FIND RBBAT DATA
         SPACE    3
ADINIT   LI,R4    ADSCR
         LI,R5    ADKSIZE
         LW,R6    SN
         BEZ      %+3
         LI,R4    X'C'              CHANGE SCR AND KEYSIZE IF PRIVATE PACK OR
         LI,R5    12+4+5
         LI,R6    MACNDIR
         LI,R7    -1
ADINIT2  STW,R4   SCRL
         STW,R5   KEYSIZE
         STW,R6   CURMES
         STW,R7   TYPEFLAG
         STW,R5   FLAGSDSP
         MTW,-3   FLAGSDSP          PROBABLE FLAGS POSITION
         MTW,0    SN                RIGHT IF PRIVATE
         BNEZ     *R11
         MI,R7    -2                ELSE FIX FOR AD
         AWM,R7   FLAGSDSP          (NO TWO BYTE HOLE)
         B        *R11
*
FDINIT   LI,R4    FDSCR
         LI,R5    FDKSIZE
         LI,R6    MFILDIR
         LI,R7    0
         B        ADINIT2
*
BUFWRT   PUSH     R11
BUFWRT1  LW,R11   BUFDA,R7
         AND,R11  FLR:DUAL          RESET DUAL READ FLAG
         STW,R11  BUFDA,R7
         LW,R11   FL:UPDT
         CW,R11   BUFDA,R7
         BAZ      BUFWRT2
         BAL,R11  DISCWRT
         BAL,R11  IOSPIN
         LW,R11   BUFDUAL,R7
         BLEZ     BUFWRT2           NO DUAL TO WRITE
         LW,R11   FL:DUAL
         STS,R11  BUFDA,R7          SET DUAL FLAG TO WRITE DUAL
         BAL,R11  DISCWRT
         BAL,R11  IOSPIN
         B        BUFWRT1           RESET DUAL FLAG AND EXIT
BUFWRT2  PULL     R11
         B        *R11
*
NOHGP1   LI,R4    BA(MHGPUSR)
         CI,R15   1
         BNE      NOCORE1
NOCORE   LI,R4    BA(MHGPCORE)
NOCORE1  BAL,R10  MOVTXTC
         BAL,R15  DUMPB
*O*  MESSAGE:      CORE SIZE TOO SMALL FOR HGP RECONSTRUCTION
*O*  ACTION:       BOOT FROM RAD WITHOUT SPECIFYING HGP RECONSTRUCTION
*O*  MEANING:      THE FIX PROCESSOR CANNOT OBTAIN ENOUGH CORE
*O*                TO PERFORM AN HGP RECONSTRUCTION.
         LW,R11   BOOTFLG
         BEZ      CLEANUP           GET OUT
*
         SNAP     'NORECON'
NORECON  LI,R4    BA(MHGPFAIL)
         BAL,R11  OCMESS            PRINT MESSAGE ON OC
*O*  MESSAGE:      HGP RECONSTRUCTION FAILURE
*O*  ACTION:       BOOT SYSTEM FROM RAD WITHOUT SPECIFYING HGP
*O*                RECONSTRUCTION.
*O*  MEANING:      THE HGP RECONSTRUCTION COULD NOT BE COMPLETED.  THE
*O*                REASON APPEARS IN A PREVIOUS MESSAGE ON THE
*O*                OPERATOR'S CONSOLE OR LINE PRINTER.
         LI,R15   -1
         B        INITXIT
*
*  CAN'T GET ENOUGH CORE FOR SECOND COPY OF HGPS
*
NOHGP2   LI,R14   MNOHGP2
         BAL,R15  PRINT
         LW,R15   HGP1
         STW,R15  HGP2
         B        SETPOINT
         SPACE    3
*
*  RECONSTRUCT SYMBIONT FILES
*
HGPRSYM  EQU      %
         LI,R15   SYM1
GBPG     RES
         M:GP     1                 GET PAGE FOR READING SYMB FILES
         BCS,8    *R15
         LI,R7    1                 BUFFER #
         STW,R9   BUFADR,R7         ADDRESS
         LI,R9    0
         STW,R7   BUFMAX
         STB,R9   BUFLINK,R7
         STW,R9   BUFDUAL,R7
         STB,R9   BUFTYPE,R7
         STW,R9   BUFDA,R7
         B        *R15
SYM1     BCS,8    HGPRDONE
*
         LW,R5    RBDATA            ADDRESS OF RBBAT STATIC DATA
         LW,R3    1,R5              TOTAL # SLOTS IN RBBAT DATA
         LW,R4    2,R5              CURRENT COMBUF ADDR
         STW,R4   CURCOMB           SAVE IT
         LW,R7    R5
         AW,R7    0,R5              POINT TO BW:SDA
SYM15    LW,R8    *R7,R3            GET NEXT DISC ADDR
         LW,R2    R5
         AW,R2    BHSID,R5          POINT TO BH:SID
         LH,R2    *R2,R3            SET SYSID
         AND,R2   M16
         STW,R2   SYSID             SAVE IT
         LI,R4    'RB'              ASSUME REMOTE FILE
         LW,R2    R5
         AW,R2    BBRID,R5          POINT TO BB:RID
         LB,R2    *R2,R3            GET REMOTE ID
         BNEZ     SYM18             IT IS REMOTE
         LI,R4    'CR'              LOCAL - ASSUME INPUT
         CW,R3    3,R5
         BLE      SYM18             IT IS
         LW,R2    R5
         AW,R2    BBDEV,R5          POINT TO BB:DEV
         LB,R2    *R2,R3
         LH,R4    OH:NM,R2          GET TEXT DEVICE TYPE
         AND,R4   M16
SYM18    STW,R4   SYMBDEV
*
         LI,R2    MINPUT            'INPUT'
         CW,R3    3,R5              IS THIS AN INPUT SLOT
         BLE      SYM19             YES
         LI,R2    MOUTPUT           'OUTPUT'
         CI,R4    'CR'              CHECK FOR NCTL ENTRY
         BNE      SYM19             NO
         LI,R2    MNCTL             YES - 'NCTL'
SYM19    STW,R2   SYMBTYPE
*
         BAL,R11  SYMBCHK           ALLOCATE THE GRANULES
*
SYM20    BDR,R3   SYM15
*
*  PROCESS COMMUNICATION BUFFERS
*
SGCBUF   LI,R3    -1
         STW,R3   SYMBDEV           DON'T KNOW TYPE
         LW,R1    RBCOMADR          ADDRESS OF COMBUFS
         BEZ      GI                NONE
         LW,R4    CURCOMB           CURRENT RBBAT COMBUF ADDRESS
         LI,R3    HOU
         LB,R2    *R1,R3            POINTER TO FIRST USED ENTRY
         AI,R4    -SGCHD            INDEX INTO SGCHD
         BLZ      SGCB10            NOT LEGAL
         CI,R4    255
         BG       SGCB10            NOT LEGAL
         AI,R2    0
         BEZ      SGCB12            NO USED CHAIN
SGCB11   CW,R2    R4                'FREE' ENTRY IN CHAIN
         BNE      %+2               NO
         LI,R4    0                 YES - PRETEND NO CURRENT COMM BUF
         LW,R2    *R1,R2
         LB,R2    R2                FLINK TO NEXT IN CHAIN
         BNEZ     SGCB11            MORE TO GO
         LB,R2    *R1,R3            HEAD OF CHAIN
         AI,R4    0
         BEZ      SGCB3             NO ENTRY - PROCESS CHAIN
SGCB12   LW,R3    *R1,R4            LINK FREE ENTRY ONTO CHAIN
         STB,R2   R3
         STW,R3   *R1,R4
         LW,R2    R4
         B        SGCB3
SGCB10   AI,R2    0
         BEZ      GI                NO CHAIN PRESENT
*
*  PROCESS CHAIN
*
SGCB3    LI,R4    X'FF'
         AND,R4   *R1,R2            ENTRY TYPE
         BEZ      SGCB4
         LI,R7    #COMCODE
         CB,R4    COMCODE,R7        IS THIS ONE TO PROCESS
         BE       SGCB3A            YES
         BDR,R7   %-2
         B        SGCB4             NO
*
SGCB3A   LW,R4    COMTYPE,R7        MESSAGE ADDR
         STW,R4   SYMBTYPE
         AI,R1    1
         LW,R8    *R1,R2            GET DISC ADDR
         AI,R1    1
         LB,R11   COMFLAG,R7
         BEZ      SGCB3B            NO SYSID
         LW,R11   *R1,R2
         AND,R11  M16               GET SYSID FROM COMBUF
SGCB3B   STW,R11  SYSID
         AI,R1    -2
         BAL,R11  SYMBCHK
*
SGCB4    LW,R2    *R1,R2
         LB,R2    R2                LINK TO NEXT
         BNEZ     SGCB3
*
*  PROCESS FILES FROM GI TABLES
*
GI       LI,R1    3
         LI,R2    -1
         STW,R2   SYMBDEV           DON'T KNOW DEVICE TYPE
         LI,R2    MGI
         STW,R2   SYMBTYPE          TYPE = GI
GI10     LB,R2    GIB:UN,R1
         BEZ      GI20              UNUSED
         AI,R2    X'10000'          PUT USER # + X'10000' IN
         STW,R2   SYSID               FOR SYSID
         LW,R8    GI:SDA,R1         DISC ADDRESS
         BAL,R11  SYMBCHK
GI20     BDR,R1   GI10
         M:FP     1                 FREE SYMBIONT BUFFER PAGE
*
*  ALLOCATE ERROR LOG
*
HGPRDONE M:GP     1
         BCS,8    ELOG35+1
         LI,R7    -1
         STW,R7   DBUF1             NO LINK CHECK ON FIRST READ
         LW,R7    R9                MOVE PAGE ADDRESS
         LW,R8    ELOGSAV           SGRAN
ELOG15   BEZ      ELOG30            DONE
         CW,R8    ELOGSAV+2         CURGRAN
         BE       ELOG18            YES - CURGRAN HASN'T BEEN WRITTEN
         LI,R2    256               # WORDS TO READ
         BAL,R11  DRDWAIT
         BNEZ     ELOGERR           I/O ERROR
         LW,R11   DBUF1
         BLZ      ELOG18            DON'T LINK CHECK SGRAN
         CW,R11   0,R7              CHECK LINK
         BNE      ELOGERR           LINK CHECK FAILURE
ELOG18   CI,R8    1
         BANZ     ELOG20            IGNORE HALF-GRANULES
         BAL,R11  ALLOCG
         BCS,11   ELOGERR           DUAL ALLOCATION
ELOG20   CW,R8    ELOGSAV+2         CURGRAN
         BE       ELOG30            DONE IF THIS IS CURGRAN
         STW,R8   DBUF1             SAVE FOR LINK CHECK
         LW,R8    1,R7              PICK UP FLINK
         B        ELOG15
*
ELOGERR  B        ELOG24            ERROR
         SNAP     'ERRLOG'
ELOG24   LI,R14   MELOGBAD
         BAL,R15  PRINT
         B        ELOG35            GET OUT
*
ELOG30   DISABLE                    ****  DISABLE
         STW,R8   CURGRAN           DISK ADDR OF CURRENT BUFFER
         LW,R8    DBUF1
         BLZ      %+2
         STW,R8   BGRAN             BLINK OF CURGRAN
         LW,R8    ELOGSAV           SGRAN
         STW,R8   SGRAN
         ENABLE                     ****  ENABLE
*
ELOG35   M:FP     1                 RELEASE BUFFER PAGE
*
*  ALL RECONSTRUCTION IS COMPLETE
*
         M:TIME   TEMP
         LI,R4    BA(MHGPDONE)
         BAL,R10  MOVTXTC
         LI,R4    BA(TEMP)
         LI,R5    4*4               # BYTES IN DATE/TIME
         BAL,R10  MOVTXT            MOVE DATE/TIME
         BAL,R15  DUMPB             TELL LP AND OC THAT WE'RE DONE
         LW,R11   LPFLAG            IF THE PRINTER HAS BEEN TURNED OFF,
         CI,R11   1                 OR IF WE'RE DOING AN 'F' RECON,
         BNE      ALLYINV           WE DON'T WANT TO SEE ALL OF THIS
         LI,R4    BA(MLOSGRQ)       DO WE WANT TO DUMNP THE RECOVERED
         BAL,R11  OCKEYIN           GRANULES
         BNE      ALLYINV
*
         LI,R4    HGPSIZE+511+20    DUMP THE LOST GRANULES
         SLS,R4   -9
         M:GP    *R4
         BCS,8    LOSGR91
         STD,R9   R6
         LB,R8    MB:SDI
         SLS,R8   16
         AI,R8    8
LOSGR1   LW,R2    R4
         SLS,R2   9
         CI,R2    512*10
         BLE      %+2
         LI,R2    512*10
         BAL,R11  DRDWAIT
         BNEZ     LOSGR90
         AI,R8    20
         AI,R7    512*10
         AI,R4    -10
         BGZ      LOSGR1
         BAL,R15  GBPG              GET A BUFFER
         BCS,8    LOSGR90           NONE THERE
         LW,R9    R6
         LW,R6    HGP1              NOW SETUP TO COMPARE THE BITMAPS
LOSGR10  LI,R10   255               GET BIT VALUE
         AND,R10  1,R6
         SLS,R10  1
         LW,R8    2,R6              START WITH PER
         INT,R2   5,R6
         AI,R2    0
         BEZ      LOSGR50           NO PER
LOSGR20  LW,R4    *R6,R3
         OR,R4    *R9,R3            ANY BIT STILL ZERO WAS LOST
         LI,R5    32                #BITS INA WORD
         CI,R4    -1
         BE       LOSGR40
LOSGR30  SLS,R4   1
         BOD      LOSGR39           NOT THIS ONE
         LW,R11   LPFLAG            IF THE PRINTER HAS BEEN TURNED OFF,
         CI,R11   1                 OR IF WE'RE DOING AN 'F' RECON,
         BNE      LOSGR90           WE DON'T WANT TO SEE ALL OF THIS
         CW,R8    4,R6              ARE WE OFF THE END
         BGE      LOSGR39           YUP
         PUSH     9,R2              SAVE R2-R10
         LW,R14   1,R6              GET DCTX
         STSECTA,R8,R11 R14         SET DA
         STW,R14  BUFDA,R7
         LI,R2    4                 ERRLOG UNUSED ONES DONT COUNT
         CW,R14   ELOGSAV+1,R2
         BE       LOSGR38
         BDR,R2   %-2
         BAL,R11  DISCRD
         BAL,R11  IOSPIN
         LI,R14   MLOSGRAN
         STW,R14  CURMES
         BAL,R11  SNAPGRN
LOSGR38  PULL     9,R2
LOSGR39  AW,R8    R10
         BDR,R5   LOSGR30
LOSGR40  MW,R5    R10
         AW,R8    R5
         AI,R3    1
         BDR,R2   LOSGR20           TO NEXT WORD
LOSGR50  INT,R2   6,R6              DONE WITH PER, DO PFA
         CW,R8    3,R6
         BG       %+4               NO, WEVE BEEN HERE ALREADY
         LW,R8    3,R6
         AI,R2    0
         BNEZ     LOSGR20
         SW,R9    R6                RECALCULATE DIFFERENCE
         AW,R9    0,R6              POINT TO NEXT ALLOCAT DEVICE
         LW,R6    0,R6
         BNEZ     LOSGR10           IF THERE IS ONE
         M:FP     1
LOSGR90  LI,R8    HGPSIZE+511+20    RETURN THE PAGES
         SLS,R8   -9
LOSGR91  M:FP     *R8
         LI,R11   1                 PUT LPFLAG BACK
         STW,R11  LPFLAG
         B        ALLYINV           WRITE OUT HGPS
         SPACE    3
*
*  ALLOCATE GRANULES FOR SYMBIONT FILE
*  R8 = DISC ADDRESS OF FDA
*
SYMBCHK  AND,R8   M24
         BEZ      *R11
         PUSH     16,R0
         LI,R4    MSYMB
         STW,R4   CURMES            MESSAGE TO DISPLAY IF ERROR
         LW,R7    BUFADR+1          ADDRESS OF BUFFER PAGE
         STW,R7   ADBUF1
         AI,R7    256               POINT TO SECOND BUFFER
         STW,R7   ADBUF2
         STW,R8   *ADBUF2           SET FDA AS NEXT FLINK
         LI,R7    0
         STW,R7   DBUF2             # GRANULES
         LI,R7    -1
         STW,R7   DBUF1             BLINK OF FDA NEED NOT BE ZERO
*
SYMBC10  LW,R8    *ADBUF2           GET NEXT DISC ADDR
         AND,R8   M24
         BEZ      SYMBC30           NOTHING HERE
*
         MTW,1    HEADFLG
         BNEZ     SYMBC12           HEADER HAS ALREADY BEEN PRINTED
         LI,R14   MBEGSYM
         BAL,R15  PRINT
         BUILD    (TEXT,MSHDR1,12),(TEXT,MSHDR2,26),(TEXT,MSHDR3,39),;
                  (TEXT,MSHDR4,52),(DUMPBUF,'A')
         B        SYMBC10
*
SYMBC12  LI,R15   ERR#02            BAD FLINK
         BAL,R11  CHKDA
         BCR,15   SYMBCERR          ERROR
         LI,R7    1                 BUFFER #
         LW,R2    ADBUF1            CURRENT BUFFER ADDRESS
         CI,R2    X'100'            IS IT HALF-PAGE
         BAZ      SYMBC15           NO - DO REAL READ
         CI,R8    1
         BAZ      SYMBC15           READ GRANULE BOUNDARY INTO FULL PAGE
         LW,R2    BUFDA,R7          LAST DISC ADDR READ
         AND,R2   M24
         AI,R2    1
         CW,R2    R8                IF ONE TO READ IS LAST HALF OF PREV
         BE       SYMBC20             GRANULE, DON'T READ
*
SYMBC15  LW,R2    BUFADR,R7
         STW,R2   ADBUF1            RESTORE BUFFER POINTERS
         AI,R2    256
         STW,R2   ADBUF2
         STW,R8   BUFDA,R7          DISK ADDRESS TO READ
         BAL,R11  DISCRD
         BAL,R11  IOSPIN
         LW,R15   BUFINFO,R7
         CI,R15   ERR#99            WAS THERE HARDWARE ERROR
         BE       SYMBCERR          YES
*
SYMBC20  LI,R15   ERR#07
         LW,R11   DBUF1             EXPECTED LINK
         BLZ      SYMBC22           NO LINK CHECK ON FDA
         LW,R2    ADBUF1            ADDRESS OF BUFFER
         CW,R11   255,R2            CHECK BLINK
         BNE      SYMBCERR          WRONG
SYMBC22  CI,R8    1
         BANZ     SYMBC25           DON'T ALLOCATE IF NOT GRAN BOUNDARY
         BAL,R11  ALLOCS            ALLOCATE AS SYMBIONT
         BCS,15   SYMBCERR          NO GOOD EITHER
*
SYMBC25  STW,R8   DBUF1             THIS DA IS NEXT LINK CHECK
         MTW,1    DBUF2             COUNT THIS GRANULE
         LW,R7    ADBUF1
         XW,R7    ADBUF2            SWITCH POINTERS
         STW,R7   ADBUF1
         B        SYMBC10
*
SYMBCERR STW,R15  ERRCODE           SAVE ERROR CODE
         BAL,R11  ERRMSG1           PRINT MESSAGES
         LI,R14   MSPACE
         BAL,R15  PRINT
         LW,R11   DBUF1
         BLEZ     SYMBC30           FDA BAD - CAN'T FIX
         LI,R7    1                 BUFFER #
         STW,R11  BUFDA,R7
         BAL,R11  DISCRD            READ PREV GRANULE
         BAL,R11  IOSPIN
         LI,R11   0
         STW,R11  *BUFADR+1         ZAP PREV FLINK
         BAL,R11  DISCWRT
         BAL,R11  IOSPIN
         LI,R11   0
         STW,R11  BUFDA,R7          MARK IN ERROR
*
*  DONE WITH THIS FILE
*
SYMBC30  LW,R2    SYSID
         BLEZ     SYMBC34           DON'T KNOW SYSID
         LI,R1    14                COL #
         BAL,R10  PUTHEXR
SYMBC34  BUILD    (TEXT,*SYMBTYPE,25)
         LW,R2    SYMBDEV           DEVICE TYPE
         BLEZ     SYMBC40           DON'T KNOW
         LI,R1    41
         LI,R4    BA(SYMBDEV)+2
         LI,R5    2                 # BYTES TO MOVE
         BAL,R10  PUTMES
SYMBC40  LI,R1    58
         LW,R3    DBUF2             # GRANS IN FILE
         BLZ      SYMBC41           DON'T KNOW
         AI,R3    1                 CONVERT SECTORS TO GRANULES
         SLS,R3   -1
         BAL,R10  PUTDECR
SYMBC41  LI,R7    1
         LW,R8    BUFDA,R7
         BNEZ     SYMBC45           NO ERRORS
         LI,R1    65
         LI,R4    BA(MTRUNC)
         BAL,R10  PUTMESC           PUT IN TRUNCATED MESSAGE
SYMBC45  BAL,R15  DUMPBUF
*
SYMBCXIT PULL     16,R0
         B        *R11
         TITLE    '****  PRIVATE PACK HGP RECONSTRUCTION  ****'
         SPACE    3
*F*      NAME:         HGPR
*F*
*F*      PURPOSE:      PERFORM HGP RECONSTRUCTION OF PRIVATE PACK SET.
*F*
*F*      DESCRIPTION:  THE PACK SET IS MOUNTED EXCLUSIVELY.  THE
*F*                    FILE DIRECTORY IS READ, AND PROCESSING
*F*                    BEGINS.  AT THE END, THE HGP'S ARE WRITTEN
*F*                    OUT TO THE VTOCS ON THE APPROPRIATE PACKS.
*
HGPR     LI,R14   MNOSN
         CI,R11   B:SN
         BAZ      MESSOUT           MUST SPECIFY SERIAL #
*
         BAL,R11  DCTSET            SET UP DCTX AND MOUNT VOLUMES
*
         LW,R2    RBUF
         AI,R2    -512              GET NEXT PAGE DOWN FOR DISC ADDRS
         M:GVP    *R2
         BCS,8    NOCORE
         STW,R2   DATADA
         AI,R2    400
         STW,R2   DIRDA
         LI,R9    400
         STW,R9   DATAMAX
         LI,R9    112
         STW,R9   DIRMAX
         STW,R9   LPFLAG            PRINT EVERYTHING
         M:TIME   TEMP
         LI,R4    BA(MHGPRIV)
         BAL,R10  MOVTXTC
         LI,R4    BA(TEMP)
         LI,R5    4*4               # BYTES
         BAL,R10  MOVTXT            MOVE IN TIME
         BAL,R15  DUMPBUF
         LI,R14   MSNLIST
         BAL,R15  PRINT
         LB,R7    F:PV+VSND
         AW,R7    F:PV+FLP
         LI,R2    X'FF00'
         AND,R2   0,R7
         SLS,R2   -8                # SERIAL NUMBERS
         LW,R4    R7
         AI,R4    1
         SLS,R4   2                 BA OF FIRST SN
AVR50    LI,R5    4                 # BYTES
         LI,R1    10                COLUMN NUMBER
         BAL,R10  PUTMES            PUT SN IN PRINT BUFFER
         BAL,R15  DUMPBUF
         BDR,R2   AVR50             PRINT ALL SN'S IN SET
         B        HGPR10
         SPACE    3
*
*  END OF PRIVATE PACK HGP RECONSTRUCTION
*
PRIVHGPEND LCI    2
         LM,R1    LOGACCT           RESTORE LOGON ACCOUNT
         STM,R1   J:ACCN
*
         LW,R6    HGP1
         LW,R7    HGP1
         BAL,R11  HGPINVERT         INVERT HGP BITS
         B        HGPERR
*
*  MOVE HGPS TO LOW CORE
*
         LW,R4    HGP1              ADDRESS OF FIRST HGP
PRIVH50  LI,R2    5
         LB,R1    *R4,R2            DCT INDEX
         LI,R7    HGP
         BAL,R5   FNDHGP1           LOCATE HGP IN LOW CORE
         B        HGPERR
         LW,R3    0,R4              ADDR OF NEXT HGP
         BNEZ     PRIVH52
         LW,R3    NXTHGP            THIS IS THE LAST
PRIVH52  SW,R3    R4
         AI,R3    -7                # WORDS TO MOVE
         LW,R6    R4
         LW,R9    5,R6              MOVE NVAT
         STW,R9   5,R7
         LW,R9    Y8
         STS,R9   6,R7              SET HGP UPDATED BIT
         AI,R6    7
         AI,R7    7
*
PRIVH60  LW,R9    0,R6
         STW,R9   0,R7
         AI,R6    1
         AI,R7    1
         BDR,R3   PRIVH60
*
         LW,R4    0,R4              NEXT IN-CORE HGP
         BNEZ     PRIVH50
*
         STW,R4   HGPBIAS
         LW,R7    HGP1
         BAL,R11  HGPCOUNT          COUNT BITS IN HGPS
*
         LI,R7    0
         XW,R7    #PAGES
         M:FP     *R7               RELEASE FIRST HGP COPY
         LW,R2    RBUF
         AI,R2    -512
         M:FVP    *R2
         BAL,R11  RELPACKS          GIVE UP EXCLUSIVE USE OF PACKS
         M:CLOSE  F:PV,REL,REM      RELEASE PACK SET
*
         BUILD    (TEXT,MHGPDONE),(DUMPB)
         B        ENDPROC2
         SPACE    2
RELPACKS LI,R2    AVRTBLSIZ         INDEX TO FIRST PACK ENTRY
         LI,R8    AVRTBLNE-AVRTBLSIZ   # PACK ENTRIES
         LW,R9    S:CUN
         AI,R9    X'4000'           HGP RECON EXCL USE FLAG
         LI,R10   0
RELPACK2 CH,R9    AVRID,R2
         BNE      RELPACK4
         STH,R10  AVRID,R2
RELPACK4 AI,R2    1
         BDR,R8   RELPACK2
         B        *R11
         TITLE    '****  DUMP HGPS  ****'
         SPACE    2
*F*  NAME:         DUMPHGP
*F*
*F*  PURPOSE:      DUMP EITHER PUBLIC (ALLOCAT DATA) OR PRIVATE PACK
*F*                SET HGPS
*F*
*F*  DESCRIPTION:  IF PUBLIC (NO SERIAL # SPECIFIED), ALLOCAT DATA
*F*                IS READ, VERIFIED, DUMPED IN HEX IF 'F' OPTION NOT
*F*                GIVEN, AND DUMPED FORMATTED.
*F*                IF PRIVATE, THE PACK SET IS MOUNTED, EACH VTOC IS
*F*                READ INTO CORE, THE HGP HEADERS ARE BUILT ONTO
*F*                THE FRONT OF EACH BIT MAP, AND THE MAPS ARE DUMPED
*F*                AS FOR PUBLIC.
         SPACE    1
DUMPHGP  LI,R7    0
         XW,R7    BUFMAX
         M:FP     *R7               FREE THE BUFFER PAGES
         LW,R10   CUROPT
         CI,R10   B:SN
         BANZ     DMPH50            BR IF PRIVATE PACK
         LI,R4    HGPSIZE+511+20
         SLS,R4   -9                # PAGES TO GET
         STW,R4   #PAGES
         M:GP     *R4
         BCS,8    NOCORE            CAN'T GET THE PAGES
         SLS,R4   9                 # WORDS GOTTEN
         LW,R7    R9                ADDRESS OF FIRST PAGE
         LB,R8    MB:SDI            DCTX OF ALLOCAT DEVICE
         SLS,R8   16
         AI,R8    8                 ALLOCAT DATA ON SECTOR 8
         LI,R14   JBUPVPA           ALLOCAT ADDRESS OF DATA
*
DMPH20   LW,R2    R4
         CI,R2    512*10
         BLE      %+2
         LI,R2    512*10            TOO MUCH FOR ONE I/O
         BAL,R11  DRDWAIT           READ IT
         LW,R12   R7                ADDRESS TO DUMP
         LW,R13   R2                # WORDS TO DUMP
         LI,R11   B:F
         CW,R11   CUROPT
         BANZ     %+2               NO HEX DUMP IF 'F'
         BAL,R11  HEXDUMP
         AW,R14   R2
         AI,R8    2*10              ADVANCE DISK ADDRESS
         AW,R7    R2                ADVANCE BUFFER ADDRESS
         SW,R4    R2
         BGZ      DMPH20            MORE TO DO
*
         STW,R9   BUFLIM            LOW LIMIT OF BUFFER
         AI,R7    -1
         STW,R7   BUFLIM+1          UPPER LIMIT OF BUFFER
         LCW,R9   R9
         AI,R9    JBUPVPA           DIFFERENCE BETWEEN ADDRESS OF
         STW,R9   HGPBIAS             ALLOCAT HGP LINKS AND BUFFER HERE
*
*  VALIDATE ALLOCAT HGP CHAIN
*
         LW,R7    BUFLIM
DMPH25   CLM,R7   BUFLIM            IS LINK WITHIN BUFFER
         BCS,9    DMPH30            NO
         LW,R9    0,R7              LINK TO NEXT HGP
         BEZ      DMPH28            DONE
         SW,R9    HGPBIAS           CONVERT TO ADDRESS IN BUFFER
         CW,R7    R9
         BGE      DMPH30            FLINK MUST BE GREATER THAN CURRENT
         LW,R7    R9
         B        DMPH25
*
DMPH28   LW,R7    BUFLIM
         BAL,R11  HGPCOUNT          PRINT FORMATTED OUTPUT
DMPH29   LI,R11   0
         XW,R11   #PAGES
         M:FP     *R11
         MTW,0    BOOTFLG
         BNEZ     HGPR10            IF NOT UP, CONTINUE RECON.
         B        ENDPROC2
*
DMPH30   BUILD    (TEXT,'BALLOCAT DATA BAD'),(DUMPB)
         MTW,1    ERRCNT
         B        DMPH29
*
*  DUMP PRIVATE PACK HGPS
*
DMPH50   LI,R7    0
         STW,R7   HGPBIAS
         STW,R7   PREVHGP
         LB,R7    F:PV+VSND
         AW,R7    F:PV+FLP          ADDRESS OF SERIAL # VLP
         LI,R3    X'FF00'
         AND,R3   0,R7
         SLS,R3   -8                # VOLUMES IN SET
         STW,R3   #PAGES
         M:GP     *R3
         BCS,8    NOCORE
         STW,R9   BUFLIM            BUFFER ADDRESS
         LI,R1    1                 FIRST VOLUME #
         LW,R7    BUFLIM
         LI,R2    512               # WORDS TO READ
DMPH52   LB,R8    DCTX,R1           DCTX OF THIS VOLUME
         SLS,R8   16                DISK ADDRESS OF VTOC
         BAL,R11  DRDWAIT           READ IT
         LW,R12   R7                ADDRESS TO DUMP
         LI,R13   512               # WORDS TO DUMP
         LI,R14   0                 ADDRESS TO PRINT
         LI,R11   B:F
         CW,R11   CUROPT
         BANZ     %+2               NO HEX DUMP IF OPTION 'F'
         BAL,R11  HEXDUMP
         AI,R7    512               ADVANCE BUFFER ADDRESS
         AI,R1    1                 ADVANCE VOLUME #
         CW,R1    R3
         BLE      DMPH52            NOT DONE YET
*
         LW,R7    BUFLIM            ADDRESS OF FIRST VTOC
         LI,R1    1                 FIRST VOLUME #
         B        DMPH60
DMPH55   LW,R8    R7
         LW,R9    R1
         SLS,R9   9
         AI,R9    -512
         AW,R9    BUFLIM            ADDRESS OF VTOC FOR THIS VOLUME
         LI,R12   512
DMPH58   LW,R13   *R9
         STW,R13  *R8               MOVE VTOC
         AD,R8    DOUBLEONE
         BDR,R12  DMPH58
*
DMPH60   LB,R4    DCTX,R1
         LH,R5    DCT23,R4          HGP DISPLACEMENT
         LCI      3
         LM,R12   HGP+1,R5          MOVE WORDS 1-3 OF IN-CORE HGP
         STM,R12  1,R7                OVER WORDS 1-3 OF VTOC
         INT,R13  4,R7
         STW,R13  4,R7              ZERO HW 0 OF WORD 4
         LI,R13   0
         STW,R13  0,R7              ZERO HGP FLINK
         STW,R7   *PREVHGP          LINK PREVIOUS HGP TO THIS ONE
         STW,R7   PREVHGP           NEW PREV HGP ADDRESS
*
         AW,R7    4,R7
         AI,R7    7                 POINT PAST THIS HGP
         AI,R1    1                 INCR VOLUME #
         BDR,R3   DMPH55
         B        DMPH28            DUMP HGPS FORMATED
         TITLE    '****  INITIALIZE ALLOCAT DATA ON TAPE BOOT  ****'
         SPACE    2
*F*      NAME:         ALLYINIT
*F*
*F*      PURPOSE:      INITIALIZE ALLOCAT DATA AND ALLOCATE AND INITIALIZE
*F*                    ACCOUNT DIRECTORY.
*F*
*F*      DESCRIPTION:  ONE HGP IS BUILT FOR EACH DISC OR RAD WHICH
*F*                    CONTAINS PFA AND/OR PER.  TWO GRANULES
*F*                    ARE ALLOCATED FOR THE ACCOUNT DIRECTORY, HGPS
*F*                    ARE WRITTEN TO ALLOCAT DATA, AND THE ACCOUNT
*F*                    DIRECTORY IS INITIALIZED.
         SPACE         1
*D*      NAME:         ALLYINIT
*D*
*D*      OUTPUT:       HGPS WRITTEN TO ALLOCAT DATA, AND ACCOUNT
*D*                    DIRECTORY FDA INITIALIZED.
*D*
*D*      DESCRIPTION:  ONE HGP IS BUILT FOR EACH PACK OR RAD CONTAINING
*D*                    PFA AND/OR PER.  TWO GRANULES FOR THE ACCOUNT
*D*                    DIRECTORY ARE THEN ALLOCATED AS FOLLOWS:
*D*                      THE MAIN FDA GRANULE IF THE FIRST GRANULE ON
*D*                      FIRST PFA RAD, OR FIRST PFA PACK IF NO RAD,
*D*                      OR FIRST CYLINDER ALLOCATED PACK IF NO RAD
*D*                      OR GRANULE ALLOCATED PACK.
*D*
*D*                      THE DUAL OF THE FDA IS THE LAST GRANULE ON
*D*                      THE LAST GRANULE ALLOCATED PACK, OR LAST
*D*                      GRANULE ON LAST PFA RAD, OR FIRST GRANULE
*D*                      OF LAST CYLINDER ON LAST CYLINDER ALLOCATED
*D*                      PACK.
*D*                    THE HGPS ARE THEN WRITTEN TO ALLOCAT DATA, AND
*D*                    THE ACCOUNT DIRECTORY FDA MAIN AND DUAL GRANULES
*D*                    INITIALIZED TO BE EMPTY.
*
         SPACE    2
ALLYINIT EQU      %
         BAL,R11  ZAPRBUF           ZAP ANY EXISTING RECOVERY BUFFER
         BAL,R11  PUBHGPS           BUILD ONE COPY OF PUBLIC HGPS
         BNEZ     HGPCORE           ERROR - NOT ENOUGH CORE
         LW,R11   HGP2
         STW,R11  HGP1              MOVE ADDRESS OF HGPS
         LI,R0    0
         STW,R0   HGPDISP
         MTW,1    HGPRFLAG          SET TO ALLOW ALLOCATION
*
*  SEARCH HGPS TO FIND FIRST AND LAST OF THE FOLLOWING TYPES:
*        RAD
*        GRANULE ALLOCATED PACK
*        CYLINDER ALLOCATED PACK
*
         BAL,R11  ACNCALC           CALCULATE ACCOUNT DIR DISC ADDRS
         STW,R8   RBJIT             SAVE MAIN DA
         STW,R9   RBAJIT              AND DUAL DA
         BAL,R11  ALLOCG            ALLOCATE MAIN DA
         BCS,11   INITERR           ERROR
         LW,R8    RBAJIT            DUAL DA
         BEZ      ALLYI40           NO DUAL
         BAL,R11  ALLOCG            ALLOCATE DUAL
         BCS,11   INITERR           ERROR
ALLYI40  LI,R11   0
         STW,R11  HGPRFLAG
         MTB,-1   RBJIT
         BEZ      ALLYI50           # GRAN/CYL = 1
         LW,R8    RBJIT
         BAL,R2   INCREMENT%SECTOR  INCREMENT SECTOR ADDRESS BY 2
         STW,R8   ALLODIRA
*
ALLYI50  LW,R8    RBAJIT
         BEZ      ALLYINV           NO DUAL
         MTB,-1   RBAJIT            CHECK DUAL FOR CYLINDER
         BEZ      ALLYINV           NOT CYL - DONE
         LW,R8    RBAJIT
         BAL,R2   INCREMENT%SECTOR  INCREMENT SECTOR ADDR BY 2
         STW,R8   ALLODIRA+1
*
*  INVERT HGP BITS, REFORMAT HGP HEADERS, RELINK HGPS
*
ALLYINV  LI,R6    JBUPVPA           ADDR OF FIRST HGP IN ALLOCAT DATA
         LW,R7    HGP1
         BAL,R11  HGPINVERT
         B        INITERR           ERROR
*
         LW,R11   HGPRFLAG
         BEZ      ALLYINV1          NO BIT COUNTING IF TAPE BOOT
         LCW,R2   HGP1
         AI,R2    JBUPVPA
         STW,R2   HGPBIAS
         LW,R7    HGP1
         BAL,R11  HGPCOUNT          COUNT BITS IN HGPS
*
ALLYINV1 LW,R4    #PAGES            # PAGES ALLOCATED FOR HGPS
         LI,R7    HGPSIZE+511
         SLS,R7   -9                # PAGES MAX TO WRITE
         CW,R4    R7
         BLE      %+2
         LW,R4    R7                DON'T WRITE TOO MANY
         SLS,R4   9                 # WORDS OF HGPS
         LW,R7    HGP1              START OF HGPS
         LB,R8    MB:SDI            DCT INDEX OF FIRST SWAPPER
         SLS,R8   16
         AI,R8    8                 DISC ADDRESS OF START OF ALLOCAT
ALLYINV2 LW,R2    R4                REMAINING # WORDS TO WRITE
         CI,R2    512*10
         BLE      %+2
         LI,R2    512*10            LIMIT I/O TO 10 PAGES
         BAL,R11  DWRWAIT           WRITE IT
         BNEZ     ALLYERR           I/O ERROR
         AW,R7    R2                INCR BUFFER ADDRESS
         AI,R8    2*10              INCR RELATIVE SECTOR
         SW,R4    R2
         BGZ      ALLYINV2          MORE TO DO
*  ZERO SPACE IN ALLOCAT DATA BEYOND HGPS
         LI,R4    0
         LW,R6    HGP1              CALCULATE CHECKSUM
         SW,R6    R7
         AW,R4    *R6,R7
         BIR,R6   %-1
         LI,R3    HGPSIZE+20+512+511 DATA + 1PAGE FOR REWRITE
         SLS,R3   -9                # PAGES IN ALLOCAT RESERVED FOR HGPS
         SW,R3    #PAGES            # PAGES NOT ALREADY WRITTEN TO
         BLEZ     ALLYINV4          NONE
         AI,R8    -(2*10)           DISC ADDR OF LAST BLOCK WRITTEN
         SLS,R2   -8                # SECTORS WRITTEN IN LAST BLOCK
         AW,R8    R2                DISC ADDR OF NEXT BLOCK
         LI,R2    512               # WORDS TO WRITE
         AI,R8    -2                BACK UP TO LAST PAGE OF HGPS
         AI,R7    -512              REWRITE IF ITS ALSO ALLOCATS LAST PAGE
ALLYINV3 AI,R3    -1                COUNT EM DOWN
         BGZ      %+3
         BLZ      ALLYINV4          ALL DONE
         STW,R4   511,R7            AND PUT CHECKSUM IN LAST WORD OF LAST PAGE
         BAL,R11  DWRWAIT
         AI,R8    2
         LI,R1    511               CLEAR REMAINING PAGES OF ALLOCAT DATA
         STW,R6   *R7,R1
         BDR,R1   %-1
         STW,R1   *R7
         B        ALLYINV3
*
ALLYINV4 LI,R8    0
         LW,R9    =X'80008000'
         STS,R8   BUFLAGS           ENABLE GRANULE ALLOCATION
         STS,R8   BUFLAGS+1
         STW,R8   LFGUN             TELL ALLOCAT IT'S OK TO RUN
         LD,R0    TXTALLY           WAKE UP ALLOCAT
         BAL,R10  T:GJOBSTRT
         LI,R11   0
         XW,R11   HGPRFLAG
         BEZ      ALLYINV5          NOT HGP RECON
         MTW,0    LPCNT             WAIT FOR LP OUTPUT TO FINISH
         BNEZ     %-1
         LI,R12   -1
         XW,R12   LPDCTX            TURN OFF DIRECT LP WRITES
         BLEZ     ALLYINV6          NO DCT INDEX
         MTW,0    LPTAPE
         BEZ      ALLYINV6          OUTPUT NOT TO TAPE
         LI,R13   3
         BAL,R11  CALLNEWQ          WRITE 2 TAPE MARKS
         BAL,R11  CALLNEWQ
         LI,R13   X'B'              REWIND TAPE OFF-LINE
         BAL,R11  CALLNEWQ
ALLYINV6 MTW,0    RBFILOK           DOES A GOOD RBBAT RECOVERY FILE EXIST
         BNEZ     RBFIL42           YES - NOTHING TO DO
         M:SETDCB,E  RBSET          IGNORE I/O ERRORS
         LI,R2    1
         M:CLOSE,E  CLSRB           RELEASE ANY OLD COPY
         B        RBOPN             OPEN NEW RECOVERY FILE
*
*  INITIALIZE ACCOUNT DIRECTORY FDA
*
ALLYINV5 LI,R5    511
         LI,R4    0
         STW,R4   JITBUF,R5         ZERO BUFFER
         BDR,R5   %-1
         STW,R4   JITBUF
*
         LW,R5    =X'4000'+MIDIS**16+ADSCR
         STW,R5   JITBUF+2
         LI,R2    512               # WORDS TO WRITE
         LI,R7    JITBUF
         LW,R8    RBJIT
         BAL,R11  DWRWAIT
         BNEZ     ADIOERR           I/O ERROR WRITING AD
         LW,R8    RBAJIT
         BEZ      ALLYINV7          NO DUAL
         BAL,R11  DWRWAIT
         BNEZ     ADIOERR           I/O ERROR WRITING AD DUAL
*
ALLYINV7 LW,R8    RBJIT             MAIN AD DISK ADDRESS
         AND,R8   M24
         OR,R8    Y8                SET EMPTY FILE FLAG
         STW,R8   ACNCFU+FDA
         LW,R8    RBAJIT
         AND,R8   M24
         STW,R8   ACNCFU+DFDA       DUAL DISC ADDRESS
         BAL,R2   REMDEV            REMOVE PARTITIONED DEVICES
         B        INITXIT           GET OUT
         SPACE    2
BADRBUF  M:SNAP   'RCVRBUF',(*RBUF,RBUFEND)
         LI,R11   ZAPRBUF2
ZAPRBUF  PUSH     R11
         LI,R2    512
         LI,R7    RBUFEND-511       ADDR OF LAST PAGE OF BUFFER
         LI,R8    RBUFSIZE-1
         SLS,R8   1
         AW,R8    RCVRAD            DISC ADDR OF LAST PAGE OF BUFFER
         STW,R2   RBUFEND           ZAP CONTROL WORD
         PULL     R11
         B        DWRWAIT           CLOBBER LAST PAGE OF BUFFER
ZAPRBUF2 RES      0
         LI,R4    BA(MNORCVR)
         BAL,R11  OCMESS            TELL OPERATOR CAN'T RECOVER
*O*  MESSAGE:      CANNOT RECOVER
*O*  ACTION:       BOOT FROM RAD
*O*  MEANING:      THE RECOVERY BUFFER CONTAINS BAD INFORMATION.
*O*                ALL ITEMS CHANGED BY THE CONTROL PROCESSOR WILL
*O*                REVERT TO SYSGEN DEFAULTS, SYMBIONT FILES MAY
*O*                BE LOST, AND SOME ERRLOG INFORMATION MAY BE LOST.
         LI,R15   -2                BAD RECOVERY BUFFER FLAG
         B        INITXIT           EXIT TO GHOST1
*
ADIOERR  LI,R4    BA(MADIOERR)
*O*  MESSAGE:      I/O ERROR WRITING ACCOUNT DIRECTORY
*O*  ACTION:       FIX HARDWARE, SYSGEN OR RECONFIGURATION CARDS
*O*  MEANING:      AN I/O ERROR OCCURRED WHILE TRYING TO INITIALIZE
*O*                THE ACCOUNT DIRECTORY.  CAN BE CAUSED BY BAD
*O*                HARDWARE OR A SYSGEN OR RECONFIGURATION
*O*                PROBLEM (TWO RADS OR PACKS ON THE SAME ADDRESS).
INITERR1 BAL,R11  OCMESS
INITERR  SNAP     'INITIALIZATION ERROR IN FIX'
         LI,R4    BA(MHALT)
         BAL,R11  OCMESS
*O*  MESSAGE:      UNABLE TO BOOT SYSTEM - BAD SYSGEN OR HARDWARE
*O*                MALFUNCTION
*O*  ACTION:       CORRECT THE PROBLEM
*O*  MEANING:      THE SYSTEM CANNOT BE BOOTED.  A PREVIOUS MESSAGE
*O*                EXPLAINS THE REASON.
         B        %
         SPACE    2
HGPCORE  LI,R4    BA(MHGPSIZE)
*O*  MESSAGE:      INSUFFICIENT CORE TO BUILD HGPS
*O*  ACTION:       FIX PATCHES OR SYSGEN
*O*  MEANING:      THE FIX PROCESSOR CAN NOT OBTAIN ENOUGH PAGES TO
*O*                BUILD THE HGPS.  EITHER THE GHOST MAX CORE IS SET
*O*                TOO LOW, OR TOO MANY PUBLIC DISK DEVICES WERE
*O*                SYSGENED.
         B        INITERR1
*
ALLYERR  LI,R4    BA(MSWAPERR)      I/O ERROR WRITING ALLYCAT DATA
*O*  MESSAGE:      I/O ERROR WRITING ALLOCAT DATA TO SWAPPER
*O*  ACTION:       NONE
*O*  MEANING:      AN I/O ERROR OCCURRED WHILE TRYING TO WRITE
*O*                THE HGPS TO ALLOCAT DATA.  MAY BE EITHER A
*O*                HARDWARE MALFUNCTION, OR A BAD SYSGEN OR
*O*                RECONFIGURATION (TWO PACK OR RAD DEVICES HAVE
*O*                THE SAME ADDRESS).
         B        INITERR1
         SPACE    3
R2:RG    PUSH     2,R3
         BAL,R6   CHKDAQ            VALIDATE DISC ADDRESS
         BCR,15   R2:EXIT1          BAD
         LDCTX,R1 R8
         LI,R7    HGP
         BAL,R5   FNDHGP1
         B        R2:EXIT1          CAN'T FIND HGP
         LI,R11   R2:EXIT           RETURN FROM RCYL, RBG, RSG
         LW,R3    1,R7
         CI,R3    ATCYLBIT          IS HGP CYLINDER ALLOCATED
         BANZ     RCYL              YES
         AI,R8    0                 IS IT SYMBIONT
         BGEZ     RBG               NO
         B        RSG               YES
R2:EXIT1 LI,R8    0
R2:EXIT  PULL     2,R3
         AI,R8    0
         B        *R10
         SPACE    3
CHKDATE  LI,R3    3
         LI,R13   X'F0F0'
CHKD10   LH,R4    DATE,R3           GET NEXT ITEM
         BGZ      CHKD20            MUST BE TWO BLANKS
         CS,R13   R4                OTHERWISE MUST BE TWO DECIMAL DIGITS
         BNE      0,R7              NO - ERROR
CHKD20   CH,R4    MAXD,R3
         BG       0,R7              TOO BIG
         CH,R4    MIND,R3
         BL       0,R7
         BE       CHKD30            BR IF TWO BLANKS
         AI,R4    X'606'            CHECK FOR 'F0' THRU 'F9'
         CS,R13   R4
         BNE      0,R7              ERROR
CHKD30   AI,R3    -1
         BGEZ     CHKD10            DO ALL FOUR ITEMS
         LW,R4    DATE              MONTH - DAY
         LI,R6    6
         CW,R4    BADATES,R6        CHECK FOR ILLEGAL MONTH/DAY
         BE       0,R7
         BDR,R6   %-2
         CW,R4    BADATES           CHECK FOR FEB 29
         BNE      1,R7              NO - DATE IS OK
         LI,R4    X'103'            CHECK FOR LEAP YEAR
         AND,R4   DATE+1
         BEZ      1,R7              OK - EVEN DECADE, YEAR = 4 OR 8
         CI,R4    X'102'            MAY ALSO BE ODD DECADE AND
         BE       1,R7                YEAR 2 OR 6
         B        0,R7              NOT LEAP YEAR
         SPACE    3
CHKTIME  LI,R3    1
         LI,R13   X'F0F0'
CHKT10   LH,R4    TIME,R3           GET NEXT ITEM
         CS,R13   R4
         BNE      0,R7              NOT DECIMAL DIGITS
         CH,R4    MAXT,R3
         BG       0,R7              TOO BIG
         AI,R4    X'606'            CHECK FOR 'F0' THRU 'F9'
         CS,R13   R4
         BNE      0,R7
         AI,R3    -1
         BGEZ     CHKT10            DO BOTH ITEMS
         B        1,R7
*
MOVDAT   LI,R8    0
MOVDAT10 BAL,R15  NXTCHAR           GET NEXT CHAR FROM INPUT BUFFER
         BCS,4    MOVDAT20          NO MORE CHARS
         LI,R7    #DTDELIM
         CB,R12   DTDELIM,R7
         BE       MOVDAT20          DONE - FOUND DELIMITER
         BDR,R7   %-2
         SLS,R8   8                 NOT DELIMITER - ACCUMULATE CHAR
         OR,R8    R12
         B        MOVDAT10
*
MOVDAT20 CW,R8    YFFFF
         BANZ     DATERR            ERROR - MORE THAN TWO CHARS
         CI,R8    X'FF00'
         BANZ     %+2
         AI,R8    '0'**8            SUPPLY LEADING ZERO
         STH,R8   0,R4              PUT IT AWAY
         AI,R4    1
         BDR,R5   MOVDAT            DO REST OF FIELDS
MOVDAT30 BAL,R15  NXTCHAR           CHECK FOR EXTRA FIELDS
         BCS,4    *R11              NO MORE CHARS - EXIT
         CI,R12   X'40'
         BE       MOVDAT30          ALLOW TRAILING BLANKS
*
DATERR   LI,R4    BA(MEH)
         LW,R11   R10
         B        OCMESS
         TITLE    '****  FREPORT  ****'
         SPACE    2
*F*      NAME:         FREPORT
*F*
*F*      PURPOSE:      READ AND DUMP TO THE LINE PRINTER SELECTED
*F*                    PARTS OF A USER WHO HAS JUST ENCOUNTERED
*F*                    A FILE INCONSISTENCY.
*F*
*F*      DESCRIPTION:  THE USER NUMBER IS OBTAINED, AND THE JIT AND
*F*                    DCBS READ FROM THE SWAP DEVICE.  JIT, DCBS,
*F*                    POOL BUFFERS, CFU AND DISC GRANULES ARE DUMPED
*F*                    TO LINE PRINTER.  FINALLY THE USER IS AWAKENED
*F*                    AND FREPORT IS DONE.
         SPACE    2
FREPORT  EQU      %
         DISABLE                    ****  DISABLE
         LW,R2    S:CUN
         CW,R2    LFGUN
         BNE      *R11              NOT THE RIGHT GHOST - EXIT
*
         LI,R2    0
FR12     LB,R6    SAVBUF,R2         SEARCH FOR A USER #
         BNEZ     FR15              FOUND ONE
         AI,R2    1
         CI,R2    3
         BLE      FR12
         B        *R11              NONE
*
FR15     STW,R6   USER#
         LI,R3    0
         STB,R3   SAVBUF,R2         ZAP USER # IN SAVBUF
         ENABLE                     ****  ENABLE
         PUSH     R11
         M:GVP    JITBUF
         BCS,8    FRNOPAGE
         M:GVP    AJITBUF
         BCS,8    FRNOPAGE
         LW,R11   SNAPFLAG
         BEZ      %+2               NO SUPERCLOSE IF NOT SNAPPING
         CAL1,9   6                 SUPERCLOSE
         LI,R6    4
         STW,R6   TEMP              RETRY COUNT
*
FR20     LI,R14   MFRHEAD
         LW,R11   SNAPFLAG
         BEZ      %+2               NO PRINTING UNLESS DESIRED
         BAL,R15  PRINT             HEADING MESSAGE
*
         BAL,R11  CHKUSER           VALIDATE USER #
         BCS,15   FR22              BAD
*
         LH,R8    UH:FLG,R7
         CI,R8    JIC+RTR           MAKE SURE USER IS OUT OF CORE
         BAZ      READJIT           YES
FR22     ENABLE                     ****  ENABLE
         M:WAIT   1                 WAIT FOR HIM TO GO OUT
         MTW,-1   TEMP
         BGZ      FR20
         B        FREXIT            GIVE UP
*
*  READ USER'S JIT AND AJIT
*
READJIT  ENABLE                     ****  ENABLE
         LH,R8    UH:JIT,R7         JIT DISC ADDRESS
         LH,R9    UH:AJIT,R7        AJIT DISC ADDRESS
         LW,R11   S:DP
         BEZ      READJ10           BR IF RAD SWAPPER
         LB,R8    UB:C#,R7          CYL # THAT USER IS ON
         LW,R9    R8
         SLD,R8   16                FORM PHYSICAL SEEK ADDRESS
         AI,R8    2                 JIT IS ON SECTOR 2
READJ10  BAL,R11  RDJIT             READ JIT AND AJIT
         BNEZ     BADJIT            ERROR
*
         LW,R5    UTSTACK
         AI,R5    JITBUF-J:JIT      ADDRESS OF TOP OF STACK IN BUFFER
         LCI      5
         LM,R6    -19-5,R5          PICK UP USERS R6-R10
         STW,R6   DCBADR            DCB ADDRESS
         STW,R7   MONOVR            MONITOR OVERLAY #
         STW,R8   ERRCODE           ERROR SUB-CODE
         STW,R10  DISCADR           DISC ADDRESS
*
         M:TIME   TEMP+1
         LW,R2    ='B   '
         STW,R2   TEMP              VFC AND SOME BLANKS
         LI,R4    BA(TEMP)
         LI,R5    4*5               # BYTES
         BAL,R10  MOVTXT
         MTW,1    COUNT             INCR # REPORTS
         LW,R11   SNAPFLAG
         BEZ      FR24              DON'T PRINT ANYTHING
         BUILD    (TEXT,MREP,50),(DEC,*COUNT),(DUMPBUF),(TEXT,MERRMES)
FR24     LW,R2    ERRCODE
         AI,R2    X'7500'           ADD IN MAJOR CODE
         BAL,R10  MOVHEX
         STW,R12  EBCERR            SAVE EBCDIC ERROR CODE
         LW,R11   SNAPFLAG
         BEZ      RDDCB             DON'T PRINT ANYTHING
         BUILD    (TEXT,MDSCADR,44),(HEX,*DISCADR),(DUMPBUF),;
                  (TEXT,MSITEID)
         LI,R4    BA(SITEID)
         LI,R5    8                 BYTE COUNT
         BAL,R10  MOVTXT
         BUILD    (TEXT,MRDF,50),;
                  (HEX,RDF:),(TEXT,MWRTF,92),(HEX,WRTF:),(DUMPBUF),;
                  (TEXT,MMONOV)
         LI,R4    BA(MNONE)
         LW,R2    MONOVR            MONITOR OVERLAY #
         BEZ      FR30              NONE
         CI,R2    MAXOVLY
         BG       FR30              GARBAGE
         LW,R4    R2
         SLS,R4   3                 BYTE DISPL FROM P:NAME
         AI,R4    BA(P:NAME)        BA OF TEXTC NAME
FR30     BAL,R10  MOVTXTC
         BUILD    (TEXT,MUSER,51),(HEX,*USER#),(TEXT,MOPNCLS,90),;
                  (HEX,*OPNCLSUS),(DUMPBUF)
*
*  READ IN USER'S DCB PAGES
*
RDDCB    BAL,R15  INITBUF
         LW,R7    USER#
         LI,R0    JITBUF+JDCBLL     POINT TO DW PAIR OF PAGE LIMITS
         BAL,R11  PGDISC            SET UP PAGE TO DISC ADDR TABLE
         BAL,R11  RDPAGES           READ THEM
         BNEZ     BADDCBS           ERROR
         STW,R5   DCBBEGIN          SAVE ADDR OF FIRST PAGE READ
*
         LW,R5    DCBADR            USER'S DCB ADDRESS
         BAL,R11  GETADDR           CONVERT TO ADDRESS IN BUFFER AREA
         STW,R12  USERDCB
         BNEZ     FR35              FOUND IT
         LW,R11   SNAPFLAG
         BEZ      FREXIT            DON'T PRINT ANYTHING
         BUILD    (TEXT,MNODCB),(HEX,*DCBADR),(DUMPBUF)
         B        DUMPCFU
*
*  BUILD MESSAGE CONTAINING FILE NAME AND ACCOUNT
*
FR35     LI,R1    X'1FFFF'
         LW,R6    USERDCB
         AND,R1   FLP,R6            ADDRESS OF VLPS IN DCB
         SW,R1    DCBADR            INDEX INTO DCB OF VLPS
         STW,R1   FITVLPX           SAVE FOR LOCCODE
         LI,R12   1                 FIND FILE NAME VLP
         BAL,R4   LOCCODE
         B        DUMPCFU           CAN'T FIND IT
         AW,R1    R6                ADDRESS OF NAME
         SLS,R1   2
         LW,R2    R1
         LI,R12   X'3F'
         AND,R12  ERRCODE           I/O ERROR SUB-CODE
         CI,R12   X'3D'
         BG       FR37              7E - NO FILE NAME
         BE       FR38              7D - FILE NAME
         CI,R12   4
         BL       FR38              01, 02, OR 03 - USE THE NAME
         CI,R12   7
         BE       FR38              USE FILE NAME FOR 75-07
FR37     LI,R2    BA(MSPACE)        DIRECTORY ERROR - DON'T USE NAME
FR38     LI,R3    BA(75NAME)
         OR,R3    Y2                MOVE 32 BYTES
         MBS,R2   0
         LI,R12   2                 FIND ACCOUNT VLP
         BAL,R4   LOCCODE
         B        DUMPCFU
         AW,R6    R1
         SLS,R6   2
         LI,R7    BA(75ACCT)
         OR,R7    Y08
         MBS,R6   0
         LW,R6    USERDCB
         LW,R7    FIL1,R6           CHECK FOR OUT/OUTIN RELEASE
         BLZ      SAVFIL            SAVE
         LW,R7    Y0014
         CW,R7    FUN,R6
         BANZ     DUMPCFU           DON'T TYPE NAME IF TEMP FILE
*
SAVFIL   LI,R2    BA(75NAME)+1
         LI,R3    BA(OC75MES)+14
         LB,R4    75NAME            # BYTES IN FILE NAME
         AND,R4   M5                SCRUB GARBAGE
         STB,R4   R3
         MBS,R2   0                 MOVE FILE NAME
         LI,R2    '.'
         STB,R2   0,R3              PUT IN PERIOD SEPARATOR
         AI,R3    1
         LI,R2    BA(75ACCT)
         OR,R3    Y08
         MBS,R2   0                 MOVE ACCOUNT
         LI,R2    CR
         STB,R2   0,R3              TRAILING CARRIAGE RETURN
         AI,R3    -BA(OC75MES)
         STB,R3   OC75MES           PUT IN TEXTC COUNT
         M:TYPE   (MESS,OC75MES)
*O*  MESSAGE:      FIX:  75XX  FID
*O*  ACTION:       INFORM THE FILE OWNER THAT HIS FILE IS BAD
*O*  MEANING:      AN I/O ERROR 75XX HAS OCCURRED IN FILE FID.
*
*  DUMP THE CFU
*
DUMPCFU  LW,R11   SNAPFLAG
         BEZ      FREXIT            DON'T PRINT ANYTHING
         LI,R14   MACNCFU
         BAL,R15  PRINT
         LI,R12   ACNCFU
         LI,R13   19
         LI,R14   ACNCFU
         BAL,R11  HEXDUMP           DUMP ACNCFU
*
         LI,R14   MFILCFU
         BAL,R15  PRINT
         LI,R12   FILCFU
         LI,R13   19
         LI,R14   FILCFU
         BAL,R11  HEXDUMP           DUMP FILCFU
*
         LI,R14   MPAGE
         BAL,R15  PRINT
*
         LW,R6    USERDCB
         BLEZ     DUMP75            NO DCB, NO CFU
         LI,R12   X'1FFFF'
         AND,R12  CFU,R6            CFU ADDRESS
         BEZ      DUMP75            NO CFU
         CI,R12   X'1FFFF'
         BE       CHKTCFU2          * FILE IN OPEN OR CLOSE
         CI,R12   ACNCFU
         BE       CHKTCFU
         CI,R12   FILCFU
         BE       CHKTCFU
         CI,R12   FITCFU
         BE       CHKTCFU
*
CHKCFU   AND,R12  M17
         BEZ      DUMP75            NO CFU
         CW,R12   ACNCFU+13         MUST BE BELOW ACCOUNT AREA
         BL       USERCFU           OK
         LW,R14   R12
         LW,R5    R12               MAY BE IN M:*
         BAL,R11  GETADDR
         BNEZ     USERCFU           GOOD
*
CFUBAD   LI,R4    BA(MBADCFU)
         BAL,R10  MOVTXTC
         LW,R2    R12
         BAL,R10  MOVHEX
         BAL,R15  DUMPBUF
         B        DUMP75
*
CHKTCFU  LW,R1    R12
         LW,R8    CDAM,R1           CURRENT DISC ADDRESS
         STW,R8   GAVALL            SAVE IT FOR LATER
CHKTCFU2 LW,R12   J:BASE-J:JIT+JITBUF+7   TCFU FOR OPNF
         LW,R8    Y002
         CW,R8    0,R6
         BAZ      CHKCFU
         LW,R12   X'D',R6           TCFU FOR CLS
         B        CHKCFU
*
USERCFU  LI,R14   MUSRCFU
         BAL,R15  PRINT
         LW,R3    R12               SAVE CFU ADDRESS
         LW,R8    TDA,R3
         STW,R8   VLP09             SAVE SOME DISC ADDRESSES
         LW,R8    FDA,R3
         STW,R8   VLP0C
         LW,R6    USERDCB
         LW,R8    BCDA,R6
         STW,R8   VLP0D
         LW,R8    DCBCDAM,R6
         STW,R8   LDAL
         BAL,R2   USRCFU            DUMP PRIMARY CFU
         LI,R12   X'FFFF'
         AND,R12  SCFU,R3           IS THERE AN SCFU
         BEZ      DUMP75            NO
         BAL,R2   USRCFU            DUMP THE SCFU
         LI,R12   X'FFFF'
         AND,R12  SCFU,R1           DOES THE SECONDARY HAVE SCFU POINTER
         BEZ      SCFUERR           NO - ERROR
         CW,R12   R3                YES - IS IT THE ORIGINAL CFU
         BE       DUMP75            YES
         BAL,R2   USRCFU            NO - DUMP IT
SCFUERR  LI,R14   MSCFUER
         BAL,R15  PRINT
         B        DUMP75
*
USRCFU   PUSH     3,R2
         LW,R1    R12
         LW,R14   R12
         LI,R13   8                 # WORDS
         BAL,R11  HEXDUMP           DUMP THE CFU
         LW,R8    2,R1              ACCOUNT/NAME POINTERS
         CW,R8    Y03
         BG       USRCFU9           * FILE
         INT,R8   2,R1
         CW,R9    ACNCFU+16
         BGE      USRCFU9           BAD NAME ADDRESS
         CW,R9    ACNCFU+15
         BL       USRCFU9           BAD NAME ADDRESS
         LW,R12   R9
         LB,R13   *R12
         AI,R13   1
         LCW,R13  R13               MAKE < 0 TO INHIBIT SPACING
         BAL,R11  HEXDUMPB
         LI,R11   DCBPRIVBIT
         CW,R11   *USERDCB
         BANZ     USRCFU9           NO ACCOUNT FOR PRIVATE
         SLS,R8   1                 WORD INDEX
         AW,R8    ACNCFU+13         ADDRESS OF ACCOUNT
         CW,R8    ACNCFU+15
         BG       USRCFU9           TOO BIG
         LW,R12   R8
         LI,R13   -8
         BAL,R11  HEXDUMPB
USRCFU9  PULL     3,R2
         B        0,R2
*
*  DUMP TABLE OF BAD DISC ADDRESSES
*
DUMP75   LI,R14   M75TABLE
         BAL,R15  PRINT
         LI,R12   75TABLE
         LI,R13   6
         LI,R14   -1
         BAL,R11  HEXDUMP
*
*  DUMP THE DCB
*
         LW,R2    USERDCB
         BLEZ     DUMPJIT           NO DCB
         LI,R14   MDCB
         BAL,R15  PRINT
         LW,R12   USERDCB
         LW,R14   DCBADR
         LI,R13   X'1FFFF'
         AND,R13  KBUF,R2
         AI,R13   8                 DCB ENDS 8 WORDS BEYOND KBUF
         SW,R13   R14
         AND,R13  M9                MAKE SURE DCB ISN'T TOO BIG
         BAL,R11  HEXDUMP
         LI,R14   MSPACE
         BAL,R15  PRINT
         LW,R14   BUFX,R2           GET BUFFER INDICES
         LI,R6    3                 # BUFFERS
BUFLOOP  LW,R4    BUFMES-1,R6       BA OF MESSAGE
         LW,R1    BUFCOL-1,R6
         BAL,R10  PUTMESC
         LI,R2    X'1F'
         AND,R2   R14               GET NEXT INDEX #
         SLS,R14  -5
         BAL,R10  MOVHEX
         BDR,R6   BUFLOOP
         BAL,R15  DUMPBUF
*
*  PRINT EXPLODED VIEW OF TSTACK
*
DUMPJIT  LI,R14   MXTSTK
         BAL,R15  PRINT
         LI,R4    BA(MXPUSH)
         BAL,R11  TMES              PUSHALL
         INT,R3   UTSTACK+1
         LW,R2    UTSTACK           TOP OF STACK
         AI,R2    JITBUF-J:JIT
         LW,R9    UTSTACK
MARKR    AI,R9    -1
         CW,R9    0,R2              SEARCH FOR TOP STACK MARKER
         BE       GOTMARK           FOUND IT
         AI,R2    -1
         BDR,R3   MARKR
STKERR   M:SNAP   'TSTACK',(JITBUF,AJITBUF+511)
         B        FREXIT
         SPACE    2
TMES     LI,R1    43                COLUMN #
         BAL,R10  PUTMESC
         LI,R10   'B'               VFC CHAR
         STB,R10  PRBUF
         PUSH     R3
         BAL,R15  DUMPBUF
         PULL     R3
         B        *R11
         SPACE    2
GOTMARK  LW,R12   R2
         AI,R12   -7
         LI,R13   8
         LI,R14   -1
         BAL,R11  HEXDUMP           DUMP PUSHALL
*
         LI,R4    BA(MXMISC)
         BAL,R11  TMES
         LW,R12   R2
         AI,R12   1                 NEXT WORD AFTER MARKER
         INT,R13  UTSTACK+1         # WORDS IN TSTACK
         SW,R13   R3                # WORDS AFTER MARDER
         AI,R13   -19-6
         BLZ      STKERR
         LI,R14   -1
         BAL,R11  HEXDUMP
*
         LI,R4    BA(MXERFIL)
         BAL,R11  TMES
         AW,R12   R13               INCR TO NEXT WORD
         LI,R13   6
         LI,R14   6
         BAL,R11  HEXDUMP
*
         LI,R4    BA(MXREG)
         BAL,R11  TMES
         AW,R12   R13
         LI,R13   19
         LI,R14   5
         BAL,R11  HEXDUMP
*
*  DUMP OSTACK
*
         INT,R6   UTSTACK+1
         AW,R6    R7                SIZE OF TSTACK
         LCW,R6   R6
         BGEZ     DMPJIT
         AI,R6    JTSTACKSZ         # WORDS IN OSTACK
         BLEZ     DMPJIT            NONE
         LI,R14   MOSTCK
         BAL,R15  PRINT
         CAL1,1   SPFPT             SINGLE SPACE
         LI,R7    UTSTACK+1+JTSTACKSZ  ADDRESS OF OLDEST ENTRY
OSTK     LW,R2    0,R7              GET NEXT ENTRY
         LB,R4    R2                OVERLAY #
         CI,R4    MAXOVLY-1
         BG       DMPJIT            ERROR
         SLS,R4   3                 BYTE INDEX INTO P:NAME
         AI,R4    BA(P:NAME)
         LI,R1    12                COL #
         BAL,R10  PUTMESC
         AND,R2   M17               ENTRY POINT ADDRESS
         BAL,R15  BIN2HEX
         LI,R1    25                COL #
         LI,R4    R12*4
         LI,R5    8                 # BYTES
         BAL,R10  PUTMES
         BAL,R15  DUMPBUF
         AI,R7    -1
         BDR,R6   OSTK
*
*  DUMP JIT IN HEX
*
DMPJIT   LI,R14   MJIT
         BAL,R15  PRINT
         LI,R12   JITBUF
         LI,R13   512
         LI,R14   J:JIT
         BAL,R11  HEXDUMP
*
*  DUMP DCB PAGES
*
         LI,R14   MDCBS
         BAL,R15  PRINT
         LB,R3    PAGE              # PAGES OF DCBS
         PUSH     R3                SAVE # DCB PAGES FOR LATER
         AI,R3    0
         BEZ      RDPOOLS           NONE
         LW,R12   DCBBEGIN          FIRST BUFFER PAGE
         LI,R13   512
RDDCBS1  LB,R14   PAGE,R3
         SLS,R14  9                 USER VIRTUAL PAGE
         BAL,R11  HEXDUMP
         AI,R12   512
         BDR,R3   RDDCBS1
*
*  READ FPOOL BUFFERS
*
RDPOOLS  LI,R2    BA(JB:FBUL)-BA(J:JIT)
         LB,R2    JITBUF,R2         HIGHEST LEGAL FPOOL VIRT PAGE
         STW,R2   POOLIMS+1         SAVE IT
         LW,R7    USER#
         LI,R0    POOLIMS
         BAL,R11  PGDISC            SET UP VIRT PAGE/DISC ADDR TABLE
         BAL,R11  RDPAGES           READ THE FPOOLS
         BNEZ     RDGRANS           ERROR
         LB,R3    PAGE
         BEZ      RDGRANS           NONE READ
         LW,R9    R5                SAVE BUFFER ADDRESS OF FIRST POOL
         LI,R7    JXBUFVP
RDPOOL10 LOAD,R10 JITBUF+JCMAP,R7   GET NEXT CMAP ENTRY
         CI,R10   X'20'
         BE       RDPOOL20          NO PAGE HERE
         LI,R4    BA(MPOOLS)
         BAL,R10  MOVTXTC
         LW,R2    R7
         AI,R2    1-JXBUFVP         BUFFER #
         BAL,R10  MOVHEX
         BAL,R15  DUMPBUF
         LW,R12   R9
         AI,R9    512
         LI,R13   512
         LI,R14   0
         BAL,R11  HEXDUMP
RDPOOL20 AI,R7    1
         CW,R7    POOLIMS+1
         BLE      RDPOOL10
*
*  READ SOME FILE GRANULES
*
RDGRANS  LI,R14   MGRANS
         BAL,R15  PRINT
         LI,R7    DCBPRIVBIT
         CW,R7    *USERDCB
         BAZ      RDG20             DCB IS PUBLIC
         LI,R0    0
         LI,R7    16
         STW,R0   DCTX-1,R7         ZERO VOL TO DCTX CONVERSION TABLE
         BDR,R7   %-1
         LW,R4    USERDCB           ADDR OF USER DCB
         LW,R7    VSND,R4
         LB,R7    R7                DISPL TO X'07' VLP
         AW,R7    FLP,R4            ADDR OF VLP
         SW,R7    DCBADR            CONVERT TO DCB DISPLACEMENT
         AW,R7    USERDCB           ADD DCB ADDRESS
         BAL,R11  DCTSET1           BUILD DCTX TABLE
*
RDG20    PULL     R4                # DCB PAGES
         LB,R3    PAGE              # FPOOL PAGES
         AW,R3    R4
         M:FP     *R3               RELEASE BUFFER PAGES
         LD,R0    DOUBLEZERO        ZERO SOME REGISTERS
         LD,R2    DOUBLEZERO
         LCI      4
         STM,R0   TEMP              CLEAR TEMP STORAGE
         STM,R0   TEMP+4
         STM,R0   TEMP+8
         STM,R0   TEMP+12
*
         LW,R8    VLP0C             FDA
         BAL,R10  ADDGRAN
         LW,R8    LDAL              DCBCDAM
         BAL,R10  ADDGRAN
         LW,R8    VLP0D             BCDA
         BAL,R10  ADDGRAN
         LW,R8    GAVALL            CDAM
         BAL,R10  ADDGRAN
         LW,R8    VLP09             TDA
         BAL,R10  ADDGRAN
*
         INT,R5   UTSTACK+1         # WORDS USED IN TSTACK
         AI,R5    -19               SKIP FINAL ENVIRONMENT
RDG30    LW,R8    UTSTACK+1,R5      LOOK FOR DISC ADDRESSES
         BAL,R10  ADDGRAN
         BDR,R5   RDG30
*  READ AND PRINT THE GRANULES
         LW,R9    TEMP+15           # GRANULES SAVED
         BLEZ     FREXIT            NONE
         LI,R6    0
RDG40    LI,R2    512               # WORDS TO READ
         LI,R7    AJITBUF           BUFFER
         LW,R8    TEMP,R6           GET DISC ADDRESS
         LDCTX,R1 R8
         LB,R1    DCTX,R1           CONVERT VOL # TO DCTX
         STDCTX,R1 R8
         BAL,R11  DRDWAIT           READ IT
         BNEZ     RDG50             ERROR
         LW,R2    R8
         BAL,R15  BIN2HEX           CONVERT DISC ADDRESS
         LI,R1    15                COL #
         LI,R4    R12*4
         LI,R5    8
         BAL,R10  PUTMES
         LDCTX,R2 TEMP,R6           VOL # OF THIS ENTRY
         CB,R2    DCTX,R2
         BE       RDG45             MUST BE PUBLIC
         LI,R1    29                COL #
         LI,R4    BA(MDCTX1)
         BAL,R10  PUTMESC
         LB,R2    DCTX,R2           GET DCTX
         BAL,R10  MOVHEX
RDG45    LI,R10   'B'
         STB,R10  PRBUF             VFC CHAR
         BAL,R15  DUMPBUF
         LI,R12   AJITBUF
         LI,R13   512
         LI,R14   0
         BAL,R11  HEXDUMP
RDG50    AI,R6    1
         BDR,R9   RDG40
*
*  DONE WITH THIS USER
*
FREXIT   LI,R7    63
         STB,R7   DCTX,R7           SET UP DCTX FOR PUBLIC
         BDR,R7   %-1
*
         BAL,R11  CHKUSER           VALIDATE USER #
         BCS,15   FREXIT1           USER HAS GONE
         LI,R5    0
         XW,R5    USER#
         LI,R6    E:WU
         BAL,R11  T:RUE             WAKE THE USER UP
*
FREXIT1  ENABLE                     ****  ENABLE
         LW,R11   SNAPFLAG
         BEZ      FREXIT5
         LI,R14   MPAGE
         BAL,R15  PRINT
*
         LI,R14   MEND
         LI,R6    15
         BAL,R15  PRINT
         BDR,R6   %-1
         CAL1,9   6
*
FREXIT5  EQU      %
         M:FVP    JITBUF
         M:FVP    AJITBUF
         M:FP     255
         PULL     R11
         B        FREPORT
         SPACE    2
FRNOPAGE LI,R14   MNOCORE
         BAL,R15  PRINT
         M:XXX
*
BADJIT   M:SNAP   'BAD JIT',(JITBUF,AJITBUF+511)
         SNAP     ' '               DUMP ALL DATA
         B        FREXIT
*
BADDCBS  SNAP     'BAD DCB'
         B        FREXIT
         SPACE    2
ADDGRAN  LI,R2    15
         AND,R8   M24
         BAL,R11  CHKDA
         BCR,15   *R10              BAD DA
         CW,R8    TEMP-1,R2         SEE IF ALREADY SAVED
         BE       *R10              YES
         BDR,R2   %-2
         LW,R2    TEMP+15
         CI,R2    15
         BGE      *R10              NO MORE ROOM
         STW,R8   TEMP,R2
         MTW,1    TEMP+15
         B        *R10
         SPACE    3
GETADDR  LW,R12   R5
         CI,R5    M:XX
         BNE      GETADD2
         AI,R12   JITBUF-J:JIT      RELOCATE IN JIT
         B        GETADDX
GETADD2  LB,R3    PAGE
         BEZ      GETADD4           NO DCB PAGES
         SLD,R12  -9
         CB,R12   PAGE,R3           SEARCH FOR PAGE
         BE       GETADD6
         BDR,R3   %-2
GETADD4  LI,R12   0                 NO SUCH PAGE
         B        *R11
GETADD6  LW,R12   DCBBEGIN
         SLS,R12  -9
         SW,R12   R3
         LB,R3    PAGE
         AW,R12   R3
         SLD,R12  9
GETADDX  AI,R12   0
         B        *R11
         SPACE    2
CHKUSER  LW,R7    USER#
         BLEZ     BADUSR
         CI,R7    SMUIS
         BG       BADUSR
         DISABLE                    ****  DISABLE
         LB,R8    UB:US,R7
         CI,R8    SW
         BNE      BADUSR
         LCI      0
         B        *R11
BADUSR   ENABLE                     ****  ENABLE
         LI,R7    0
         STW,R7   USER#
         LCI      15
         B        *R11
         TITLE    '****  PGDISC  ****'
         SPACE    2
*
*  PURPOSE:  BUILD TABLE TO CONVERT USER'S VIRTUAL ADDRESSES
*            TO SWAPPER DISC ADDRESSES.
*
*  INPUT:  R0 = ADDRESS OF DW PAIR OF VIRTUAL PAGE LIMITS
*          R7 = USER #
*
*  CALL:  BAL,R11 PGDISC
*
*  OUTPUT:  R3 = # PAGES FOUND
*           THE TABLES PAGE (BYTE TABLE OF VIRTUAL PAG NUMBERS) AND
*           DISC (WORD TABLE OF DISC ADDRESSES) ARE SET UP.  INDEX
*           0 INTO PAGE CONTAINS # USEFUL ENTRIES.
*
         SPACE    1
PGDISC   LI,R3    0
         LW,R2    UBSWAPI
         AI,R7    0
         BLZ      %+2               BR IF SPECIAL - USE INTERNAL TABLE
         LB,R2    UB:SWAPI,R7       SWAPPER TABLE INDEX
         LB,R6    JVLH+JITBUF       LMAP HEAD
         LI,R4    0
         LW,R5    JCLE+JITBUF
         AI,R5    -4
         DW,R4    =10
         LW,R1    R5
         SLS,R1   3
         AW,R1    R4
         AI,R1    4
         B        %+2
NEXTDA   LI,R4    6
         LW,R13   R4                SAVE # TIMES TO DO LOOP
         SLS,R4   -1
         LH,R14   JDA+JITBUF+:BIGX512,R5   GET NEXT DISC ADDRESS
         LB,R15   MB:GAM6,R2
         AI,R4    0
         BEZ      NEXTPGE
NXTDA0   AI,R14   2
         CS,R14   M:GASLIM,R2
         BLE      NXTDA1
         AW,R14   M:ADRINCR,R2
NXTDA1   BDR,R4   NXTDA0
NEXTPGE  CLM,R6   *R0               IS THIS PAGE DESIRED
         BCS,9    NXTPG1            NO
         AI,R3    1                 YES - INCR POINTER INTO TABLES
         STB,R6   PAGE,R3           PUT AWAY VIRTUAL PAGE #
         STW,R1   DISC,R3           AND SECTOR INDEX IF DP SWAPPER
         MTW,0    S:DP
         BNEZ     NXTDA2
         STW,R14  DISC,R3
         MTW,0    ZAPDUMP           IF COMING UP FROM ZAP
         BEZ      NXTDA2
         STB,R13  ZAPDUMP
NXTDA2   RES
         CI,R3    27
         BGE      NXTPG2            TOO MANY ENTRIES IN TABLE - STOP
*
NXTPG1   AI,R14   -2
         CS,R14   M:GASLIM,R2
         BL       NXTPG1A
         SW,R14   M:ADRINCR,R2
NXTPG1A  AI,R1    -2
         LB,R6    JLMAP+JITBUF,R6     GET NEXT PAGE FROM LMAP
         BEZ      NXTPG2            NO MORE
         AI,R13   -2
         BGEZ     NEXTPGE           STILL MORE GRANULES IN GROUP
         AI,R5    -1
         BGEZ     NEXTDA            GET NEXT GRANULE GROUP
*
NXTPG2   STB,R3   PAGE              SAVE # USED ENTRIES
         AI,R3    0
         BEZ      *R11              EXIT IF NOTHING FOUND
         PUSH     R11               CONVERT ENTRIES IN DISC TO
         LW,R8    S:DP                RELATIVE SECTOR/DCT INDEX FORMAT
         BNEZ     NXTPG5            BR IF PACK SWAPPER
*  RAD SWAPPER - ENTRIES IN DISC ARE PHYSICAL SEEK ADDRESSES
NXTPG3   LW,R8    DISC,R3
         BAL,R11  SEEKCONV          CONVERT IT
         STW,R8   DISC,R3
         BDR,R3   NXTPG3
NXTPG4   PULL     R11
         LB,R3    PAGE
         B        *R11
*
*  PACK SWAPPER - DISC CONTAINS SECTOR INDEX INTO USER'S CYLINDER
NXTPG5   LW,R8    UBC#
         AI,R7    0
         BLZ      %+2               IF SPECIAL, USE INTERNAL TABLE
         LB,R8    UB:C#,R7          CYL # FOR THIS USER
         SLS,R8   16                FORM PHYSICAL SEEK ADDRESS
         BAL,R11  SEEKCONV          CONVERT TO RELATIVE SECTOR
         LDCTX,R1 R8                DCT INDEX
NXTPG6   LW,R8    R9                REFRESH RELATIVE SECTOR OF CYL
         AW,R8    DISC,R3           ADD SECTOR DISPLACEMENT
         CI,R8    X'10000'          SPLIT SECTOR FIELD IF NECESSARY
         BAZ      %+2
         OR,R8    Y008
         CI,R8    X'20000'
         BAZ      %+2
         OR,R8    Y004
         STDCTX,R1  R8              ADD DCT INDEX
         STW,R8   DISC,R3
         BDR,R3   NXTPG6
         B        NXTPG4
         TITLE    '****  RDJIT  ****'
         SPACE    2
*
*  PURPOSE:  READ A JIT AND AJIT AND VERIFY THE JIT
*
*  INPUT:  R7 = USER #
*          R8 = JIT DISC ADDRESS (SEEK ADDRESS)
*          R9 = AJIT DISC ADDRESS (ZERO IF NO AJIT)
*
*  CALL:  BAL,R11  RDJIT
*
*  OUTPUT:  R15 = 0  OK
*               = 1  I/O ERROR
*               = 2  BAD DISC ADDRESS
*               = 3  BAD JIT
*
         SPACE    1
RDJIT    PUSH     R11
         PUSH     R8                SAVE JIT SEEK ADDR
         PUSH     R7                SAVE USER #
         LW,R1    R9                SAVE AJIT DISC ADDRESS
         BAL,R11  SEEKCONV          CONVERT JIT DA TO DCT/REL SECT
         LI,R2    512               # WORDS TO READ
         LI,R7    JITBUF            ADDRESS TO READ INTO
         BAL,R11  ZAPINC            READ FROM WHEREITIS
         BNEZ     RDJXIT            ERROR
         LW,R8    R1                RESTORE AJIT DISC ADDRESS
         BEZ      RDJ10             NO AJIT
         MTW,0    ZAPDUMP           IF IN DUMPFILE
         BNEZ     RDJ10             THERE'S NO AJIT
         LW,R7    *SPD              RESTORE USER #
         BAL,R11  SEEKCONV
         LI,R7    AJITBUF
         BAL,R11  DRDWAIT
         BNEZ     RDJXIT            ERROR
*
RDJ10    LI,R15   3                 ASSUME JIT BAD
         LW,R4    UTSTACK           TOP OF STACK POINTER
         LI,R5    1
         LH,R5    UTSTACK+1,R5      GET # WORDS USED
         BLZ      RDJXIT            ERROR
         SW,R4    R5                TOP MINUS # WORDS USED MUST
         CI,R4    TSTACK+1            BE THE EMPTY TOP OF STACK
         BNE      RDJXIT
         LH,R4    UTSTACK+1         # WORDS REMAINING
         BLZ      RDJXIT            CAN'T BE NEGATIVE
         LI,R15   0                 EVERYTHING OK
RDJXIT   PULL     R7
         PULL     R8
         PULL     R11
         AI,R15   0
         B        *R11
         TITLE    '****  RDPAGES  ****'
         SPACE    2
*
*  PURPOSE:  READ USER PAGES GIVEN A JIT AND VIRTUAL PAGE LIMITS
*
*  INPUT:  PAGE AND DISC TABLES SET UP BY PGDISC
*
*  CALL:  BAL,R11 RDPAGES
*
*  OUTPUT:  R4 = FIRST USER VIRTUAL WORD ADDRESS
*           R5 = FIRST BUFFER ADDRESS
*           R15 = 0  NO ERRORS
*               = 1  I/O ERROR
*               = 2  BAD DISC ADDRESS
*               = 3  CAN'T GET ENOUGH PAGES
*
         SPACE    1
RDPAGES  PUSH     R11
         LI,R15   0                 ASSUME NO ERRORS
         LB,R3    PAGE              # PAGES TO READ
         BEZ      RDPXIT            NONE
         M:GP     *R3               GET THE PAGES
         CW,R8    R3
         BNE      RDPXIT1           DIDN'T GET ALL OF THEM
         LW,R5    R9                SAVE FIRST BUFFER ADDRESS
*
RDP10    LI,R2    512               # WORDS TO READ
         LW,R7    R9                BUFFER ADDRESS
         LW,R8    DISC,R3           DISC ADDRESS
         BAL,R11  ZAPINC            READ FROM WHEREITIS
         BNEZ     RDPXIT            ERROR
         AI,R9    512
         BDR,R3   RDP10
*
         LB,R3    PAGE
         LB,R4    PAGE,R3           FIRST VIRTUAL PAGE
         SLS,R4   9
RDPXIT   PULL     R11
         AI,R15   0
         B        *R11
*
RDPXIT1  M:FP     *R8               GIVE BACK ANY GOTTEN
         LI,R15   3
         B        RDPXIT
         PAGE
*
*  PURPOSE:  READ NEXT GRANULE FROM DUMPFILE IF ITS THERE
*            THEN INCREMENT ZAPDUMP TO THE NEXT ONE
*
*  INPUT:  ZAPDUMP = NEXT DISCADDR OR ZERO IF DA IN R8
*
*  CALL:  BAL,R11  ZAPINC
*
*  RETURNS THROUGH DRDWAIT AFTER INCREMENTING ZAPDUMP
*
ZAPINC   RES
         MTW,0    ZAPDUMP
         BEZ      DRDWAIT           NOT IN DUMPFILE
         LW,R8    ZAPDUMP
         BAL,R2   INCREMENT%SECTOR  INCR TO NEXT
         XW,R8    ZAPDUMP           FOR NEXT TIME
         LI,R2    512               RESTORE READ SIZE
         B        DRDWAIT
         TITLE    '****  SEEKCONV  ****'
         SPACE    2
*
*  PURPOSE:  CONVERT PHYSICAL SEEK ADDRESS TO DCT/REL SECTOR
*
*  INPUT:  R7 = USER #
*          R8 = PHYSICAL SEEK ADDRESS
*
*  CALL:  BAL,R11  SEEKCONV
*
*  OUTPUT:  R8 = DCT/REL SECTOR
*           R9 = RELATIVE SECTOR
*
         SPACE    1
SEEKCONV PUSH     7,R1
         LW,R4    UBSWAPI
         AI,R7    0
         BLZ      %+2               BR IF SPECIAL - DON'T LOOK AT USER
         LB,R4    UB:SWAPI,R7       SWAP DEVICE INDEX
         LB,R1    MB:SDI,R4         DCT INDEX
         LB,R4    DCT22,R1          DISC TYPE
         LW,R3    R8                MOVE INPUT DISC ADDRESS
         AND,R3   M24
         LI,R9    0
         LI,R6    48                ASSUME RAD
         LW,R2    NCYL,R4           # CYLINDERS ON DEVICE
         BEZ      TRK%CVT           NONE - MUST BE RAD
*
         LI,R2    0
         LI,R5    32                SHIFT OFFSET FOR PACK
         LI,R6    X'7F'
         AND,R6   CYL%SHFT,R4       GET CYL SHIFT FACTOR
         SW,R5    R6                RK = CYL SIZE
         SLD,R2   0,R5              R2=CYL # RIGHT JUSTIFIED
         LW,R9    R2
         MW,R9    NSPC,R4           # CYLS * NSPC = # SECTORS
         LI,R2    0
*
TRK%CVT  LI,R5    X'7F'
         AND,R5   TRK%SHFT,R4       TRACK SHIFT FACTOR
         SW,R6    R5
         SLD,R2   0,R6              R2 = TRACK ADDRESS
         LI,R6    X'7F'
         AND,R6   SEC%SHFT,R4       SECTOR SHIFT FACTOR
         SW,R5    R6
         SCS,R3   0,R5              RIGHT JUSTIFY SECTOR FIELD
         AW,R9    R3
         LW,R3    R2
         MW,R3    NSPT,R4           CONVERT TRACKS TO SECTORS
         AW,R9    R3                GRAND TOTAL IN SECTORS
         LW,R8    R9
         CI,R8    X'10000'          SPLIT THE SECTOR FIELD
         BAZ      %+2
         OR,R8    Y008
         CI,R8    X'20000'
         BAZ      %+2
         OR,R8    Y004
         LW,R2    R1                DCT INDEX
         LI,R3    X'3F'
         SLD,R2   16
         STS,R2   R8
         PULL     7,R1
         B        *R11
         TITLE    '****  KEYIN  ****'
         SPACE    2
*
*  PURPOSE:  ISSUE KEYIN SEQUENCE TO OPERATOR'S CONSOLE
*
*  INPUT:  R4 = BA OF MESSAGE TO SEND
*
*  CALL:  BAL,R11  KEYIN
*
*  OUTPUT:  OCIOCNT = NUMBER OF READ REQUESTS OUTSTANDING
*           INBUF = RECORD READ (BTD = 1)
*           INCNT = NUMBER OF BYTES READ (EXCLUSIVE OF ACTIVATION CHAR)
*
         SPACE    1
KEYIN    PUSH     R11
         LB,R14   0,R4              # BYTES IN MESSAGE
         LW,R13   R4                BA OF MESSAGE
         AI,R13   1                 SKIP TEXTC COUNT
         LI,R12   OCDCT             DCT INDEX OF OC
         LI,R7    XOCWRT            SPECIAL BUFFER CODE
         LI,R2    1                 FUNCTION CODE (WRITE)
         BAL,R11  IOQUEUE           QUEUE THE I/O
*
         LI,R14   OCRDCNT           BYTE COUNT FOR READ
         LI,R13   BA(INBUF)+1       BA OF BUFFER
         LI,R7    XOCRD             SPECIAL BUFFER CODE
         LI,R2    0                 FUNCTION CODE (READ)
         MTW,1    OCIOCNT           INCR # READS OUTSTANDING
         PULL     R11
         B        IOQUEUE           QUEUE IT THEN RETURN TO CALLER
         SPACE    3
*
*  ISSUE M:KEYIN SEQUENCE TO OPERATOR'S CONSOLE AND WAIT FOR
*  REPLY TO BE RECEIVED.
*
*  INPUT:  R4 = BA OF MESSAGE TO SEND.  REPLY READ INTO INBUF WITH
*              BYTE DISPLACEMENT OF 1.
*  OUTPUT:  R2 = FIRST CHAR INPUT, CC FROM CI,R2 'Y'
*
OCKEYIN  PUSH     R11
         BAL,R11  KEYIN             ISSUE WRITE AND READ
OCK10    DISABLE                    ****  DISABLE
         LW,R11   OCIOCNT           HAS READ FINISHED
         BEZ      OCK20             YES
         M:WAIT   10                NO
         B        OCK10
OCK20    ENABLE                     ****  ENABLE
         PULL     R11
         LI,R2    1
         LB,R2    INBUF,R2
         CI,R2    'Y'
         B        *R11
         SPACE    3
OCMESS   LB,R14   0,R4              TEXTC COUNT
         LW,R13   R4
         AI,R13   1                 BA OF MESSAGE
         LI,R2    1                 FCN CODE FOR WRITE
         LI,R7    XOCWRT            SPECIAL BUFFER CODE FOR OC WRITE
         LI,R12   OCDCT             DCT INDEX
         B IOQUEUE                  QUEUE THE I/O
         TITLE    '****  PUBHGPS  ****'
         SPACE    2
*
*  PURPOSE:  BUILD ONE COPY OF PUBLIC HGPS
*
*  CALL:  BAL,R11  PUBHGPS
*
*  OUTPUT:  PUBLIC HGPS BUILT STARTING AT 'HGP2'.  PRIVATE HGPS
*           AND THOSE WITH NO PER OR PFA WILL BE SKIPPED.
*           RETURN SKIPPING IF ENOUGH CORE AVAILABLE.
*
         SPACE    1
PUBHGPS  PUSH     R11
         LI,R7    0
         STW,R7   GETNXT            INDICATE NO PAGES GOTTEN YET
         STW,R7   NXTHGP
         STW,R7   #PAGES1           NO PAGES GOTTEN YET
         LI,R7    HGP               ADDRESS OF HGP HEADERS
         LW,R11   BOOTFLG
         BEZ      PRIVHGPS          SYSTEM UP - MUST BE PRIVATE
HGPLOOP  LW,R2    1,R7
         CI,R2    ATPRIVBIT
         BANZ     HGPNXT            PRIVATE - SKIP
         SLS,R2   -16
         AND,R2   M8                DCT INDEX
         LB,R3    DCT22,R2          DISK TYPE
         BEZ      HGPNXT            NOT DISK - IGNORE
         LW,R9    4,R7              # PER AND PFA WORDS
         BEZ      HGPNXT            NONE - SKIP IT
         LI,R15   1
         BAL,R11  BLDHGP            BUILD ONE HGP
         B        HGPERR            NOT ENOUGH CORE
*
HGPNXT   LW,R2    NXTHGP
         SW,R2    HGP2              # WORDS OF HGPS GENERATED
         AI,R2    -HGPSIZE
         BGZ      HGPBIG            TOO BIG FOR ALLOCAT DATA
         LW,R7    0,R7              OK - SEE IF MORE TO DO
         BNEZ     HGPLOOP           YES
         LW,R2    GETNXT
         SW,R2    NXTHGP            # WORDS TO END OF CURRENT PAGE
         BLEZ     HGPNXT8           NONE
HGPNXT4  STW,R7   *NXTHGP           ZERO REMAINING SPACE IN PAGE
         MTW,1    NXTHGP
         BDR,R2   HGPNXT4
HGPNXT8  PULL     R11
         AI,R11   1
         LW,R2    #PAGES1           # PAGES ALLOCATED FOR THIS SET
         AWM,R2   #PAGES            INCREMENT TOTAL
         B        *R11
*
HGPERR   LI,R11   0
         STW,R11  HGP2
         XW,R11   #PAGES1           FREE ANY PAGES GOTTEN
         M:FP     *R11              FREE ANY PAGES GOTTEN
         PULL     R11
         B        *R11              ERROR RETURN
         SPACE    2
*
*  BUILD ONE SET OF PRIVATE PACK HGPS
*
PRIVHGPS LI,R3    1                 CURRENT INDEX INTO DCTX TABLE
PRIVH10  LI,R4    5
         LI,R7    HGP
         LB,R5    DCTX,R3           NEXT DCT INDEX
         BEZ      HGPNXT8           DONE
PRIVH20  CB,R5    *R7,R4
         BE       PRIVH30           LOCATE HGP
         LW,R7    0,R7
         BNEZ     PRIVH20
         SNAPX    'PRIV ERR'
PRIVH30  STW,R3   CMDL              SAVE INDEX
         LI,R15   2
         AI,R5    -BATAPE           CNVRT DCTX TO AVRTBL INDEX
         LH,R8    AVRNOU,R5         # USERS OF PACK
         CI,R8    2                 SHOULD BE 2 (1 FOR USER, 1 FOR DCB)
         BNE      HGPERR            NO - SOMEONE ELSE IS HERE TOO
         LW,R8    S:CUN
         AI,R8    X'4000'
         STH,R8   AVRID,R5          MAKE THIS USER EXCLUSIVE
         BAL,R11  BLDHGP            BUILD THE HGP
         B        HGPERR            ERROR
         LW,R3    CMDL              RESTORE INDEX
         AI,R3    1
         B        PRIVH10
         SPACE    3
HGPBIG   LI,R4    BA(MHGPBIG)
         BAL,R11  OCMESS            TELL THE OPERATOR
         B        INITERR
*O*      MESSAGE: HGPS TOO BIG FOR ALLOCAT'S DATA
*O*      ACTION:  NONE - INITIALIZATION HALTS AUTOMATICALLY
*O*      MEANING: THE SYSGEN DID NOT ALLOCATE ENOUGH SPACE IN ALLOCAT'S
*O*               HGPS FOR THE DEVICES GEN'ED. COULD BE A PATCH TO
*O*               THE DEVICE TABLES CHANGING DCT22, DISCLIMS, OR THE
*O*               CYLINDER SIZE FOR SO-ALLOCATED DEVICES.
         TITLE    '****  BLDHGP  ****'
         SPACE    2
*
*  PURPOSE:  BUILD ONE HGP HEADER AND BIT MAP
*
*  INPUT:  R7 = ADDRESS OF HGP HEADER
*
*  CALL:  BAL,R11  BLDHGP
*
*  OUTPUT:  ADDRESS OF FIRST WORD PAST HGP IN NXTHGP.
*
*  HGP HEADER FORMAT:
*
*      WORD
*        0        LINK TO NEXT HGP
*        1        0,DCTX,TYPE,NGC   (8,8,8,8)
*        2        FIRST PER SECTOR (ZERO IF NO PER)
*        3        FIRST PFA SECTOR (# SECTORS ON DEVICE IF NO PFA)
*        4        FIRST SECTOR BEYOND END OF DEVICE
*        5        # PER WORDS, DISPL TO PER BIT MAP  (16,16)
*                     IF PRIVATE, NAVAT
*        6        # PFA WORDS, DISPL TO PFA BIT MAP  (16,16)
*
         SPACE    1
GETNXT   EQU      TEMP+15
CURHGP   EQU      TEMP+14
BLDHGP   EQU      %
         LW,R8    GETNXT            ADDRESS OF FIRST UN-ALLOCATED WORD
         BNEZ     BLDH10            NOT FIRST CALL
         STW,R8   CURHGP
         STW,R8   PREVHGP
         LI,R4    0                 MAKE BLDGET1 GET ONLY 1 PAGE
         LI,R5    0
         LI,R12   0
         BAL,R10  BLDGET1           ALLOCATE A PAGE
         BEZ      BLDH90
         AI,R9    -512
         STW,R9   NXTHGP            ADDRESS OF FIRST WORD
         STW,R9   HGP2
*
BLDH10   LI,R8    0
         XW,R8    NXTHGP            RIPPLE DOWN HGP ADDRESSES
         XW,R8    CURHGP
         STW,R8   PREVHGP
         LW,R4    CURHGP            ADDRESS OF CURRENT HGP
         LI,R5    0                 CURRENT HGP DISPLACEMENT
         LI,R12   7                 INSURE THAT THERE ARE 7
         BAL,R10  BLDGET              WORDS REMAINING
         BEZ      BLDH90            OUT OF PAGES
*
         LI,R8    0                 LINK TO NEXT HGP
         STW,R8   0,R4
         STW,R8   5,R4              ZERO PER AND PFA POINTERS
         STW,R8   6,R4
         LW,R9    1,R7
         CI,R9    ATCYLBIT
         BANZ     BLDH12            BR IF CYL ALLOCATED
         AND,R9   YFFFFFF           GRANULE - FORCE # GRAN/CYL TO 1
         AI,R9    1
BLDH12   STW,R9   1,R4
         STW,R4   *PREVHGP          LINK PREVIOUS HGP TO THIS ONE
         INT,R9   6,R7              PFA FIRST SECTOR INTO
         STW,R9   2,R4              PER FIRST SECTOR AND
         STW,R9   3,R4              PFA FIRST SECTOR
         LI,R2    5
         LB,R2    *R4,R2            DCT INDEX
         LB,R3    DCT22,R2          DISC TYPE
         LW,R15   DISCLIMS,R3       # SECTORS ON DEVICE
         STW,R15  4,R4              FIRST SECTOR BEYOND DEVICE
*
*  BUILD PER MAP
*
         LI,R5    7                 CURRENT INDEX INTO HGP
         LI,R2    8
         LH,R14   *R7,R2            # WORDS IN PER MAP
         BEZ      BLDH30            NO PER
         INT,R9   5,R7              PER FIRST SECTOR
         STW,R9   2,R4              INTO PER FIRST SECTOR
         INT,R9   6,R7              PFA FIRST SECTOR
         INT,R3   4,R7              # PFA WORDS
         AI,R3    0
         BNEZ     BLDH20
         LW,R9    R15               NO PFA - END OF PER IS END OF DEVICE
BLDH20   STW,R5   5,R4              WORD INDEX TO PER BIT MAP
         LW,R8    2,R4              PER FIRST SECTOR
         STW,R9   3,R4              PER LAST SECTOR
         BAL,R15  BLDMAP            BUILD PER MAP
         B        BLDH90            NOT ENOUGH CORE
         LI,R2    10
         STH,R14  *R4,R2            SET # WORDS USED IN BIT MAP
*
*  BUILD PFA
*
BLDH30   EQU      %
         LI,R2    9
         LH,R14   *R7,R2            # PFA BIT MAP WORDS
         BEZ      BLDH40            NONE - NO PFA
         STW,R5   6,R4              WORD INDEX TO PFA BIT MAP
         LW,R8    3,R4              PFA FIRST SECTOR
         LW,R9    4,R4              PFA LAST SECTOR
         BAL,R15  BLDMAP            BUILD THE PFA BIT MAP
         B        BLDH90            NOT ENOUGH CORE
         LI,R2    12
         STH,R14  *R4,R2            SET # WORDS USED IN BIT MAP
*
BLDH40   EQU      %
         LW,R8    =X'80000003'
         LW,R9    1,R7
         CI,R9    ATPRIVBIT
         BAZ      %+2
         STW,R8   5,R4              INIT NVAT IF PRIVATE
         LI,R12   1
         BAL,R10  BLDGET            INSURE 1 WORD REMAINS
         BEZ      BLDH90            NOT ENOUGH ROOM
         AW,R4    R5                POINT TO FIRST WORD PAST BIT MAP
         STW,R4   NXTHGP            ADDRESS OF NEXT HGP
         AI,R11   1
         B        *R11              NORMAL EXIT
*
BLDH90   EQU      %
         LI,R15   1
         B        *R11              NOT ENOUGH CORE
         TITLE    '****  BLDMAP  ****'
         SPACE    2
*
*  PURPOSE:  BUILD ONE BIT MAP SEGMENT
*
*  INPUT:  R5 = INDEX INTO HGP OF START OF BIT MAP
*          R4 = ADDRESS OF HGP
*          R8 = FIRST RELATIVE SECTOR
*          R9 = LAST RELATIVE SECTOR
*
*  CALL:  BAL,R15  BLDMAP
*
*  OUTPUT:  R5 = INDEX OF FIRST WORD PAST BIT MAP
*           R14 = # WORDS IN BIT MAP
*        RETURNS SKIPPING IF ENOUGH CORE IS AVAILABLE
*
         SPACE    1
BLDMAP   SW,R9    R8
         SLS,R9   -1                # GRANULES
         LW,R2    1,R4
         CI,R2    ATCYLBIT
         AND,R2   M8                MASK OFF # GRAN/CYL
         BAZ      %+2               NOT CYL
         DW,R9    R2                CONVERT # GRANULES TO # CYLS
*  R9 = # BITS IN BIT MAP
         LW,R12   R9
         SLD,R12  -5                R12 = # FULL WORDS IN BIT MAP
         SLS,R13  -27               R13 = # BITS IN LAST WORD
         AI,R13   0
         BEZ      %+2               IF PARTIAL WORD, INCR # WORDS
         AI,R12   1
         BAL,R10  BLDGET
         BEZ      *R15              NOT ENOUGH CORE
         LW,R14   R12               # FULL WORDS
         LI,R2    0
         STW,R2   *CURHGP,R5        ZERO THE HGP
         AI,R5    1
         BDR,R12  %-2
         AI,R15   1                 NORMAL EXIT
         B        *R15
         SPACE    4
*
*  INSURE ENOUGH PAGES HAVE BEEN ALLOCATED.
*
*  R4 = HGP ADDRESS
*  R5 = CURRENT DISPLACEMENT
*  R12 = # WORDS TO BE ADDED
*
BLDGET   LW,R8    R12
         AW,R8    R5
         AW,R8    R4                R8 = FIRST WORD BEYOND
         CW,R8    GETNXT
         BL       *R10              OK
BLDGET1  M:GP     1                 GET ONE PAGE
         CI,R8    1
         BNE      BLDGET2           CAN'T GET THE PAGE
         AI,R9    512
         STW,R9   GETNXT
         MTW,1    #PAGES1           INCR # PAGES GOTTEN
         B        BLDGET
BLDGET2  LCI      0
         B        *R10
         TITLE    '****  ALLOCG/ALLOCS  ****'
         SPACE    2
*
*  PURPOSE:  ALLOCATE A GRANULE OR CYLINDER IN HGPS
*
*  INPUT:  R8 = DISC ADDRESS
*
*  CALL:  BAL,R11  ALLOCG           ALLOCATE PFA GRANULE OR CYLINDER
*         BAL,R11  ALLOCS           ALLOCATE SYMBIONT GRANULE
*
*  OUTPUT:  R15 = ERROR CODE
*                    0 = NO ERRORS
*                    ERR#51 = NO HGP FOR DCT INDEX
*                    ERR#52 = RELATIVE SECTOR NOT WITHIN LIMITS OF HGP
*                    ERR#53 = DUALLY ALLOCATED IN HGP1
*                    ERR#54 = DUALLY ALLOCATED IN HGP2
*           CC = 1---  BAD DISC ADDRESS (ERR#51 OR ERR#52)
*              = ---1  DUALLY ALLOCATED IN HGP1 (ERR#53)
*              = --1-  DUALLY ALLOCATED IN HGP2 (ERR#54)
*              = -1--  NOT MASTER OF CYLINDER
*
         SPACE    1
ALLOCG   LI,R6    4                 FLAG FOR PFA
         B        %+2
ALLOCS   LI,R6    3                 FLAG FOR PER
         LI,R15   0                 NO ERRORS YET
ALLOCKD  LCI      15
         STM,R0   TEMP              SAVE ALL REGISTERS
         STW,R8   BADDA             SAVE DISC ADDRESS IN CASE IT'S BAD
         LW,R1    HGPRFLAG
         BEZ      ALLOCXIT          EXIT IF NOT HGP RECON
         LDCTX,R1 R8                DCT INDEX OF GRANULE
         LB,R1    DCTX,R1           CONVERT VOL # TO DCT INDEX
         BAL,R5   FNDHGP            LOCATE HGP
         B        ALLOC40           CAN'T FIND IT - BAD DISC ADDRESS
         BAL,R5   FNDBIT            LOCATE BIT IN BITMAP
         B        ALLOC50           RELATIVE SECTOR OUT OF RANGE
         CI,R15   X'100'
         BANZ     ALLOGKD           BR IF NON-MASTER KEYED FILE DATA
         LW,R5    1,R7
         CI,R5    ATCYLBIT
         BAZ      ALLOG10           NOT CYLINDER ALLOCATED
         CW,R15   Y4
         BAZ      ALLOG10           MASTER OF CYLINDER
ALLOGKD  CW,R3    *HGPDISP,R2       CHECK AGAINST CURRENT HGP COPY
         BANZ     ALLOCXIT          ALREADY THERE - OK
         CW,R3    0,R2              CHECK AGAINST MASTER HGP
         BANZ     ALLOC10           ERROR
         STB,R4   R2
         LW,R5    CURDATA
         BLEZ     ALLOG08           NONE IN BUFFER
         LW,R6    DATADA            SEE IF THIS ONE IS
         AI,R6    -1                  ALREADY THERE
         CW,R2    *R5,R6
         BE       ALLOCXIT          YES IT IS
         BDR,R5   %-2
ALLOG08  LW,R5    CURDATA           ADD IT TO TABLE
         CW,R5    DATAMAX
         BGE      ALLOCXIT          NO MORE ROOM
         STW,R2   *DATADA,R5        SAVE IT
         MTW,1    CURDATA
         B        ALLOCXIT
*
ALLOG10  STB,R4   R2
         LW,R5    CURDATA
         BLEZ     ALLOG30           NONE SAVED
         LI,R6    0
         CW,R2    *DATADA,R6        SEE IF THIS DA IS IN LIST
         BE       ALLOG20
         AI,R6    1
         BDR,R5   %-3
         B        ALLOG30           NOT IN LIST
ALLOG20  LW,R4    R6                REMOVE FROM LIST
         MTW,-1   CURDATA           DECR # IN BUFFER
ALLOG22  AI,R4    1
         CW,R6    CURDATA
         BGE      ALLOG30
         LW,R8    *DATADA,R4
         STW,R8   *DATADA,R6        SHUFFLE DOWN LIST
         AI,R6    1
         B        ALLOG22
*
ALLOG30  CW,R3    0,R2              CHECK IF ALLOCATED IN MASTER HGP
         BANZ     ALLOC10           YES
         CW,R3    *HGPDISP,R2       CHECK OTHER HGP COPY
         BANZ     ALLOC20
         CW,R15   Y4                IS IT NOT MASTER OF CYLINDER
         BANZ     ALLOCXIT          YES - DON'T SET BIT
         STS,R3   0,R2              ALLOCATE IN BOTH HGPS
         STS,R3   *HGPDISP,R2
         LI,R3    X'FF'
         AND,R3   1,R7              # GRANULES/CYLINDER
         AWM,R3   #GRAN             INCR SIZE OF FILE
*
ALLOCXIT RES
         LW,R8    TEMP+8            RESTORE DISC ADDRESS
         LSECTA,R3  R8
         LI,R2    0
         SLS,R3   -1                IN GRANULES
         DW,R2    GAVALC            DIVIDE BY SIZE OF GAVAL'S CYLS
         LI,R9    X'FFFF'           PUT CYL# IN 8
         LS,R8    R3
         LW,R9    M22               IS THIS THE SAME CYLINDER
         CS,R8    GAVALL
         BNE      %+4               NO
         CB,R2    GAVALL            IS IT THE LAST SO FAR
         BLE      %+2
         STB,R2   GAVALL
         LCI      15
         LM,R0    TEMP              RESTORE REGISTERS
         STW,R15  ERRCODE
         LC       R15               EXIT CONDITION CODES
         B        *R11
*
ALLOC10  LW,R15   =X'10000000'+ERR#53    ERROR CODE PLUS CC = 0001
         B        ALLOCXIT
*
ALLOC20  LW,R15   =X'20000000'+ERR#54  ERROR CODE PLUS CC = 0010
         B        ALLOCXIT
*
ALLOC40  LI,R15   ERR#51
         B        %+2
ALLOC50  LI,R15   ERR#52
         OR,R15   Y8                SET BAD DISC ADDRESS FLAG
         B        ALLOCXIT
         TITLE    '****  FNDHGP/FNDHGP1  ****'
         SPACE    2
*
*  PURPOSE:  LOCATE AN HGP GIVEN A DCT INDEX
*
*  INPUT:  R1 = DCT INDEX
*          R7 = FIRST HGP ADDRESS (FNDHGP1 ONLY)
*
*  CALL:  BAL,R5  FNDHGP            SEARCH HGP CHAIN POINTED TO BY HGP1
*         BAL,R5  FNDHGP1           SEARCH HGP CHAIN POINTED TO BY R7
*
*  OUTPUT:  R7 = HGP ADDRESS
*           RETURNS SKIPPING IF HGP FOUND
*
         SPACE    1
FNDHGP   LW,R7    HGP1
FNDHGP1  LI,R2    5                 BYTE DISPL OF DCT INDEX
         STW,R2   PREVHGP
FNDHGP2  CB,R1    *R7,R2
         BE       1,R5              FOUND IT
         STW,R7   PREVHGP           SAVE ADDRESS OF PREVIOUS HGP
         LW,R7    0,R7              LINK TO NEXT HGP
         BNEZ     FNDHGP2
         B        0,R5              NO MORE
         TITLE    '****  FNDBIT  ****'
         SPACE    2
*
*  PURPOSE:  GIVEN A DISC ADDRESS, FIND THE BIT IN AN HGP
*
*  INPUT:  R6 = 3 IF PER, 4 IF PFA
*          R7 = HGP ADDRESS
*          R8 = DISC ADDRESS
*
*  OUTPUT:  R2 = ADDRESS OF WORD CONTAINING BIT
*           R3 = BIT MASK
*
         SPACE    1
FNDBIT   LSECTA,R3  R8              RELATIVE SECTOR
         LW,R4    BOOTFLG
         BNEZ     FNDBIT1           BR IF PUBLIC HGP RECON
         CI,R3    60                IS DISC ADDR IN NVAT
         BGE      FNDBIT1           NO
*  RELEASE INTO NVAT
         SLS,R3   -1                GRANULE #
         LW,R2    PREVHGP           ADDRESS OF PREVIOUS HGP
         CI,R2    20
         BLE      ALLOCXIT          EXIT IF THIS IS FIRST HGP
         AI,R2    5                 POINT TO NVAT WORD
         LCW,R4   R3
         LW,R3    BT31TO0+32,R4     GET CORRECT BIT
         B        ALLOG30           ALLOCATE IT
*
FNDBIT2  AI,R6    1                 IF NOT PER, TRY PFA
         CI,R6    4
         BG       0,R5              NO GOOD ANYWHERE
FNDBIT1  CW,R3    *R7,R6            COMPARE WITH MAX REL SECT
         BGE      FNDBIT2           TOO BIG HERE
         AI,R6    -1
         SW,R3    *R7,R6            SUBTRACT BEGINNING REL SECTOR
         BLZ      0,R5              REL SECT TOO SMALL
         SLS,R3   -1                GRANULE INDEX INTO BIT MAP
         LW,R4    1,R7
         CI,R4    ATCYLBIT          IS THIS CYLINDER ALLOCATED
         BAZ      FNDB20            NO
         AND,R4   M8                # GRAN/CYL
         LI,R2    0
         DW,R2    R4
         AI,R2    0                 REMAINDER NON-ZERO IF DISC ADDR
         BEZ      %+2                 NOT ON CYL BOUNDARY
         LW,R15   Y4                IT ISN'T - SET FLAG FOR EXIT CC
FNDB20   LW,R2    R3
         SLD,R2   -5                R2 = WORD INDEX INTO THIS BIT MAP
         SLS,R3   -27               BIT INDEX INTO WORD
         AI,R6    3
         INT,R9   *R7,R6            DISPL TO START OF BIT MAP
         AW,R2    R9                WORD DISPL INTO HGP
         AW,R2    R7                ADDRESS OF WORD
         LCW,R4   R3
         LW,R3    BT31TO0+32,R4     BIT MASK
         B        1,R5              NORMAL EXIT
         TITLE    '****  HGPZAP  ****'
         SPACE    2
*
*  PURPOSE:  ZERO ALL HGPS IN A CHAIN
*
*  INPUT:  R7 = ADDRESS OF FIRST HGP
*
*  CALL:  BAL,R11  HGPZAP
*
         SPACE    1
HGPZAP   STW,R11  TEMP+1
HGPZ02   STW,R7   TEMP
         LW,R3    6,R7              HW 0 = # PFA WORDS
         LI,R4    ATPRIVBIT
         CW,R4    1,R7
         BANZ     HGP04             BR IF PRIVATE PACK
         AW,R3    5,R7              PUBLIC - ADD # PER WORDS
         B        HGP05
HGP04    LW,R8    =X'80000003'      PRIVATE - INITIALIZE NVAT
         STW,R8   5,R7
HGP05    SLS,R3   -16               TOTAL # WORDS TO ZERO
         LI,R2    0
         DW,R2    =(14*3)
         STW,R2   TEMP+2            # WORDS LEFT OVER AFTER STM LOOP
         LW,R2    TEMP              CURRENT HGP ADDRESS
         AI,R2    7                 POINT PAST HEADER
         LD,R0    DOUBLEZERO
         LD,R4    DOUBLEZERO
         LD,R6    DOUBLEZERO
         LCI      4
         STM,R4   R8
         STM,R4   R12               ZERO R0, R1, R4-R15
         AI,R3    0
         BEZ      HGPZ20            NO STM LOOPS
*
HGPZ10   LCI      14
         STM,R4   0,R2              ZERO 14 WORDS AT A TIME
         STM,R4   14,R2
         STM,R4   14+14,R2
         AI,R2    14*3              INCR POINTER
         BDR,R3   HGPZ10
*
HGPZ20   LW,R3    YE
         XW,R3    TEMP+2            RETRIEVE # LEFT OVER WORDS
         BEZ      HGPZXIT           NONE
HGPZ30   CI,R3    14
         BG       %+3               MORE THAN 14 - DO 14 THIS TIME
         SCS,R3   -4                LESS THAN 14 - PUT # IN CC SPOT
         XW,R3    TEMP+2            PUT IT AWAY, MAKE R3 NEGATIVE
         LC       TEMP+2            SET CC TO # WORDS TO ZERO
         STM,R4   0,R2
         AI,R2    14
         AI,R3    -14
         BGZ      HGPZ30            MORE TO DO
*
HGPZXIT  LW,R7    *TEMP             ADDRESS OF NEXT HGP
         BNEZ     HGPZ02            MORE TO DO
         B        *TEMP+1           DONE - EXIT
         TITLE    '****  HGPINVERT  ****'
         SPACE    2
*
*  PURPOSE:  INVERT BITS IN HGPS AND CHANGE LINKS
*
*  INPUT:  R6 = NEW ADDRESS OF FIRST HGP
*           R7 = ADDRESS OF FIRST HGP
*
*  CALL:  BAL,R11 HGPINVERT
*
*  OUTPUT:  EXITS SKIPPING IF NO ERRORS
*
         SPACE    1
HGPINVERT EQU     %
         LCW,R15  R7
         AW,R15   R6                BIAS TO ADD TO LINKS
         PUSH     R11
*
HGPI10   LI,R14   0
         LW,R8    3,R7              LAST PER SECTOR + 1
         SW,R8    2,R7              R8 = # PER SECTORS
         BLEZ     HGPI30            NONE
         SLS,R8   -1                # GRANULES
         INT,R5   5,R7              DISPL TO PER BIT MAP
HGPI15   SLD,R8   -5                R8 = # FULL WORDS IN BIT MAP
         SLS,R9   -27               R9 = # BITS IN PARTIAL WORD
         AW,R5    R7                ADDRESS OF START OF BIT MAP
         AI,R8    0
         BEZ      HGPI22            NO FULL WORDS
HGPI20   LW,R10   0,R5              GET NEXT BIT MAP WORD
         EOR,R10  M32               INVERT THE BITS
         STW,R10  0,R5
         AI,R5    1
         BDR,R8   HGPI20            DO ALL FULL WORDS
HGPI22   AI,R9    0
         BEZ      HGPI30            NO PARTIAL WORD
         LW,R10   Y8                BUILD MASK - BITS SET WHERE LEGAL
         B        %+2
         SAS,R10  -1
         BDR,R9   %-1
         LW,R9    0,R5              PICK UP PARTIAL WORD
         EOR,R9   M32               FLIP THE BITS
         AND,R9   R10               AND OFF ILLEGAL BITS
         STW,R9   0,R5
*
HGPI30   BDR,R14  HGPI40            BR IF DONE
         LW,R9    4,R7              END OF PFA
         SW,R9    3,R7              R9 = # PFA SECTORS
         BLEZ     HGPI40            NO PFA
         SLS,R9   -1                GRANULES
         LW,R2    1,R7
         CI,R2    ATCYLBIT
         AND,R2   M8                # GRANULES / CYL
         BAZ      %+2
         DW,R9    R2                CYLINDER - CONVERT # GRAN TO # CYLS
         LW,R8    R9
         INT,R5   6,R7              DISPL TO BIT MAP
         LI,R14   20                FLAG TO STOP AFTER THIS ONE
         B        HGPI15
*
*
*  CHANGE HGP HEADER TO STANDARD FORMAT
*
HGPI40   LW,R10   5,R7
         LW,R11   6,R7
         SLD,R10  -16
         STH,R10  R11               R11 = # PER WORDS, # PFA WORDS
         LW,R12   2,R7              PER FIRST SECTOR
         LW,R9    5,R7
         STH,R9   R12               PER DISPL
         LW,R13   3,R7              PFA FIRST SECTOR
         LW,R9    6,R7
         STH,R9   R13               PFA DISPL
         LI,R9    ATPRIVBIT
         CW,R9    1,R7
         BAZ      HGPI50            BR IF PUBLIC
         LW,R12   5,R7              RESTORE NVAT FOR PRIVATE
         EOR,R12  M32               INVERT NVAT BITS
         AND,R11  M16               ZAP # PER WORDS
         LI,R2    X'FF'
         AND,R2   1,R7              # GRAN/CYL
         LW,R9    Y8
         LI,R8    30                COUNT AT LEAST 30 GRANULES IN NVAT
HGPI48   STS,R8   7,R7              ALLOCATE CYLS FOR NVAT
         SLS,R9   -1
         SW,R8    R2
         BGZ      HGPI48
HGPI50   LW,R8    1,R7
         CI,R8    ATCYLBIT
         AND,R8   Y00FFFF
         BANZ     %+2
         STW,R8   1,R7              RESET # GRAN/CYL IF GRAN ALLOCATED
         LW,R9    Y00FFFF
         LI,R2    HGP
HGPI55   CS,R8    1,R2              SEARCH FOR THIS HGP HEADER
         BE       HGPI58              TO FIND NST AND NSG
         LW,R2    0,R2              LINK TO NEXT
         BNEZ     HGPI55
         PULL     R11               ERROR - CAN'T FIND HGP
         B        *R11
*
HGPI58   LCI      2
         LM,R9    2,R2              PICK UP TWO WORDS FROM HGP HEADER
         LCI      5
         STM,R9   2,R7              SET UP HEADER
         LW,R2    0,R7              GET LINK
         BEZ      HGPI60            DONE
         AWM,R15  0,R7              CHANGE LINK
         LW,R7    R2
         B        HGPI10
*
HGPI60   PULL     R11
         AI,R11   1
         B        *R11              NORMAL EXIT
         TITLE    '****  HGPCOUNT  ****'
         SPACE    2
*
*  PURPOSE:  COUNT AND DISPLAY TOTAL AND # UNUSED GRANULES IN
*              A SET OF HGPS.
*
*  INPUT:  R7 = ADDRESS OF FIRST HGP
*          HGPBIAS SET TO ADDR OF WHERE HGPS SHOULD BE MINUS
*            THEIR ACTUAL BIAS.
*
*  OUTPUT:  SUMMARY FOR EACH HGP IS DISPLAYED ON LP.
*
         SPACE    1
HGPCOUNT PUSH     R11
         PUSH     R7
         LI,R14   MGRANSUM
         BAL,R15  PRINT
         LW,R15   SN
         BNEZ     HGPC12            BR IF PRIVATE PACK
         BUILD    (TEXT,MPER,24),(TEXT,MPFA,46),(DUMPB,'A'),;
                  (TEXT,MDCTX,7),(TEXT,MUSED,20),(TEXT,MUSED,42),;
                  (TEXT,MTOT,63),(DUMPB)
         B        HGPC18
HGPC12   BUILD    (TEXT,'SN',8),(TEXT,'GRAN/CYL',15),;
                  (TEXT,MUSED,28),(TEXT,MTOT,44),(DUMPB,'A')
         LI,R11   'A'
         STB,R11  PRBUF             VFC CHAR
HGPC18   BUILD    (TEXT,MSPACE),(DUMPB)
*
         PULL     R7
HGPC20   LI,R4    0
         STW,R4   TOTPER            ZAP TOTAL # GRANULES
         STW,R4   TOTPFA
         LI,R4    5                 HGP DISPL TO DCTX
         LB,R2    *R7,R4            DCT INDEX
         LB,R4    DCT24,R2
         CI,R4    2
         BANZ     HGPC40            RECONFIGURED OUT - IGNORE
         LB,R4    DCT22,R2          DISC TYPE
         LW,R11   DISCLIMS,R4       # SECTORS ON DEVICE
         STW,R11  DEVSIZE
         LW,R11   SN
         BEZ      HGPC24            BR IF PUBLIC DEVICE
*  LOCATE SERIAL # IN AVR TABLE
         AI,R2    -BATAPE
         LD,R14   AVRTBL,R2         R14 HAS SERIAL #
         LI,R1    7
         LI,R4    R14**2
         LI,R5    4
         BAL,R10  PUTMES
         LW,R3    1,R7
         AND,R3   M8                # GRAN/CYL
         LI,R1    19
         BAL,R10  PUTDECR
         B        HGPC30            SKIP PER FOR PRIVATES
*
HGPC24   LI,R1    9
         BAL,R10  PUTHEXR           PUT DCTX IN PRINT BUFFER
*
*  COUNT PER GRANULES
*
         LI,R4    8
         LH,R10   *R7,R4            # PER WORDS
         BEZ      HGPC30            NONE
         LW,R11   DEVSIZE           ASSUME AREA ENDS AT END OF DEVICE
         LI,R4    9
         LH,R12   *R7,R4            # PFA WORDS
         BEZ      %+2               NO PFA
         INT,R11  6,R7              PFA - PER ENDS AT PFA START
         INT,R9   5,R7              PER START
         SW,R11   R9                # PER SECTORS
         SLS,R11  -1
         STW,R11  TOTPER            TOTAL # PER GRANULES
         LI,R2    10
         LH,R9    *R7,R2            INDEX TO START OF PER BIT MAP
         BAL,R4   BITCOUNT          COUNT THE BITS
         STW,R3   #UNUSED           # UNUSED GRANULES
         LCW,R3   R3
         AW,R3    TOTPER            # USED GRANULES
         LI,R1    23
         BAL,R10  PUTDECR           # USED GRANULES
         LW,R3    #UNUSED
         LI,R1    32
         BAL,R10  PUTDECR           # UNUSED GRANULES
*
*  COUNT PFA BITS
*
HGPC30   LI,R2    9
         LH,R10   *R7,R2
         BEZ      HGPC35            NO PFA
         LW,R11   DEVSIZE
         INT,R9   6,R7              FIRST PER SECTOR
         SW,R11   R9                # PFA SECTORS
         SLS,R11  -1
         STW,R11  TOTPFA            TOTAL # PFA GRANULES
         LI,R2    12
         LH,R9    *R7,R2            DISPL TO PFA BIT MAP
         BAL,R4   BITCOUNT
         STW,R3   #UNUSED
         LCW,R3   R3
         AW,R3    TOTPFA
         LI,R1    45                COL #
         LW,R10   SN
         BEZ      %+2
         LI,R1    31                PRIV PACK
         BAL,R10  PUTDECR           # USED PFA
         LW,R3    #UNUSED
         LI,R1    54
         LW,R10   SN
         BEZ      %+2
         LI,R1    40                PRIV PACK
         BAL,R10  PUTDECR           # UNUSED PFA
HGPC35   LW,R3    TOTPER
         AW,R3    TOTPFA
         LI,R1    67
         LW,R10   SN
         BEZ      %+2
         LI,R1    48
         BAL,R10  PUTDECR           TOTAL # GRANULES ON DEVICE
         BAL,R15  DUMPB
*
HGPC40   LW,R7    0,R7              GO TO NEXT HGP
         BEZ      HGPCXIT           NO MORE
         SW,R7    HGPBIAS           ADJUST ADDRESS
         B        HGPC20
*
HGPCXIT  LI,R14   MPAGE
         PULL     R15
         B        PRINT
         SPACE    3
BITCOUNT LI,R3    0
         AND,R9   M15               SCRUB SIGN BIT
BITCNT2  LW,R11   *R9,R7
         BEZ      BITCNT4           NOTHING HERE
         LI,R2    32
BITCNT3  SLS,R11  1
         BEV      %+2
         AI,R3    1                 COUNT BIT SHIFTED OFF
         BDR,R2   BITCNT3
*
BITCNT4  AI,R9    1
         BDR,R10  BITCNT2           DO ALL WORDS
*
         LI,R2    X'FF'
         AND,R2   1,R7              # GRANULES/CYLINDER
         BNEZ     %+2
         LI,R2    1                 FORCE = 1 FOR GRANULE ALLOCATED
         MW,R3    R2                CONVERT CYLINDERS TO GRANULES
         B        0,R4
         TITLE    '****  BREAK INTERRUPT HANDLER  ****'
         TITLE    '****  ACNCALC  ****'
         SPACE    2
*
*  PURPOSE:  CALCULATE DISC ADDRESSES OF ACCOUNT DIRECTORY MAIN
*            AND DUAL GRANULES.
*
*  CALL:  BAL,R11  ACNCALC
*
*  OUTPUT:  R8 = DISC ADDR OF MAIN GRANULE
*           R9 = DISC ADDR OF DUAL GRANULE
*
*  TEMP+0 = FIRST RAD HGP
*  TEMP+1 = FIRST GRANULE PACK
*  TEMP+2 = FIRST GRANULE PACK WITH PSA AND PFA
*  TEMP+3 = FIRST CYLINDER PACK
*  TEMP+4 = LAST RAD
*  TEMP+5 = LAST GRANULE PACK
*  TEMP+6 = LAST GRANULE PACK WITH PSA AND PFA
*  TEMP+7 = LAST CYLINDER PACK
*
         SPACE    1
ACNCALC  EQU      %
         LD,R2    DOUBLEZERO
         LD,R4    DOUBLEZERO
         LCI      4
         STM,R2   TEMP
         STM,R2   TEMP+4            CLEAR TEMP STORAGE
         LI,R7    HGP
         LI,R2    6                 BYTE INDEX TO DEVICE TYPE
         LI,R1    5                 BYTE INDEX TO DCTX
ACNC10   LW,R8    6,R7
         CW,R8    YFFFF
         BAZ      ACNC30            NO PFA - SKIP THIS DEVICE
         LB,R5    *R7,R1            DCT INDEX
         LB,R8    DCT24,R5          FLAGS
         CI,R8    X'82'
         BANZ     ACNC30            PARTITIONED - DON'T ALLOCATE HERE
         LB,R8    *R7,R2            DEVICE TYOE
         LI,R3    0                 ASSUME RAD
         CI,R8    X'07'
         BE       ACNC20            YES
         LI,R3    3                 ASSUME CYLINDER PACK
         CI,R8    X'0B'
         BNE      ACNC20            YES
         LI,R3    2                 ASSUME PFA AND PSA
         LI,R4    LSWAP
ACNC17   CB,R5    MB:SDI,R4         IS THIS DEVICE A SWAPPER
         BE       ACNC20            YES
         AI,R4    -1
         BGEZ     ACNC17
         LI,R3    1                 GRANULE PACK, NO PSA
ACNC20   STW,R7   TEMP+4,R3         SAVE LAST HGP OF THIS TYPE
         LW,R8    TEMP,R3
         BNEZ     %+2               BR IF NOT FIRST
         STW,R7   TEMP,R3           SAVE FIRST HGP OF THIS TYPE
ACNC30   LW,R7    0,R7
         BNEZ     ACNC10
*
*  CALCULATE MAIN DISC ADDRESS
*
         LI,R9    0                 INITIALIZE DUAL DISC ADDRESS
         LI,R3    -4                LOOK IN THIS ORDER:  RAD, GRANULE
         LW,R7    TEMP+4,R3          PACK, GRANULE WITH PSA, CYL PACK
         BNEZ     ACNC40            FOUND ONE
         BIR,R3   %-2
         B        ACNC90            CAN'T FIND ANY DEVICES
ACNC40   INT,R3   6,R7              FIRST PFA SECTOR ADDRESS
         LW,R8    1,R7              DCT INDEX IN BYTE 1
         STB,R8   R8                # GRAN/CYL IN BYTE 0
         STSECTA,R3  R8             PUT IN REL SECTOR
*
*  CALCULATE DUAL DISC ADDRESS
*
         MTW,0    NODUAL
         BEZ      ACNC60            NO DIRECTORY DUALS
         LW,R7    TEMP+5            GRANULE PACK, NO PSA
         BNEZ     ACNC50
         LW,R7    TEMP+4            RAD
         BNEZ     ACNC50
         LW,R7    TEMP+6            GRANULE PACK WITH PSA
         BNEZ     ACNC50
         LW,R7    TEMP+7            CYLINDER PACK
         BEZ      ACNC90            NONE - ERROR
ACNC50   XW,R8    R9                GET FIRST SECTOR IF ON DIFFERENT DEVICES
         BEZ      ACNC40
         CW,R8    R9
         BNE      ACNC60            THEY ARE (ON DIFFERENT DEVICES)
         LI,R3    5
         LB,R3    *R7,R3            FIND LAST SECTOR ON DEVICE
         LB,R3    DCT22,R3
         LW,R3    DISCLIMS,R3
         AI,R3    -2                LAST SECTOR ON DEVICE
         LI,R9    X'FF'
         AND,R9   1,R7              # GRAN PER CYL
         BEZ      %+3               ZERO = ONE
         DW,R3    R9                ROUND DOWN TO FIRST GRAN
         MW,R3    R9                  IN LAST CYLINDER
         LW,R9    1,R7              DCT INDEX IN BYTE 1
         STB,R9   R9                # GRAN/CYL IN BYTE 0
         STSECTA,R3  R9
ACNC60   RES                        CALCULATE ADDRESS FOR ALLOCAT'S DUAL
         STW,R8   ACNCFU+FDA        PUTES AWAY
         STW,R9   ACNCFU+DFDA
         MTW,0    ALLODDA           UNLESS WE DONT WAT IT
         BLZ      *R11
         LW,R9    DCT%MASK%1        IF ON THE SAME DEVICE, USE PRIMARY
         CS,R8    ACNCFU+DFDA
         BE       %+2
         LW,R8    ACNCFU+DFDA       OTHERWISE USE DUAAL
         LW,R7    R11               SAVE RETURN ADDRESS
         LB,R9    R8                CALCULATE INCREMENT IF FLAWS
         BNEZ     %+2
         LI,R9    1
         SLS,R9   1                 ALSO NOT TO OVERWRITE ACNDIR
         LH,R5    R8                GET DCTX OF DEVICE
         AW,R8    R9                NOW ADD (MIGHT HAVE CROSSED X'FFFF'
         LB,R6    DCT22,R5          USE NSPT FOR INCREMENT IF GRANULE ALLOCATED
         CI,R9    2
         BNE      %+2
         LW,R9    NSPT,R6
         LI,R10   HGPSIZE+20+511    SIZE OF DATA AREA
         SLS,R10  -9                IN PAGES
         SLS,R10  1                 IN SECTORS
         LW,R11   R10               PLUS ONE SECTOR PER 32
         AI,R11   -1
         DO       1                 MPC CODE FOR E01 ONLY
         LW,12    NSPT,R6
         CI,12    8                 IF MPC ADD 1 SECTOR PER 8
         BE       %+2
         LI,12    32
         DW,11    12
         ELSE
         SLS,R11  -5
         FIN
         AW,R10   R11
         BAL,R11  GMB               GET END ACTION BUFFER
         BNEZ     %+3
         M:WAIT   1
         B        GMB
         STW,R14  DCBADR
         DO       1                 MORE E01 MCP CODS
         CI,12    8
         BE       ACNC6S-6
         FIN
         CW,R10   NSPC,R6           WILL IT FIT ON A CYLINDER
         BG       ACNC69            NO, GIVE UP
         LCI      5                 PUT ROUTINE IN IT
         LM,R0    UIOEA
         STM,R0   *R14
ACNC62   LDCTX,R12 R8               IS R8 STILL ON SAME DEVICE
         CW,R12   R5
         BE       ACNC63            YES
         LB,R12   R8                NO, MOVE OVERFLOW BIT TO PROPER PLACE
         AW,R8    Y007F
         CB,R12   R8                DID THAT WORK
         BE       ACNC62            YES
         SW,R8    Y00C              NO, ADJUST AGAIN
         B        ACNC62            THAT'S THE BEST WE CAN DO
ACNC63   LSECTA,R1 R8               CHECK THAT WERE STILL ON THE DEVICE
         CW,R1    DISCLIMS,R6
         BGE      ACNC69            CANT DO IT
         OR,R12   XCFF0A00          GET REGS FOR NEWQ
         LW,R13   Y1                DO READ HEADER-SKIP
         LW,R14   R10               AT 8 BYTES PER SECTOR
         SLS,R14  3
         LW,R15   R8                LOOKING FOR FLAWS OR CYL BOUNDS
         LW,R0    DCBADR
         LW,R1    DCBADR
         BAL,R11  NEWQ
         NOP
         LW,R1    DCBADR
         INT,R1   5,R1              CHECK TDV STATUS
         BCR,6    %+3               ALL IS OK
ACNC64   AW,R8    R9                FLAW OR CYL PROB, TRUNDLE ON
         B        ACNC62
         LW,R2    R8                NOW MUST CHECK FOR X'FFFF' IN RANGE
         AW,R2    R10
         LI,R3    X'F0000'
         CS,R2    R8
         BNE      ACNC64            ALLOCAT DOESNT KNOW ABOUT IT
         CS,R2    BUFLIM            AND IF ON PRIM DEVICE
         BNE      %+3               WE MIGHT HAVE RUN INTO THE DUAL
         CW,R2    BUFLIM+1
         BG       ACNC69            CANT DO ANYTHING ABOUT IT
         LB,R9    R8                ALL IS OK, ALLOCATE THE SPACE
         BNEZ     %+2
         LI,R9    1
         SLS,R9   1
         AND,R8   M24
         LPSD,0   NOWKPSD           TURN OFF WRITE PROTECTION
ACNC6S   STW,R8   ALLODDA
         BAL,R11  ALLOCG
         AW,R8    R9
         SW,R10   R9
         BGZ      ALLOCG
         AW,R8    R10               CALCULATE PLACE FOR LAST PAGE
         AI,R8    -2
         STW,R8   ALLODCKDA
ACNC69   LW,R8    ACNCFU+FDA        RESTORE ACNDIR POINTERS
         LW,R9    ACNCFU+DFDA
         LW,R14   DCBADR
         BAL,R11  RMB               RELEASE THE BUFFFER
         B        0,R7              AND RETURN TO CALLER
*
*        UNIVERSAL I/O END ACTION
*
UIOEA    LW,R2    R14               GET THIS ADDR FROM EA INFO
         STW,R12  6,R2              SAVE TYC INFO
         LD,R12   DCT13,R1          GET TDV STATUS
         STW,R13  5,R2              SAVE IT
         B        *R11
         BOUND    8
NOWKPSD  GEN,12,20,32 4,ACNC6S,0    MAP, WRITE KEY=0
*
*  CAN'T FIND ANY PFA FOR ACCOUNT DIRECTORY
*
ACNC90   LI,R4    BA(MNOPFA)        'NO PFA IN SYSTEM'
         BAL,R11  OCMESS
         B        INITERR
*O*  MESSAGE:      NO PFA, CAN'T BOOT SYSTEM
*O*  ACTION:       CORRECT SYSGEN OR RECONFIGURATION PATCHES
*O*  MEANING:      NO DEVICES CAN BE FOUND IN THE SYSTEM WHICH
*O*                CONTAIN PFA.
         TITLE    '****  REMDEV  ****'
         SPACE    2
*
*  PURPOSE:        ZERO DCT22 (DISK TYPE) FOR ALL RECONFIGURED
*                  REMOVED DISK DEVICES.  DCT22 MUST BE INTACT FOR
*                  THE BUILDING OF THE HGPS BY PUBHGPS, BUT SHOULD
*                  BE ZEROED FOR NON-EXISTENT DEVICES BEFORE COMING
*                  UP SO THAT FMCHKDA WILL SAY THAT A DISK ADDRESS
*                  ON A NON-EXISTENT DEVICE IS BAD.
*
REMDEV   LI,R3    DCTSIZ
         LI,R5    0
REMD10   LB,R4    DCT24,R3
         CI,R4    2
         BAZ      %+2
         STB,R5   DCT22,R3          ZERO IF NON-EXISTENT
         BDR,R3   REMD10
         B        0,R2
         TITLE    '****  MESSAGES  ****'
         SPACE    2
MDATE    TXTC     CR,'DATE(MM/DD/YY)='
MTIME    TXTC     CR,'TIME(HH:MM)='
MEH      TXTC     CR,'  ??',CR
MHGPR    TXTC     CR,'DO YOU WANT HGP RECONSTRUCTION(Y/N)?'
MRBRECOV TXTC     CR,'ATTEMPT BATCH QUEUE RECOVERY(Y/N)?'
MALLYSWX TXTC     CR,'DO YOU WANT ALLOCAT DATA DUAL(Y/N)?'
MLOSGRQ  TXTC     CR,'DO YOU WANT RECOVERED GRANULE DUMPS(Y/N)?'
MNORCVR  TXTC     CR,CR,TAB,'CANNOT RECOVER',CR,CR
MHGPCORE TEXTC    'CCORE SIZE TOO SMALL FOR HGP RECONSTRUCTION'
MHGPFAIL TXTC     CR,CR,TAB,'HGP RECONSTRUCTION FAILURE',CR,CR
MHALT    TXTC     CR,CR,CR,'    UNABLE TO BOOT SYSTEM - BAD SYSGEN ',;
                  'OR HARDWARE MALFUNCTION',CR,CR,CR
MNOHGP2  TEXTC    'CNOT ENOUGH CORE FOR 2 COPIES OF HGPS - ',;
                    'PROCEEDING WITH ONE COPY'
MNOPFA   TXTC     CR,TAB,'NO PFA, CAN''T BOOT SYSTEM'
MRELDUAL TEXTC    'BDUAL REMOVED FROM DIRECTORY'
MACNDIR  TEXTC    'ACCOUNT DIRECTORY'
MFILDIR  TEXTC    'FILE DIRECTORY'
MPAGE    TEXTC    '1'
MHGPS    TEXTC    'CALLOCAT DATA:'
MHGPUB   TEXTC    'A PUBLIC HGP RECONSTRUCTION INITIATED AT '
MHGPRIV  TEXTC    '1 PRIVATE PACK HGP RECONSTRUCTION INITIATED AT '
MSNLIST  TEXTC    'C SERIAL NUMBER LIST:'
MBEGSYM  TEXTC    '1   SYMBIONT FILE RECONSTRUCTION'
MHGPDONE TEXTC    'BHGP RECONSTRUCTION COMPLETE   '
MTRUNC   TEXTC    '** TRUNCATED **'
MRBJIT   TEXTC    'CRBBAT JIT BAD'
MRBSTAT  TEXTC    'CRBBAT STATIC DATA BAD'
MNORBRCV TXTC     CR,CR,TAB,'UNABLE TO RECOVER BATCH QUEUE',CR
MNOSN    TEXTC    ' NO SERIAL # SPECIFIED'
MADKEY   TEXTC    'B  ACCOUNT = '
MADBAD   TEXTC    ' ACCOUNT DIRECTORY DESTROYED'
MHGPUSR  TEXTC    'B**** ANOTHER USER IS ACCESSING THE PACK SET'
MADIOERR TXTC     CR,CR,TAB,'I/O ERROR WRITING ACCOUNT DIRECTORY',CR
MHGPBIG  TXTC     CR,CR,'HGPS TOO BIG FOR ALLOCAT''S DATA',CR,CR
MLOSGRAN TEXTC     'RECOVERED'
MHGPSIZE TXTC     CR,CR,CR,'INSUFFICIENT CORE TO BUILD HGPS',CR,CR
MSWAPERR TXTC     CR,CR,TAB,'I/O ERROR WRITING ALLYCAT DATA TO SWAPPER'
MSPACE   TEXTC    '  '
         BOUND    8
TXTGHST1 TEXTC    'GHOST1'
TXRBIV   TEXTC    'RBBATIV'
TXRBSD   TEXTC    'RBBATSD'
TXRBDD   TEXTC    'RBBATDD'
TXRBCM   TEXTC    'RBBATCM'
TXTALLY  TEXTC    'ALLOCAT'
MFRHEAD  TEXTC    'A************************************',;
                  '     FILE MANAGEMENT ERROR REPORT     ',;
                  '************************************'
MREP     TEXTC    'REPORT #'
MERRMES  TEXTC    'B  ERROR CODE:  '
MDSCADR  TEXTC    'DISC ADDRESS:  '
MSITEID  TEXTC    'B  SITE-ID:  '
MRDF     TEXTC    'RDF = '
MWRTF    TEXTC    'WRTF = '
MMONOV   TEXTC    'B  MONITOR OVERLAY:  '
MNONE    TEXTC    '** NONE **'
MUSER    TEXTC    'USER #'
MOPNCLS  TEXTC    'OPN/CLS USER #'
MNODCB   TEXTC    'B**** CAN''T FIND DCB:  '
MACNCFU  TEXTC    'C  ACNCFU:'
MFILCFU  TEXTC    'C  FILCFU:'
MBADCFU  TEXTC    'C**** BAD CFU ADDRESS:  '
MUSRCFU  TEXTC    '   USER''S CFU:'
MSCFUER  TEXTC    'B**** BAD SCFU POINTERS'
M75TABLE TEXTC    'B  75TABLE:'
MDCB     TEXTC    'B  DCB:'
MBUF1    TEXTC    'BUF1 #'
MBUF2    TEXTC    'BUF2 #'
MTOP     TEXTC    'TOP #'
BUFMES   DATA     BA(MTOP),BA(MBUF2),BA(MBUF1)
BUFCOL   DATA     65,38,11
MXTSTK   TEXTC    '1  TSTACK:'
MXPUSH   TEXTC    'PUSHALL'
MXMISC   TEXTC    'MISC'
MXERFIL  TEXTC    'ERFILDA'
MXREG    TEXTC    'T:REG'
MOSTCK   TEXTC    'C  OSTACK:'
MJIT     TEXTC    '1  USER''S JIT:'
MDCBS    TEXTC    '1  DCBS:'
MPOOLS   TEXTC    'B  POOL BUFFER #'
MGRANS   TEXTC    '1  FILE GRANULES:'
MDCTX1   TEXTC    'DCTX = '
MEND     TEXTC    'AEND END END END END END END END END END END END ',;
                  'END END END END END END END END END END END'
MNOCORE  TEXTC    'B**** INSUFFICIENT CORE'
MSYMB    TEXTC    'FOLLOWING SYMBIONT FILE'
MINPUT   TEXTC    'INPUT'
MOUTPUT  TEXTC    'OUTPUT'
MNCTL    TEXTC    ' NCTL'
MSHDR1   TEXTC    'SYSID'
MSHDR2   TEXTC    'TYPE'
MSHDR3   TEXTC    'DEVICE'
MSHDR4   TEXTC    '# GRANULES'
MGRANSUM TEXTC    '1 GRANULE ALLOCATION SUMMARY'
TXAIF    TEXTC    'AIF'
TXAIFJE  TEXTC    'AIFJE'
TXAIFNC  TEXTC    'AIFNC'
TXAOF    TEXTC    'AOF'
TXAOFL   TEXTC    'AOFL'
TXAOFNB  TEXTC    'AOFNB'
TXAOFP   TEXTC    'AOFP'
MGI      TEXTC    ' GI'
MPER     TEXTC    'PER'
MPFA     TEXTC    'PFA'
MDCTX    TEXTC    'DCTX'
MUSED    TEXTC    'USED   UNUSED'
MTOT     TEXTC    'TOTAL'
MELOGBAD TEXTC    'B **** ERRLOG FILE BAD - DELETED'
         TITLE    '****  STATIC DATA  ****'
         SPACE    2
BADATES  DATA     '0229','0230','0231','0431','0631','0931','1131'
MIND     TEXT     '0101  70'        MIN VALUES FOR DATE
MAXD     TEXT     '1231  99'        MAX VALUES FOR DATE
MAXT     TEXT     '2359'            MAV VALUE FOR TIME
*
DTDELIM  DATA,1   0,' ',':','/'     DATE/TIME DELIMITERS
#DTDELIM EQU      BA(%)-BA(DTDELIM)-1
         BOUND    4
MTBL     DATA,2   10,6,10,30000
HGPANS   DATA,1   5,0,'N','E','A','F' TYPES OF PRINTOUT DESIRED
         BOUND  4
*
Y03      DATA     X'03000000'
YE       DATA     X'E0000000'
YFFFF    DATA     X'FFFF0000'
YFFFFFF  DATA     X'FFFFFF00'
Y00FF    DATA     X'00FF0000'
Y00FFFF  DATA     X'00FFFF00'
Y0014    DATA     X'00140000'
XCFF0A00 DATA     X'CFF0A00'
Y007F    DATA     X'7F0000'
Y00C     DATA     X'C00000'
*
SPFPT    M:WRITE,L  M:LO,(BUF,BLANKS),(SIZE,2),(BTD,0),WAIT
CLSRB    GEN,8,24   X'15',F:RB
         DATA     X'B0000000'
         PZE      *R2               SAVE/REL
         DATA     FIXERR,FIXERR     ERA,ABA
*
BLANKS   TEXT     ' '
*
COMCODE  DATA,1   0,AIF,AIFJE,AIFNC,AOF,AOFL,AOFNB,AOFP
#COMCODE EQU      BA(%)-BA(COMCODE)-1
         BOUND    4
COMFLAG  DATA,1   0,0,1,0,1,1,1,1   NON-ZERO IF SYSID EXISTS
         BOUND    4
COMTYPE  EQU      %-1
         DATA     TXAIF,TXAIFJE,TXAIFNC,TXAOF,TXAOFL
         DATA     TXAOFNB,TXAOFP
         TITLE    '****  DATA  ****'
         SPACE    2
         CSECT    0
FIXHD:   TEXT     'FIXHD'
         SPACE    2
MSTMP    TXTC     CR,'DATA STAMP =00MMDDHHMM00000',;
                  'DUAL STAMP =00MMDDHHMM00000'
         ORG      MSTMP
BADDA    RES      1
ACCT     RES      2
FILE     RES      8
ADBUF1   RES      1
ADBUF2   RES      1
FDBUF1   RES      1
FDBUF2   RES      1
DBUF1    RES      1
DBUF2    RES      1
ADCMD    RES      1
FDCMD    RES      1
*
DATADA   RES      1
DATAMAX  RES      1
CURDATA  DATA     0
DIRDA    RES      1
DIRMAX   RES      1
CURDIR   DATA     0
*
ELOGSAV  DATA     0,0,0,0,0,0
SYMGADR  DATA     0
TAPDUMP  DATA     0
ZAPDUMP  DATA     0
*
#UNUSED  RES      1
TOTPFA   RES      1
TOTPER   RES      1
DEVSIZE  RES      1
HGPBIAS  RES      1
*
DCBADR   RES      1
MONOVR   RES      1
DCBBEGIN RES      1
DISCADR  RES      1
SAVBUF   DATA     0
COUNT    DATA     0                 # FREPORTS
UBC#     RES      1
UBSWAPI  RES      1
USER#    DATA     0
USERDCB  RES      1
75ACCT   RES      2
75NAME   RES      8
OC75MES  TEXT     '  FIX:  75XX    '
         RES      10
EBCERR   EQU      OC75MES+2
*
         BOUND    8
POOLIMS  DATA     JXBUFVP,0
BUFLIM   RES      2
*
HGP1     DATA     0
HGP2     DATA     0
HGPDISP  RES      1
NXTHGP   DATA     0
PREVHGP  RES      1
*
RBJIT    DATA     0
RBAJIT   DATA     0
RELFDA   DATA     0
RBUF     DATA     0
RBCOMADR DATA     0
RBCOMSIZ DATA     0
RBDATA   DATA     0
RBDATSIZ DATA     0
RBFILOK  DATA     0
CURCOMB  RES      1
SYSID    RES      1
SYMBTYPE RES      1
SYMBDEV  RES      1
HEADFLG  DATA     -1
ALLYFLG  DATA     -1
ALLODCKDA DATA -1
#PAGES1  RES      1
VLP0C    RES      1
VLP0D    RES      1
VLP09    RES      1
*
PAGE     RES,1    28
DISC     EQU      %-1
         RES      27
*
OPN:MON  GEN,8,24  X'14',F:MONDMP
         DATA     X'C7480001'
         DATA     FIXERR,FIXERR     IGNORE I/O ERRORS
         DATA     2                 KEYED
         DATA     2                 DIRECT
         PZE      *R2               MODE
         DATA     2                 SAVE
         DATA     7                 KEYM
         DATA     X'00010202'       NO X'01' VLP - GIVES 14-00
DMPNAME  TEXTC    'MONDMP0'
         DATA     X'04010202'
         TEXT     ' 00100  '        EXPIRE 1 DAY HENCE
*
DEVOPN   GEN,1,7,7,17  1,X'14',0,R1   DCB = *R1
         DATA     X'00040003'
         PZE      *R2               DEVICE TYPE IN R2
         SPACE    2
         END

