Google
 

Trailing-Edge - PDP-10 Archives - cuspmar86binsrc_2of2_bb-fp63a-sb - 10,7/dskrat/dskrat.mac
There are 4 other files named dskrat.mac in the archive. Click here to see a list.
TITLE DSKRAT - LEVEL D DISK DAMAGE ASSESSMENT PROGRAM  V14A(24)
SUBTTL	VERSION OF DSKRAT

;  D BLACK, A FRANTZ/JE/TW/WLH/DAL/SHP	19 APR 83



;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1970,1971,1972,1973,1974,1984,1986.ALL RIGHTS RESERVED.
;
;
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
;ONLY  IN  ACCORDANCE  WITH  THE  TERMS  OF  SUCH LICENSE AND WITH THE
;INCLUSION OF THE ABOVE COPYRIGHT NOTICE.  THIS SOFTWARE OR ANY  OTHER
;COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
;OTHER PERSON.  NO TITLE TO AND OWNERSHIP OF THE  SOFTWARE  IS  HEREBY
;TRANSFERRED.
;
;THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT  NOTICE
;AND  SHOULD  NOT  BE  CONSTRUED  AS A COMMITMENT BY DIGITAL EQUIPMENT
;CORPORATION.
;
;DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY  OF  ITS
;SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.

VRAT==14
VEDIT==24
VMINOR==1
VWHO==0
PRGABV==ASCII /DSR/	; 3-CHARACTER PROGRAM ABBREVIATION


	SEARCH	UUOSYM
SUBTTL	DSKRAT DIRECTORY

COMMENT	\

	       	TABLE OF CONTENTS FOR DSKRAT

                      SECTION                          PAGE

AC ASSIGNMENTS........................................   4
AC PRESERVATION SUBROUTINES...........................  23
BAD HOME BLOCKS.......................................  28
BLOCK READING.........................................  26
BYTE POINTER DEFINITIONS..............................  41
CFP CONVERSION........................................  23
CHECK UFD'S IN MFD BLOCK..............................  15
CHECK FILES IN UFD BLOCK..............................  15
CHECKSUM COMPUTATION..................................  23
CLUSTER ERROR REPORTING...............................  37
CORE BLOCK POINTERS...................................  22
CORE BLOCK DESCRIPTION................................  42
DATE SUBROUTINES......................................  40
DSKCHR INDICES........................................   4
DSKCHR AND BLOCK SETUP FOR UNIT U.....................  27
DSKRAT DIRECTORY......................................   2
DSKRAT................................................   8
DUPLICATED CLUSTER REPORTING..........................  34
EDIT HISTORY..........................................   3
FILE STRUCTURE PROCESSING.............................  12
FIND HOME BLOCKS......................................  20
FREE CLUSTER REPORTING................................  33
HOME BLOCK READING AND VERIFICATION...................  20
IDENTIFICATION OF RUN.................................  24
INCREMENTAL EXTENSION LOOKUP/ENTER BLOCK..............  27
IO CHANNELS...........................................   4
JOB CHECKING..........................................  27
LOOKUP ERRORS.........................................  29
LOST BLOCK RECOVERY FLAGS.............................   3
LOST BLOCK RECOVERY ROUTINE...........................  31
LOST CLUSTER FINDING..................................  35
LOW SEGMENT DATA BASE.................................  41
MONERR - MACRO TO MONITOR ERRORS......................   7
PARAMETERS FROM COMMOD.MAC............................   3
PRINT SUBROUTINES.....................................  38
PRINTING RIGHT-JUSTIFIED INTEGERS.....................  39
PROCESSING OF MFD'S, UFD'S AND SFD'S..................  14
PROGRAM REENTRY.......................................  24
READ UNIT HOME BLOCKS.................................   9
READ UNIT SAT BLOCKS..................................  11
READ AND VERIFY 1ST RIB...............................  21
RELATIVE POINTER TO RETRIEVAL PTRS IN RIB.............   3
RELATIVE INDECES INTO EXTENDED RIB....................   5
REPORTING LOST CLUSTERS...............................  30
RETRIEVAL POINTERS....................................  22
SAT BIT SET DETERMINATION.............................  25
SAT CHECKOUT..........................................  19
SAT POINTER TABLES....................................  10
SAT TABLE BIT SETTING.................................  25
SAT WORD ADDING FOR UNIT U............................  25
SET UNIT PARAMETERS...................................   9
SFD SCANNING..........................................  15
SIXBIT LOGICAL UNIT COMPUTATION.......................  24
STORAGE MACROS........................................   6
SUPER USET SUBROUTINE.................................  32
TIME SUBROUTINES......................................  40
UFD ENTRY PROCESS ROUTINE.............................  16
UFD SCANNING..........................................  15
VERSION OF DSKRAT.....................................   1
WORD AND CLUSTER COMPUTATION PER SAT..................  27

\
; CONDITIONAL ASSEMBLY PARAMETER TO GENERATE A VERSION THAT
; IGNORES THE FACTS THAT ST%NLG=0 AND MORE THAN ONE JOB
; IS CURRENTLY LOGGED. THIS IN ESSENCE IS THE RATDDT VERSION.
	IFDEF RATDDT,<IF2,<PRINTX ASSEMBLING RATDDT VERSION>>


SUBTTL	EDIT HISTORY


;12	ADDED POPJ P, IN SUBROUTINE PRLOST
;13	CHANGE THE OUTPUT LOG FILE NAME TO DSKRAT
;14	CHANGE TO USE SUSET. INSTEAD OF USETI
;15	FIX PROBLEMS WITH MIXED RP02/RP03 STRUCTURES
;16	DO EXTENDED LOOKUP/ENTER'S EVERYWHERE.
;17	ALLOW STR'S MOUNTED AS SINGLE ACCESS TO IGNORE SCHEDULING
;	AND NUMBER OF JOBS RUNNING. SPR #10-16,022.
;20	FINISH MIXED RPO2/RP03 SUPPORT IN EDIT 15 BY REPLACING
;	UNIBPU(T) AT OUTRIB+9 WITH STRBPU.
;21	CHANGE FORMULA FOR CALCULATING FIRST UNIT CLUSTER FROM
;	(STRBPU*U)/BLKPCL TO (STRBPU/BLKPCL)*U. SPR #10-15642.
;22	FIX RATDDT VERSION TO BE LESS SCRUPULOUS.
;23	FIX PDL OV ON SFD'S NESTED TOO DEEPLY
;	ALLOW LOST-BLOCK RECOVERY ON SCHED 10
;	DON'T PUT BLOCKS IN LSTBLK.N IF THEY ARE IN BAT BLOCK
;	FIX LOST BLOCK RECOVERY CODE TO ALWAYS READ THE RIGHT SAT
;24	FIX CODE TO STEP FROM LAST SAT BLOCK ON UNIT ZERO TO
;	FIRST SAT BLOCK ON UNIT ONE. CAUSED BOGUS LSTBLK FILE
;	TO BE WRITTEN FOR SOME STRS. DELETING THE FILE CAN
;	CAUSE BAZ STOPCD.

JOBVER==137
LOC	JOBVER
	BYTE	(3)VWHO(9)VRAT(6)VMINOR(18)VEDIT
	RELOC

	SALL

	LBRCOD==1		; DEFINE LOST BLOCK RECOVERY CODE
IFNDEF	LBRCOD,<LBRCOD==0>
IFNDEF PURESW,<PURESW=0>

SUBTTL	PARAMETERS FROM COMMOD.MAC

HOMNAM==0	;"HOM" IN SIXBIT
HOMNXT==5	;ID OF NEXT UNIT IN FILE STRUCTURE
HOMLUN==10	;LOGICAL UNIT IN STR
HOMBSC==14	;BLOCKS PER SUPERCLUSTER
HOMSCU==15	;SUPER-CLUSTERS PER UNIT
HOMCNP==16	;CLUSTER COUNT BYTE PTR FOR RETRIEVAL PTRS
HOMCKP==17	;CHECKSUM BYTE PTR
HOMCLP==20	;CLUSTER ADDR BYTE PTR
HOMBPC==21	;BLOCKS PER CLUSTER
HOMSPU==31	;SATS ON THIS UNIT
HOMSAT==34	;LOGICAL BLOCK WITHIN STR OF 1ST RIB FOR SAT.SYS
HOMMFD==46	;LOGICAL BLOCK WITHIN STR OF 1ST MFD RIB
HOMCOD==176	;CONAINS UNLIKELY CODE
HOMSLF==177	;THIS BLOCK WITHIN UNIT

CODHOM==707070	;UNLIKELY CODE FOR HOME BLOCK

SUBTTL	RELATIVE POINTER TO RETRIEVAL PTRS IN RIB
RIBFIR==0
RIBPPN==1
RIBNAM==2
RIBEXT==3
RIBSIZ==5
RIBVER==6
RIBALC==11
RIBSTS==17
RIBFLR==33
RIBXRA==34
RIBCOD==176
RIBSLF==177

RIPABC==20000
RIPNUB==400000

CODRIB==777777

CODBAT==606060
BATCOD==176
BATNAM==0
BAFFIR==1
BAFELB==1
BATMSK==777000
LBOBAT==1
BLKSIZ==200

SFDLVL==5	;MAXIMUM NUMBER OF NESTED SFD'S

;END PARAMETERS FROM COMMOD.MAC

SUBTTL	LOST BLOCK RECOVERY FLAGS
GTBFAL==1	; GETTAB FAILURE
NTONE==2	; NOT THE ONLY JOB RUNNING
BADSCH==4	; SCHEDULING INCORRECT
NOPRV==10	; JOB NOT PRIVILEGED
ST%NLG==1
ST%NRT==10
CL.DAT==100
DC.SAF==1B4		; [17]

EXTERN	.JBREL,.JBFF,.JBREN
SUBTTL	AC ASSIGNMENTS

M=0
T=1
T1=T+1
T2=T+2
T3=T+3
T4=T+4
N=6
N1=N+1
CH=10
R=11
U=12
P1=13
P2=P1+1
P3=P2+1
P4=P3+1
P=17

SUBTTL	IO CHANNELS

DSK==1		;FOR READING DISK
LPT==2		;FOR OUTPUT
STR==3		;FOR LOOKUPS
RCV==4		; LOST BLOCK RECOVERY CHANNEL
BAT==5	;BAT BLOCK CHANNEL

;CALLI ADDRESSES

RESET==0
EXPAND==11
EXIT==12
DATE==14
MSTIME==23
PATH.==110

SUBTTL	DSKCHR INDICES

.CHSNM==4	;NAME OF STR
.CHCHR==5	;CHARACTERISTICS
.CHBPU==6	;BLOCKS ON THIS UNIT

.CHLEN==7	;WORDS IN DSKCHR ARGUMENT LIST

MAXUN==8		;MAXIMUM NUMBER OF UNITS IN A FILE STRUCTURE

OPDEF PJRST [JRST]
SUBTTL	RELATIVE INDECES INTO EXTENDED RIB

.RBCNT==0	;COUNT OF ARGS FOLLOWING
.RBPPN==1	;DIRECTORY NAME OR POINTER
.RBNAM==2	;FILENAME
.RBEXT==3	;EXTENSION, ACCESS DATE, ERROR CODE
.RBPRV==4	;PRIVILEGE, MODE, CREATION TIME AND DATE
.RBSIZ==5	;LENGTH
.RBVER==6	;VERSION
.RBSPL==7	;SPOOLED FILE NAME
.RBEST==10	;ESTIMATED LENGTH
.RBALC==11	;ALLOCATION
.RBPOS==12	;POSITION TO ALLOCATE
.RBFT1==13	;DEC NON-PRIV. FUTURE ARG
.RBNCA==14	;NON-PRIV. CUSTOMER ARG
.RBMTA==15	;TAPE LABEL
.RBDEV==16	;LOGICAL UNIT NAME
.RBSTS==17	;FILE STATUS BITS
.RBELB==20	;ERROR LOGICAL BLOCK
.RBEUN==21	;ERROR UNIT AND LENGTH
.RBQTF==22	;FCFS LOGGED-IN QUOTA
.RBQTO==23	;LOGGED-OUT QUOTA
.RBQTR==24	;RESERVED QUOTA
.RBUSD==25	;BLOCK IN USE
.RBAUT==26	;AUTHOR
.RBNXT==27	;CONTINUED STR
.RBPRD==30	;PREDECESSOR STR
.RBPCA==31	;PRIV. CUSTOMER ARG
.RBUFD==32	;POINTER BACK TO UFD
.RBFLR==33	;RELATIVE BLOCK IN FILE COVERED BY THIS RIB
.RBXRA==34	;POINTER TO NEXT RIB IN CHAIN
.RBTIM==35	;CREATION DATE,,TIME IN INTERNAL SYSTEM FORMAT
SUBTTL	STORAGE MACROS

.ZZ=140
DEFINE U(A)<UU(A,1)>

IFN PURESW,<	HISEG
DEFINE UU(A,B)<
A=.ZZ
.ZZ==.ZZ+B>>
IFE PURESW,<DEFINE UU(A,B)<
A:	BLOCK B
.ZZ==.ZZ+B>>

SUBTTL	MONERR - MACRO TO MONITOR ERRORS

COMMENT	$	MONERR - MACRO TO MONITOR ERRORS

NOTE:  THE SYMBOL PRGABV MUST  BE  DEFINED  WITH  THE  ASCII
VALUE  OF THE 3-CHARACTER ABBREVIATION FOR THE PROGRAM NAME.
FOR EXAMPLE:  IF THE ABBREVIATED CODE FOR THE PROGRAM MUMBLE
IS "MBL" THEN THE USER SHOULD DEFINE THE SYMBOL PRGABV THUS:
PRGABV==ASCIZ "MBL"

CODE = 3-CHARACTER STOP CODE (UNIQUE)
STPR = LONG MESSAGE
APACT = ACTION
	1) STOP		EXECUTE A CALLI 1,12
	2) EXIT		EXECUTE A CALLI 0,12
	3) AUTO		CONTINUE AFTER TYPING MESSAGE
	4) CONT		CONTINUE IF USER TYPES CONTINUE
	5) HALT		EXECUTE A HALT
	6) RETRY	WHERE TO GO ON A FAILURE
			REQUIRES ADDITIONAL ARGUMENT (GOADR)
	7) EXPAND	TYPE MESSAGE AND AUTOMATICALLY GO TO
			GOADR; PRESUMABLY TO A ROUTINE TO EITHER
			EXECUTE SPECIAL RECOVERY CODE OR TO TYPE
			A MORE EXPLICIT ERROR MESSAGE.

EXAMPLES:
	MONERR (SMC,SAMPLE MACRO CALL,EXIT)
	MONERR (NRP,NO RECOVERY POSSIBLE,HALT)
	MONERR (RIP,RECOVERY IS POSSIBLE,RETRY,REENT)

SAMPLE TYPEOUT:
	ASSUMING THAT PRGABV=ASCII /XXX/ THEN THE
	LAST EXAMPLE WOULD TYPE THE FOLLOWING:
? XXXRIP RECOVERY IS POSSIBLE
	ON THE TERMINAL.

$

	DEFINE MONERR (COD,STPR,APACT,GOADR,FINI),<
	...'COD==.
	XLIST
	JRST	[OUTSTR	[ASCIZ \
? \]
	IFNDEF PRGABV,<PRGABV==ASCIZ "...">
	OUTSTR	[EXP PRGABV]
	IFB <FINI>,<
	OUTSTR	[ASCIZ \COD STPR
\]>
	IFNB <FINI>,<
	OUTSTR	[ASCIZ \COD STPR\]
	PUSHJ	17,FINI
>

	IFIDN <APACT><STOP>,<CALLI 1,12
	JRST	.+1>

	IFIDN <APACT><EXIT>,<CALLI 12>

	IFIDN <APACT><AUTO>,<JRST .+1>

	IFIDN <APACT><CONT>,<
	OUTSTR	[ASCIZ \  TYPE CONTINUE TO RECOVER
\]
	CALLI 1,12
	JRST	.+1>

	IFIDN <APACT><HALT>,<HALT ...'COD>

	IFIDN <APACT><RETRY>,<
	OUTSTR	[ASCIZ \  CONTINUATION WILL ATTEMPT TO RECOVER ...
\]
	CALLI	1,12
	JRST	GOADR>
	IFIDN <APACT><EXPAND>,<JRST GOADR>
]
	LIST>
SUBTTL	DSKRAT

DOLOOK:	0			;=0 IF DO LOOKUPS, NON-0 IF FAST (NO LOOKUPS)

COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1970,1986. ALL RIGHTS RESERVED.
\;END COPYRIGHT MACRO


DSKRAT:	MOVE	P,PDL		;INITIALIZE PUSH DOWN POINTER
	MOVEI	T,^D36		; COUNT OF ARGS IN EXTENDED LOOKUP BLOCK
	MOVEM	T,ERRNAM+.RBCNT ; STORE IN RIB BLOCK
	IFN LBRCOD,<
	SETZM	LSTFLG		; CLEAR LBR FLAG
	PUSHJ	P,CHKJOB	; SEE IF CONDITIONS OK FOR LBR AND SET FLAG
	SETZM	FUNNAM		; CLEAR INCREMENTAL EXTENSION
		>	; ! END OF LBRCOD CONDITIONAL
	MOVEI	T,REENTR
	MOVEM	T,.JBREN
	MOVE	T,[IOWD 200,BUF]
	MOVEM	T,IOCW		;SET UP IOWD FOR THIS LOOP
	SETZB	T2,IOCW+1
	SETZB	U,STRBPU	;START WITH LOG UNIT 0
	MOVSI	T1,(SIXBIT .STR.)
	MOVEM	T1,CHRBUF	;LOGICAL DEVICE STR
	MOVEI	T,17
	OPEN	DSK,T
	  JRST	NOSTR		;NOT A DEVICE
	PUSHJ	P,GETCHR	;GET DSKCHR CHARACTERISTICS
	MOVE	T,CHRBUF+.CHSNM	;NAME OF STR
	MOVEM	T,STRNAM
SETTLE:	MOVE	T,U		;T=THIS LOGICAL UNIT
	PUSHJ	P,LNAME		;COMPUTE SIXBIT LOGICAL UNIT IN STR
	MOVEI	T,17
	MOVE	T1,CHRBUF	;SIXBIT LOGICAL UNIT IN STR
	MOVEM	T1,ERRNAM+.RBNAM ;USE A HANDY FILE NAME
	SETZB	T2,ERRNAM+.RBPPN
	OPEN	DSK,T		;OPEN THIS UNIT
	  JRST	INITL		;NO MORE UNITS
;[15] SETTLE+7 1/2    SHP    14 MAR 75
	PUSHJ	P,GETCHR	;[15] SET UP BLOCKS/UNIT
	ENTER	DSK,ERRNAM+.RBCNT ;ENTER A FILE ON THIS UNIT
	  AOJA	U,SETTLE	;NO GOOD, TRY NEXT UNIT
	OUTPUT	DSK,IOCW	;TRY AN OUTPUT TO MAKE SURE SAT IS WRITTEN OUT
	CALLI	RESET		;RESET TO CLEAR THE FILE WE DONT WANT
	AOJA	U,SETTLE	;LOOP FOR ALL UNITS
INITL:	CALLI	RESET
	MOVEI	T,17
	MOVSI	T1,(SIXBIT .STR.) ;LOGICAL NAME
	SETZB	T2,TRBFLG	;CLEAR TRBFLG - SET IF MULT USED CLUSTERS
	OPEN	DSK,T		;OPEN STR FOR READING
	  JRST	NOSTR
	OPEN	STR,T		;AND FOR LOOKUPS
	  JRST	NOSTR
	MOVSI	T3,(SIXBIT .LPT.)
	HRLZI	T4,LOBUF
	OPEN	LPT,T2		;OPEN LPT IN ASCII MODE (KNOW T2=0)
	MONERR	(NLA,<DEVICE "LPT" NOT AVAILABLE>,EXPAND,QUIT1)
	MOVE	T,[SIXBIT "DSKRAT"] ;[13] STANDARD FILE NAME
	MOVSI	T1,(SIXBIT .LST.)
	SETZB	T2,T3
	ENTER	LPT,T		;ENTER IN CASE DIRECTORY DEVICE
	  JFCL
	SETZB	U,T
SUBTTL	READ UNIT HOME BLOCKS
SUBTTL	SET UNIT PARAMETERS

;HERE TO READ FIRST HOME BLOCK AND SET PARAMETERS FOR FIRST UNIT

	PUSHJ	P,LNAME		;COMPUTE SIXBIT LOGICAL UNIT IN STR
	PUSHJ	P,GETCHR	;DSKCHR, SET BLOCKS PER UNIT
	LDB	N,UNYBPC
	MOVEM	N,BLKPCL
	PUSHJ	P,HOMCHK	;READ,VERIFY HOME BLOCKS, LEAVE IN BUFFER
	  JRST	BADHOM
	MOVE	T,BUF+HOMMFD
	MOVEM	T,MFDRIB	;LOGICAL BLOCK WITHIN STR OF MFD RIB
	MOVE	T,BUF+HOMCLP	;CLUSTER ADDR IN RET. PTR BYTE PTR
	HRRI	T,P1		;OUR PTRS ARE IN P1
	MOVEM	T,STYCLP
	MOVE	T,BUF+HOMCNP	;CLUSTER COUNT BYTE PTR
	HRRI	T,P1
	MOVEM	T,STYCNP
	MOVE	T,BUF+HOMCKP	;CHECKSUM BYTE PTR
	HRRI	T,P1
	MOVEM	T,STYCKP
	MOVE	T,BUF+HOMBSC	;BLOCKS PER SUPERCLUSTER
	MOVEM	T,STRBSC
	MOVE	T,BUF+HOMSCU	;SUPERCLUSTERS PER UNIT
	MOVEM	T,STRSCU
	MOVE	T,BUF+HOMSPU	;SATS ON THIS UNIT
	HRLZM	T,DSKSAT	;STORE IN TABLE FOR UNIT 0
	PUSHJ	P,CPSWPS	;COMPUTE CLUSTERS PER SAT AND WORDS PER SAT

;HERE TO READ HOME BLOCKS FOR THE REST OF THE UNITS IN THE FILE STRUCTURE

NXTUN:	MOVE	T,BUF+HOMNXT	;UNIT ID OF NEXT UNIT IN STR
	JUMPE	T,ENDHOM
	ADDI	U,1		;NEXT UNIT
	PUSHJ	P,HOMCHK	;READ,VERIFY NEXT HOME BLOCK
	  JRST	BADHOM
	MOVE	T,BUF+HOMSPU	;SATS ON THIS UNIT
	HRLZM	T,DSKSAT(U)
	MOVE	T,U		;T=LOGICAL UNIT NUMBER
	PUSHJ	P,LNAME		;COMPUTE NEXT LOG UNIT IN STR IN SIXBIT
	PUSHJ	P,GETCHR	;DSKCHR, SET BLOCKS PER UNIT
	PUSHJ	P,CPSWPS	;COMPUTE CLUSTERS PER SAT AND WORDS PER SAT
	JRST	NXTUN
SUBTTL	SAT POINTER TABLES

;HERE TO SET UP TABLES POINTING TO SATS IN CORE

ENDHOM:	MOVE	T,.JBFF
	MOVEM	U,HIGHU
	SETZ	U,
SETST1:	HRRM	T,DSKSAT(U)	;ADDR OF 1ST SAT ON THIS UNIT
	PUSHJ	P,NXSTAD	;ADD WORDS FOR SATS ON THIS UNIT
	CAME	U,HIGHU		;SKIP IF NO MORE UNITS
	AOJA	U,SETST1
	SETZ	U,
SETOU1:	HRRM	T,OURSAT(U)	;ADDR OF OUR 1ST SAT FOR THIS UNIT
	PUSHJ	P,NXSTAD	;ADD WORDS FOR SATS ON THIS UNIT
	CAME	U,HIGHU		;SKIP IF NO MORE UNITS
	AOJA	U,SETOU1
	SETZ	U,
SETTR1:	HRRM	T,TRBSAT(U)	;ADDR OF 1ST TROUBLE SAT FOR THIS UNIT
	PUSHJ	P,NXSTAD	;ADD WORDS FOR SATS ON THIS UNIT
	CAME	U,HIGHU		;SKIP IF NO MORE UNITS
	AOJA	U,SETTR1
	MOVEM	T,.JBFF		;SET FIRST FRELOCATION
	SOS	P1,T		;SAVE LAST ADDR IN P1

	CAMG	T,.JBREL
	JRST	HAVCOR
	MOVE	T1,T
	CALLI	T1,EXPAND
	MONERR	(MCR,MORE CORE REQUIRED,EXPAND,NOCORE)
HAVCOR:	MOVE	T,OURSAT
	HRLS	T
	SETZM	(T)
	ADDI	T,1
	BLT	T,(P1)		;CLEAR OUR SATS AND TROUBLE SATS
SUBTTL	READ UNIT SAT BLOCKS

;HERE TO READ IN SAT BLOCKS

	MOVE	T,BUF+HOMSAT	;LOGICAL BLOCK WITHIN STR OF SAT.SYS RIB
	PUSHJ	P,RIBCHK	;READ, VERIFY 1ST SAT.SYS RIB
	MONERR	(BSR,BAD SAT RIB,EXPAND,SRBER4)
	MOVEI	P2,BUF
	ADD	P2,RIBFIR(P2)	;P2=PTR TO RETRIEVAL PTRS
	SETZ	P3,		;P3=COUNTER FOR SATS ON EACH UNIT
NXSPTR:	MOVE	P1,(P2)		;P1=NEXT PTR
	LDB	T,STYCNP	;NUMBER OF CLUSTERS IN THIS GROUP
	JUMPN	T,NXSBLK	;JUMP IF NON-ZERO
	TRZN	P1,RIPNUB	;SKIP IF NEW UNIT PTR
	JRST	ALLSAT		;ALL SATS ARE IN CORE
	SKIPE	P3		;SKIP UNLESS NOT ENOUGH SATS ON UNIT
	PUSHJ	P,SRBER1
	CAMLE	P1,HIGHU
	JRST	SRBER6		;ILLEGAL UNIT
	HRRZ	U,P1		;SET U=NEW UNIT
	SKIPN	U		;UNIT 0 HAS 1ST RIB
	AOBJN	P2,.+1		;MUST IGNORE IT
	HLRZ	P3,DSKSAT(U)	;P3=SATS ON THIS UNIT
	JRST	NXLPTR		;GO TO NEXT PTR
NXSBLK:	JUMPG	P3,NXSBL1	;TOO MANY SATS THIS UNIT
	CAML	U,HIGHU		;LAST UNIT HAS 2ND RIB
	JRST	NXLPTR		;IGNORE THIS PTR
	PUSHJ	P,SRBER2
NXSBL1:	HLRZ	T,DSKSAT(U)	;SATS ON THIS UNIT
	SUB	T,P3		;-COUNTER=INDEX
	HRRZ	T1,UNIWPS(U)	;WORDS IN THIS SAT
	IMUL	T,T1
	ADD	T,DSKSAT(U)	;RH=ADDR OF 1ST WORD FOR THIS SAT
	SUBI	T,1		;-1 FOR IOWD
	MOVNS	T1		;-WORDS IN THIS SAT
	HRL	T,T1		;FORM IOWD IN T
	LDB	T1,STYCLP	;CLUSTER ADDR WITHIN UNIT FOR THIS SAT
	IMUL	T1,BLKPCL	;TIMES BLOCKS PER CLUSTER=LOGICAL BLOCK NUM
	PUSHJ	P,BLKRED	;READ THE SAT (FIRST BLOCK IN CLUSTER IS SAT BLOCK)
	  PUSHJ	P,SRBER5	;ERROR READING SAT BLOCK
	SUBI	P3,1		;COUNT SATS ON THIS UNIT
NXLPTR:	AOBJN	P2,NXSPTR	;LOOP FOR ALL PTRS IN RIB
	PUSHJ	P,SRBER3	;TOO MANY PTRS
SUBTTL	FILE STRUCTURE PROCESSING

;HERE WHEN ALL DISK SATS READ INTO CORE - PROCESS FILE STRUCTURE

ALLSAT:	MOVE	T,[IOWD 200,MFDBUF]
	MOVEM	T,MFDRIB+XIOWD
	MOVEI	T,MFNXUF	;ROUTINE TO PROCESS MFD ENTRIES
	MOVEM	T,MFDRIB+ROUTIN

	MOVE	T,[IOWD 200,UFDBUF]
	MOVEM	T,UFDRIB+XIOWD
	MOVEI	T,UFNXFL	;ROUTINE TO PROCESS UFD ENTRIES
	MOVEM	T,UFDRIB+ROUTIN
	MOVE	T,[XWD 3,SFDBUF]
	SETOM	SFDBUF		;-1 TO READ DEFAULT PATH
	CALLI	T,PATH.
	  SKIPA	T,SFDBUF	;NO SFD'S IN THIS MONITOR
	SETZ	T,		;HAVE SFD'S
	MOVEM	T,SFDCNT	;-1 IF NO SFD'S, ELSE 0
	JUMPL	T,PROCES
	MOVE	T,[XWD -SFDLVL,SFDRIB]
	MOVEI	T2,UFNXFL	;PROCESS SFD'S SAME AS UFDS'S
	MOVE	T1,[IOWD 200,SFDBUF]
SETSFD:	MOVEM	T1,XIOWD(T)
	MOVEM	T2,ROUTIN(T)
	ADDI	T1,200
	ADD	T,[XWD 1,CRBSIZ]
	JUMPL	T,SETSFD	;INITIALIZE FOR ALL SF LEVELS
	SETZM	SFDNAM
	MOVE	T,[XWD SFDNAM,SFDNAM+1]
	BLT	T,SFDNAM+SFDLVL-1
PROCES:	TTCALL	3,[ASCIZ .
RUNNING
.]
	SETZM	TRBFIL		;CLEAR LAST FILE HAD PROBLEM FLAG
	PUSHJ	P,IDENT		;IDENTIFY OURSELF
	MOVEI	P4,MFDRIB	;SET UP FOR MFD
	PUSHJ	P,MFUFFL	;PROCESS MFD

	PUSHJ	P,IDENT		;IDENTIFY OURSELF
	PUSHJ	P,PRLOST	;PRINT LIST OF LOST CLUSTERS
	PUSHJ	P,PRFREE	;PRINT LIST OF FREE CLUSTERS
	PUSHJ	P,PRMULT	;PRINT LIST OF MULTIPLY USED CLUSTERS
	OUTPUT	LPT,		;MAKE SURE ALL OUTPUT OUT BEFORE TYPING
	TTCALL	3,[ASCIZ .
END OF PASS 1.]
	SKIPE	TRBFLG		;SKIP IF NO MULTIPLY USED CLUSTERS
	JRST	PASS2		;START PASS 2
	TTCALL	3,[ASCIZ .  NO NEED FOR PASS 2.]
	JRST	QUIT
PASS2:	TTCALL	3,[ASCIZ .  BEGINNING PASS 2
.]
	HRRZ	T,OURSAT
	SETZM	(T)
	HRLS	T
	ADDI	T,1
	HRRZ	T1,TRBSAT
	BLT	T,-1(T1)	;CLEAR OUR SAT
	SETZM	TRBFIL
	PUSHJ	P,IDENT
	SETOM	DOLOOK		;NO NEED TO LOOKUP AGAIN ON 2ND PASS
	MOVEI	P4,MFDRIB
	PUSHJ	P,MFUFFL	;PROCESS MFD AGAIN
	JRST	QUIT
SUBTTL	PROCESSING OF MFD'S, UFD'S AND SFD'S

;SUBROUTINE TO PROCESS MFD, UFD OR SFD
;ARG	P4=ADDR OF CORE BLOCK 

MFUFFL:	MOVE	T,RIBLBN(P4)	;LOGICAL BLOCK NUM OF 1ST RIB
	PUSHJ	P,RIBCHK	;READ, VERIFY 1ST RIB
	  JRST	MURBER
	MOVE	T,BUF+RIBSIZ	;DATA WORDS WRITTEN
	ADDI	T,BLKSIZ-1	;PAD TO FULL BLOCK SIZE
	IDIVI	T,BLKSIZ	;CONVERT TO BLOCKS
	JUMPE	T,CPOPJ		;EXIT IF NO DATA WORDS
	MOVEM	T,FULBLK(P4)	;SAVE FULL BLOCKS
	SETOM	RIBFLG(P4)	;REMEMBER 1ST GROUP FOR 1ST RIB
	PUSHJ	P,PTRCPY	;COPY SOME PTRS INTO CORE BLOCK
NXTP1:	PUSHJ	P,DPTGET	;GET NEXT REAL PTR IN P1, CLUSTER COUNT IN P3
				; UNIT TO U IF NEW UNIT
	  JRST	MUILUN		;PRINT ILLEGAL UNIT, GO TO NEXT NEW UNIT PTR
	JUMPE	P1,CPOPJ	;EXIT IF LAST PTR DONE
	IMUL	P3,BLKPCL	;P3=BLOCKS LEFT IN THIS GROUP
	LDB	T,STYCLP	;CLUSTER WITHIN UNIT OF THIS GROUP
	IMUL	T,BLKPCL	;T=1ST BLOCK IN GROUP
	AOSE	RIBFLG(P4)	;SKIP IF 1ST GROUP
	SUBI	T,1		;COMPENSATE FOR 1ST AOS
	MOVEM	T,NXTBLK(P4)	;SAVE NEXT BLOCK TO READ-1
	HRLM	U,THSUNI(P4)	;AND THE UNIT ITS ON
	SKIPG	RIBFLG(P4)	;SKIP IF NOT 1ST GROUP
	JRST	NXTG4
NXTG2:	MOVE	T,XIOWD(P4)	;GET IOWD
	AOS	T1,NXTBLK(P4)	;NEXT BLOCK TO READ
	HLRZ	U,THSUNI(P4)	;UNIT ITS ON
	PUSHJ	P,BLKRED	;READ NEXT DATA BLOCK
	  JRST	NXTG5		;ERROR READING BLOCK
NXTG3:	MOVE	P2,XIOWD(P4)
	ADDI	P2,1		;MAKE AOBJN PTR
	HRRZ	T,ROUTIN(P4)	;ADDR OF ROUTINE TO CALL
	PUSHJ	P,(T)		;PROCESS THIS ENTRY
NXTG5:	SOSG	FULBLK(P4)	;SKIP IF MORE BLOCKS
	POPJ	P,		;ALL DONE
NXTG4:	SOJG	P3,NXTG2	;LOOP FOR ALL BLOCKS IN THIS GROUP
	HLRZ	U,THSUNI(P4)	;MAKE SURE U IS THIS UNIT
	JRST	NXTP1		;GET NEXT PTR
SUBTTL	CHECK UFD'S IN MFD BLOCK

;SUBROUTINE TO CHECK ALL UFD'S IN AN MFD BLOCK
;THIS ROUTINE IS CALLED BY MFUFFL AT MFD LEVEL
;ARGS	P2=AOBJN PTR TO BLOCK

MFNXUF:	HLRZ	T,1(P2)		;GET NEXT EXT
	CAIN	T,(SIXBIT .UFD.) ;SKIP IF NOT A UFD
	PUSHJ	P,UFDSCN	;CHECK ALL FILES IN UFD
	AOBJN	P2,.+1
	AOBJN	P2,MFNXUF
	POPJ	P,

SUBTTL	UFD SCANNING
;SUBROUTINE TO SCAN A UFD

UFDSCN:	JSP	T4,SAVE4
	MOVE	T,(P2)		;GET PPN
	MOVEM	T,PPN
	HRRZ	T,1(P2)		;T=CFP FOR THIS UFD
	PUSHJ	P,CFP2BK	;GET LOG BLOCK WITHIN STR OF 1ST RIB
	MOVEM	T,UFDRIB
	MOVEI	P4,UFDRIB
	PJRST	MFUFFL		;PROCESS THIS UFD

SUBTTL	CHECK FILES IN UFD BLOCK
;SUBROUTINE TO CHECK ALL FILES IN A UFD BLOCK
;THIS ROUTINE IS CALLED BY MFUFFL AT UFD LEVEL
;ARGS	P2=AOBJN PTR TO BLOCK

UFNXFL:	SKIPN	(P2)		;SKIP IF HAVE FILE NAME
	SKIPE	1(P2)		; OR EXT OR CFP
	PUSHJ	P,FILSCN
	AOBJN	P2,.+1
	AOBJN	P2,UFNXFL	;LOOP FOR ALL ENTRIES IN THIS BLOCK
	POPJ	P,


SUBTTL	SFD SCANNING
;SUBROUTINE TO SCAN AN SFD
SFDSCN:	JSP	T4,SAVE4
	AOS	T1,SFDCNT
	MOVE	T,(P2)		;SFD NAME
	MOVEM	T,SFDNAM-1(T1)	;SAVE IN LOOKUP BLOCK
	HRRZ	T,1(P2)
	PUSHJ	P,CFP2BK	;LOG BLOCK WITHIN STR OF SFD RIB
	SOSE	T1		;COMPUTE ADDR OF RIGHT SFD CONTROL BLOCK
	IMULI	T1,CRBSIZ
	MOVEI	P4,SFDRIB	;1ST CONTROL BLOCK
	ADD	P4,T1
	MOVEM	T,(P4)		;SAVE RIB BLOCK IN CONTROL BLOCK
	PUSHJ	P,MFUFFL	;PROCESS THE SFD
	SOS	T,SFDCNT	;REDUCE THE SFD NESTING BY 1
	SETZM	SFDNAM(T)
	POPJ	P,
SUBTTL	UFD ENTRY PROCESS ROUTINE
;SUBROUTINE TO PROCESS NEXT ENTRY IN A UFD
;ARGS	P2=AOBJN PTR IN UFD

FILSCN:	JSP	T4,SAVE4
	SKIPE	TRBFIL		;SKIP IF NO MESSAGES LAST FILE
	PUSHJ	P,CRLF		;CRLF TO SET FILES APART
	SETZM	TRBFIL
	MOVE	T,PPN		;PPN
	SKIPGE	SFDCNT
	JRST	FILSC1		;SAVE PPN IN E+3 IF NO SFD'S
	MOVEM	T,SFDPPN	;SFD'S - SAVE IN SFD BLOCK
	MOVEI	T,SFDBLK	;POINT E+3 TO THE BLOCK
FILSC1:	MOVEM	T,ERRNAM+.RBPPN
	MOVE	T4,ERRNAM+.RBPPN ;SAVE PPN OR SFD POINTER
	MOVE	T,(P2)		;FILE NAME
	MOVEM	T,ERRNAM+.RBNAM
	HLLZ	T,1(P2)		;EXT
	MOVEM	T,ERRNAM+.RBEXT
	SKIPE	DOLOOK		;FAST?
	JRST	FILSC3		;YES, SKIP THE LOOKUP
	LOOKUP	STR,ERRNAM+.RBCNT
	  PUSHJ	P,LOOKER
	MOVEM	T4,ERRNAM+.RBPPN ;RESTORE PPN OR SFD POINTER
;DROP INTO FILSC3
FILSC3:	HRRZ	T,1(P2)		;CFP FOR FILE
	PUSHJ	P,CFP2BK	;CONVERT TO LOG BLOCK NUM
	MOVEM	T,FILRIB	;SAVE IN CORE BLOCK
	PUSHJ	P,RIBCHK	;READ,VERIY 1ST RIB
	  PJRST	FLRBER		;PRINT MESSAGE AND MARK CLUSTER AS USED
	MOVE	T,BUF		;NUMBER OF POINTERS
	HRRZM	T,FSTPTR	;SAVE FOR EXTENDED-RIB CHECK
	MOVE	T,PPN
	SKIPGE	SFDCNT
	MOVEM	T,ERRNAM+.RBPPN
	MOVE	T1,BUF+RIBNAM	;NAME FROM RIB
	CAMN	T,BUF+RIBPPN	;SKIP IF BAD PPN
	CAME	T1,(P2)		;SKIP IF FILE NAME AND PPN OK
	PJRST	FLRBER		;RIB ERROR
	HLLZ	T,BUF+RIBEXT	;EXT FROM RIB
	HLLZ	T1,1(P2)	;EXT
	CAME	T,T1		;SKIP IF EXT OK
	PJRST	FLRBER
	MOVEI	P4,FILRIB
	PUSHJ	P,PTRCPY	;COPY PTRS TO CORE BLOCK
	MOVE	T,BUF+RIBSTS	;STATUS BITS
	MOVEM	T,NXTBLK+FILRIB	;SAVE IN CORE BLOCK
	MOVE	T,BUF+RIBSIZ	;NUMBER OF DATA WORDS WRITTEN
	ADDI	T,BLKSIZ-1
	IDIVI	T,BLKSIZ	;NUMBER OF DATA BLOCKS WRITTEN
	MOVEM	T,FULBLK+FILRIB	;SAVE FOR CHECKSUMMING PURPOSES
FILSC2:	SETOM	RIBFLG+FILRIB
FLNXPT:	PUSHJ	P,DPTGET	;GET NEXT DATA PTR
	  PUSHJ	P,FLILUN	;PRINT MESSAGE, GET 1ST PTR IN NEXT UNIT
	JUMPE	P1,FLDONE	;EXIT IF LAST PTR DONE
	AOS	RIBFLG+FILRIB
	MOVE	T,NXTBLK+FILRIB ;STATUS WORD FROM RIB
	SKIPLE	FULBLK+FILRIB	;NO CHECKSUM IF NO MORE DATA BLOCKS
	TRNE	T,RIPABC	;SKIP UNLESS ALWAYS BAD CHECKSUM
	JRST	NOCHEK
	IMUL	P3,BLKPCL	;P3=BLOCKS IN THIS GROUP
	SKIPG	RIBFLG+FILRIB	;SKIP UNLESS 1ST GROUP
	SUBI	P3,1		;-1 FOR 1ST RIB
	JUMPE	P3,NOCHEK	;P3=0 IF 1ST GROUP, ONLY 1 BLOCK
	SUBM	P3,FULBLK+FILRIB ;SUBTRACT FROM DATA BLOCKS
	MOVNS	FULBLK+FILRIB	;MAKE PROPER SIGN AGAIN
FILCHK:	LDB	T,STYCLP	;1ST CLUSTER IN THIS GROUP
	PUSHJ	P,USET1
	MOVE	T,[IOWD 200,BUF]
	PUSHJ	P,BLKRD1
	  JRST	NOCHEK
	PUSHJ	P,CHKSUM
	LDB	T1,STYCKP	;CHECKSUM FROM PTR
	CAME	T,T1		;COMPARE COMPUTED AND STORED
	PUSHJ	P,CHKERR	;PRINT IF DIFFERENT
NOCHEK:	LDB	P3,STYCNP	;NUMBER OF CLUSTERS
	LDB	P2,STYCLP	;1ST CLUSTER IN GROUP
FLNXBL:	MOVE	T,P2
	PUSHJ	P,CLSCHK	;CHECK BITS FOR THIS CLUSTER IN VARIOUS SATS
	  JRST	FLNXPT		;SOMETHING WRONG WITH THIS GROUP
	ADDI	P2,1
	SOJG	P3,FLNXBL	;LOOP FOR ALL CLUSTERS IN GROUP
	JRST	FLNXPT		;GET NEXT PTR

FLRBER:	HRLZI	T,[ASCIZ .RIB ERROR.]
	MOVE	N,FILRIB
	IDIV	N,BLKPCL
	HRRI	T,ERRNAM+.RBCNT
	PUSHJ	P,PRTRBL
	MOVE	T,FILRIB
	IDIV	T,STRBPU
	MOVE	T,T1
	IDIV	T,BLKPCL
	PUSHJ	P,CLSCHK
	  JFCL
	POPJ	P,

FLDONE:	MOVE	P2,-3(P)	;RESTORE P2
	JUMPL	T1,FLDON1	;JUMP IF RIB NOT FULL OF POINTERS
	MOVE	T,FSTPTR	;IF LESS THAN RIBXRA ARGS IN RIB
	CAIG	T,RIBXRA	; THIS IS AN OLD FILE
	JRST	FLDON1		; WHICH CAN'T HAVE AN EXTENDED RIB
	SKIPL	SAVRIB+RIBXRA(P4)	;POINTER TO EXTENDED RIB?
	JRST	FLDON1		;NO, PROCEED
	LDB	T,RBYRBU	;GET LOGICAL UNIT NUMBER OF EXTENDED RIB
	CAMLE	T,HIGHU		;LEGAL UNIT?
	PJRST	FLRBER		;NO, RIB ERROR
	MOVE	U,T		;GET NEW UNIT (OR OLD) TO U
	LDB	T1,RBYRBA	;GET CLUSTER ADDRESS
	IMUL	T1,BLKPCL	;CONVERT TO LOGICAL BLOCK NUMBER
	MOVEM	T1,FILRIB	; SAVE IT
	PUSHJ	P,RIBCK1	;READ AND VERIFY EXTENDED RIB
	  PJRST	FLRBER		;ERROR
	MOVE	T,PPN
	MOVEM	T,ERRNAM+.RBPPN
	MOVE	T1,BUF+RIBNAM	;NAME FROM RIB
	CAMN	T,BUF+RIBPPN	;SKIP IF BAD PPN
	CAME	T1,(P2)		;SKIP IF FILE NAME AND PPN OK
	PJRST	FLRBER		;RIB ERROR
	HLLZ	T,BUF+RIBEXT	;EXT FROM RIB
	HLLZ	T1,1(P2)	;EXT
	CAME	T,T1		;SKIP IF EXT OK
	PJRST	FLRBER		;RIB ERROR
	PUSHJ	P,PTRCPY	;COPY POINTERS TO CORE BLOCK
	SETZM	SAVRIB+RIBFLR(P4)	;CLEAR RIBFLR FOR CHECH ABOVE

;HERE WHEN WE'RE FINISHED WITH THE RIB(S) FOR THE CURRENT FILE
	JRST	FILSC2		;LOOK AT THE POINTERS IN THIS RIB
FLDON1:	SKIPL	T,SFDCNT	;IF THE MONITOR HAS SFD'S,
	HLRZ	T,1(P2)		; AND THE EXTENSION = 'SFD'
	CAIN	T,(SIXBIT .SFD.)
	PUSHJ	P,SFDSCN	;SCAN ALL THE FILES IN THE SFD
	POPJ	P,		;AND EXIT
SUBTTL	SAT CHECKOUT

;SUBROUTINE TO SET BIT IN OUR SAT AND CHECK OTHER SATS
;ARG	T=CLUSTER WITHIN UNIT
;	U=LOGICAL UNIT NUMBER

CLSCHK:	JSP	T4,SAVE1
	MOVE	P1,T
	IMUL	T,BLKPCL	;CONVERT TO LOGICAL BLOCK
	CAMLE	T,UNIBPU(U)	;SKIP UNLESS TOO BIG
	PJRST	NONEXC		;PRINT NON-EXISTENT CLUSTER
	HRRZ	T,TRBSAT(U)	;T=ADDR OF 1ST TROUBLE SAT ON THIS UNIT
	MOVE	T1,P1		;T1=CLUSTER WITHIN UNIT
	PUSHJ	P,TSTONE	;SEE IF BIT SET IN TROUBLE SAT
	  JRST	NOTRB		;NO
	PUSHJ	P,MULT		;YES, PRINT MULTIPLY USED AND SET TROUBLE BIT
	HRRZ	T,OURSAT(U)
	MOVE	T1,P1
	PUSHJ	P,MRKONE	;SET OUR SAT, BUT DONT CARE IF ALREADY SET
	  JFCL
	JRST	LKFREE		;SEE IF CLUSTER IS FREE
NOTRB:	MOVE	T1,P1
	HRRZ	T,OURSAT(U)
	PUSHJ	P,MRKONE	;SET BITS IN OUR SAT
	  PUSHJ	P,MULT		;ALREADY SET, PRINT AND SET TROUBLE BIT
LKFREE:	MOVE	T1,P1
	HRRZ	T,DSKSAT(U)
	PUSHJ	P,TSTONE	;SEE IF BIT SET IN DISK SAT
	  PUSHJ	P,FREE		;NO, CLUSTER IS FREE
	JRST	CPOPJ1

MULT:	MOVE	T1,P1
	HRRZ	T,TRBSAT(U)
	PUSHJ	P,MRKONE
	   JFCL
	SETOM	TRBFLG
	MOVE	N,STRBPU	; N=LOGICAL BLOCKS PER UNIT
	IDIV	N,BLKPCL	; N=CLUSTERS PER UNIT
	IMUL	N,U		; N=FIRST UNIT CLUSTER
	ADD	N,P1
	HRLZI	T,[ASCIZ .MULTIPLY-USED CLUSTER.]
	JRST	FREE2

FREE:	HRLZI	T,[ASCIZ .USED BUT NOT MARKED IN SAT.]
	MOVE	N,STRBPU	; N=LOGICAL BLOCKS PER UNIT
	IDIV	N,BLKPCL	; N=CLUSTERS PER UNIT
	IMUL	N,U		; N=FIRST UNIT CLUSTER
	ADD	N,P1
	JRST	FREE1
SUBTTL	HOME BLOCK READING AND VERIFICATION

;SUBROUTINE TO READ AND VERIFY HOME BLOCKS ON UNIT U
;ARG	U=LOGICAL UNIT NUMBER
;RETURN	NON-SKIP IF ERROR
;	SKIP RETURN IF ERROR

HOMCHK:	JSP	T4,SAVE1
	PUSHJ	P,FNDHOM	;RETURN HOME BLOCKS IN T
	MOVE	P1,T
	MOVE	T,[IOWD 200,BUF]
	HLRZ	T1,P1		;T1=LOG BLOCK WITHIN UNIT
	PUSHJ	P,BLKRED	;READ 1ST HOME BLOCK
	  JRST	HOM2		;ERROR READING 1ST HOME BLOCK
	MOVSI	T,(SIXBIT .HOM.)
	CAME	T,BUF+HOMNAM
	JRST	HOM2		;1ST IS NOT SIXBIT .HOM.
	MOVEI	T,CODHOM
	CAME	T,BUF+HOMCOD
	JRST	HOM2		;1ST DOES NOT HAVE PROPER CODE
	HLRZ	T,P1
	CAMN	T,BUF+HOMSLF
	JRST	CPOPJ1		;1ST IS OK
HOM2:	MONERR	(ERH,ERROR READING FIRST HOME BLOCK,EXPAND,.+1)
	HRRZ	T1,P1		;BLOCK NUM OF 2ND HOME BLOCK
	MOVE	T,[IOWD 200,BUF]
	PUSHJ	P,BLKRED
HOM3:	MONERR	(ERS,ERROR READING SECOND HOME BLOCK,EXPAND,CPOPJ)
	MOVSI	T,(SIXBIT .HOM.)
	CAME	T,BUF+HOMNAM
	JRST	HOM3		;2ND FAILS TOO
	MOVEI	T,CODHOM
	CAME	T,BUF+HOMCOD
	JRST	HOM3
	HRRZ	T,P1
	CAME	T,BUF+HOMSLF
	JRST	HOM3
	JRST	CPOPJ1

SUBTTL	FIND HOME BLOCKS
;SUBROUTINE TO FIND HOME BLOCKS ON UNIT IN U
;ARGS	U=LOGICAL UNIT NUMBER
;VALUES	T=XWD 1ST HOME BLOCK, 2ND HOME BLOCK

FNDHOM:	MOVE	T,[XWD 1,12]	;FOR NOW MUST BE 1 AND 12
	POPJ	P,
SUBTTL	READ AND VERIFY 1ST RIB
;SUBROUTINE TO READ AND VERIFY 1ST RIB AND LEAVE IN BUFFER
;ARG	T=LOGICAL BLOCK IN STR OF 1ST RIB

RIBCHK:	IDIV	T,STRBPU
	MOVE	U,T		;U=LOGICAL UNIT
RIBCK1:	MOVE	P1,T1		;P1=T1=LOG BLOCK WITHIN UNIT
	CAMLE	U,HIGHU		;SKIP IF LEGAL UNIT
	POPJ	P,
	MOVE	T,[IOWD 200,BUF]
	PUSHJ	P,BLKRED
	  POPJ	P,		;ERROR READING RIB
	MOVEI	T,CODRIB
	CAMN	P1,BUF+RIBSLF
	CAME	T,BUF+RIBCOD
	POPJ	P,
	JRST	CPOPJ1

SUBTTL	CORE BLOCK POINTERS
;SUBROUTINE TO GET NEXT REAL PTR FROM CORE BLOCK
;ARG	P4=ADDR OF CORE BLOCK
;VALUES	P1=RETRIEVAL PTR OR 0 IF NO MORE PTRS
;	P3=CLUSTER COUNT
;	U=LOGICAL UNIT

DPTGET:	PUSHJ	P,PTRGET	;GET NEXT PTR
	MOVE	P1,T		;SAVE IN P1
	LDB	P3,STYCNP	;CLUSTER COUNT
	JUMPN	P3,CPOPJ1	;EXIT IF NON-0
	TRZN	P1,RIPNUB	;SKIP IF NEW UNIT PTR
	JRST	CPOPJ1
	HRRZ	U,P1		;SET U=NEW UNIT
	CAMLE	U,HIGHU
	POPJ	P,		;ILLEGAL UNIT
	JRST	DPTGET

SUBTTL	RETRIEVAL POINTERS
;SUBROUTINE TO GET NEXT RETRIEVAL PTR FROM CORE BLOCK
;ARG	P4=ADDR OF CORE BLOCK
;VALUE	T=NEXT PTR

PTRGET:	SETZ	T,
	SKIPL	T1,SAVRIB+RIBFIR(P4)
	POPJ	P,		;NO MORE PTRS
	MOVE	T,(T1)		;T=NEXT PTR
	AOBJN	T1,.+1
	MOVEM	T1,SAVRIB+RIBFIR(P4)
	POPJ	P,

;SUBROUTINE TO COPY RETRIEVAL PTRS INTO CORE BLOCK
;COPY WHOLE RIB FOR NOW
;ARG	P4=ADDR OF CORE BLOCK

PTRCPY:	HRLZI	T,BUF		;RIB IS IN BUF
	HRRI	T,SAVRIB(P4)	;TO PROPER CORE BLOCK
	BLT	T,SAVRIB+BLKSIZ-1(P4)
	MOVEI	T,SAVRIB(P4)	;ADDR OF BEGINNING OF RIB
	ADDM	T,SAVRIB+RIBFIR(P4) ;MAKE PTR TO PTRS
	POPJ	P,
SUBTTL	CFP CONVERSION

;SUBROUTINE TO CONVERT A CFP TO LOGICAL BLOCK NUMBER
CFP2BK:	PUSH	P,T1
	IDIV	T,STRSCU	;GET UNIT, RELATIVE SUPERCLUSTER
	IMUL	T1,STRBSC	;RELATIVE BLOCK NUMBER
	IMUL	T,STRBPU	;+FIRST BLOCK OF UNIT
	ADD	T,T1
	POP	P,T1
	POPJ	P,

USET1:	IMUL	T,BLKPCL
	SKIPG	RIBFLG(P4)
	ADDI	T,1
	MOVE	T1,U
	IMUL	T1,STRBPU
	ADD	T,T1
	TLO	T,(<DSK>B12)	;PUT IN CHAN #
	PUSHJ	P,DOSUP
	POPJ	P,

SUBTTL	AC PRESERVATION SUBROUTINES
SAVE1:	PUSH	P,P1
	PUSHJ	P,(T4)
	  JRST	SAVE1X
	AOS	-1(P)
	JRST	SAVE1X
SAVE4:	PUSH	P,P1
	PUSH	P,P2
	PUSH	P,P3
	PUSH	P,P4
	PUSHJ	P,(T4)
	  JRST	.+2
	AOS	-4(P)
	POP	P,P4
	POP	P,P3
	POP	P,P2
SAVE1X:	POP	P,P1
	POPJ	P,

SUBTTL	CHECKSUM COMPUTATION
;SUBROUTINE TO COMPUTE CHECKSUM ON A GROUP THE SAME AS FILSER DOES
;ARGS	BUF=BLOCK TO BE CHECKSUMMED
;VALUES	T=CHECKSUM
CHKSUM:	JSP	T4,SAVE1
	MOVE	P1,BUF		;CHECKSUM ON 1ST WORD
	MOVE	T3,STYCKP	;CHECKSUM PTR
	LDB	T2,[POINT 6,T3,11] ;SIZE OF CHECKSUM FIELD
	MOVNS	T2		;SET FOR LSH
	TLZA	T3,770000	;SET TO BIT 35
CHKSM1:	ADD	P1,T		;NOT DONE, ADD BYTE TO REST OF WORD
	LDB	T,T3		;GET A BYTE OF CHKSUM SIZE
	LSH	P1,(T2)		;THROW AWAY THE BYTE
	JUMPN	P1,CHKSM1	;FINISHED WHEN NO MORE OF ORIGINAL WORD
	POPJ	P,
SUBTTL	PROGRAM REENTRY
;HERE IF REENTER TYPED

REENTR:	PUSHJ	P,FORM
	CLOSE	LPT,
	CALLI	EXIT

SUBTTL	IDENTIFICATION OF RUN
;SUBROUTINE TO IDENTIFY THIS RUN

IDENT:	PUSHJ	P,FORM
	MOVE	T,STRNAM
	PUSHJ	P,PR6BIT
	MOVEI	M,[ASCIZ .	BLOCKS PER CLUSTER = .]
	PUSHJ	P,MSG
	MOVE	N,BLKPCL
	PUSHJ	P,DECPRT
	MOVEI	M,[ASCIZ /.	ANALYSIS BEGUN AT /]
	PUSHJ	P,MSG
	PUSHJ	P,NOW
	PJRST	CRLF2

SUBTTL	SIXBIT LOGICAL UNIT COMPUTATION
;SUBROUTINE TO COMPUTE SIXBIT FOR LOGICAL UNIT WITHIN FILE STRUCTURE
;ARGS	STRNAM=SIXBIT NAME OF FILE STRUCTURE
;	T=LOGICAL UNIT IN STR
;VALUE	CHRBUF=SIXBIT LOGICAL UNIT IN STR

LNAME:	MOVE	T2,STRNAM
	MOVE	T3,[POINT 6,T2]
	ILDB	T4,T3
	JUMPN	T4,.-1		;FIND END OF STR NAME
	MOVEI	T4,T2
	CAIE	T4,(T3)
	JRST	STRLUX
	TLNN	T3,770000
	JRST	STRLUX
	IDIVI	T,^D10
	JUMPE	T,STRLU1
	ADDI	T,20
	DPB	T,T3
	IBP	T3
STRLU1:	ADDI	T1,20
	TLNE	T3,770000
	DPB	T1,T3
STRLUX:	MOVEM	T2,CHRBUF
	POPJ	P,
SUBTTL	SAT WORD ADDING FOR UNIT U
;SUBROUTINE TO ADD WORDS FOR SATS ON UNIT U
;ARGS	U=LOGICAL UNIT NUMBER
;	T=ADDR
;VALUE	T=ADDR+WORDS FOR SATS ON UNIT U

NXSTAD:	HLRZ	T1,DSKSAT(U)	;NUMBER OF SATS THIS UNIT
	HRRZ	T2,UNIWPS(U)	;WORDS PER SAT ON THIS UNIT
	IMUL	T1,T2
	ADD	T,T1
	POPJ	P,


SUBTTL	SAT TABLE BIT SETTING
;SUBROUTINE TO SET A BIT IN A SAT TABLE (ANY TYPE OF SAT)
;ARGS	T=ADDR OF 1ST SAT ON UNIT
;	T1=CLUSTER NUMBER WITHIN UNIT
;	U=LOGICAL UNIT NUMBER
;RETURN	NON-SKIP IF BIT ALREADY SET (CLUSTER PREVIOUSLY ALLOCATED)
;	SKIP IF BIT NOT ALREADY SET

MRKONE:	PUSHJ	P,TSTONE	;SEE IF ALREADY SET
	  AOS	(P)		;NO, SKIP RETURN
	MOVNS	T3		;-NUMBER OF PLACES TO SHIFT
	ROT	T1,(T3)
	MOVEM	T1,(T)
	POPJ	P,


SUBTTL	SAT BIT SET DETERMINATION
;SUBROUTINE TO DETERMINE IF A BIT IN A SAT TABLE IS SET (ANY TYPE OF SAT)
;ARGS	T=ADDR OF 1ST SAT ON UNIT
;	T1=CLUSTER NUMBER WITHIN UNIT
;	U=LOGICAL UNIT NUMBER
;VALUES	T1=WORD CONTAINING BIT WITH BIT ROTATED TO SIGN BIT
;	T3=NUMBER OF BITS ROTATED
;RETURN	NON-SKIP IF BIT IS NOT SET
;	SKIP IF BIT IS SET

TSTONE:	HRRZ	T2,UNICPS(U)	;CLUSTERS PER SAT
	IDIV	T1,T2		;T1=SAT NUMBER, T2=INDEX OF CLUSTER IN SAT
	HRRZ	T3,UNIWPS(U)	;WORDS PER SAT
	IMUL	T1,T3		;T1=INDEX OF BEGINNING OF SAT
	ADD	T,T1		;T=BEGINNING OF THE SAT WE WANT
	IDIVI	T2,^D36		;T2=INDEX IN SAT, T3=POS IN WORD
	ADD	T,T2		;T=ADDR OF WORD CONTAINING BIT
	MOVE	T1,(T)		;T1=WORD
	ROT	T1,(T3)		;ROTATE DESIRED BIT TO SIGN BIT
	TLOE	T1,400000	;SKIP IF NOT SET AND SET FOR CALLER
CPOPJ1:	AOS	(P)		;SKIP RETURN IF SET
CPOPJ:	POPJ	P,
SUBTTL	BLOCK READING

;SUBROUTINE TO READ A BLOCK
;ARGS	T=IOWD FOR TRANSFER
;	T1=LOGICAL BLOCK WITHIN UNIT TO READ
;	U=LOGICAL UNIT NUMBER
;	IOCW=IOWD
;ENTER AT BLKRD1 IF NO USETI REQUIRED

BLKRED:	MOVE	T2,STRBPU	;BLOCKS PER UNIT IN STR
	IMUL	T2,U		;BLOCK NUM OF 1ST BLOCK ON UNIT
	ADD	T1,T2		;T1=LOGICAL BLOCK WITHIN STR
	PUSH	P,T		;SAVE T
	MOVE	T,T1		;COPY BLOCK #
	TLO	T,(<DSK>B12)	;PUT IN CHAN #
	PUSHJ	P,DOSUP		;DO SUPER USETI
	POP	P,T		;RESTORE IOWD
BLKRD1:	MOVEM	T,IOCW
	INPUT	DSK,IOCW
	GETSTS	DSK,T		;GET STATUS
	TRZN	T,740000	;SKIP IF AN ERROR
	JRST	CPOPJ1
	SETSTS	DSK,(T)		;CLEAR ERROR BITS
	POPJ	P,		;ERROR RETURN
SUBTTL	DSKCHR AND BLOCK SETUP FOR UNIT U
;SUBROUTINE TO GET DSKCHR CHARACTERISTICS AND SET UP BLOCKS PER UNIT
;ARG	U=LOGICAL UNIT IN STR
;	CHRBUF=SIXBIT LOGICAL UNIT IN STR

GETCHR:	MOVE	T,[XWD .CHLEN,CHRBUF]
	DSKCHR	T,0
	MONERR	(SND,<DEVICE "STR" NOT A DISK FILE STRUCTURE>,EXPAND,QUIT1)
	MOVE	T,CHRBUF+.CHBPU	;BLOCKS ON THIS UNIT
	MOVEM	T,UNIBPU(U)
	CAMLE	T,STRBPU	;REMEMBER LARGEST UNIT IN STR
	MOVEM	T,STRBPU
	POPJ	P,

SUBTTL	WORD AND CLUSTER COMPUTATION PER SAT

;SUBROUTINE TO COMPUTE CLUSTERS PER SAT AND WORDS PER SAT
;ARGS	U=LOGICAL UNIT NUMBER
;VALUES	RH(UNICPS)=CLUSTERS PER SAT FOR THIS UNIT
;	RH(UNIWPS)=WORDS PER SAT FOR THIS UNIT

CPSWPS:	MOVE	T,UNIBPU(U)	;BLOCKS ON THIS UNIT
	IDIV	T,BLKPCL	;T=CLUSTERS ON THIS UNIT
	HLRZ	T1,DSKSAT(U)	;T1=SATS ON THIS UNIT
	SUBI	T,1
	IDIV	T,T1
	HRRM	T,UNICPS(U)
	AOS	UNICPS(U)	;CLUSTERS PER SAT
	IDIVI	T,^D36
	ADDI	T,1
	HRRM	T,UNIWPS(U)	;WORDS PER SAT
	POPJ	P,

NOSTR:	MONERR	(NSR,<NO STRUCTURE NAMED "STR">,EXPAND,QUIT1)
SUBTTL	JOB CHECKING

	IFN	LBRCOD, <
CHKJOB:	MOVEI	T1,0		; CLEAR ALL FLAGS
	HRLZI	T3,'STR'	; LOAD LOGICAL NAME "STR" [17]
	MOVE	T,[1,,T3]	; PREPARE FOR DSKCHR UUO [17]
	DSKCHR	T,0		; GET DEVICE CHARACTERISTICS [17]
	MONERR	(DND,<DEVICE 'STR' NOT A DISK>,EXIT) ; [21]
	TLNE	T,(DC.SAF)	; STR MOUNTED SINGLE ACCESS? [17]
	JRST	CHKJB2		; YES, IGNORE SCHEDULING REQUIREMENTS [17]
	MOVE	T,[17,,11]	; GET SCHEDULING INFO
	GETTAB	T,0
	TRO	T1,GTBFAL	; GETTAB FAILURE
	TRNE	T,ST%NRT	; SET FOR STAND-ALONE?
	JRST	CHKJB2		; YES, ALL IS OK
	TRNN	T,ST%NLG	; SET FOR NO MORE LOGINS?
	TRO	T1,BADSCH	; NO, SET ERROR
	MOVE	T,[54,,11]	; CHECK ON # OF JOBS CURRENTLY LOGGED IN
	GETTAB	T,0
	TRO	T1,GTBFAL	; GETTAB FAILURE
	SOSE	T		; ONLY 1 JOB?
	TRO	T1,NTONE	; NO, SET ERROR
CHKJB2:	MOVE	T2,[2,,16]	; GET FAILSA PPN [17]
	GETTAB	T2,0
	MOVE	T2,[1,,2]	; DEFAULT IN CASE IT FAILS
	GETPPN	T,0		; GET OUR PPN
	JFCL			; GUARD AGAINST ALTERNATE RETURN
	CAME	T,T2
	TRO	T1,NOPRV	; NOT PRIVILEGED
	IFDEF RATDDT,<
	TRZ	T1,BADSCH!NTONE	; CLEAR SCHEDULING ERRORS
>
	TRNN	T1,GTBFAL!BADSCH!NTONE!NOPRV ; ANY PROBLEMS?
	JRST	SETPRV		; NO
	SKIPE	LSTFLG		; PASS2, ABORT LBR?
	JRST	CHKJB1		; YES
	TRNE	T1,GTBFAL	; GETTAB UUO FAILURE?
	MONERR	(GUF,GETTAB UUO FAILURE,EXPAND,.+1)
	TRNE	T1,NTONE	; MORE THAN ONE JOB LOGGED IN?
	MONERR	(MOJ,MORE THAN ONE JOB LOGGED IN,EXPAND,.+1)
	TRNE	T1,BADSCH	; BAD SCHEDULING?
	MONERR	(NML,SET SCHEDULING FOR NO MORE LOGINS,EXPAND,.+1)
	TRNE	T1,NOPRV	; NO PRIVILEGES?
	MONERR	(NPJ,YOU ARE NOT A PRIVILEGED JOB,EXPAND,.+1)
	TRNE	T1,GTBFAL!NOPRV
	CALLI	EXIT
	MONERR	(LBN,LOST BLOCK RECOVERY WILL NOT BE DONE,EXPAND,.+1)
	POPJ	P,0
SETPRV:	SETOM	LSTFLG	; SET FLAG FOR LOST BLOCK RECOVERY
	POPJ	P,0
CHKJB1:	TRNN	T1,BADSCH!NTONE	; BAD SCHEDULING OR PARALLEL
				; JOB RUNNING?
	JRST	SETPRV		; OK, GETTAB FAILED THIS TIME

	IFNDEF RATDDT,<
	MONERR	(LBA,LOST BLOCK RECOVERY PHASE ABORTED,EXPAND,,.+1)
>
	TRNE	T1,NTONE
	MONERR	(AJR,ANOTHER JOB IS CURRENTLY RUNNING,EXPAND,.+1)
	TRNE	T1,BADSCH
	MONERR	(MLA,IMPROPER SCHEDULING SET,EXPAND,.+1)

	IFNDEF RATDDT,<
	SETZM	LSTFLG>

	POPJ	P,0

SUBTTL	INCREMENTAL EXTENSION LOOKUP/ENTER BLOCK

; ROUTINE TO SETUP THE ENTER/LOOKUP BLOCK WITH INCREMENTAL EXTENSION
; ON ENTRY T1=# TO BE USED FOR THE EXTENSION
; ON RETURN T1 = SIXBIT EXTENSION

EXTGEN:	MOVE	T1,FUNNAM	; GET INCREMENTAL EXTENSION
	MOVE	T3,[POINT 6,T1]
	MOVEI	T4,3
	IDIVI	T1,^D10
	PUSH	P,T2
	SOJG	T4,.-2
	MOVEI	T4,3
	POP	P,T2
	ADDI	T2,20
	IDPB	T2,T3
	SOJG	T4,.-3
	MOVE	T,[SIXBIT /LSTBLK/] ; DEFAULT FILENAME
	SETZB	T2,T3
	POPJ	P,0

		>	; ! END OF LBRCOD CONDITIONAL
SUBTTL	BAD HOME BLOCKS

BADHOM:	MOVEI	M,[ASCIZ .ERROR READING HOME BLOCKS ON LOGICAL UNIT .]
	MONERR	(HBE,<HOME BLOCK ERROR ON STR "STR">,EXPAND,.+1)
	PUSHJ	P,MSG
	MOVE	N,U
	PUSHJ	P,DECPRT
	JRST	QUIT

NOCORE:	LSH	T,-^D10
	MOVE	N,T
	PUSHJ	P,DECPRT
	MOVEI	M,[ASCIZ .K CORE NEEDED
.]
	PUSHJ	P,MSG
QUIT:	PUSHJ	P,FORM
QUIT1:	RELEASE	DSK,
	RELEASE	LPT,
	RELEASE	STR,
	CALLI	EXIT

SRBER4:	MOVEI	M,[ASCIZ \BAD RIB FOR SAT.SYS\]
	PUSHJ	P,MSG
	JRST	QUIT

SRBER1:	MOVEI	M,[ASCIZ .NOT ENOUGH SAT PTRS FOR LOGICAL UNIT .]
	JRST	SRBERA

SRBER2:	MOVEI	M,[ASCIZ .TOO MANY SAT PTRS FOR LOGICAL UNIT .]
SRBERA:	PUSHJ	P,MSG
	MOVE	M,U
	PUSHJ	P,DECPRT
	PJRST	CRLF

SRBER3:	MOVEI	M,[ASCIZ \TOO MANY PTRS FOR SAT.SYS
\]
	PJRST	MSG

SRBER5:	MOVSI	T,(SIXBIT .SAT.)
	MOVEM	T,ERRNAM+.RBNAM
	MOVSI	T,(SIXBIT .SYS.)
	MOVEM	T,ERRNAM+.RBEXT
	SETZM	ERRNAM+.RBPPN
	HRLZI	T,[ASCIZ .ERROR READING SAT BLOCK.]
	PJRST	FREE1

SRBER6:	MOVEI	M,[ASCIZ \ILLEGAL LOGICAL UNIT FOR SAT.SYS = \]
	PUSHJ	P,MSG
	MOVE	N,P1
	PUSHJ	P,DECPRT
	PUSHJ	P,CRLF
SRBE6A:	AOBJP	P2,ALLSAT	;JUMP IF TOO MANY PTRS
	MOVE	P1,(P2)
	LDB	T,STYCNP
	JUMPN	T,SRBE6A	;BYPASS ALL BUT NEW UNIT POINTERS
	JUMPE	P1,ALLSAT
	TRZN	P1,RIPNUB
	JRST	ALLSAT
	CAMLE	P1,HIGHU
	JRST	SRBE6A
	MOVE	U,P1
	HLRZ	P3,DSKSAT(U)
	JRST	NXLPTR

MURBER:	HRLZI	T,[ASCIZ .RIB ERROR, NOT PROCESSING UFD.]
	MOVE	T1,PPN
	MOVEM	T1,ERRNAM+.RBNAM
	MOVSI	T1,(SIXBIT .UFD.)
	MOVEM	T1,ERRNAM+.RBEXT
	SETZM	ERRNAM+.RBPPN
	MOVE	N,RIBLBN(P4)
	HRRI	T,ERRNAM+.RBCNT
	PJRST	PRTRBL

MUILUN:	MOVE	T,PPN
	MOVEM	T,ERRNAM+.RBNAM
	MOVSI	T,(SIXBIT .UFD.)
	MOVEM	T,ERRNAM+.RBEXT
	SETZM	ERRNAM+.RBPPN
FLILUN:	MOVE	N,RIBLBN(P4)
	HRLZI	T,[ASCIZ .ILLEGAL UNIT.]
	HRRI	T,ERRNAM+.RBCNT
	PUSHJ	P,PRTRBL
FLILU1:	PUSHJ	P,DPTGET
	  JRST	.-1
	CAMLE	U,HIGHU
	JRST	FLILU1
	POPJ	P,

SUBTTL	LOOKUP ERRORS

LOOKER:	HRLZI	T,[ASCIZ .LOOKUP FAILED, CLUSTER NUMBER = ERROR CODE.]
	HRRZ	N,ERRNAM+.RBEXT
	JRST	FREE2

CHKERR:	HRLZI	T,[ASCIZ .CHECKSUM ERROR.]
	JRST	FREE1

NONEXC:	HRLZI	T,[ASCIZ .NON-EXISTENT CLUSTER.]

FREE1:	LDB	N,STYCLP
FREE2:	HRRI	T,ERRNAM+.RBCNT
	PJRST	PRTRBL
SUBTTL	REPORTING LOST CLUSTERS
;SUBROUTINE TO PRINT SUMMARY OF NUMBER OF "LOST" CLUSTERS, I.E., THOSE
; CLUSTERS WHICH ARE MARKED AS IN USE BUT APPEAR IN NO FILE.....

PRLOST:	SETOM LOSTCT		;COUNT NUMBER OF LOST CLUSTERS
	SETOM BUF+1
LOSTLP:	PUSHJ P,GVLOST		;GET NEXT LOST CLUSTER NUMBER
	JUMPL T,FINLOS		;NEGATIVE NUMBER INDICATES NO MORE LOST
	MOVEI M,HEDLOS
	AOSG LOSTCT		;COUNT NUMBER LOST
	PUSHJ P,MSG		;PRINT HEADER IF THIS IS FIRST ONE
	MOVEI N,0(T)
	MOVEI T,6		;PRINT CLUSTER NUMBERS AS RIGHT-JUSTIFIED
	PUSHJ P,OCTZRO		; SIX-DIGIT OCTAL NUMBERS WITH LEADING ZEROES
	PUSHJ P,SPC
	PUSHJ P,SPC
	MOVE T2,LOSTCT
	ADDI T2,1
	IDIVI T2,^D15		;PRINT 15 CLUSTER NUMBERS ON EACH LINE
	JUMPN T3,LOSTLP
	PUSHJ P,CRLF
	JRST LOSTLP

FINLOS:	AOSG N,LOSTCT		;INCREMENT COUNT ONCE MORE (STARTED AT -1)
	  JRST NOLOST		;THERE WERE NO LOST CLUSTERS
	MOVEI M,TOTLOS
	PUSHJ P,MSG
	PUSHJ P,DECPRT
	PUSHJ P,PDOT
	PUSHJ	P,CRLF3
	OUTPUT	LPT,0

	; THE FOLLOWING CONDITIONAL ASSEMBLY PARAMETER CALLS THE
	; LOST BLOCK RECOVERY CODE
	IFN	LBRCOD,<
	SKIPE	LSTFLG		; LBR IN EFFECT?
	PUSHJ	P,LSTREC	; YES, CALL LOST BLOCK RECOVERY CODE
		>	; ! END OF LBRCOD CONDITIONAL ASSEMBLY
	POPJ	P,		;[12]  RETURN

NOLOST:	JSP M,MSG
	ASCIZ	/
THERE ARE NO LOST CLUSTERS (MARKED IN USE, BUT IN NO FILE).


/
HEDLOS:	ASCIZ	/
THE FOLLOWING CLUSTERS ARE LOST (MARKED IN USE, BUT IN NO FILE):

/
TOTLOS:	ASCIZ	/

TOTAL NUMBER OF LOST CLUSTERS = /
SUBTTL	LOST BLOCK RECOVERY ROUTINE

;	ON ENTRY	LOSTCT=# OF LOST BLOCKS FOUND

	IFN LBRCOD,<
LSTREC:	PUSHJ	P,CHKJOB	; CHECK ON JOBS RUNNING
	SKIPL	LSTFLG		; OK TO RUN?
	POPJ	P,0		; NO, JUST RETURN
	SKIPG	LOSTCT		; ANY LOST BLOCKS?
	JRST	CPOPJ		; NO, EXIT
	SETOM	LOSTCT		; INITIALIZE SCAN
	SETOM	BUF+1
	SETOM	BATUNI		; NO BAT BLOCKS IN CORE
	SETO	P1,0		; CREATE MAXIMUM COUNT
	LDB	T1,STYCNP
	MOVEM	T1,MAXN		; AND SAVE IT
	SETZM	CPTR		; CLEAR CLUSTER POINTER

LSTENT:	MOVEI	T,0		; USE UNIT 0
	PUSHJ	P,LNAME
	MOVEI	T,17		; DUMP MODE
	MOVE	T1,CHRBUF	; SIXBIT LOGICAL UNIT NAME
	MOVEI	T2,0		; NO RING BUFFERING
	OPEN	RCV,T
	MONERR	(OFS,OPEN FAILURE FOR DEVICE STR,EXPAND,QUIT1)
	MOVSI	T1,'STR'
	OPEN	BAT,T
	MONERR	(OFS,OPEN FAILURE FOR DEVICE STR,EXPAND,QUIT1)

LSTTRY:	PUSHJ	P,EXTGEN	; GENERATE THE FILE BLOCK
	LOOKUP	RCV,T		; MAKE SURE THE FILE DOESN'T ALREADY EXIST
	JRST	GDENT		; NO, PROCEED
	AOS	FUNNAM		; GO FOR NEXT
	JRST	LSTTRY
GDENT:	ENTER	RCV,T
	MONERR	(EFS,ENTER FAILURE FOR DEVICE STR,EXPAND,QUIT1)
	CLOSE	RCV,0
	STATZ	RCV,74B23
	MONERR	(CER,ERROR FLAGS RETURNED ON CLOSE,EXIT)
	PUSHJ	P,EXTGEN	; GENERATE THE FILE BLOCK
	LOOKUP	RCV,T
	MONERR	(CLR,<CAN'T LOOKUP RECOVERY FILE>,EXIT)
	USETI	RCV,0		; POINT TO RIB
	INPUT	RCV,[IOWD BLKSIZ,RCVBUF
	Z] ; READ IT
	STATZ	RCV,74B23
	MONERR	(IFS,INPUT FAILURE FOR DEVICE STR,EXPAND,QUIT1)
	MOVEI	P2,RCVBUF	; INITIALIZE AOBJN INDEX
	MOVE	T1,RIBSTS(P2)	; GET STATUS WORD
	TRO	T1,RIPABC	; ALWAYS BAD CHECKSUM
	MOVEM	T1,RIBSTS(P2)
	MOVE	T1,JOBVER	; GET THIS VERSION DSKRAT
	MOVEM	T1,RIBVER(P2)	; AND PLANT IN RIB
	ADD	P2,(P2)		; UPDATE IT TO POINT TO FIRST ITEM
	MOVE	T1,(P2)		; PICK UP UNIT POINTER
	TRZ	T1,1B18		; CLEAR CHANGE BIT
	MOVEM	T1,UNIBEG	; SAVE THE UNIT # FOR THE USETO CALCULATION
	MOVEM	T1,UNINUM	; REMEMBER IT

	SKIPE	(P2)		; FIND THE END OF FILE POINTER
	AOBJN	P2,.-1		; ..
	AOS	FUNNAM		; INCREMENT EXTENSION FOR NEXT
	SKIPE	T,CPTR		; REENTRY?
	JRST	UNICHG		; NO
	PUSHJ	P,LBRNXT	; RETURN LOST CLUSTER IN T AND UNIT (0-7) IN U
	JUMPL	T,RCVDON	; NO MORE LOST CLUSTERS
	MOVEM	T,CPTR		; SAVE CLUSTER POINTER
;	HERE TO ENTER A UNIT CHANGE POINTER IF REQUIRED

UNICHG:	HLRE	M,P2		; GET IOWD INDEX
	CAMN	U,UNINUM	; UNIT CHANGE?
	JRST	RCVCHG		; NO
	CAMLE	M,[-3]		; ROOM FOR 3 WORDS?
	JRST	OUTRIB		; NO
	MOVEM	U,UNINUM	; REMEMBER THAT
	TRO	U,1B18		; SET UNIT CHANGE BIT
	MOVEM	U,(P2)		; AND PLANT IN RIB
	TRZ	U,1B18		; CLEAR UNIT CHANGE BIT
	AOBJN	P2,.+1

;	HERE TO ENTER A CLUSTER POINTER IF ENOUGH ROOM

RCVCHG:	CAMLE	M,[-2]		; ROOM FOR 2 WORDS?
	JRST	OUTRIB		; NO
	MOVEI	T,1		; SET CLUSTER COUNT TO 1
	MOVEM	T,CLSCNT	; AND SAVE IT
	MOVE	P1,CPTR		; FETCH CLUSTER POINTER
	SUB	P1,UNIFTR	; UNIT OFFSET
	DPB	T,STYCNP	; PLANT INITIAL COUNT
	MOVEM	P1,(P2)		; UPDATE THE RIB
	MOVE	T,BLKPCL	; UPDATE BLOCK ALLOCATION
	ADDM	T,RCVBUF+RIBALC	; ..
	IMULI	T,200		; UPDATE WORD COUNT
	ADDM	T,RCVBUF+RIBSIZ
	AOBJN	P2,.+1		; UPDATE AOBJN POINTER
;DROP INTO RCVCON
;	HERE TO SCAN FOR CONTIGUOUS LOST CLUSTERS

RCVCON:	PUSHJ	P,LBRNXT	; GET NEXT LOST CLUSTER
	JUMPL	T,RCVDON	; NO MORE, WE'RE DONE
	MOVE	T4,CPTR		; FETCH LAST CLUSTER POINTER
	MOVEM	T,CPTR		; SAVE THIS PTR.
	SUB	T,T4		; SEE IF DIFFERENCE IS ONE (CONTIGUOUS)
	SOJN	T,UNICHG	; IF IT ISN'T, ENTER NEW POINTERS
	MOVE	T1,CLSCNT	; FETCH LAST CLUSTER COUNT
	ADDI	T1,1		; INCREMENT THE COUNT
	CAMLE	T1,MAXN		; TOO BIG?
	JRST	UNICHG		; YES
	MOVE	P1,-1(P2)	; GET LAST POINTER
	DPB	T1,STYCNP	; PLANT NEW COUNT
	MOVEM	P1,-1(P2)	; UPDATE THE RIB WITH IT
	AOS	CLSCNT		; UPDATE THE CLUSTER COUNT
	MOVE	T,BLKPCL	; UPDATE BLOCK ALLOCATION
	ADDM	T,RCVBUF+RIBALC	; ..
	IMULI	T,200		; UPDATE WORD COUNT
	ADDM	T,RCVBUF+RIBSIZ
	JRST	RCVCON		; LOOP
RCVDON:	SETZM	CPTR		; CLEAR POINTER WHEN WE'RE DONE

OUTRIB:	SETZM	(P2)		; SET END OF RIB
	CLOSE	RCV,CL.DAT		; DO THE CLOSE
	STATZ	RCV,74B23	; ANY ERRORS?
	MONERR	(LBC,ERROR IN CLOSING LOST BLOCK FILE,EXIT)
	; USETO to (Unit Number)*(Blocks-per-Unit)+(Word 177 of Rib)
	MOVE	T,UNIBEG	; RECOVER STARTING UNIT
	IMUL	T,STRBPU	; MULTIPLY BY BLOCKS PER UNIT [20]
	ADD	T,RCVBUF+RIBSLF	; ADD WORD 177 OF RIB
	TLO	T,(<RCV>B12)	;PUT IN CHAN
	PUSHJ	P,DOSUP		; SUPER USET
	OUTPUT	RCV,[IOWD BLKSIZ,RCVBUF
	Z]
	STATZ	RCV,74B23
	MONERR	(LBO,OUTPUT ERROR TO LOST BLOCK FILE,EXIT)
	SKIPE	CPTR		; DONE?
	JRST	LSTENT		; NO
	RELEASE	RCV,0		; YES
	POPJ	P,0
;SUBROUTINE TO GET NEXT BLOCK FOR LSTBLK FILE
LBRNX0:	POP	P,(P)	;REMOVE GARBAGE FROM LIST
LBRNXT:	PUSHJ	P,GVLOST	;GET NEXT LOST CLUSTER
	JUMPL	T,CPOPJ		;GO IF NO MORE
	PUSH	P,T
	PUSHJ	P,REDBAT	;GET RIGHT BAT BLOCK IN CORE
	  JRST	TPOPJ		;ERROR READING BAT
	MOVE	T,(P)		;BAD CLUSTER
	SUB	T,UNIFTR	;RELATIVE TO 1ST CLUSTER ON UNIT
	MOVE	T1,BLKPCL
	IMULI	T,(T1)		;T=1ST BLOCK OF CLUSTER
	ADDI	T1,-1(T)	;T1=LAST BLOCK OF CLUSTER
	MOVEI	T2,BATBUF
	ADD	T2,BAFFIR(T2)	;T2=AOBJN WORD FOR BAT BLOCK
LBRNX1:	MOVE	T3,BAFELB(T2)
	TLZ	T3,BATMSK	;T3=1ST BAD BLOCK IN GROUP
	JUMPE	T3,TPOPJ	;NOT IN BAT BLOCK IF 0
	LDB	T4,BAYNBB
	ADDI	T4,(T3)		;T4=LAST BAD BLOCK IN GROUP
	CAML	T1,T3		;IF TOP OF CLUSTER .LT. 1ST IN BAD
	CAMLE	T,T4		;OR 1ST IN CLUSTER .GT. LAST IN BAD
	AOBJN	T2,LBRNX2	; IT ISNT IN THIS BAD REGION (ALWAYS JUMPS)
	JRST	LBRNX0		;THIS CLUSTER IS IN BAT BLOCK, IGNORE IT
LBRNX2:	AOBJN	T2,LBRNX1	;GO TEST NEXT GROUP
TPOPJ:	POP	P,T
	POPJ	P,
;SUBROUTINE TO READ BAT BLOCKS
REDBAT:	CAMN	U,BATUNI	;HAVE THAT BAT IN CORE?
	JRST	CPOPJ1		;YES, OK
	MOVEM	U,BATUNI
	; BLOCKS PER UNIT/BLOCKS PER CLUSTER*UNIT=UNIT OFFSET FACTOR
	MOVE	T1,STRBPU	;[15] BLOCKS PER UNIT
	IDIV	T1,BLKPCL	; DIVIDE BY BLOCKS PER CLUSTER
	IMUL	T1,U		; MULTIPLIED BY THE UNIT NUMBER
	MOVEM	T1,UNIFTR	; SAVE IT AS THE UNIT OFFSET FACTOR
	MOVE	T,U
	IMUL	T,STRBPU	;NO, HAVE TO READ BAT
	MOVE	T1,T
	PUSHJ	P,FNDHOM	;GET 2ND HOME BLOCK
	HRRZS	T
	ADDI	T,LBOBAT(T1)	;+OFFSET FOR BAT BLOCK +BLOCK 0 OF UNIT
	TLO	T,400000+(<BAT>B12) ;SET FOR SUSET.
REDBT1:	PUSHJ	P,DOSUP
	MOVE	T1,[IOWD 200,BATBUF]
	MOVEM	T1,IOCW
	INPUT	BAT,IOCW	;READ THE BAT
	GETSTS	BAT,T1
	TRZN	T1,740000
	JRST	REDBT2		;NO ERRORS READING
	SETSTS	BAT,(T1)
	JRST	REDBT3		;TRY 2ND BAT IF THIS 1ST
REDBT2:	MOVSI	T1,'BAT'
	MOVEI	T2,CODBAT
	CAMN	T1,BATBUF+BATNAM
	CAME	T2,BATBUF+BATCOD	;OK?
	JRST	REDBT3		;NO, TRY 2ND BAT
	JRST	CPOPJ1		;OK

REDBT3:	TLZE	T,400000
	JRST	REDBT4		;TRIED 1ST BAT, NOW TRY 2ND
	SETZM	BATBUF+BAFFIR	;LOSE. SO WE WONT FIND ANYTHING
	POPJ	P,
REDBT4:	MOVE	T1,T
	PUSHJ	P,FNDHOM	;GET LOC OF 1ST BAT
	EXCH	T,T1
	SUBI	T,(T1)		;+LOC OF 1ST HOME
	HLRZS	T1
	ADD	T,T1		;- LOC OF 2ND
	JRST	REDBT1		;GO TRY TO READ 2ND BAT
		>	; ! END OF LBRCOD CONDITIONAL
SUBTTL	SUPER USET SUBROUTINE

;SUBROUTINE TO DO SUPER USET
;CALL WITH:
;	T = BLOCK NUMBER
;	PUSHJ	P,DOSUP
;	RETURN HERE
DOSUP:	SUSET.	T,		;TRY SUSET. UUO
	  SKIPA			;ASSUME NOT IN THIS MONITOR
	POPJ	P,0		;WON--RETURN
	PUSH	P,T1		;SAVE T1
	HLLZ	T1,T		;COPY CHAN
	TLZ	T,777740	;CLEAR CHAN AND FLAGS
	TLZ	T1,777037	;CLEAR ANY JUNK
	IOR	T1,[USETO T]	;TURN INTO USETO CHAN,T
	XCT	T1		;DO THE SUPER USETO
	POP	P,T1		;RESTORE T1
	POPJ	P,0		;RETURN
SUBTTL	FREE CLUSTER REPORTING

;SUBROUTINE TO PRINT SUMMARY OF NUMBER OF "FREE" CLUSTERS, I.E., THOSE
; CLUSTERS WHICH ARE NOT MARKED AS IN USE BUT BELONG TO A FILE.....

PRFREE:	SETOM FREECT		;COUNT NUMBER OF FREE CLUSTERS
	SETOM BUF+1
FREELP:	PUSHJ P,GVFREE		;GET NEXT FREE CLUSTER NUMBER
	JUMPL T,FINFRE		;NEGATIVE NUMBER INDICATES NO MORE FREE
	MOVEI M,HEDFRE
	AOSG FREECT		;COUNT NUMBER FREE
	PUSHJ P,MSG		;PRINT HEADER IF THIS IS FIRST ONE
	MOVEI N,0(T)
	MOVEI T,6		;PRINT CLUSTER NUMBERS AS RIGHT-JUSTIFIED
	PUSHJ P,OCTZRO		; SIX-DIGIT OCTAL NUMBERS WITH LEADING ZEROES
	PUSHJ P,SPC
	PUSHJ P,SPC
	MOVE T2,FREECT
	ADDI T2,1
	IDIVI T2,^D15		;PRINT 15 CLUSTER NUMBERS ON EACH LINE
	JUMPN T3,FREELP
	PUSHJ P,CRLF
	JRST FREELP

FINFRE:	AOSG N,FREECT		;INCREMENT COUNT ONCE MORE (STARTED AT -1)
	  JRST NOFREE		;THERE WERE NO FREE CLUSTERS
	MOVEI M,TOTFRE
	PUSHJ P,MSG
	PUSHJ P,DECPRT
	PUSHJ P,PDOT
	PJRST CRLF3

NOFREE:	JSP M,MSG
	ASCIZ	/
THERE ARE NO FREE CLUSTERS (NOT MARKED IN USE, BUT IN SOME FILE).


/
HEDFRE:	ASCIZ	/
THE FOLLOWING CLUSTERS ARE FREE (NOT MARKED IN USE, BUT IN SOME FILE):

/
TOTFRE:	ASCIZ	/

TOTAL NUMBER OF FREE CLUSTERS = /
SUBTTL	DUPLICATED CLUSTER REPORTING
;SUBROUTINE TO PRINT SUMMARY OF NUMBER OF "DUPLICATED" CLUSTERS, I.E., THOSE
; CLUSTERS WHICH BELONG TO MORE THAN ONE FILE......

PRMULT:	SETOM MULTCT		;COUNT NUMBER OF DUPLICATED CLUSTERS
	SETOM BUF+1
MULTLP:	PUSHJ P,GVMULT		;GET NEXT DUPLICATED CLUSTER NUMBER
	JUMPL T,FINMUL		;NEGATIVE NUMBER INDICATES NO MORE
	MOVEI M,HEDMUL
	AOSG MULTCT		;COUNT NUMBER DUPLICATED
	PUSHJ P,MSG		;PRINT HEADER IF THIS IS FIRST ONE
	MOVEI N,0(T)
	MOVEI T,6		;PRINT CLUSTER NUMBERS AS RIGHT-JUSTIFIED
	PUSHJ P,OCTZRO		; SIX-DIGIT OCTAL NUMBERS WITH LEADING ZEROES
	PUSHJ P,SPC
	PUSHJ P,SPC
	MOVE T2,MULTCT
	ADDI T2,1
	IDIVI T2,^D15		;PRINT 15 CLUSTER NUMBERS ON EACH LINE
	JUMPN T3,MULTLP
	PUSHJ P,CRLF
	JRST MULTLP

FINMUL:	AOSG N,MULTCT		;INCREMENT COUNT ONCE MORE (STARTED AT -1)
	  JRST NOMULT		;THERE WERE NO DUPLICATED CLUSTERS
	MOVEI M,TOTMUL
	PUSHJ P,MSG
	PUSHJ P,DECPRT
	PUSHJ P,PDOT
	PJRST CRLF3

NOMULT:	JSP M,MSG
	ASCIZ	/
THERE ARE NO MULTIPLY USED CLUSTERS (BELONG TO MORE THAN ONE FILE).


/
HEDMUL:	ASCIZ	/
THE FOLLOWING CLUSTERS ARE MULTIPLY USED (BELONG TO MORE THAN ONE FILE):

/
TOTMUL:	ASCIZ	/

TOTAL NUMBER OF MULTIPLY USED CLUSTERS = /
SUBTTL	LOST CLUSTER FINDING

; SUBROUTINE TO RETURN NEXT LOST CLUSTER THIS UNIT - IF ANY

GVLOST:	SKIPL	BUF+1
	JRST	GVLOS1
	SETZ	U,
	HRRZ	T3,DSKSAT(U)
	HRRZ	T4,OURSAT(U)
	PUSHJ	P,GVNXUN
	  JRST	NOMORE
	JRST	GVLOS3
GVLOS1:	MOVE	N,[XWD BUF+1,T]
	BLT	N,T4
	MOVE	N,BUF
GVLOS2:	PUSHJ	P,GVNXCL
	  JRST	NOMORE
GVLOS3:	TDNE	T1,(T3)		;SKIP IF NOT SET IN DISK SAT
	TDNE	T1,(T4)		;SKIP IF NOT SET IN OUR SAT
	JRST	GVLOS2		;OK
	JRST	GVNXT		;WE HAVE A LOSER, RETURN

GVFREE:	SKIPL	BUF+1
	JRST	GVFRE1
	SETZ	U,
	HRRZ	T3,DSKSAT(U)
	HRRZ	T4,OURSAT(U)
	PUSHJ	P,GVNXUN
	  JRST	NOMORE
	JRST	GVFRE3
GVFRE1:	MOVE	N,[XWD BUF+1,T]
	BLT	N,T4
	MOVE	N,BUF
GVFRE2:	PUSHJ	P,GVNXCL
	  JRST	NOMORE
GVFRE3:	TDNN	T1,(T3)		;SKIP IF SET IN DISK SAT
	TDNN	T1,(T4)		;SKIP IF SET IN OUR SAT
	JRST	GVFRE2		;OK
	JRST	GVNXT

GVMULT:	SKIPL	BUF+1
	JRST	GVMUL1
	SETZ	U,
	HRRZ	T3,TRBSAT(U)
	PUSHJ	P,GVNXUN
	  JRST	NOMORE
	JRST	GVMUL3
GVMUL1:	MOVE	N,[XWD BUF+1,T]
	BLT	N,T4
	MOVE	N,BUF
GVMUL2:	PUSHJ	P,GVNXCL
	  JRST	NOMORE
GVMUL3:	TDNN	T1,(T3)		;SKIP IF SET IN TROUBLE SAT
	JRST	GVMUL2
GVNXT:	MOVEM	N,BUF		;SAV ACS
	MOVE	N,[XWD T,BUF+1]
	BLT	N,BUF+1+T4-T
	POPJ	P,

NOMORE:	SETO	T,
	POPJ	P,

GVNXUN:	MOVE	T,UNIBPU(U)	;BLOCKS ON THIS UNIT
	IDIV	T,BLKPCL	;CLUSTERS ON THIS UNIT
	MOVE	T2,T		;T2=CLUSTERS LEFT ON UNIT
	MOVE	T,STRBPU	; T=LOGICAL BLOCKS PER UNIT
	IDIV	T,BLKPCL	; T=CLUSTERS PER UNIT
	IMUL	T,U		; T=FIRST UNIT CLUSTER
	SUBI	T,1		; -1
	SUBI	T3,1
	SUBI	T4,1
GVNXST:	MOVEI	T1,1
	HRRZ	N,UNICPS(U)	;CLUSTERS PER SAT
GVNXCL:	ADDI	T,1		;T=NEXT CLUSTER
	SOJL	T2,GVNXCU	;JUMP IF NO MORE CLUSTERS THIS UNIT
	SOJL	N,GVNXCS	;JUMP IF NO MORE CLUSTERS THIS SAT
	ROT	T1,-1		;ROTATE BIT TO CHECK
	JUMPGE	T1,CPOPJ1	;RETURN IF STILL SAME WORD
	ADDI	T4,1		;MOVE TO NEXT WORD
	AOJA	T3,CPOPJ1	;SKIP RETURN
GVNXCS:	ADDI	T2,1		;ACCOUNT FOR SOJL AT GVNXCL+1
	SOJA	T,GVNXST
GVNXCU:	CAML	U,HIGHU		;SKIP IF MORE UNITS
	POPJ	P,
	MOVE	T,N
	JFFO	T1,.+1		;PLUS BITS SO FAR THIS WORD
	ADD	T,T2
	IDIVI	T,^D36
	ADDI	T3,1(T)
	ADDI	T4,1(T)
	AOJA	U,GVNXUN
SUBTTL	CLUSTER ERROR REPORTING
;SUBROUTINE TO PRINT ERROR MESSAGES CONCERNING PARTICULAR CLUSTERS IN THE FORMAT:
;     FILE  FILE.EXT  [PRJ,PRG] CLSTR # (= BLK #)  RANDOM ERROR MESSAGE
; THE ARGUMENTS TO THE SUBROUTINE ARE:
;     ACC N CONTAINS THE CLUSTER NUMBER (IF NEGATIVE CLSTR # WILL NOT BE PRINTED)
;     LH OF ACC T HAS ADR OF RANDOM ASCIZ ERROR MESSAGE (CAN BE 0 IF NONE DESIRED)
;     RH OF ACC T HAS ADR OF EXTENDED LOOKUP BLOCK CONTAINING THE SIXBIT
;      FILENAME AND EXTENSION AND PRJ,PRG IN THE STANDARD PLACES

PRTRBL:	PUSH P,N		; SAVE THE CLUSTER NUMBER
	PUSH P,T		; SAVE ADDRESS OF EXTENDED LOOKUP BLOCK
	SETOM TRBFIL
	MOVEI M,[ASCIZ /FILE  /]
	PUSHJ P,MSG
	HLRZ T1,.RBEXT(T)	; GET THE FILE EXTENSION
	CAIN T1,(SIXBIT /UFD/)
	JRST PRTRBU		; OUTPUT AS PPN
	MOVE T,.RBNAM(T)	;GET FILE NAME
	PUSHJ P,PR6BIT		; OUTPUT IT
PRTRB2:	MOVE T,0(P)		; RECOVER THE ADDRESS OF EXTENDED LOOKUP
				;  BLOCK FROM THE STACK
	HLLZ T,.RBEXT(T)	; GET EXTENSION
	SKIPE T			; ANY EXTENSION TO OUTPUT?
	PUSHJ P,PDOT		; YES, PRINT DOT ONLY IF NON-NULL EXT
	PUSHJ P,PR6BIT		; OUTPUT THE EXTENSION
	PUSHJ P,SPC		; OUTPUT A SPACE
	MOVE T,0(P)		; RECOVER THE ADDRESS OF EXTENDED LOOKUP
				;  BLOCK FROM THE STACK
	SKIPN	T1,.RBPPN(T)	; NULL PPN?
	JRST PRTRB3		; YES
	MOVEI CH,"["		; NO, OUTPUT PPN
	PUSHJ P,TYO
	HLRZ N,.RBPPN(T)	; RECOVER THE PROJECT NUMBER
	JUMPE	N,PRTSFD	; POINTS TO A PATH IF 0,,ADR
	PUSHJ P,OCTPRT		; PRINT THE PROJECT NUMBER
	PUSHJ P,COMMA
	HRRZ N,.RBPPN(T)	; GET THE PROGRAMMER NUMBER
	PUSHJ P,OCTPRT		; AND PRINT IT
PRTR2A:	MOVEI CH,"]"		; FINISH UP PPN
	PUSHJ P,TYO
	PUSHJ P,SPC
PRTRB3:	SKIPGE N,-1(P)		; RECOVER THE CLUSTER NUMBER
	JRST PRTRB4		; NONE
	MOVEI M,[ASCIZ /CLUSTER /]
	PUSHJ P,MSG
	PUSHJ P,OCTPRT		; PRINT THE CLUSTER NUMBER
	MOVEI M,[ASCIZ / ( =BLOCK /]
	PUSHJ P,MSG
	MOVE N,-1(P)		; RECOVER CLUSTER NUMBER AGAIN
	IMUL N,BLKPCL		; COMPUTE BLOCK NUMBER
	PUSHJ P,OCTPRT		; AND PRINT IT
	MOVEI CH,")"		; FINISH UP
	PUSHJ P,TYO
PRTRB4:	PUSHJ P,SPC
	PUSHJ P,SPC
	HLRZ M,0(P)		; GET ADDRESS OF SPECIFIED MESSAGE,
				;  IF ANY.
	SKIPE M
	PUSHJ P,MSG		; OUTPUT SPECIFIED MESSAGE
	PUSHJ P,CRLF
	POP P,T			; RESTORE SAVED ARGUMENTS
	POP P,N			; ..
	POPJ P,0		; RETURN

; HERE TO OUTPUT PPN FILENAME
PRTRBU:	HLRZ N,.RBNAM(T)	; GET LEFT HALF
	PUSHJ P,OCTPRT
	PUSHJ P,COMMA		; SEPARATE WITH COMMA
	HRRZ N,.RBNAM(T)	; AND THE RIGHT HALF
	PUSHJ P,OCTPRT
	JRST PRTRB2		; REENTER


; HERE TO OUTPUT FULL PATH
; T1 = ADDRESS OF PATH BLOCK
PRTSFD:	HLRZ	N,2(T1)		;PRJ
	PUSHJ	P,OCTPRT
	PUSHJ	P,COMMA
	HRRZ	N,2(T1)		;PRG
	PUSHJ	P,OCTPRT
	ADDI	T1,3
PRTSF1:	SKIPN	T,(T1)		;NEXT SFD NAME
	JRST	PRTR2A		; DONE, REENTER
	PUSHJ	P,COMMA
	PUSHJ	P,PR6BIT
	AOJA	T1,PRTSF1
SUBTTL	PRINT SUBROUTINES

;THESE ARE PRINT-OUT ROUTINES LIFTED FROM DSKLST AND OCCASIONALLY
; SLIGHTLY MODIFIED  (AC USAGE, ETC.)

MSG:	HRLI M,(POINT 7)	;PRINT RANDOM LENGTH (ASCIZ) MESSAGE
MSGL:	ILDB CH,M		;  ADDRESS OF MESSAGE IS IN ACC M
	JUMPE CH,CPOPJ
	PUSHJ P,TYO
	JRST MSGL

SPC:	MOVEI CH,40		;PRINT OUT PARTICULAR CHARACTERS...
	JRST TYO
FORM:	MOVEI	CH,14
	JRST	TYO
COMMA:	MOVEI CH,","
	JRST TYO
PDOT:	MOVEI CH,"."
	JRST TYO
TAB:	MOVEI CH,11

TYO:	SOSG LOBUF+2		;LOW LEVEL CHARACTER PRINT-OUT ROUTINE
	OUTPUT LPT,0
	IDPB CH,LOBUF+1
	POPJ P,0

CRLF3:	PUSHJ P,CRLF
CRLF2:	PUSHJ P,CRLF
CRLF:	JSP M,MSG
	ASCIZ /
/


PR6BIT:	MOVSI M,(POINT 6)	;PRINT SIXBIT WORD FROM ACC T
	HRRI M,T
PR6BT1:	ILDB CH,M
	JUMPE CH,CPOPJ		;QUIT WHEN FIRST SPACE FOUND (AND DON'T PRINT IT)
	ADDI CH,40
	PUSHJ P,TYO
	TLNE M,(77B5)		; DONE?
	JRST PR6BT1		; NO, LOOP
	POPJ P,0		; YES, RETURN
SUBTTL	PRINTING RIGHT-JUSTIFIED INTEGERS
;ROUTINES TO PRINT RIGHT-JUSTIFIED INTEGERS
; FIELD WIDTH IN ACC T
; NUMBER IN ACC N

DECSPC:	SKIPA CH,[40]		;DECIMAL WITH LEADING SPACES
DECZRO:	MOVEI CH,"0"		;DECIMAL WITH LEADING ZEROES
	MOVEI R,^D10
	JRST RJRDXP
OCTSPC:	SKIPA CH,[40]		;OCTAL WITH LEADING SPACES
OCTZRO:	MOVEI CH,"0"		;OCTAL WITH LEADING ZEROES
	MOVEI R,^D8
RJRDXP:	MOVE N1,R
JUSTFY:	SOJLE T,RDXPRT		;RIGHT JUSTIFY
	CAMGE N,N1
	PUSHJ P,TYO
	IMUL N1,R
	JRST JUSTFY

DECPRT:	SKIPA R,[^D10]
OCTPRT:	MOVEI R,^D8
RDXPRT:	IDIVI N,(R)		;ANY RADIX PRINT ROUTINE
	HRLM N1,0(P)
	SKIPE N
	PUSHJ P,RDXPRT
	HLRZ CH,0(P)
	ADDI CH,"0"
	JRST TYO

SUBTTL	TIME SUBROUTINES

NOW:	CALLI T1,MSTIME		;GET TIME IN MILLISECONDS
	IDIVI T1,^D60000
	MOVE T3,T2
	IDIVI T3,^D1000		;SECONDS IN T3
	IDIVI T1,^D60		;HOURS IN T1, MINUTES IN T2
	HRREI T4,-2
	SKIPA CH,[40]
NOWLUP:	MOVEI CH,":"
	PUSHJ P,TYO
	MOVEI T,2
	MOVE N,T3(T4)
	PUSHJ P,DECZRO
	AOJLE T4,NOWLUP
	PUSHJ P,SPC
	PUSHJ P,SPC
	CALLI T1,DATE		;GET DATE

SUBTTL	DATE SUBROUTINES
PRDATE:	IDIVI T1,^D31
	MOVEI N,1(T2)
	MOVEI T,2
	PUSHJ P,DECZRO
	IDIVI T1,^D12
	MOVE T2,MONTAB(T2)
	MOVEI T3,0
	MOVEI M,T2
	PUSHJ P,MSG
	MOVEI N,^D64(T1)
	PJRST DECPRT


	DEFINE MONMAC(A),<
	XLIST
	IRP A,<ASCII /-A-/>
	LIST>

MONTAB:	MONMAC	<JAN,FEB,MAR,APR,MAY,JUN,JUL,AUG,SEP,OCT,NOV,DEC>
SUBTTL	BYTE POINTER DEFINITIONS

UNYBPC:	POINT	9,CHRBUF+.CHCHR,8
RBYRBU:	POINT	3,SAVRIB+RIBXRA(P4),12
RBYRBA:	POINT	23,SAVRIB+RIBXRA(P4),35
IFN LBRCOD,<
BAYNBB:	POINT	9,(T2),8
>
PDSIZE==40+SFDLVL*20

SUBTTL	LOW SEGMENT DATA BASE

PDL:	IOWD	PDSIZE,PDLIST

	XLIST	;LITERALS HERE
	LIT
	LIST

	IFN	LBRCOD,<
U(LSTFLG)
U(UNIFTR)
U(FUNNAM)
U(UNIBEG)
U(BATUNI)
UU(BATBUF,200)
		> ; ! END OF LBRCOD CONDITIONAL
U(BLKPCL)
U(HIGHU)
U(PPN)
U(STRBPU)
U(STRBSC)
U(STYCLP)
U(STYCNP)
U(STYCKP)
U(STRNAM)
U(STRSCU)
U(TRBFIL)
U(TRBFLG)
U(LOSTCT)
U(FREECT)
U(MULTCT)
U(FSTPTR)

;THESE LOCATIONS MUST STAY TOGETHER

	UU(ERRNAM,^D36)	; EXTENDED LOOKUP/ENTER BLOCK

;END OF LOCATIONS THAT MUST STAY TOGETHER

UU(IOCW,2)
UU(RCVOUT,2)
UU(LOBUF,3)
UU(CHRBUF,.CHLEN)
UU(PDLIST,PDSIZE)
UU(BUF,200)
UU(MFDBUF,200)
UU(UFDBUF,200)
UU(RCVBUF,200)
UU(SFDBUF,200*SFDLVL)

U(CLSCNT)
U(CPTR)
U(MAXN)
U(UNINUM)
UU(DSKSAT,MAXUN)
UU(OURSAT,MAXUN)
UU(TRBSAT,MAXUN)
UU(UNIBPU,MAXUN)
UU(UNIWPS,MAXUN)
UU(UNICPS,MAXUN)
	DEFINE UUU(NAME,SIZE)<
NAME==CRBSIZ
CRBSIZ==CRBSIZ+SIZE
>

SUBTTL	CORE BLOCK DESCRIPTION
;THIS DESCRIBES CORE BLOCKS
;EACH SYMBOL IS AN INDEX INTO A CORE BLOCK
;CRBSIZ IS THE TOTAL SIZE OF EACH CORE BLOCK

CRBSIZ==0
UUU(RIBLBN,1)
UUU(XIOWD,1)
UUU(NXTBLK,1)
UUU(ROUTIN,1)
UUU(RIBFLG,1)
UUU(FULBLK,1)
UUU(SAVRIB,BLKSIZ)
THSUNI==ROUTIN

U(SFDCNT)

;THESE LOCS MUST STAY TOGETHER
UU(SFDBLK,2)
U(SFDPPN)
UU(SFDNAM,SFDLVL)

UU(MFDRIB,CRBSIZ)
UU(UFDRIB,CRBSIZ)
UU(FILRIB,CRBSIZ)
UU(SFDRIB,SFDLVL*CRBSIZ)

RATEND:	END	DSKRAT