Google
 

Trailing-Edge - PDP-10 Archives - SRI_NIC_PERM_SRC_3_19910112 - swskit/dirtst.mac
There are 7 other files named dirtst.mac in the archive. Click here to see a list.
;SRA:<5-SWSKIT>DIRTST.MAC.9, 16-Nov-84 00:04:57, Edit by WHP4
; OPEN OUTJFN BEFORE USE BY TYPFIL IN VERIFY COMMAND
;<TOMCZAK.EXEC>DIRTST.MAC.8, 22-Jan-80 14:07:57, EDIT BY TOMCZAK
;ACCEPT TWO DIFFERENT FDB SIZES WHEN V1 FDB
;<V-SOURCES>DIRTST.MAC.32, 14-Jun-79 10:15:49, EDIT BY HELLIWELL
;INCREASE SIZES OF FDB AREA AND SYMBOL TABLE AREA
TITLE DIRTST - NEW FORMAT DIRECTORY TESTER
SUBTTL	D. KIRSCHEN		2-13-75

;	ACCUMULATOR DEFINITIONS
;	=========== ===========

	T1=	1	;JSYS ARGUMENT AC 1
	T2=	2	;JSYS ARGUMENT AC 2
	T3=	3	;JSYS ARGUMENT AC 3
	T4=	4	;JSYS ARGUMENT AC 4
	P1=	5	;TEMPORARY AC 1
	P2=	6	;TEMPORARY AC 2
	P3=	7	;TEMPORARY AC 3
	P4=	10	;TEMPORARY AC 4
	I1=	11	;INDEX/COUNTER 1
	I2=	12	;INDEX/COUNTER 2
	FB=	13	;BASE ADDRESS OF FDB
	Q1=	14	;PRESERVED AC 1
	Q2=	15	;PRESERVED AC 2
	MA=	16	;MAPPING ADDRESS
	P=	17	;PUSH-DOWN POINTER

	SALL

	.REQUIRE SYS:MACREL, SYS:MONSYM
	SEARCH MACSYM, MONSYM

; VERSION NUMBER DEFINITIONS

VMAJOR==15		;MAJOR VERSION OF DIRTST
VMINOR==0		;MINOR VERSION NUMBER
VEDIT==50		;EDIT NUMBER
VWHO==0			;GROUP WHO LAST EDITED PROGRAM (0=DEC DEVELOPMENT)

VDIRTS== <VWHO>B2+<VMAJOR>B11+<VMINOR>B17+VEDIT

; MISCELLANEOUS SYMBOL DEFINITIONS

NCHPW==5		;NUMBER OF ASCII CHARACTERS PER WORD
BUFSIZ==200		;SIZE OF INPUT TEXT BUFFER
ATMSIZ==BUFSIZ		;SIZE OF ATOM BUFFER FOR COMND JSYS
GJFSIZ==.GJRTY+2	;SIZE OF GTJFN BLOCK USED BY COMND JSYS
FDBSIZ==.CMDEF+2	;SIZE OF FUNCTION DESCRIPTOR BLOCK
PDLSIZ== 50		;PUSH-DOWN LIST SIZE
PRIMRY== .PRIIN,,.PRIOU	;PRIMARY JFN'S
DIRORG== 200		;PAGE WHERE DIRECTORY IS MAPPED
DIRADR== DIRORG*1000	;ADDRESS WHERE DIRECTORY IS MAPPED
PAGSIZ== 1000		;SIZE OF A PAGE
FDBPGS== 200		;# OF PAGES TO MAP FDB'S INTO
STBPGS== 40		;# OF PAGES TO MAP SYMBOL TABLE INTO
MAXREP== ^D72		;MAXIMUM OF 72 CHARS IN REPLIES
REPSIZ== MAXREP/5+1	;SIZE OF USER'S REPLY BUFFER
STGADR==77,,-1
SUBTTL	SYMBOL AND DATA STRUCTURE DEFINITIONS

; BLOCK TYPE DEFINITIONS

.TYNAM== 400001		;NAME BLOCK
.TYEXT== 400002		;EXTENSION BLOCK
.TYACT== 400003		;ACCOUNT BLOCK
.TYUNS== 400004		;USER NAME STRING
.TYFDB== 400100		;FILE DESCRIPTOR BLOCK
.TYLAC== 400200		;LEGAL ACCOUNT BLOCK
.TYDIR== 400300		;DIRECTORY PAGE
.TYSYM== 400400		;SYMBOL TABLE
.TYFRE== 400500		;FREE BLOCK
.TYFBT== 400600		;FREE STORAGE BIT TABLE
.TYGDB== 400700		;GROUP DESCRIPTOR BLOCK


; SYMBOL TABLE ENTRY TYPES

.STNAM== 0		;FILE NAME ENTRY, POINTER IS TO FDB
.STUNS== 2		;USER NAME ENTRY, POINTER IS TO A USER NAME BLOCK
.STACT== 4		;ACCOUNT ENTRY, POINTER IS TO ACT BLOCK
.STMSK== 7B2		;MASK FOR SYMBOL TABLE ENTRY TYPE
.STPTR== 77777,,-1	;MASK FOR SYMBOL TABLE ENTRY POINTER


STHSIZ== 2		;SIZE OF SYMBOL TABLE HEADER
STESIZ== 2		;SIZE OF SYMBOL TABLE ENTRIES
; STRUCTURE DEFINITION FOR FIRST PAGE OF DIRECTORY

DEFSTR (DIRTYP,DIRPG0+00,17,18)	;DIRECTORY BLOCK TYPE (.TYDIR)
DEFSTR (DIRLHD,DIRPG0+00,35,18)	;LENGTH OF HEADER
DEFSTR (DIRPAG,DIRPG0+01,17,18)	;PAGE # WITHIN DIRECTORY
DEFSTR (DIRNUM,DIRPG0+01,35,18)	;DIRECTORY NUMBER
DEFSTR (DIRFFB,DIRPG0+02,35,36)	;POINTER TO FIRST FREE BLOCK
DEFSTR (DIRBOT,DIRPG0+03,35,36)	;START ADDRESS OF SYMBOL TABLE
DEFSTR (DIRTOP,DIRPG0+04,35,36)	;ADDRESS OF END OF SYMBOL TABLE
DEFSTR (DIRFRE,DIRPG0+05,35,36)	;LAST ADR USED FOR FDB'S
DEFSTR (DIRFBT,DIRPG0+06,35,36)	;POINTER TO FREE POOL BIT TABLE
DEFSTR (DIRDPW,DIRPG0+07,35,36)	;DEFAULT FILE PROTECTION WORD
DEFSTR (DIRPRT,DIRPG0+10,35,36)	;DIRECTORY PROTECTION
DEFSTR (DIRDBK,DIRPG0+11,35,36)	;BACKUP SPECIFICATION
DEFSTR (DIRLIQ,DIRPG0+12,35,36)	;MAX LOGGED-IN DISK ALLOCATION
DEFSTR (DIRLOQ,DIRPG0+13,35,36)	;MAX LOGGED-OUT ALLOCATION
DEFSTR (DIRCUR,DIRPG0+14,35,36)	;CURRENT DISK ALLOCATION
DEFSTR (DIRNAM,DIRPG0+15,35,36)	;POINTER TO NAME STRING
DEFSTR (DIRPSW,DIRPG0+16,35,36)	;POINTER TO PASSWORD STRING
DEFSTR (DIRCAP,DIRPG0+17,35,36)	;PRIVILEGE BITS
DEFSTR (DIRMOD,DIRPG0+20,35,36)	;MODE BITS
DEFSTR (DIRDAT,DIRPG0+21,35,36)	;DATE AND TIME OF LAST LOGIN
DEFSTR (DIRUGR,DIRPG0+22,35,36)	;GROUPS THIS USER BELONGS TO
DEFSTR (DIRGRP,DIRPG0+23,35,36)	;DIRECTORY GROUPS
DEFSTR (DIRUDT,DIRPG0+24,35,36)	;LAST UPDATE DATE AND TIME
DEFSTR (DIRSCT,DIRPG0+25,35,18)	;SUBDIRECTORY COUNT
DEFSTR (DIRSDM,DIRPG0+25,17,18)	;SUBDIRECTORY MAXIMUM
DEFSTR (DIRSGP,DIRPG0+26,35,36)	;SUBDIRECTORY USER GROUPS
DEFSTR (DIRACT,DIRPG0+27,35,36)	;DEFAULT DIRECTORY ACCOUNT
DEFSTR (DIRDNE,DIRPG0+30,35,36) ;DEFAULT ONLINE EXPIRATION DATE/INTERVAL
DEFSTR (DIRDFE,DIRPG0+31,35,36) ;DEFAULT OFFLINE EXPIRATION DATE/INTERVAL
; OFFSETS TO VALUES AT BEGINNING OF EACH DIRECTORY PAGE

.DIDPC== 0	;DIRECTORY PAGE CODE (.TYDIR)
.DILHD== 0	;LENGTH OF HEADER AREA FOR THIS PAGE
.DIRPN== 1	;RELATIVE PAGE # WITHIN DIRECTORY
.DITDN== 1	;THIS DIRECTORY NUMBER
.DIFFB== 2	;POINTER TO FIRST FREE BLOCK

; OFFSETS TO VALUES IN FREE BLOCK HEADERS

.FRTYP== 0	;BLOCK TYPE (.TYFRE)
.FRLEN== 0	;LENGTH OF BLOCK
.FRPTR== 1	;POINTER TO NEXT BLOCK ON FREE LIST

; OFFSETS TO VALUES IN THE NAME BLOCK

.NBTYP== 0	;BLOCK TYPE (.TYNAM)
.NBLEN== 0	;LENGTH OF BLOCK
.NBPTR== 1	;POINTER TO ASCIZ NAME STRING
MINNBL== 2	;MINIMUM NAME BLOCK LENGTH

; OFFSETS TO VALUES IN THE EXTENSION BLOCK

.EBTYP== 0	;BLOCK TYPE (.TYEXT)
.EBLEN== 0	;LENGTH OF BLOCK
.EBPTR== 1	;POINTER TO ASCIZ EXTENSION STRING
MINEBL== 2	;MINIMUM EXTENSION BLOCK LENGTH

; OFFSETS TO VALUES IN THE ACCOUNT BLOCK


.ABTYP== 0	;TYPE OF BLOCK (.TYACT)
.ABLEN== 0	;LENGTH OF BLOCK
.ABCNT== 1	;SHARE COUNT
.ABPTR== 2	;POINTER TO ACCOUNT STRING
MINABL== 3	;MINIMUM ACCOUNT BLOCK LENGTH

; OFFSETS TO VALUES IN USER NAME BLOCKS

.UNTYP==0		;TYPE OF BLOCK (.TYUNS)
.UNLEN==0		;LENGTH OF BLOCK
.UNCNT==1		;SHARE COUNT
.UNPTR==2		;POINTER TO USER NAME STRING
MINUNS==3		;MINIMUM LENGTH OF USER NAME BLOCKS


BT%TYP==-1,,0		;MASK FOR BLOCK TYPE FIELD
BT%VER==770000		;MASK FOR VERSION OF DIRECTORY BLOCKS
BT%LEN==7777		;MASK FOR LENGTH OF DIRECTORY BLOCKS
SUBTTL	MACRO DEFINITIONS


	DEFINE TXT(TEXT) <POINT 7,[ASCIZ\TEXT\]>

	DEFINE O.STR (STRING)
<	MOVE T1,OUTJFN
	XLIST
	HRROI T2,[ASCIZ\STRING\]
	SETZM T3
	SOUT
	LIST
>


	DEFINE O.OCT(NUM)
<	MOVE T1,OUTJFN
	XLIST
	MOVE T2,NUM
	MOVEI T3,10
	NOUT
	  CALL TYPERR
	LIST
>

	DEFINE O.DEC (NUM)
<	MOVE T1,OUTJFN
	XLIST
	MOVE T2,<NUM>
	MOVEI T3,^D10
	NOUT
	  CALL TYPERR
	MOVEI T2,"."
	BOUT
	LIST
>

	DEFINE O.CRLF
<	MOVE T1,OUTJFN
	XLIST
	MOVEI T2,.CHCRT
	BOUT
	MOVEI T2,.CHLFD
	BOUT
	LIST
>
	DEFINE MAPTST (ADR,ERR)
<	MOVE MA,ADR
	XLIST
	CAML MA,MAPBOT
	CAMLE MA,MAPTOP
	JRST [	CALL MAPDIR
		 IFB <ERR>,<RET>
		 IFNB <ERR>,<JRST ERR>
		JRST .+1]
	LIST
>


	DEFINE GETMPW (AC,LOC,ERR)
<	MAPTST LOC,ERR
	XLIST
	HRRZ AC,MA
	ADD AC,FDBOFS
	MOVE AC,(AC)
	LIST
>


	DEFINE GETSYM (AC,LOC)
<	HRRZ AC,LOC
	XLIST
	ADD AC,STBOFS
	MOVE AC,(AC)
	LIST
>


	DEFINE PUTSYM (AC,LOC)
<	HRRZ AC,LOC
	XLIST
	ADD AC,STBOFS
	MOVEM AC,(AC)
	LIST
>
	DEFINE TLOAD (AC,LOC,ADR)
<	MOVE MA,LOC
	XLIST
	CAML MA,MAPBOT
	CAMLE MA,MAPTOP
	CALL MAPDIR
	LOAD AC,LOC,ADR
	LIST
>
	DEFINE CRLF
<	MOVEI T1,.CHCRT
	XLIST
	PBOUT
	MOVEI T1,.CHLFD
	PBOUT
	LIST
>

	DEFINE SAY (STRING)
<	HRROI T1,[ASCIZ\STRING\]
	XLIST
	MOVEM T1,LASTQ
	PSOUT
	LIST
>

	DEFINE SAYCR (STRING)
<	HRROI T1,[ASCIZ\STRING
\]
	XLIST
	MOVEM T1,LASTQ
	PSOUT
	LIST
>


	DEFINE PUTOCT
<	MOVEI	T1, 101
	XLIST
	MOVE	T3, [1B0+^D8]
	NOUT
	  CALL	TYPERR
	LIST
>
SUBTTL	MAIN ENTRY POINT AND INITIALIZATION

START:	RESET			;CLEAR THE UNIVERSE
	MOVE P,PDP		;SET UP STACK
	MOVX T1,.PRIOU		;GET DEFAULT OUTPUT JFN
	MOVEM T1,OUTJFN		;DEFUALT IS PRIMARY OUTPUT FILE
SUBTTL	COMMAND PARSER AND DISPATCH

	HRROI T1,PROMPT		;GET POINTER TO PROMPT STRING
	MOVEM T1,CMDBLK+.CMRTY	;PUT RE-TYPE PROMPT POINTER IN STATE BLOCK
	HRROI T1,BUFFER		;GET POINTER TO INPUT TEXT BUFFER
	MOVEM T1,CMDBLK+.CMPTR	;SAVE POINTER TO COMMAND STRING
	MOVEM T1,CMDBLK+.CMBFP	;SAVE POINTER TO START-OF-BUFFER
	MOVE T1,[.PRIIN,,.PRIOU] ;GET PRIMARY INPUT,, OUTPUT JFN'S
	MOVEM T1,CMDBLK+.CMIOJ	;SAVE PRIMARY JFN'S
	MOVEI T1,PARSE1		;GET RE-PARSE ADDRESS
	MOVEM T1,CMDBLK+.CMFLG	;SAVE RE-PARSE ADDRESS
	SETZM CMDBLK+.CMINC	;INITIALIZE # OF CHARACTERS AFTER POINTER
	MOVEI T1,BUFSIZ*NCHPW	;GET # OF CHARACTERS IN BUFFER AREA
	MOVEM T1,CMDBLK+.CMCNT	;SAVE INITIAL # OF FREE CHARACTER POSITIONS
	HRROI T1,ATMBFR		;GET POINTER TO ATOM BUFFER
	MOVEM T1,CMDBLK+.CMABP	;SAVE POINTER TO LAST ATOM INPUT
	MOVEI T1,ATMSIZ*NCHPW	;GET # OF CHARACTERS IN ATOM BUFFER
	MOVEM T1,CMDBLK+.CMABC	;SAVE COUNT OF SPACE LEFT IN ATOM BUFFER
PARSE:	MOVEI T1,CMDBLK		;GET ADDRESS OF COMMAND STATE BLOCK
	MOVEI T2,[FLDDB. (.CMINI)] ;GET FUNCTION DESCRIPTOR BLOCK
	COMND			;INITIALIZE COMMAND SCANNER JSYS

PARSE1:	MOVE P,PDP		;SET UP STACK
	MOVE T1,[GJFBLK,,GJFBLK+1] ;SET UP TO CLEAR GTJFN BLOCK
	SETZM GJFBLK		;CLEAR FIRST WORD OF BLOCK
	BLT T1,GJFBLK+GJFSIZ-1	;CLEAR GTJFN BLOCK

	MOVEI T1,GJFBLK		;GET ADDRESS OF GTJFN BLOCK
	MOVEM T1,CMDBLK+.CMGJB	;STORE POINTER TO GTJFN BLOCK
	MOVEI T1,CMDBLK		;GET POINTER TO COMMAND STATE BLOCK
	MOVEI T2,[FLDDB. (.CMKEY,,CMDTAB)] ;GET FUNCTION BLOCK
	COMND			;DO INITIAL PARSE
	TXNN T1,CM%NOP		;VALID COMMAND ENTERED ?
	JRST PARSE5		;YES, GO DISPATCH TO PROCESSING ROUTINE
	CALL TSTCOL		;TEST COLUMN POSITION, NEW LINE IF NEEDED
	TMSG <? DIRTST: No such DIRTST command as ">
	MOVE T1,CMDBLK+.CMABP	;GET POINTER TO ATOM BUFFER
	PSOUT			;OUTPUT STRING ENTERED BY USER
	TMSG <"
>				;OUTPUT END-OF-MESSAGE
	JRST PARSE		;GO TRY TO GET A COMMAND AGAIN

PARSE5:	HRRZ T1,(T2)		;GET DISPATCH ADDRESS
	CALL (T1)		;PERFORM REQUESTED FUNCTION
	JRST PARSE		;GO PARSE NEXT COMMAND
SUBTTL	TEST COMMAND

.TEST:
DOMAP:	STKVAR <TSTJFN,TSTOUT>
	MOVEI T1,CMDBLK		;GET ADDRESS OF COMMAND STATE BLOCK
	MOVEI T2,[FLDDB. (.CMNOI,,<TXT(DIRECTORY FILE)>)]
	COMND			;PARSE NOISE WORDS
	TXNN T1,CM%NOP		;PARSED GUIDE PHRASE OK ?
	JRST TEST05		;YES, GO ON
	HRROI T1,[ASCIZ/Invalid guide phrase/]
	CALLRET TYPATM		;GO OUTPUT USER'S TEXT
	RET			;DONE, RETURN

; HERE ON A VALID GUIDE PHRASE - PARSE DIRECTORY FILE SPECIFICATION

TEST05:	GJINF			;GET CONNECTED DIRECTORY NUMBER
	HRROI T1,REPLY		;GET POINTER TO DIRECTORY NAME
	DIRST			;GET STRING FOR DIRECTORY NAME
	 JRST [	SETZM DIRFDB+.CMDEF ;FAILED, CLEAR DEFAULT
		JRST TEST10 ]	;GO DO INPUT WITHOUT DEFAULT
	MOVE T1,[POINT 7,REPLY]	;GET POINTER TO STR:<DIR> STRING
	CALL GTSTR		;SET UP TO DUMP CONNECTED DIRECTORY STRING
	 JRST [	SETZM DIRFDB+.CMDEF ;FAILED, CLEAR DEFAULT
		JRST TEST10 ]	;GO DO INPUT WITHOUT DEFAULT
	MOVEM T2,DIRFDB+.CMDEF	;SAVE POINTER TO DEFAULT STRING
	MOVE T1,[GJFBLK,,GJFBLK+1] ;SET UP TO CLEAR
	SETZM GJFBLK		; THE GTJFN BLOCK
	BLT T1,GJFBLK+GJFSIZ-1	;CLEAR THE BLOCK
	MOVX T1,GJ%IFG!GJ%PHY!GJ%IFG ;FLAGS
	MOVEM T1,GJFBLK+.GJGEN	;SAVE FLAGS
	HRROI T1,[ASCIZ/DIRECTORY/] ;GET DEFAULT EXTENSION
	MOVEM T1,GJFBLK+.GJEXT	;SAVE EXTENSION DEFAULT
	HRROI T1,[ASCIZ/ROOT-DIRECTORY/]
	MOVEM T1,GJFBLK+.GJDIR	;SAVE DEFAULT DIRECTORY POINTER
TEST10:	MOVEI T1,CMDBLK		;GET ADDRESS OF COMMAND STATE BLOCK
	MOVEI T2,DIRFDB		;GET ADDRESS OF DIRECTORY FILESPEC FDB
	COMND			;PARSE FILESPEC
	TXNN T1,CM%NOP		;FILENAME PARSED OK ?
	JRST TEST15		;YES, GO STORE DIRECTORY NUMBER
	CALL TSTCOL		;OUTPUT CRLF IF NEEDED
	TMSG <? DIRTST: No such directory file as ">
	HRROI T1,ATMBFR		;GET ATOM BUFFER POINTER
	PSOUT			;OUTPUT NAME ENTERED BY USER
	TMSG <"
	>			;OUTPUT END OF MESSAGE
	MOVEI T1,.PRIOU		;GET OUTPUT JFN
	HRLOI T2,.FHSLF		;GET OUR PROCESS HANDLE
	SETZM T3		;NO FLAGS
	ERSTR			;OUTPUT ERROR STRING
	 JFCL			;IGNORE ERRORS
	 JFCL			;IGNORE ERRORS
	CALL TSTCOL		;OUTPUT CRLF IF NEEDED
	RET			;RETURN
; HERE ON A VALID DIRECTORY FILE SPECIFICATION - PARSE END OF COMMAND

TEST15:	MOVEM T2,TSTJFN		;SAVE JFN
	MOVEI T2,[FLDDB. (.CMCFM)]
	COMND			;CONFIRM COMMAND
	TXNE T1,CM%NOP		;END-OF-COMMAND SEEN OK ?
	CALLRET COMER2		;NO, GO ISSUE MESSAGE
	MOVEI T1,.FHSLF		;GET OUR FORK HANDLE
	RPCAP			;READ OUR ENABLED CAPABILITIES
	TXNN T3,SC%WHL!SC%OPR	;WHEEL OR OPERATOR ENABLED ?
	JRST [	CALL TSTCOL	;NO, NEW LINE IF NEEDED
		TMSG <? DIRTST: WHEEL or OPERATOR capability required
>				;OUTPUT MESSAGE
		HALTF		;QUIT
		JRST START ]	;AND START AGAIN IF CONTINUE'D
	MOVE T1,OUTJFN		;GET JFN BACK AGAIN
	MOVX T2,<FLD(7,OF%BSZ)+OF%WR>
	OPENF			;OPEN THE FILE
	 JRST [	JSERR		;UNEXPECTED ERROR
		MOVE T1,OUTJFN	;GET JFN
		RLJFN		;RELEASE JFN
		 JFCL		;IGNORE ERRORS
		RET ]		;RETURN
	MOVE T1,TSTJFN		;GET JFN OF DIRECTORY FILE
	MOVEM T1,DIRFLG		;ALSO SAVE FLAGS
	MOVEM T1,DIRJFN		;SAVE DIRECTORY JFN
	HRRZ T1,DIRJFN		;GET DIRECTORY JFN
	MOVX T2,<FLD(^D36,OF%BSZ)+OF%RD+OF%THW>
	OPENF			;OPEN THE FILE TO BE TESTED
	 JRST [	JSERR		;ERROR, ISSUE MESSAGE
		MOVE T1,DIRJFN	;GET JFN BACK
		RLJFN		;RELEASE THE JFN
		 JFCL		;IGNORE ERRORS HERE
		RET ]		;RETURN
	; ..
	; ..

; HERE TO START TESTING

TEST20:	CALL MAPDP0		;GO MAP FIRST PAGE OF DIRECTORY
	CALL MAPSTB		;GO MAP IN THE SYMBOL TABLE
	MOVEI MA,0		;GET AN ADDRESS TO MAP
	CALL MAPDIR		;GO MAP SOMETHING TO START
	 JRST [	CALL TSTCOL	;ISSUE NEW LINE IF NEEDED
		TMSG <? DIRTST: Could not map directory file
>
		HALTF		;DIE
		JRST START ]	;TRY AGAIN
	SETZM ERRCNT		;INITIALIZE ERROR COUNT
	CALL SETNAM		;GO SET UP DIRECTORY NAME

MAIN00:	MOVE T1,OUTJFN		;GET OUTPUT JFN
	MOVEI T2,.CHFFD		;GET A FORM FEED
	BOUT			;OUTPUT A FORM FEED
	O.STR <Test of directory >
	MOVE T1,OUTJFN		;GET OUTPUT JFN
	HRROI T2,CURNAM		;GET POINTER TO DIRECTORY NAME
	SETZM T3		;TERMINATE ON NULL
	SOUT			;OUTPUT DIRECTORY NAME
	O.STR <, # >		;OUTPUT PUNCTUATION
	HRRZ P1,CURDIR		;GET DIR #
	O.OCT P1		;OUTPUT DIRECTORY NUMBER
	MOVE T1,OUTJFN		;GET OUTPUT JFN
	O.STR (<, on >)		;OUTPUT PUNCTUATION
	MOVE T1,OUTJFN		;GET OUTPUT JFN
	SETOM T2		;USE CURRENT DATE AND TIME
	SETZM T3		;USE STANDARD DATE FORMAT
	ODTIM			;OUTPUT THE DATE AND TIME
	O.CRLF			;OUTPUT A CRLF
	O.CRLF			;LEAVE A BLANK LINE
MAIN01:	CALL DIRCHK		;GO CHECK HEADER OF EACH PAGE
	CALL DUPCHK		;CHECK FOR DUPLICATE ST ENTRIES
	CALL ORDCHK		;GO CHECK ALPHABETIC ORDERINGS
	CALL TSTBLK		;INSURE ALL BLOCKS POINTED TO
	CALL GENTST		;CHECK ORDERING OF GENERATIONS
	CALL CHKFRN		;VERIFY NO PTRS GO TO FREE LIST
	CALL FRETST		;CHECK THAT NO FREE BLOCKS ABUT
NEWTST:	CALL PTRTST		;GO CHECK CONSISTENCY OF FDB'S


	O.CRLF			;LEAVE A BLANK LINE
	SKIPN NEXCNT		;ANY FDB'S WITH FD%NEX ON ?
	JRST MAIN65		;NO, OMIT MESSAGE
	O.STR <% >		;OUTPUT INITIAL PART OF MESSAGE
	O.DEC NEXCNT		;OUTPUT # OF FDB'S WITH FD%NEX
	O.STR < FDB's with FD%NEX on were found
>
MAIN65:	CALL SUMMRY		;OUTPUT A SUMMARY
	MOVE T1,OUTJFN		;GET OUTPUT JFN
	DVCHR			;GET CHARACTERISTICS
	LOAD T4,DV%TYP,T2	;GET JUST THE DEVICE TYPE
	CAIN T4,.DVTTY		;A TERMINAL ?
	JRST MAIN80		;YES, DO NOT OUTPUT SUMMARY AGAIN
	MOVE T1,OUTJFN		;GET OUTPUT JFN
	MOVEM T1,TSTOUT		;SAVE OUTPUT JFN
	MOVEI T1,.PRIOU		;GET PRIMARY OUTPUT JFN
	MOVEM T1,OUTJFN		;SAVE AS TEMPORARY OUTPUT JFN
	CALL SUMMRY		;OUTPUT SUMMARY TO TERMINAL
	MOVE T1,TSTOUT		;GET ORIGINAL OUTPUT JFN
	MOVEM T1,OUTJFN		;SAVE OUTPUT JFN

MAIN80:	SETOM T1		;REMOVE PAGES FROM THIS FORK
	HRRZI T2,DIRPG0		;GET ADR WERE MAPPING BEGINS
	LSH T2,-^D9		;CONVERT ADR TO A PAGE NUMBER
	HRLI T2,.FHSLF		;GET OUR FORK HANDLE
	MOVX T3,FDBPGS+STBPGS+3	;GET # OF PAGES TO REMOVE
	TXO T3,PM%CNT		;INDICATE PMAP SHOULD ITERATE
	PMAP			;MAP THE PAGES INTO LIMBO
	HRRZ T1,DIRJFN		;GET DIRECTORY JFN
	TLO T1,400000		;DO NOT RELEASE JFN
	CLOSF			;CLOSE DIRECTORY FILE
	  CALL PUTERR		;UNEXPECTED ERROR, CONTINUE

	MOVE T1,DIRFLG		;GET FLAGS AND DIRECTORY JFN
	GNJFN			;GET NEXT JFN IN GROUP
	  JRST ALLDON		;NO MORE FILES, ALL DONE
	MOVEM T1,DIRJFN		;SAVE THE DIRECTORY JFN
	CALL OPNDIR		;GO OPEN DIRECTORY FILE
	JRST TEST20		;GO DO NEXT DIRECTORY
; HERE AT COMPLETION OF TESTS - CLEAN UP AND RETURN TO PARSER

ALLDON:	MOVE T1,OUTJFN		;GET OUTPUT JFN
	MOVEI T2,.CHFFD		;GET A FORM FEED CHARACTER
	BOUT			;OUTPUT A FORM FEED
	MOVE T1,OUTJFN		;GET OUTPUT JFN
	TXO T1,CO%NRJ		;KEEP THE JFN
	CLOSF			;CLOSE OUTPUT FILE
	  CALL PUTERR		;UNEXPECTED ERROR, CONTINUE
	RET			;RETURN TO PARSER
;SUMMRY - ROUTINE TO OUTPUT SUMMARY AFTER PERFORMING TESTS

SUMMRY:	SKIPN ERRCNT		;ANY ERRORS FOUND ?
	JRST SMRY70		;NO, GO SAY SO
	O.STR <[Total of >
	O.DEC ERRCNT		;OUTPUT # OF ERRORS
	O.STR < error>		;OUTPUT NEXT PART OF MESSAGE
	MOVE P1,ERRCNT		;GET # OF ERRORS FOUND
	CAIG P1,1		;MORE THAN ONE ERROR FOUND ?
	JRST SMRY67		;NO, USE 1-ERROR MESSAGE
	O.STR <s were detected]
>
	RET			;DONE
SMRY67:	O.STR < was detected]
>
	RET			;DONE

SMRY70:	O.STR <[No errors were detected]
>
	RET			;DONE



;SETNAM - ROUTINE TO SET UP THE NAME OF DIRECTORY BEING TESTED


SETNAM:	HRROI T1,REPLY		;GET ADDRESS OF TEMPORARY BUFFER
	HRRZ T2,DIRJFN		;GET JFN OF DIRECTORY FILE
	MOVX T3,<FLD(.JSAOF,JS%DEV)+JS%PAF>
	JFNS			;GET THE STRUCTURE NAME
	HRROI T1,REPLY		;GET POINTER TO STR NAME
	STDEV			;GET DEV DESIGNATOR
	 ERJMP R		;FAILED, RETURN
	HRLM T2,NUMDIR		;SAVE STR UNIQUE CODE
	HRRZ T1,DIRJFN		;GET DIRECTORY FILE JFN
	MOVE T2,[1,,.FBGEN]	;GET DIR # FROM FDB
	MOVEI T3,T4		;PUT DIR # INTO T4
	GTFDB			;GET DIRECTORY NUMBER
	 ERJMP R		;RETURN ON FAILURE
	HRRM T4,NUMDIR		;FORM COMPLETE DIRECTORY DESIGNATOR
	MOVE T1,NUMDIR		;GET DIRECTORY DESIGNATOR
	HRRZM T1,CURDIR		;SAVE JUST DIR # PART
	HRROI T1,CURNAM		;GET POINTER TO WHERE NAME GOES
	MOVE T2,NUMDIR		;GET DIRECTORY DESIGNATOR
	DIRST			;FORM DIRECTORY NAME
	 JRST [	HRROI T1,CURNAM	;FAILED, USE SOME OTHER STRING
		HRROI T2,[ASCIZ/*** <Unknown Directory Name> ***/]
		SETZM T3
		SOUT		;SAVE STRING
		JRST .+1]	;CONTINUE
	RET			;DONE
; DIRCHK - ROUTINE TO CHECK THE HEADER IN EACH PAGE OF THE
;	   DIRECTORY FOR CONSISTENCY.  PERFORMS THE FOLLOWING
;	   TESTS:
;		1.  BLOCK TYPE SHOULD BE 403000
;		2.  DIRECTORY # SHOULD BE THE SAME IN EACH PAGE.
;		3.  PAGE # SHOULD INCREMENT FOR EACH PAGE.
;
; CALL:		CALL DIRCHK
;		RETURN

DIRCHK:	SETZM I2		;START WITH PAGE 0
	LOAD I1,DIRFRE		;GET HIGHEST ADR+1 USED BLOCKS
	JUMPE I1,DIRCH1		;IF JUST PAGE 0, ALL SET
	SUBI I1,1		;COMPUTE HIGHEST ADR ACTUALLY USED
	LSH I1,-^D9		;CONVERT TO A PAGE NUMBER

DIRCH1:	MOVE P1,I2		;GET # OF PAGE TO CHECK
	LSH P1,^D9		;CONVERT PAGE # TO AN ADDRESS
	MOVEI P2,.DIDPC(P1)	;GET DIRECTORY PAGE CODE ADR
	GETMPW P3,P2		;GET WORD ROM HEADER
	HLRZ P3,P3		;KEEP JUST THE CODE
	CAIN P3,.TYDIR		;CORRECT CODE ?
	JRST DIRCH2		;YES, GO ON TO NEXT CHECK
	AOS ERRCNT		;INCREMENT # OF ERRORS DETECTED
	O.STR <
? Incorrect Block Type >
	O.OCT P3		;OUTPUT THE BLOCK TYPE
	O.STR < encountered in directory page >
	O.OCT I2		;OUTPUT DIRECTORY PAGE #
	O.CRLF			;NEW LINE

DIRCH2:	MOVE P1,I2		;GET PAGE # TO CHECK
	LSH P1,^D9		;CONVERT PAGE # TO ADDRESS
	MOVEI P2,.DITDN(P1)	;GET ADR OF DIRECTORY NUMBER
	GETMPW P3,P2		;GET THIS DIRECTORY NUMBER
	HRRZ P3,P3		;KEEP JUST THE DIR NUMBER
	CAMN P3,CURDIR		;CORRECT DIRECTORY NUMBER ?
	JRST DIRCH3		;YES, GO ON TO NEXT CHECK
	AOS ERRCNT		;INCREMENT # OF ERRORS DETECTED
	O.STR <
? Incorrect directory number >
	O.OCT P3		;OUTPUT DIRECTORY # FOUND
	O.STR < found on directory page >
	O.OCT I2		;OUTPUT PAGE #
	O.STR <
	Expected directory # was >
	O.OCT CURDIR		;OUTPUT EXPECTED #
	O.CRLF
DIRCH3:	MOVE P1,I2		;COPY PAGE # TO CHECK
	LSH P1,^D9		;CONVERT PAGE # TO ADDRESS
	MOVEI P2,.DIRPN(P1)	;GET ADR OF PAGE #
	GETMPW P3,P2		;GET WORD FROM HEADER
	HLRZ P3,P3		;GET RELATIVE PAGE NUMBER
	CAMN P3,I2		;CORRECT PAGE NUMBER ?
	JRST DIRCH4		;YES, GO ON
	AOS ERRCNT		;INCREMENT # OF ERRORS DETECTED
	O.STR <
? Incorrect page # >
	O.OCT P3		;OUTPUT PAGE # FOUND
	O.STR < found on page >
	O.OCT I2		;OUTPUT REAL PAGE #
	O.STR < of directory
>

DIRCH4:	CAMGE I2,I1		;DONE ALL PAGES YET ?
	AOJA I2,DIRCH1		;NO, GO DO NEXT PAGE

	LOAD P1,DIRBOT		;GET BOTTOM ADR OF SYMBOL TABLE
	GETSYM P2,P1		;GET FIRST WORD OF SYMBOL TABLE
	HLRZ P3,P2		;GET BLOCK TYPE
	CAIN P3,.TYSYM		;BLOCK TYPE = SYMBOL TABLE ?
	RET			;YES, RETURN
	AOS ERRCNT		;INCREMENT # OF ERRORS DETECTED
	O.STR <
? Incorrect Block Type >
	O.OCT P3		;OUTPUT BLOCK TYPE
	O.STR < in first word of Symbol Table
>
	RET			;RETURN
SUBTTL	SYMBOL TABLE CHECKER

; DUPCHK - ROUTINE TO CHECK FOR DUPLICATE ENTRIES IN THE
;	   SYMBOL TABLE.
;
; CALL:		CALL DUPCHK
;		RETURN

DUPCHK:	STKVAR <CURPTR>		;ALLOCATE TEMPORARY STORAGE
	LOAD I1,DIRBOT		;GET BOTTOM ADR OF SYMBOL TABLE
	ADDI I1,STHSIZ		;POINT TO FIRST ENTRY

DUPCH1:	LOAD P1,DIRTOP		;GET TOP ADDRESS IN SYMBOL TABLE
	CAMG P1,I1		;AT END OF TABLE YET ?
	RET			;YES, RETURN TO WHENCE WE CAME
	GETSYM P1,I1		;NO, GET ADDRESS OF A BLOCK
	MOVEM P1,CURPTR		;SAVE POINTER TO BLOCK
	MOVEI I2,STESIZ(I1)	;GET ADDRESS OF NEXT ENTRY

; LOOP TO SEE IF THE BLOCK ADDRESS P1 IS DUPLICATED

DUPCH2:	LOAD P4,DIRTOP		;GET ADDRESS OF TOP OF TABLE
	CAMG P4,I2		;AT END-OF-SYMBOL TABLE YET ?
	JRST DUPCH3		;YES, GO COMPARE NEXT ENTRY
	GETSYM P3,I2		;NO, GET FIRST WORD OF ENTRY
	CAMN P3,CURPTR		;DUPLICATE ENTRY ?
	CALL DUPENT		;YES, GO ISSUE ERROR MESSAGE
	ADDI I2,STESIZ		;INCREMENT POINTER TO NEXT ENTRY
	JRST DUPCH2		;GO CHECK FOR END-OF-TABLE

DUPCH3:	ADDI I1,STESIZ		;INCREMENT POINTER TO NEXT ENTRY
	JRST DUPCH1		;GO CHECK NEXT ENTRY IN TABLE
; DUPENT - ROUTINE TO ISSUE AN ERROR MESSAGE ON ENCOUNTERING
;	   A DUPLICATE POINTER IN THE SYMBOL TABLE.
;
; CALL:		MOVE I1,ADDRESS OF FIRST ENTRY
;		MOVE I2,ADDRESS OF DUPLICATE ENTRY
;		CALL DUPENT
;		RETURN

DUPENT:	O.STR <? Duplicate pointers In Symbol Table
    First entry at >
	O.OCT <I1>		;OUTPUT ADDRESS OF ENTRY
	O.STR < is:
>
	MOVE Q1,I1		;COPY ADDRESS IN ARGUMENT AC
	CALL PUTSTE		;GO OUTPUT SYMBOL TABLE ENTRY
	o.str <    Second entry at >
	O.OCT (I2)		;OUTPUT ADR OF DUPLICATE ENTRY
	O.STR < is
>
	MOVE Q1,I1		;COPY ADDRESS IN ARGUMENT AC
	CALL PUTSTE		;GO OUTPUT SYMBOL TABLE ENTRY
	AOS ERRCNT		;INCREMENT # OF ERRORS DETECTED
	RET			;RETURN TO WHENCE WE CAME ...


; PUTSTE - ROUTINE TO OUTPUT A SYMBOL TABLE ENTRY
;
; CALL:		MOVE Q1,ADDRESS OF ENTRY
;		CALL PUTSTE
;		RETURN


PUTSTE:	O.STR <	Type & Pointer: >
	GETSYM T2,Q1		;GET FIRST WORD OF ENTRY
	MOVE T1,OUTJFN		;GET OUTPUT JFN
	MOVE T3,[1B0+10]	;PRINT MAGNITUDE, RADIX IS OCTAL
	NOUT			;OUTPUT THE FIRST WORD OF ENTRY
	  CALL TYPERR		;UNEXPECTED ERROR
	O.STR <
	Name string:	>
	MOVEI P1,1(Q1)		;GET ADDRESS OF SECOND WORD
	GETSYM P2,P1		;GET ASCII NAME
	MOVE T1,OUTJFN		;GET OUTPUT JFN
	HRROI T2,P2		;FORM POINTER TO NAME
	MOVEI T3,5		;OUTPUT 5 CHARACTERS MAX
	SETZM T4		;TERMINATE IF NULL SEEN
	SOUT			;OUTPUT THE NAME STRING
	O.CRLF			;OUTPUT A CRLF
	RET			;RETURN TO WHENCE WE CAME ...
; ORDCHK - ROUTINE TO CHECK THE ALPHABETIC ORDERING OR
;	   STRINGS IN THE DIRECTORY.
;
; CALL:		CALL ORDCHK
;		RETURN

ORDCHK:	STKVAR <LSTSYM,ORDTYP>		;ALLOCATE TEMPORARY STORAGE
	MOVEI T1,.STNAM		;GET FIRST TYPE OF SYMBOL TABLE ENTRIES
	MOVEM T1,ORDTYP		;SAVE CURRENT ENTRY TYPE
	LOAD I1,DIRBOT		;GET BOTTOM ADR OF SYMBOL TABLE
	ADDI I1,STHSIZ		;POINT TO FIRST ENTRY
	LOAD P1,DIRTOP		;GET TOP ADDRESS IN SYMBOL TABLE
	CAMG P1,I1		;CHECKED ALL ENTRIES YET ?
	JRST ORDCK7		;YES, GO CHECK EXT CHAINS
	MOVEI P1,1(I1)		;GET ADDRESS OF SYMBOL
	GETSYM P2,P1		;GET SYMBOL FROM TABLE
	LSH P2,-1		;MAKE THE NUMBER POSITIVE

ORDCK1:	MOVEM P2,LSTSYM		;SAVE LAST SYMBOL
	ADDI I1,STESIZ		;POINT TO NEXT ENTRY IN TABLE
	LOAD P1,DIRTOP		;GET TOP ADR IN SYMBOL TABLE
	CAMG P1,I1		;REACHED LAST ENTRY YET ?
	JRST ORDCK7		;YES, GO CHECK EXT CHAINS
	MOVEI P1,1(I1)		;GET ADR OF SYMBOL
	GETSYM P2,P1		;GET A SYMBOL FROM TABLE
	GETSYM P4,I1		;GET FIRST WORD OF ENTRY
	LDB P4,[POINTR P4,.STMSK] ;GET ENTRY TYPE
	CAME P4,ORDTYP		;SAME AS CURRENT TYPE ?
	JRST [	MOVEM P4,ORDTYP	;NO, SAVE NEW CURRENT TYPE
		LSH P2,-1	;MAKE THE NEW "LAST NUMBER" POSITIVE
		JRST ORDCK1 ]	;GO START CHECKING NEXT SECTION OF TABLE
	LSH P2,-1		;MAKE NUMBER POSITIVE
	CAMN P2,LSTSYM		;THIS SYMBOL SAME AS LAST ?
	JRST ORDCK2		;YES, GO CHECK ENTIRE NAME
	CAMG P2,LSTSYM		;THIS SYMBOL .GT. LAST ?
	CALL ORDERR		;NO, ISSUE ERROR MESSAGE
	JRST ORDCK1		;GO CHECK NEXT PAIR OF SYMBOLS
ORDCK2:	GETSYM P1,I1		;GET FIRST WORD OF ENTRY 1
	LDB Q1,[POINTR P1,.STPTR] ;GET ADR IN ENTRY
	LDB P2,[POINTR P1,.STMSK] ;GET TYPE OF ENTRY
	CAIE P2,.STNAM		;IS THIS A POINTER TO AN FDB ?
	JRST ORDCK3		;NO, WE HAVE ACCOUNT BLOCK ADR
	MOVEI P1,.FBNAM(Q1)	;YES, GET ADR OF PTR TO NAME BLK
	GETMPW P2,P1		;GET ADR OF NAME BLOCK
	MOVEI Q1,.NBPTR(P2)	;GET ADR OF NAME STRING
	JRST ORDCK4		;GO GET PREVIOUS ENTRY
ORDCK3:	ADDI Q1,.ABPTR		;POINT TO ACCOUNT STRING
ORDCK4:	MOVEI P1,-STESIZ(I1)	;GET ADR OF PREVIOUS ENTRY
	GETSYM P2,P1		;GET FIRST WORD OF ENTRY
	LDB Q2,[POINTR P2,.STPTR] ;GET ADR IN ENTRY
	LDB P3,[POINTR P2,.STMSK] ;GET TYPE OF ENTRY
	CAIE P3,.STNAM		;IS THIS AN FDB ADDRESS ?
	JRST ORDCK5		;NO, MUST BE AN ACCOUNT BLK
	MOVEI P1,.FBNAM(Q2)	;YES, GET ADDRESS OF NAME BLK
	GETMPW P2,P1		;GET ADDRESS OF NAME BLOCK
	MOVEI Q2,.NBPTR(P2)	;GET ADDRESS OF NAME STRING
	JRST ORDCK6		;GO COMPARE THE STRINGS
ORDCK5:	ADDI Q2,.ABPTR		;FORM POINTER TO ACCOUNT STRING
				;FALL INTO ORDCK6 ...
ORDCK6:	CALL STRCMP		;GO COMPARE THE STRINGS
	JUMPG Q1,ORDCK1		;GO CHECK NEXT PAIR OF ENTRIES
	CALL ORDERR		;GO ISSUE ERROR MESSAGE
	MOVEI P1,1(I1)		;GET ADR OF THIS SYMBOL
	GETSYM P2,P1		;GET THE SYMBOL AGAIN
	JRST ORDCK1		;GO CHECK NEXT PAIR OF ENTRIES


ORDCK7:	CALLRET ORDEXT		;GO CHECK EXT ORDERING



; ORDERR - ROUTINE TO ISSUE ERROR MESSAGE IF THE SYMBOL TABLE
;	   IS OUT OF ORDER.
;
; CALL:		MOVE I1,ADR OF BAD ENTRY
;		CALL ORDERR
;		RETURN


ORDERR:	O.STR <
? Symbol Table entry at >
	O.OCT I1		;OUTPUT ADR OF ENTRY
	O.STR < is out of order
>
	AOS ERRCNT		;INCREMENT # OF ERRORS DETECTED
	RET			;RETURN TO WHENCE WE CAME ...
; ORDEXT - ROUTINE TO CHECK THE ORDERING OF FDB'S ON AN
;	   EXTENSION CHAIN.
;
; CALL:		CALL ORDEXT
;		RETURN


ORDEXT:	STKVAR <LSTEXT,LSTFDB>	;ALLOCATE TEMPORARY STORAGE
	LOAD I1,DIRBOT		;GET BOTTOM ADR IN SYMBOL TABLE
	ADDI I1,STHSIZ		;POINT TO FIRST ENTRY

ORDEX1:	LOAD P1,DIRTOP		;GET TOP ADR IN SYMBOL TABLE
	CAMG P1,I1		;ALL ENTRIES CHECKED YET ?
	RET			;YES, RETURN
	GETSYM P1,I1		;NO, GET FIRST WORD OF ENTRY
	LDB P2,[POINTR P1,.STMSK] ;GET ENTRY TYPE
	CAIE P2,.STNAM		;FILENAME ENTRY ?
	JRST ORDEX3		;NO, GO CHECK NEXT ENTRY
	LDB FB,[POINTR P1,.STPTR] ;YES, GET ADR OF FDB
	MOVEI P1,.FBEXT(FB)	;GET ADDRESS OF PTR TO EXT BLOCK
	GETMPW P2,P1		;GET ADDRESS OF EXT BLOCK
	MOVEI P2,.EBPTR(P2)	;GET ADDRESS OF EXTENSION STRING
	MOVEM P2,LSTEXT		;SAVE ADDRESS OF LAST EXTENSION

ORDEX2:	MOVEM FB,LSTFDB		;SAVE ADDRESS OF LAST FDB
	MOVEI P1,.FBEXL(FB)	;GET ADR OF PTR TO NEXT EXT FDB
	GETMPW FB,P1		;GET ADDRESS OF NEXT EXT FDB
	JUMPE FB,ORDEX3		;IF END-OF-CHAIN, DO NEXT CHAIN
	MOVEI P1,.FBEXT(FB)	;GET ADR OF PTR TO EXT STRING
	GETMPW P2,P1		;GET ADDRESS OF EXTENSION BLOCK
	MOVEI Q2,.EBPTR(P2)	;GET ADDRESS OF EXTENSION STRING
	MOVE Q1,LSTEXT		;GET ADDRESS OF LAST STRING
	MOVEM Q2,LSTEXT		;SAVE NEW LAST EXTENSION
	CALL STRCMP		;COMPARE THE TWO EXTENSIONS
	JUMPL Q1,ORDEX2		;IF ORDERING OK, CHECK NEXT EXT
	AOS ERRCNT		;INCREMENT # OF ERRORS DETECTED
	O.STR <
? Extension chain is out of order
	FDB with bad extension is at address >
	O.OCT FB		;OUTPUT THE FDB ADDRESS
	O.STR <
	Previous FDB is at address >
	MOVE P1,LSTFDB		;GET ADR OF PREVIOUS FDB
	O.OCT P1		;OUTPUT FDB ADDRESS
	O.CRLF			;OUTPUT A CRLF
	JRST ORDEX2		;GO CHECK NEXT PAIR OF STRINGS

ORDEX3:	ADDI I1,STESIZ		;POINT TO NEXT ENTRY
	JRST ORDEX1		;GO CHECK NEXT PAIR OF EXT'S
SUBTTL	CHECK ORDERING OF FDB'S ON GENERATION CHAINS

; GENTST - ROUTINE TO CHECK THE ORDERING OF FDB'S ON GENERATION
;	   CHAINS.
;
; CALL:		CALL GENTST
;		RETURN, MESSAGE ISSUED IF APPROPRIATE


GENTST:	STKVAR <EXHEAD,CURGEN>	;ALLOCATE TEMPORARY STORAGE
	LOAD I1,DIRBOT		;GET BOTTOM ADR IN SYMBOL TABLE
	ADDI I1,STHSIZ		;POINT TO FIRST ENTRY IN TABLE

GENTS1:	LOAD P1,DIRTOP		;GET TOP ADR IN SYMBOL TABLE
	CAMG P1,I1		;CHECKED ALL ENTRIES YET ?
	RET			;YES, RETURN
	GETSYM P1,I1		;NO, GET FIRST WORD OF ENTRY
	LDB P2,[POINTR P1,.STMSK] ;GET ENTRY TYPE
	CAIE P2,.STNAM		;IS THIS AN FDB ADR ?
	JRST GENTS5		;NO, GO CHECK NEXT ENTRY
	LDB P1,[POINTR P1,.STPTR] ;YES, GET ADR OF FDB

GENTS2:	MOVEM P1,EXHEAD		;SAVE ADR OF HEAD OF CHAIN
	MOVEI P2,.FBGEN(P1)	;GET ADR OF GENERATION
	GETMPW P3,P2		;GET GENERATION FROM FDB

GENTS3:	HLRZM P3,CURGEN		;SAVE THIS GENERATION
	MOVEI P2,.FBGNL(P1)	;GET ADR OF PTR TO NEXT GEN
	GETMPW P1,P2		;GET POINTER TO NEXT GEN FDB
	JUMPE P1,GENTS4		;IF END-OF-CHAIN, TRY NEXT EXT
	MOVEI P2,.FBGEN(P1)	;GET ADR OF GENERATION WORD
	GETMPW P3,P2		;GET GENERATION WORD FROM FDB
	HLRZ P4,P3		;GET JUST THE GENERATION
	CAML P4,CURGEN		;IS THE ORDERING CORRECT ?
	CALL GENERR		;NO, ISSUE ERROR MESSAGE
	JRST GENTS3		;GO CHECK NEXT FDB ON CHAIN

GENTS4:	MOVE P1,EXHEAD		;GET ADR OF FDB AT HEAD OF CHAIN
	MOVEI P2,.FBEXL(P1)	;GET ADR OF PTR TO NEXT FDB
	GETMPW P1,P2		;GET POINTER TO NEXT FDB
	JUMPN P1,GENTS2		;GO CHECK THIS EXT CHAIN

GENTS5:	ADDI I1,STESIZ		;POINT TO NEXT ENTRY IN S.T.
	JRST GENTS1		;GO CHECK NEXT FDB CHAIN
; GENERR - ROUTINE TO ISSUE AN ERROR MESSAGE IF THE FDB'S ON
;	   A GENERATION CHAIN WERE FOUND TO BE OUT OF ORDER.
;
; CALL:		MOVE P1,ADR OF FDB
;		CALL GENERR
;		RETURN


GENERR:	STKVAR <BADFDB>		;ALLOCATE TEMPORARY STORAGE
	MOVEM P1,BADFDB		;SAVE ADR OF FDB
	O.STR <
? Generation chain is out of order
	fdb with bad generation is at address >
	move P1,badfdb		;restore fdb address
	o.oct P1		;output address of fdb
	o.crlf			;output a crlf
	AOS ERRCNT		;INCREMENT # OF ERRORS DETECTED
	ret			;return to whence we came ...
SUBTTL		FREE LIST CHECKER

; CHKFRN - ROUTINE TO DETERMINE IF ANY OF THE POINTERS IN
;	   AN FDB CHAIN OF POINTING INTO THE FREE LIST.
;
; CALL:		CALL CHKFRN
;		RETURN, ERROR MESSAGES ISSUED IF APPROPRIATE


CHKFRN:	LOAD I1,DIRBOT		;GET BOTTOM ADR OF SYMBOL TABLE
	ADDI I1,STHSIZ		;POINT TO FIRST ENTRY

CHKFN1:	LOAD P1,DIRTOP		;GET TOP ADDRESS IN SYMBOL TABLE
	CAMG P1,I1		;AT END-OF-TABLE YET ?
	RET			;YES, RETURN

	GETSYM Q1,I1		;GET A SYMBOL TABLE ENTRY
	LDB P1,[POINTR Q1,.STMSK] ;GET JUST THE TYPE CODE
	CAIE P1,.STNAM		;IS THIS A POINTER TO AN FDB ?
	JRST CHKFN4		;NO, GO CHECK ACCOUNT BLOCK
	CALL BLKCHK		;YES, GO SEE IF ITS ON FREE LIST
	  JRST [ HRROI T2,[ASCIZ/FDB/]
		 CALL BOFLER	;BLOCK ON FREE LIST ERROR
		 JRST CHKFN2 ]	;GO CHECK NAME BLOCK

CHKFN2:	MOVEI P1,.FBNAM(Q1)	;GET ADDRESS OF NAME WORD IN FDB
	GETMPW Q1,P1		;GET THE NAME WORD FROM THE FDB
	CALL BLKCHK		;SEE IF NAME BLK IS ON FREE LIST
	  JRST [ HRROI T2,[ASCIZ/Name Block/]
		 CALL BOFLER	;BLOCK ON FREE LIST ERROR
		 JRST CHKFN3 ]	;GO CHECK REST OF EXT CHAIN

CHKFN3:	GETSYM P1,I1		;GET SYMBOL TABLE ENTRY AGAIN
	LDB FB,[POINTR(P1,.STPTR)] ;GET JUST THE BLOCK ADDRESS
	CALL CHKFRE		;GO CHECK ENTIRE EXT CHAIN
	JRST CHKFN5		;CHECK NEXT SYMBOL TABLE ENTRY

CHKFN4:	CALL BLKCHK		;GO CHECK ACCOUNT BLOCK
	  JRST [ HRROI T2,[ASCIZ/Account Block/]
		 CALL BOFLER	;BLOCK ON FREE LIST ERROR
		 JRST CHKFN5 ]	;GO CHECK NEXT ENTRY

CHKFN5:	ADDI I1,STESIZ		;POINT TO NEXT ENTRY IN TABLE
	JRST CHKFN1		;GO CHECK THE NEXT ENTRY
; CHKFRE - ROUTINE TO DETERMINE IF ANY OF THE POINTERS IN
;	   THE FDB'S ON AN EXTENSION CHAIN POINT INTO THE
;	   FREE LIST.
;
; CALL:		MOVE FB, ADDRESS OF FDB AT HEAD OF CHAIN
;		CALL CHKFRE
;		RETURN, ERROR MESSAGE ISSUED IF ANY POINTERS
;		  POINTED INTO THE FREE LIST.


CHKFRE:	STKVAR <ARGFDB>		;ALLOCATE TEMPORARY STORAGE
	MOVEM FB,ARGFDB		;SAVE ARGUMENT FDB ADDRESS

CHKFE1:	MOVE P1,FB		;GET ADR OF FDB AT HEAD OF CHAIN
	MOVEI P2,.FBEXT(P1)	;GET ADDRESS OF EXTENSION WORD
	GETMPW Q1,P2		;GET EXTENSION WORD FROM FDB
	CALL BLKCHK		;GO CHECK EXTENSION BLOCK
	  JRST [ HRROI T2,[ASCIZ/Extension Block/]
		 CALL BOFLER	;BLOCK ON FREE LIST ERROR
		 JRST CHKFE2 ]	;GO CHECK GENERATION CHAIN

CHKFE2:	CALL CHKFRG		;GO CHECK ACCOUNT, GEN POINTERS
	MOVEI P1,.FBEXL(FB)	;GET ADDRESS OF EXTENSION WORD
	GETMPW FB,P1		;GET EXTENSION WORD FROM FDB
	JUMPE FB,CHKFE3		;IF END-OF-CHAIN, GO RETURN
	MOVE Q1,FB		;GET ADDRESS OF NEXT CHAIN
	CALL BLKCHK		;GO CHECK HEAD OF NEXT EXT CHAIN
	  JRST [ HRROI T2,[ASCIZ/FDB/]
		 CALL BOFLER	;BLOCK ON FREE LIST ERROR
		 JRST CHKFE1 ]	;GO CHECK NEXT EXT CHAIN
	JRST CHKFE1		;GO CHECK NEXT EXT CHAIN

CHKFE3:	MOVE FB,ARGFDB		;RESTORE ORIGINAL FDB ADDRESS
	RET			;RETURN TO WHENCE WE CAME ...
; CHKFRG - ROUTINE TO DETERMINE IF ANY OF THE FDB OR ACCOUNT
;	   BLOCK POINTERS IN THE FDB'S ON A GIVEN GENERATION
;	   CHAIN POINT INTO THE FREE LIST.
;
; CALL:		MOVE FB,ADDRESS OF FDB AT HEAD OF GEN CHAIN
;		CALL CHKFRG
;		RETURN, ERROR MESSAGE ISSUED FOR ANY
;		  POINTERS ERRONEOUSLY POINTING INTO FREE LIST.


CHKFRG:	STKVAR <CURFDB>		;ALLOCATE TEMPORARY STORAGE
	MOVE P1,FB		;COPY CURRENT FDB ADDRESS

CHKFG1:	MOVEM P1,CURFDB		;SAVE CURRENT FDB ADDRESS
	MOVEI P2,.FBACT(P1)	;GET ADDRESS OF ACCOUNT WORD
	GETMPW Q1,P2		;GET ACCOUNT WORD FROM FDB
	JUMPL Q1,CHKFG2		;IF NUMERIC, GO CHECK GEN
	CALL BLKCHK		;GO SEE IF ACCOUNT BLOCK IS OK
	  JRST [ HRROI T2,[ASCIZ/Account Block/]
		 CALL BOFLER	;BLOCK ON FREE LIST ERROR
		 JRST CHKFG2 ]	;GO CHECK GENERATION POINTER

CHKFG2:	MOVE P1,CURFDB		;GET CURRENT FDB ADDRESS
	MOVEI P2,.FBGNL(P1)	;GET ADDRESS OF GEN WORD
	GETMPW Q1,P2		;GET GEN LINK WORD FROM FDB
	JUMPE Q1,R		;RETURN IF END-OF-GEN CHAIN
	CALL BLKCHK		;SEE IF NEXT FDB IS ON FREE LIST
	  JRST [ HRROI T2,[ASCIZ/FDB/]
		 CALL BOFLER	;BLOCK ON FREE LIST ERROR
		 JRST CHKFG3 ]	;GO CHECK NEXT FDB ON GEN CHAIN

CHKFG3:	MOVE P1,CURFDB		;GET CURRENT FDB ADDRESS
	MOVEI P2,.FBGNL(P1)	;GET ADDRESS OF GEN WORD
	GETMPW P1,P2		;GET GEN LINK WORD FROM FDB
	JRST CHKFG1		;GO CHECK NEXT FDB ON GEN CHAIN
; BOFLER - ROUTINE TO ISSUE AN ERROR MESSAGE IF A BLOCK IS FOUND
;	   TO BE ERRONEOUSLY ON THE FREE LIST.
;
; CALL:		HRROI T2,[ASCIZ/TYPE OF BLOCK/]
;		CALL BOFLER
;		RETURN


BOFLER:	STKVAR <BLKTYP>		;ALLOCATE TEMPORARY STORAGE
	MOVEM T2,BLKTYP		;SAVE THE POINTER TO BLOCK TYPE
	O.STR <
? >				;OUTPUT INITIAL PUNCTUATION
	MOVE T1,OUTJFN		;GET OUTPUT JFN
	MOVE T2,BLKTYP		;GET POINTER TO BLOCK TYPER
	SETZM T3		;TERMINATE ON NULL
	SOUT			;OUTPUT THE BLOCK TYPE
	O.STR < at >		;OUTPUT PREPOSITION...
	O.OCT Q1		;OUTPUT ADDRESS OF BLOCK
	O.STR < is on the Free List !
>
	AOS ERRCNT		;INCREMENT # OF ERRORS DETECTED
	RET			;RETURN TO WHENCE WE CAME ...
; BLKCHK - ROUTINE TO DETERMINE IF THE BLOCK WHOSE ADDRESS IS
;	   IN Q1 IS ON THE FREE LIST.
;
; CALL:		MOVE Q1,ADDRESS OF BLOCK TO CHECK
;		CALL BLKCHK
;		  BLOCK IS ON FREE LIST
;		BLOCK IS NOT ON FREE LIST


BLKCHK:	MOVE P1,Q1		;COPY ADDRESS OF ARGUMENT BLOCK
	TRZ P1,777		;COMPUTE FIRST ADDRESS IN PAGE
	MOVEI P1,.DIFFB(P1)	;GET FIRST FREE BLOCK ADR
	GETMPW Q2,P1		;GET ADDRESS OF FIRST FREE BLOCK
	JUMPE Q2,RSKP		;RETURN IF THERE ARE NO
				;  FREE BLOCKS ON THIS PAGE

BLKCH1:	GETMPW P1,Q2		;GET FIRST WORD IN FREE BLOCK
	HLRZ P2,P1		;GET BLOCK TYPE CODE
	CAIE P2,.TYFRE		;IS THIS A FREE BLOCK ?
	CALL FREERR		;NO, ISSUE ERROR MESSAGE !
	CALL FRECHK		;ARG BLOCK IN THFREE BLOCK ?
	  RET			;YES, RETURN NON-SKIP
	MOVEI P1,.FRPTR(Q2)	;GET ADDRESS OF LINK TO NEXT BLK
	GETMPW Q2,P1		;GET ADDRESS OF NEXT FREE BLK
	JUMPN Q2,BLKCH1		;CHECK NEXT BLK IF MORE ON LIST
	RETSKP			;RETURN IF END-OF-FREE-LIST



; FRECHK - ROUTINE TO DETERMINE IF THE BLOCK WHOSE ADDRESS IS IN
;	   Q1 IS IN THE FREE BLOCK WHOSE HEADER WORD IS IN Q2.
;
; CALL:		MOVE Q1,ADDRESS OF BLOCK TO CHECK
;		MOVE Q2,ADDRESS OF HEADER OF FREE BLOCK
;		CALL FRECHK
;		  ARG BLOCK IS IN FREE BLOCK
;		ARG BLOCK IS NOT IN FREE BLOCK


FRECHK:	GETMPW P3,Q2		;GET HEADER OF FREE BLOCK
	LOAD P1,BT%LEN,P3	;GET LENGTH OF FREE BLOCK
	ADD P1,Q2		;COMPUTE FIRST ADR PAST FREE BLK
	CAML Q1,Q2		;ARG BLOCK LOWER THAN FREE BLK ?
	CAML Q1,P1		;  OR PAST END OF FREE BLOCK ?
	RETSKP			;YES, ARG BLOCK NOT IN FREE BLK
	RET			;NO, ARG BLOCK IS IN FREE BLOCK
; FREERR - ROUTINE TO ISSUE ERROR MESSAGE IF FREE LIST IS
;	   SCREWED UP.
;
; CALL:		CALL FREERR
;		RETURN

FREERR:	STKVAR <TMPTYP>		;ALLOCATE TEMPORARY STORAGE
	MOVEM P2,TMPTYP		;SAVE TYPE ENCOUNTERED
	O.STR <
? Incorrect Block Type >
	MOVE P2,TMPTYP		;GET TYPE BACK
	O.OCT P2		;OUTPUT TYPE
	O.STR < in Free Block at >
	O.OCT Q2		;OUTPUT ADDRESS OF BLOCK
	O.CRLF
	AOS ERRCNT		;INCREMENT # OF ERRORS DETECTED
	RET
; FRETST - ROUTINE TO TEST THE BLOCKS ON THE FREE LIST TO INSURE
;	   THAT NONE OF THE BLOCKS ABUT.
;
; CALL:		CALL FRETST
;		RETURN, ERROR MESSAGE ISSUED IF NEEDED


FRETST:	STKVAR <BLK1,BLK2>	;ALLOCATE TEMPORARY STORAGE
	MOVEI I2,0		;START WITH PAGE 0 OF DIRECTORY
	LOAD I1,DIRFRE		;GET HIGHEST ADR+1 FOR BLOCKS
	JUMPE I1,FRETS1		;IF JUST PAGE 0, WE ARE ALL SET
	SUBI I1,1		;COMPUTE HIGHEST ADR USED
	LSH I1,-^D9		;GET HIGHEST PAGE # TO CHECK

FRETS1:	MOVE P1,I2		;GET CURRENT PAGE #
	LSH P1,^D9		;CONVERT PAGE # TO ADDRESS
	MOVEI P1,.DIFFB(P1)	;GET ADR OF FIRST FREE BLOCK PTR
	GETMPW P2,P1		;GET POINTER TO FREE BLOCK
	JUMPE P2,FRETS4		;IF NO FREE LIST, TRY NEXT PAGE

FRETS2:	MOVEM P2,BLK1		;SAVE ADR OF FIRST BLOCK
	MOVEI P1,.FRLEN(P2)	;GET ADR OF LENGTH OF BLOCK
	GETMPW P3,P1		;GET FIRST WORD OF FREE BLOCK
	LOAD P1,BT%LEN,P3	;GET JUST THE BLOCK LENGTH
	ADD P1,BLK1		;COMPUTE ADR OF NEXT BLOCK 
	MOVEI P3,.FRPTR(P2)	;GET ADR OF PTR TO NEXT BLOCK
	GETMPW P4,P3		;GET POINTER TO NEXT BLOCK
	MOVEM P4,BLK2		;SAVE SECOND BLOCK ADR
	CAME P1,P4		;TWO FREE BLOCKS ABUT ?
	JRST FRETS3		;NO, GO ON TO NEXT CHECK
	AOS ERRCNT		;INCREMENT # OF ERRORS DETECTED
	O.STR <
? Two consecutive free blocks found at >
	MOVE P2,BLK1		;GET ADR OF FIRST BLOCK
	O.OCT P2		;OUTPUT ADDRESS OF FIRST BLOCK
	O.STR < and at >	;OUTPUT SOME TEXT
	MOVE P4,BLK2		;GET ADR OF SECOND BLOCK
	O.OCT P4		;OUTPUT SECOND FREE BLOCK ADR
	O.CRLF			;OUTPUT A CRLF

FRETS3:	MOVE P2,BLK2		;GET ADR OF NEXT BLOCK
	JUMPN P2,FRETS2		;GO CHECK NEXT PAIR OF BLOCKS

FRETS4:	ADDI I2,1		;INCREMENT THE CURRENT PAGE #
	CAMG I2,I1		;CHECKED ALL PAGES YET ?
	JRST FRETS1		;NO, GO CHECK NEXT PAGE
	RET			;YES, RETURN
SUBTTL		TESTS TO CHECK CONSISTENCY OF FDB'S AND POINTERS

; PTRTST - ROUTINE TO TEST THE CONSISTENCY OF FDB POINTERS AND
;	   THE BLOCKS POINTED TO BY FDB'S.
;
; CALL:		CALL PTRTST
;		RETURN

PTRTST:	STKVAR <NAMBLK,EXTBLK,NXTEXT> ;ALLOCATE TEMP STORAGE
	LOAD I1,DIRBOT		;GET BOTTOM ADR IN SYMBOL TABLE
	ADDI I1,STHSIZ		;POINT TO FIRST ENTRY IN S.T.

PTRT00:	LOAD P1,DIRTOP		;GET TOP ADR IN SYMBOL TABLE
	CAMG P1,I1		;CHECKED ALL ENTRIES YET ?
	RET			;YES, RETURN

	GETSYM P1,I1		;NO, GET A S.T. ENTRY
	LDB P2,[POINTR P1,.STMSK] ;GET ENTRY TYPE
	CAIE P2,.STNAM		;IS THIS AN FDB ENTRY ?
	JRST PTRP13		;NO, GO CHECK NEXT ENTRY IN S.T.
	LDB FB,[POINTR P1,.STPTR] ;YES, GET ADDRESS OF FDB

	CALL TSTNAM		;GO TEST NAME BLOCK
	MOVEM T1,NAMBLK		;SAVE ADDRESS OF NAME BLOCK

PTRT02:	CALL TSTEXT		;GO TEST EXTENSION BLOCK
	MOVEM T1,EXTBLK		;SAVE ADDRESS OF EXTENSION BLOCK
	MOVEI P1,.FBEXL(FB)	;GET ADR OF PTR TO NEXT EXT FDB
	GETMPW P2,P1		;GET ADR OF NEXT EXT FDB
	MOVEM P2,NXTEXT		;SAVE ADDRESS OF NEXT EXTENSION FDB

PTRT05:	MOVE T1,NAMBLK		;GET ADDRESS OF NAME BLOCK
	MOVE T2,EXTBLK		;GET ADDRESS OF EXTENSION BLOCK
	CALL TSTFDB		;GO TEST THIS FDB
	CALL TSTACT		;GO TEST THE ACCOUNT BLOCK
	CALL TSTUNS		;GO TEST THE USER NAME STRING
	; ..
	; ..

PTRP11:	MOVEI P1,.FBEXL(FB)	;GET ADR OF PTR TO NEXT-EXT FDB
	GETMPW P2,P1		;GET ADDRESS OF NEXT-EXT FDB
	CAMN P2,NXTEXT		;CORRECT POINTER ?
	JRST PTRP12		;YES, GO ON TO NEXT GENERATION
	AOS ERRCNT		;NO, INCREMENT ERROR COUNT
	O.STR <
? Incorrect pointer >		;OUTPUT FIRST PART OF MESSAGE
	O.OCT P2		;OUTPUT POINTER TO NEXT-EXT FDB
	O.STR < to next-extension FDB, in FDB at >
	O.OCT FB		;OUTPUT ADDRESS OF FDB
	O.STR <
	Correct pointer to next-extension FDB is >
	O.OCT NXTEXT		;OUTPUT POINTER TO NEXT-EXT
	O.CRLF			;OUTPUT A CRLF

PTRP12:	MOVEI P1,.FBGNL(FB)	;GET ADR OF PTR TO NEXT GEN FDB
	GETMPW FB,P1		;GET ADDRESS OF NEXT GEN FDB
	JUMPN FB,PTRT05		;GO CHECK NEXT GEN FDB

	MOVE FB,NXTEXT		;GET ADR OF NEXT-EXT FDB
	JUMPN FB,PTRT02		;GO CHECK NEXT EXT CHAIN

PTRP13:	ADDI I1,STESIZ		;POINT TO NEXT ENTRY IN S.T.
	JRST PTRT00		;GO CHECK NEXT FDB CHAIN
;TSTNAM - ROUTINE TO CHECK CONSISTENCY OF NAME BLOCK
;
;ACCEPTS IN FB/	ADDRESS OF FDB
;		CALL TSTNAM
;RETURNS: +1 ALWAYS, WITH T1/ ADDRESS OF NAME BLOCK


TSTNAM:	MOVEI P1,.FBNAM(FB)	;GET ADR OF PTR TO NAME BLOCK
	GETMPW P2,P1		;GET ADDRESS OF NAME BLOCK
	GETMPW P3,P2		;GET FIRST WORD OF NAME BLOCK
	HLRZ P4,P3		;GET THE BLOCK TYPE
	CAIN P4,.TYNAM		;IS THIS A NAME BLOCK ?
	JRST TNAM10		;YES, GO CHECK LENGTH OF BLOCK
	AOS ERRCNT		;NO, INCREMENT COUNT OF ERRORS
	O.STR <
? Name Block pointer >		;OUTPUT FIRST PART OF ERROR MSG
	O.OCT P2		;OUTPUT ADDRESS OF NAME BLOCK
	O.STR < in FDB at >	;OUTPUT NEXT PART OF MESSAGE
	O.OCT FB		;OUTPUT ADDRESS OF FDB
	O.STR < does not point to a Name Block
>

TNAM10:	LOAD P4,BT%LEN,P3	;GET LENGTH OF NAME BLOCK
	CAIL P4,MINNBL		;LESS THAN MINIMUM LENGTH ?
	JRST TNAM20		;NO, GO CHECK EXTENSION BLOCK
	AOS ERRCNT		;YES, INCREMENT ERROR COUNT
	O.STR <
? Name block at >		;OUTPUT FIRST PART OF ERROR MSG
	O.OCT P2		;OUTPUT ADDRESS OF NAME BLOCK
	O.STR < is less than >	;OUTPUT NEXT PART OF MESSAGE
	O.DEC [MINNBL]		;OUTPUT MINIMUM LENGTH
	O.STR < words long
>

; DONE - RETURN

TNAM20:	MOVE T1,P2		;COPY ADDRESS OF NAME BLOCK
	RET			;DONE, RETURN TO CALLER
;TSTEXT - ROUTINE TO CHECK EXTENSION BLOCK
;
;ACCEPTS IN FB/ ADDRESS OF FDB
;		CALL TSTEXT
;RETURNS: +1 ALWAYS, WITH T1/ ADDRESS OF EXTENSION BLOCK

TSTEXT:	MOVEI P1,.FBEXT(FB)	;GET ADR OF PTR TO EXTENSION BLK
	GETMPW P2,P1		;GET ADR OF EXTENSION BLOCK
	MOVEI P1,.FBCTL(FB)	;GET ADR OF CONTROL BITS
	GETMPW P4,P1		;GET CONTROL BITS FOR FDB
	TXNE P4,FB%NEX		;IS THERE AN EXTENSION YET ?
	AOS NEXCNT		;NO, INCREMENT COUNT OF NEX'S
	TXNE P4,FB%NEX		;IS THERE AN EXTENSION YET ?
	JRST TEXT10		;NO, DO NOT TEST EXT POINTER
	GETMPW P3,P2		;GET FIRST WORD OF EXTENSION BLK
	HLRZ P4,P3		;GET THE BLOCK TYPE
	CAIN P4,.TYEXT		;IS THIS AN EXTENSION BLOCK ?
	JRST TEXT10		;YES, GO CHECK THE LENGTH
	AOS ERRCNT		;NO, INCREMENT ERROR COUNT
	O.STR <
? Extension Block pointer >	;OUTPUT FIRST PART OF ERROR MSG
	O.OCT P2		;OUTPUT ADR OF EXTENSION BLOCK
	O.STR < in FDB at >	;OUTPUT NEXT PART OF MESSAGE
	O.OCT FB		;OUTPUT ADDRESS OF FDB
	O.STR < does not point to an Extension Block
>

TEXT10:	LOAD P4,BT%LEN,P3	;GET LENGTH OF EXTENSION BLOCK
	CAIL P4,MINEBL		;LESS THAN MINIMUM LENGTH ?
	JRST TEXT20		;NO, GO CHECK THE FDB ITSELF
	AOS ERRCNT		;YES, INCREMENT ERROR COUNT
	O.STR <
? Extension Block at >		;OUTPUT FIRST PART OF ERROR MSG
	O.OCT P2		;OUTPUT ADDRESS OF EXT BLOCK
	O.STR < is less than >	;OUTPUT NEXT PART OF MESSAGE
	O.DEC [MINEBL]		;OUTPUT MINIMUM LENGTH
	O.STR < words long
>

TEXT20:	MOVE T1,P2		;GET ADDRESS OF EXTENSION BLOCK
	RET			;DONE, RETURN
;TSTFDB - ROUTINE TO CHECK AN FDB
;
;ACCEPTS IN T1/	ADDRESS OF NAME BLOCK FOR THIS FDB
;	    T2/	ADDRESS OF EXTENSION BLOCK FOR THIS FDB
;		CALL TSTFDB
;RETURNS: +1 ALWAYS

TSTFDB:	ASUBR <TFDNAM,TFDEXT>
	MOVEI P1,.FBHDR(FB)	;GET ADR OF HEADER WORD
	GETMPW P2,P1		;GET HEADER WORD FROM FDB
	HLRZ P3,P2		;GET BLOCK TYPE FROM FDB
	CAIN P3,.TYFDB		;IS THIS AN FDB
	JRST TFDB10		;YES, GO CHECK THE LENGTH
	AOS ERRCNT		;INCREMENT ERROR COUNT
	O.STR <
? Incorrect block type >	;OUTPUT FIRST PART OF ERROR MSG
	O.OCT P3		;OUTPUT THE BLOCK TYPE FOUND
	O.STR < in block on FDB chain at >
	O.OCT FB		;OUTPUT ADDRESS OF "FDB"
	O.CRLF			;OUTPUT A CRLF
TFDB10:	LOAD P3,BT%LEN,P2	;GET THE LENGTH OF THE FDB
	LOAD T1,BT%VER,P2	;GET VERSION # OF FDB
	CAMN P3,FDBLEN(T1)	;CORRECT LENGTH FOR FDB OF THIS VERSION ?
	JRST TFDB20		;YES, GO CHECK POINTER TO NAME
	SKIPN -1(T1)		;V1 FDB?
	 JRST [	CAMN P3,OLDV1	;YES, TWO ACCEPTABLE SIZES
		JRST TFDB20	;MATCHES SHORT V1
		JRST .+1]	;STILL WRONG
	AOS ERRCNT		;NO, INCREMENT COUNT OF ERRORS
	O.STR <
? Incorrect length >
	O.DEC P3		;OUTPUT THE WRONG LENGTH
	O.STR < in FDB at >	;OUTPUT NEXT PART OF MESSAGE
	O.OCT FB		;OUTPUT ADDRESS OF FDB
	O.STR <
	Correct FDB length is assumed to be >
	LOAD P1,BT%VER,P2	;GET VERSION OF FDB AGAIN
	MOVE P1,FDBLEN(P1)	;GET CORRECT FDB LENGTH
	O.DEC P1		;OUTPUT CORRECT LENGTH

TFDB20:	MOVEI P1,.FBNAM(FB)	;GET ADR OF PTR TO NAME BLOCK
	GETMPW P2,P1		;GET ADDRESS OF NAME BLOCK
	CAMN P2,TFDNAM		;CORRECT NAME BLOCK POINTER ?
	JRST TFDB30		;YES, GO CHECK EXTENSION PTR
	AOS ERRCNT		;NO, INCREMENT ERROR COUNT
	O.STR <
? Incorrect Name Block pointer >
	O.OCT P2		;OUTPUT BAD NAME BLOCK PTR
	O.STR < found in FDB at >
	O.OCT FB		;OUTPUT ADDRESS OF FDB
	O.STR <
	Correct Name block Pointer is >
	O.OCT TFDNAM		;OUTPUT CORRECT POINTER
	O.CRLF			;OUTPUT A CRLF
TFDB30:	MOVEI P1,.FBEXT(FB)	;GET ADR OF PTR TO EXT BLOCK
	GETMPW P2,P1		;GET ADDRESS OF EXT BLOCK
	CAMN P2,TFDEXT		;CORRECT EXT BLOCK POINTER ?
	JRST TFDB40		;YES, GO CHECK ACCOUNT BLOCK
	AOS ERRCNT		;NO, INCREMENT ERROR COUNT
	O.STR <
? Incorrect Extension Block pointer >
	O.OCT P2		;OUTPUT ADDRESS OF EXT BLOCK
	O.STR < found in FDB at >
	O.OCT FB		;OUTPUT ADDRESS OF FDB
	O.STR <
	Correct Extension Block pointer is >
	O.OCT TFDEXT		;OUTPUT CORRECT POINTER
	O.CRLF			;OUTPUT A CRLF
TFDB40:	RET			;DONE
;TSTACT - ROUTINE TO CHECK AN ACCOUNT BLOCK

TSTACT:	MOVEI P1,.FBACT(FB)	;GET ADR OF PTR TO ACCOUNT BLK
	GETMPW P2,P1		;GET ADDRESS OF ACCOUNT BLOCK
	JUMPLE P2,TACT20	;IF NOT ALPHANUMERIC, GO ON
	GETMPW P3,P2		;GET FIRST WORD OF ACCOUNT BLK
	HLRZ P4,P3		;GET JUST THE BLOCK TYPE
	CAIN P4,.TYACT		;IS THIS AN ACCOUNT BLOCK ?
	JRST TACT10		;YES, GO CHECK THE BLOCK LENGTH
	AOS ERRCNT		;NO, INCREMENT COUNT OF ERRORS
	O.STR <
? Account Block pointer >	;OUTPUT FIRST PART OF MESSAGE
	O.OCT P2		;OUTPUT THE ADR OF THE ACT BLOCK
	O.STR < in FDB at >	;OUTPUT NEXT PART OF MESSAGE
	O.OCT FB		;OUTPUT ADDRESS OF FDB
	O.STR < does not point to an Account Block
>

TACT10:	LOAD P4,BT%LEN,P3	;GET LENGTH OF ACCOUNT BLOCK
	CAIL P4,MINABL		;LESS THAN MINIMUM LENGTH ?
	JRST TACT20		;NO, GO CHECK NEXT-EXT POINTER
	AOS ERRCNT		;YES, INCREMENT ERROR COUNT
	O.STR <
? Account Block at >		;OUTPUT FIRST PART OF MESSAGE
	O.OCT P2		;OUTPUT ADDRESS OF BLOCK
	O.STR < is less than >	;OUTPUT NEXT PART OF MESSAGE
	O.DEC [MINABL]		;OUTPUT MINIMUM LENGTH
	O.STR < words long
>

TACT20:	RET			;DONE, RETURN
;TSTUNS - ROUTINE TO CHECK USER NAME BLOCKS

TSTUNS:	MOVEI P1,.FBHDR(FB)	;GET ADR OF HEADER WORD
	GETMPW P2,P1		;GET HEADER WORD FROM FDB
	LOAD T1,BT%VER,P2	;GET VERSION # OF FDB
	caig t1,0		;version 0 fdb's have no name strings
	ret			;do not check if version 0 fdb
	MOVEI P1,.FBAUT(FB)	;GET ADR OF PTR TO USER NAME BLK
	GETMPW P2,P1		;GET ADDRESS OF USER NAME BLOCK
	JUMPE P2,TUNS20		;IF NONE, GO ON
	GETMPW P3,P2		;GET FIRST WORD OF USER NAME BLK
	HLRZ P4,P3		;GET JUST THE BLOCK TYPE
	CAIN P4,.TYUNS		;IS THIS AN USER NAME BLOCK ?
	JRST TUNS10		;YES, GO CHECK THE BLOCK LENGTH
	AOS ERRCNT		;NO, INCREMENT COUNT OF ERRORS
	O.STR <
? Author pointer >		;OUTPUT FIRST PART OF MESSAGE
	O.OCT P2		;OUTPUT THE ADR OF THE ACT BLOCK
	O.STR < in FDB at >	;OUTPUT NEXT PART OF MESSAGE
	O.OCT FB		;OUTPUT ADDRESS OF FDB
	O.STR < does not point to a User Name Block
>

TUNS10:	LOAD P4,BT%LEN,P3	;GET LENGTH OF USER NAME BLOCK
	CAIL P4,MINUNS		;LESS THAN MINIMUM LENGTH ?
	JRST TUNS20		;NO, GO ON
	AOS ERRCNT		;YES, INCREMENT ERROR COUNT
	O.STR <
? User Name Block at >		;OUTPUT FIRST PART OF MESSAGE
	O.OCT P2		;OUTPUT ADDRESS OF BLOCK
	O.STR < is less than >	;OUTPUT NEXT PART OF MESSAGE
	O.DEC [MINUNS]		;OUTPUT MINIMUM LENGTH
	O.STR < words long
>

TUNS20:	MOVEI P1,.FBLWR(FB)	;GET ADR OF PTR TO USER NAME BLK
	GETMPW P2,P1		;GET ADDRESS OF USER NAME BLOCK
	JUMPE P2,TUNS40		;IF NONE, GO ON
	GETMPW P3,P2		;GET FIRST WORD OF USER NAME BLK
	HLRZ P4,P3		;GET JUST THE BLOCK TYPE
	CAIN P4,.TYUNS		;IS THIS AN USER NAME BLOCK ?
	JRST TUNS30		;YES, GO CHECK THE BLOCK LENGTH
	AOS ERRCNT		;NO, INCREMENT COUNT OF ERRORS
	O.STR <
? Last Writer pointer >		;OUTPUT FIRST PART OF MESSAGE
	O.OCT P2		;OUTPUT THE ADR OF THE ACT BLOCK
	O.STR < in FDB at >	;OUTPUT NEXT PART OF MESSAGE
	O.OCT FB		;OUTPUT ADDRESS OF FDB
	O.STR < does not point to a User Name Block
>
	;..
	;..

; CHECK LENGTH OF USER NAME BLOCK

TUNS30:	LOAD P4,BT%LEN,P3	;GET LENGTH OF USER NAME BLOCK
	CAIL P4,MINUNS		;LESS THAN MINIMUM LENGTH ?
	JRST TUNS40		;NO, GO ON
	AOS ERRCNT		;YES, INCREMENT ERROR COUNT
	O.STR <
? User Name Block at >		;OUTPUT FIRST PART OF MESSAGE
	O.OCT P2		;OUTPUT ADDRESS OF BLOCK
	O.STR < is less than >	;OUTPUT NEXT PART OF MESSAGE
	O.DEC [MINUNS]		;OUTPUT MINIMUM LENGTH
	O.STR < words long
>

TUNS40:	RET			;DONE, RETURN
SUBTTL		ROUTINES TO INSURE THAT ALL BLOCKS ARE POINTED TO

; TSTBLK - ROUTINE TO CHECK TO SEE IF EVERY FDB AND ACCOUNT
;	   BLOCK IN THE DIRECTORY IS POINTED TO BY EITHER A
;	   SYMBOL TABLE ENTRY OR BY A POINTER IN AN FDB.
;
; CALL:		CALL TSTBLK
;		RETURN

TSTBLK:	STKVAR <CURPAG,CURLEN,OLDI1>  ;ALLOCATE TEMP STORAGE
	SETZM CURPAG		;START AT PAGE 0 OF DIRECTORY

TSTBK1:	MOVE P1,CURPAG		;GET CURRENT PAGE #
	LSH P1,^D9		;CONVERT PAGE # TO AN ADDRESS
	ADDI P1,.DILHD		;COMPUTE ADR OF HEADER LENGTH
	GETMPW P2,P1		;GET THE HEADER LENGTH WORD
	LOAD I1,BT%LEN,P2	;GET JUST THE HEADER LENGTH
	MOVE P2,CURPAG		;GET THE CURRENT PAGE #
	LSH P2,^D9		;COMPUTE FIRST ADR IN PAGE
	ADD I1,P2		;COMPUTE ADR OF FIRST BLOCK
	LOAD P1,DIRFRE		;GET HIGHEST ADR USED FOR BLOCKS
	CAML I1,P1		;AT HIGHEST ADR YET ?
	RET			;YES, RETURN

TSTBK2:	MOVE Q1,I1		;GET POSSIBLE FDB ADDRESS
	MOVEM I1,OLDI1		;SAVE CURRENT ADDRESS
	GETMPW P1,I1		;GET FIRST WORD OF THIS BLOCK
	LOAD T1,BT%LEN,P1	;GET JUST THE LENGTH
	HRRZM T1,CURLEN		;SAVE LENGTH OF CURRENT BLOCK
	HLRZ P1,P1		;GET BLOCK TYPE FIELD

	MOVEI P2,TYPSIZ-1	;GET INDEX INTO TYPTAB
TSTBK3:	HLRZ P3,TYPTAB(P2)	;GET A VALID BLOCK TYPE
	CAMN P3,P1		;FOUND A VALID BLOCK TYPE ?
	JRST TSTBK4		;YES, GO CHECK THE BLOCK
	SOJGE P2,TSTBK3		;NO, GO CHECK NEXT VALID TYPE

	AOS ERRCNT		;INCREMENT # OF ERRORS DETECTED
	O.STR <
? Unknown block type >		;ISSUE FIRST PART OF MESSAGE
	O.OCT P1		;OUTPUT BLOCK TYPE
	O.STR < found at address >
	O.OCT I1		;OUTPUT ADDRESS
	O.STR < in directory
>
DIRQ2B:	SAYCR <[Searching for a valid block ...]>
dirQ2c:	ADDI I1,1		;GET NEXT WORD IN DIRECTORY
	LOAD P1,DIRFRE		;GET END OF FREE STORAGE
	CAMGE I1,P1		;CHECK REMAINDER OF DIRECTORY ?
	JRST DIRQ2d		;nO, GO CHECK THIS WORD
	SAYCR <[End of directory - no more blocks found]>
	RET			;RETURN TO WHENCE WE CAME ...

DIRQ2D:	GETMPW P1,I1		;GET A WORD
	HLRZ P2,P1		;GET POSSIBLE BLOCK TYPE

	MOVEI P3,TYPSIZ-1	;GET INDEX INTO TYPTAB
DIRQ2E:	HLRZ P4,TYPTAB(P3)	;GET A VALID BLOCK TYPE
	CAMN P4,P2		;COULD THIS BE A GOOD BLOCK ?
	JRST DIRQ2F		;YES, GO START OUTPUT AGAIN
	SOJGE P3,DIRQ2E		;NO, CHECK NEXT TABLE ENTRY
	JRST DIRQ2C		;GO CHECK NEXT WORD IN DIRECTORY
; HERE WHEN VALID BLOCK FOUND AFTER UNKNOWN BLOCK TYPE ENCOUNTERED

DIRQ2F:	SAY <[Valid block type found at >
	MOVE T2,I1		;GET ADDRESS
	PUTOCT			;OUTPUT ADDRESS OF BLOCK
	SAYCR <]>
	MOVEM I1,OLDI1		;DON'T LOOK AT THIS BLOCK AGAIN
	GETMPW T1,I1		;GET FIRST WORD OF THIS GOOD BLOCK
	LOAD T1,BT%LEN,T1	;GET JUST THE LENGTH
	HRRZM T1,CURLEN		;FUDGE TO LOOK AT NEXT BLOCK
	MOVE P2,P3		;GET INDEX INTO TYPTAB
TSTBK4:	HRRZ P1,TYPTAB(P2)	;GET ADDRESS OF CHECKING ROUTINE
	CALL (P1)		;CALL THE CHECKING ROUTINE
TSTBK5:	MOVE I1,OLDI1		;RESTORE ORIGINAL I1
	ADD I1,CURLEN		;POINT TO THE NEXT BLOCK
	LOAD P1,DIRFRE		;GET HIGHEST ADR USED FOR BLOCKS
	CAML I1,P1		;CHECKED ALL BLOCKS YET ?
	RET			;YES, RETURN
	MOVE P1,CURPAG		;GET CURRENT PAGE #
	LSH P1,^D9		;CONVERT PAGE # TO ADDRESS
	CAIGE I1,PAGSIZ(P1)	;AT END OF PAGE YET ?
	JRST TSTBK2		;NO, GO CHECK NEXT BLOCK
	CAIG I1,PAGSIZ(P1)	;BLOCK LENGTHS ADD CORRECTLY ?
	JRST TSTBK6		;YES, SEE IF MORE PAGES TO CHECK
	AOS ERRCNT		;INCREMENT # OF ERRORS DETECTED
	O.STR <
? Inconsistency in directory page >
	O.OCT CURPAG
	O.STR <
	Sum of all block lengths + address of Free
	Space Pool is greater than 1000 !
>

TSTBK6:	AOS CURPAG		;NO, INCREMENT CURRENT PAGE #
	JRST TSTBK1		;GO CHECK NEXT PAGE IN DIRECTORY
; CHKNAM - ROUTINE TO DETERMINE IF A GIVEN NAME BLOCK IS POINTED
;	   TO BY EITHER A SYMBOL TABLE ENTRY OR THE POINTERS TO
;	   THE PASSWORD OR USER NAME IN THE HEADER ON PAGE 0.
;
; CALL:		MOVE Q1,ADDRESS OF NAME BLOCK
;		CALL CHKNAM
;		RETURN, ERROR MESSAGE ISSUED IF NO POINTER FOUND


CHKNAM:	LOAD I1,DIRBOT		;GET BOTTOM ADR IN SYMBOL TABLE

CHKNM1:	LOAD P1,DIRTOP		;GET TOP OF SYMBOL TABLE
	CAML I1,P1		;DONE ALL ENTRIES YET ?
	JRST CHKNM3		;YES, GO CHECK NAME, PASSWORD
	GETSYM P1,I1		;NO, GET SYMBOL TABLE ENTRY
	LDB P2,[POINTR(P1,.STMSK)] ;GET TYPE OF ENTRY
	CAIE P2,.STNAM		;IS THIS A POINTER TO AN FDB ?
	JRST CHKNM2		;NO, GO LOOK AT NEXT ENTRY
	LDB P1,[POINTR(P1,.STPTR)] ;YES, GET ADDRESS OF FDB
	MOVEI P2,.FBNAM(P1)	;GET ADR OF POINTER TO NAME
	GETMPW P3,P2		;GET POINTER TO NAME BLOCK
	CAMN Q1,P3		;FOUND DESIRED NAME BLOCK ?
	RET			;YES, RETURN FOUND
CHKNM2:	ADDI I1,STESIZ		;INCREMENT POINTER TO NEXT ENTRY
	JRST CHKNM1		;GO LOOK AT NEXT TABLE ENTRY

CHKNM3:	LOAD P1,DIRNAM		;GET POINTER TO USER NAME
	CAMN P1,Q1		;FOUND DESIRED NAME BLOCK ?
	RET			;YES, RETURN TO WHENCE WE CAME
	LOAD P1,DIRPSW		;NO, GET POINTER TO PASSWORD
	CAMN P1,Q1		;FOUND DESIRED NAME BLOCK ?
	RET			;YES, RETURN FOUND
	LOAD P1,DIRACT		;GET POINTER TO DEFAULT ACCOUNT
	CAMN P1,Q1		;FOUND DESIRED NAME BLOCK ?
	RET			;YES, RETURN FOUND

	AOS ERRCNT		;INCREMENT # OF ERRORS DETECTED
	O.STR <
? No pointer in directory to Name Block at >
	O.OCT Q1		;OUTPUT ADDRESS OF BLOCK
	O.STR <:
	>			;OUTPUT PUNCTUATION
	GETMPW T2,Q1		;GET FIRST WORD OF BLOCK
	MOVE T3,[1B0+10]	;PRINT MAGNITUDE, USE OCTAL
	CALL PUTHLF		;OUTPUT TWO HALFWORDS
	O.STR <
	>			;OUTPUT MORE PUNCTUATION
	MOVE T1,OUTJFN		;GET OUTPUT JFN
	HRROI T2,1(Q1)		;GET POINTER TO STRING
	ADD T2,FDBOFS		;POINT TO ADR IN CORE, NOT FILE
	SETZM T3		;TERMINATE ON A NULL
	SOUT			;OUTPUT THE STRING
	O.CRLF			;NEW LINE
	RET			;RETURN
; CHECKX - ROUTINE TO DETERMINE IF A GIVEN EXTENSION BLOCK IS
;	   POINTED TO BY ANY FDB.
;
; CALL:		MOVE Q1,ADR OF EXTENSION BLOCK
;		CALL CHECKX
;		RETURN, ERROR MESSAGE ISSUED IF BLOCK NOT FOUND


CHECKX:	LOAD I1,DIRBOT		;GET BOTTOM ADR IN SYMBOL TABLE

CHEKX1:	LOAD P1,DIRTOP		;GET TOP OF SYMBOL TABLE
	CAML I1,P1		;DONE ALL ENTRIES YET ?
	JRST CHEKX3		;YES, GO ISSUE ERROR MESSAGE
	GETSYM P1,I1		;NO, GET SYMBOL TABLE ENTRY
	LDB P2,[POINTR(P1,.STMSK)] ;GET TYPE OF ENTRY
	CAIE P2,.STNAM		;IS THIS A POINTER TO AN FDB ?
	JRST CHEKX2		;NO, GO LOOK AT NEXT ENTRY
	LDB FB,[POINTR(P1,.STPTR)] ;YES, GET ADDRESS OF FDB
	CALL CKEXT		;SEE IF EXT BLK IS ON THIS CHAIN
	  RET			;FOUND, RETURN
CHEKX2:	ADDI I1,STESIZ		;INCREMENT POINTER TO NEXT ENTRY
	JRST CHEKX1		;GO LOOK AT NEXT TABLE ENTRY

CHEKX3:	O.STR <
? No pointer in directory to Extension Block at >
	O.OCT Q1		;OUTPUT ADDRESS OF BLOCK
	O.STR <:
	>			;OUTPUT PUNCTUATION
	GETMPW T2,Q1		;GET FIRST WORD OF BLOCK
	MOVE T3,[1B0+10]	;PRINT MAGNITUDE, USE OCTAL
	CALL PUTHLF		;GO OUTPUT TWO HALFWORDS
	O.STR <
	>			;OUTPUT MORE PUNCTUATION
	MOVE T1,OUTJFN		;GET OUTPUT JFN
	HRROI T2,1(Q1)		;GET POINTER TO STRING
	ADD T2,FDBOFS		;POINT TO ADR IN CORE, NOT FILE
	SETZM T3		;TERMINATE ON A NULL
	SOUT			;OUTPUT THE STRING
	O.CRLF			;NEW LINE
	AOS ERRCNT		;INCREMENT # OF ERRORS DETECTED
	RET			;RETURN
; CKEXT - ROUTINE TO DETERMINE IF A GIVEN EXTENSION BLOCK IS
;	  ON A GIVEN EXTENSION CHAIN OF FDB'S.
;
; CALL:		MOVE Q1,ADDRESS OF EXTENSION BLOCK
;		MOVE FB,ADDRESS OF FDB AT HEAD OF CHAIN
;		CALL CKEXT
;		  RETURN HERE IF EXT BLOCK FOUND
;		RETURN HERE IF EXT BLOCK NOT POINTED TO

CKEXT:	MOVEI P1,.FBEXT(FB)	;GET ADDRESS OF PTR TO EXT BLOCK
	GETMPW P2,P1		;GET ADR OF EXTENSION BLOCK
	CAMN P2,Q1		;FOUND DESIRED EXTENSION BLOCK ?
	RET			;YES, RETURN
	MOVEI P1,.FBEXL(FB)	;NO, GET ADR OF PTR TO NEXT FDB
	GETMPW FB,P1		;GET ADDRESS OF NEXT FDB
	JUMPN FB,CKEXT		;GO CHECK NEXT FDB
	RETSKP			;END-OF-CHAIN, RETURN NOT-FOUND
; CHKFDB - ROUTINE TO DETERMINE IF A GIVEN FDB IS POINTED TO BY
;	   EITHER A SYMBOL TABLE ENTRY OR BY ANOTHER FDB.
;
; CALL:		MOVE Q1,FDB TO LOOK FOR
;		CALL CHKFDB
;		RETURN, ERROR MESSAGE ISSUED IF FDB
;		  WAS NOT FOUND ...

CHKFDB:	LOAD I1,DIRBOT		;GET ADDRESS OF START OF TABLE
	ADDI I1,STHSIZ		;COMPUTE ADDRESS OF FIRST ENTRY

CHKFD1:	GETSYM P1,I1		;GET ENTRY TYPE AND ADDRESS
	LDB P2,[POINTR(P1,.STMSK)] ;GET ENTRY TYPE ONLY
	CAIE P2,.STNAM		;IS THIS A POINTER TO AN FDB ?
	JRST CHKFD2		;NO, GO CHECK NEXT BLOCK
	LDB FB,[POINTR(P1,.STPTR)] ;YES, GET ADDRESS OF FDB
	CALL CHKEXT		;SEE IF DESIRED FDB IS ON THIS CHAIN
	  JRST CHKFD2		;NO, GO CHECK NEXT CHAIN
	RET			;TARGET FDB FOUND, RETURN

CHKFD2:	ADDI I1,STESIZ		;COMPUTE ADDRESS OF NEXT ENTRY
	LOAD P1,DIRTOP		;GET HIGHEST SYMBOL TABLE ADR
	CAMGE I1,P1		;CHECK ALL ENTRIES YET ?
	JRST CHKFD1		;NO, GO BACK AND CHECK NEXT ENTRY
	AOS ERRCNT		;INCREMENT # OF ERRORS DETECTED
	O.STR <
? No pointer in directory to FDB at >
	O.OCT Q1		;OUTPUT ADDRESS OF TARGET
	O.CRLF			;OUTPUT A CRLF
	RET			;RETURN TO WHENCE WE CAME ...
; CHKEXT - ROUTINE TO DETERMINE IF A GIVEN FDB IS ON A GIVEN
;	   EXTENSION CHAIN.
;
; CALL:		MOVE FB,ADDRESS OF BASE FDB
;		MOVE Q1,FDB ADDRESS TO LOOK FOR
;		CALL CHKEXT
;		  RETURN HERE IF NOT FOUND
;		RETURN HERE IF FDB FOUND ON CHAIN


CHKEXT:	STKVAR <NXTEXT,TARGET,OLDFB>  ;ALLOCATE TEMP STORAGE

	MOVEM FB,OLDFB		;SAVE ORIGINAL BASE FDB
	MOVEI P1,.FBEXL(FB)	;GET ADDRESS OF EXT WORD IN FDB

CHKEX1:	GETMPW P2,P1		;GET EXTENSION WORD FROM FDB
	MOVEM P2,NXTEXT		;SAVE THE LINK TO NEXT FDB
	MOVEM Q1,TARGET		;SAVE TARGET FDB ADDRESS
	CALL CHKGEN		;SEE IF TARGET IS ON GEN CHAIN
	  JRST CHKEX2		;NO, GO LOOK AT NEXT EXTENSION
	MOVE FB,OLDFB		;RESTORE ORIGINAL BASE FDB ADR
	RETSKP			;YES, GIVE SKIP RETURN

CHKEX2:	MOVE Q1,TARGET		;RESTORE TARGET FDB ADDRESS
	MOVE FB,NXTEXT		;GET ADDRESS OF NEXT EXT FDB
	MOVEI P1,.FBEXL(FB)	;GET ADDRESS OF NEXT EXT WORD
	JUMPN FB,CHKEX1		;GO CHECK NEXT FDB ON CHAIN
	MOVE FB,OLDFB		;RESTORE ORIGINAL BASE FDB ADR
	RET			;RETURN NOT-FOUND



; CHKGEN - ROUTINE TO DETERMINE IF A GIVEN FDB IS ON A GIVEN
;	   GENERATION CHAIN.
;
; CALL:		MOVE Q1,FDB ADDRESS TO LOOK FOR
;		MOVE FB,ADDRESS OF FIRST FDB ON CHAIN
;		CALL CHKGEN
;		  RETURN NON-SKIP IF FDB NOT ON CHAIN
;		RETURN SKIP IF FDB FOUND ON THIS CHAIN


CHKGEN:	CAMN FB,Q1		;DESIRED FDB AT HEAD OF CHAIN ?
	RETSKP			;YES, GIVE FOUND RETURN
	MOVEI P1,.FBGNL(FB)	;NO, SET UP FIRST FDB ADDRESS

CHKGN1:	GETMPW P2,P1		;GET GENERATION FIELD OF FDB
	JUMPE P2,R		;RETURN IF END-OF-CHAIN
	CAMN P2,Q1		;FOUND CORRECT FDB YET ?
	RETSKP			;YES, GIVE FOUND RETURN
	MOVEI P1,.FBGNL(P2)	;GET ADDRESS OF NEXT GEN WORD
	JRST CHKGN1		;GO BACK AND CHECK NEXT FDB
; CHKACT - ROUTINE TO DETERMINE IF A GIVEN ACCOUNT BLOCK IS
;	   POINTED TO BY EITHER A SYMBOL TABLE ENTRY OR AN FDB.
;
; CALL:		MOVE Q1,ACCOUNT BLOCK ADDRESS TO LOOK FOR
;		CALL CHKACT
;		RETURN, ERROR MESSAGE ISSUED IF ACCOUNT BLOCK
;		  WAS NOT FOUND ...

CHKACT:	STKVAR <CUREXT,COUNT>	;ALLOCATE TEMPORARY STORAGE
	SETZM COUNT		;INITIALIZE COMPUTED COUNT
	CALL FNDACT		;DOES SYMBOL TABLE ENTRY EXIST ?
	  JRST CHKA00		;ENTRY EXISTS, GO CHECK POINTERS
	AOS ERRCNT		;INCREMENT # OF ERRORS DETECTED
	O.STR <
? No Symbol Table entry exists for Account Block At >
	O.OCT Q1
	O.CRLF			;OUTPUT A CRLF
	CALL PUTACT		;GO OUTPUT THE ACCOUNT BLOCK
	O.CRLF			;OUTPUT A CRLF

CHKA00:	MOVEI P1,.ABCNT(Q1)	;GET ADDRESS OF SHARE COUNT
	GETMPW P2,P1		;GET SHARE COUNT FROM BLOCK
	JUMPN P2,CHKAC0		;COUNT SHOULD BE NON-ZERO
	AOS ERRCNT		;INCREMENT # OF ERRORS DETECTED
	O.STR <
? Account Block at >
	O.OCT Q1		;OUTPUT ADDRESS OF BLOCK
	O.STR < has a share count of 0 !
>
	CALL PUTACT		;GO OUTPUT THE ACCOUNT BLOCK

CHKAC0:	LOAD I1,DIRBOT		;GET ADDRESS OF START OF TABLE
	ADDI I1,STHSIZ		;COMPUTE ADDRESS OF FIRST ENTRY
CHKAC1:	LOAD P1,DIRTOP		;GET TOP ADR OF SYMBOL TABLE
	CAMG P1,I1		;CHECKED ALL ENTRIES YET ?
	JRST CHKAC5		;YES, GO VERIFY SHARE COUNT

	GETSYM P1,I1		;GET ENTRY TYPE AND ADDRESS
	LDB P2,[POINTR P1,.STMSK] ;GET JUST THE TYPE CODE
	CAIE P2,.STNAM		;IS THIS AN FDB ENTRY ?
	JRST CHKAC4		;NO, GO CHECK NEXT ENTRY
	LDB P1,[POINTR P1,.STPTR] ;GET POINTER TO FDB
CHKAC2:	MOVEM P1,CUREXT		;SAVE ADR OF HEAD OF EXT CHAIN

CHKAC3:	MOVEI P2,.FBACT(P1)	;GET ADDRESS OF ACCOUNT POINTER
	GETMPW P3,P2		;GET POINTER TO ACCOUNT BLOCK
	CAMN P3,Q1		;IS THIS DESIRED POINTER ?
	AOS COUNT		;YES, INCREMENT THE COUNT
	MOVEI P2,.FBGNL(P1)	;GET ADR OF NEXT GEN POINTER
	GETMPW P1,P2		;GET POINTER TO NEXT GEN FDB
	JUMPN P1,CHKAC3		;GO CHECK NEXT FDB ON GEN CHAIN

	MOVE P1,CUREXT		;GET ADR OF CURRENT CHAIN HEAD
	MOVEI P2,.FBEXL(P1)	;GET ADR OF POINTER TO NEXT EXT
	GETMPW P1,P2		;GET POINTER TO NEXT EXT FDB
	JUMPN P1,CHKAC2		;GO COUNT POINTERS ON NEXT CHAIN

CHKAC4:	ADDI I1,STESIZ		;COMPUTE ADDRESS OF NEXT ENTRY
	JRST CHKAC1		;NO, GO BACK, CHECK NEXT ENTRY

CHKAC5:	MOVEI P1,.ABCNT(Q1)	;GET ADDRESS OF SHARE COUNT
	GETMPW P2,P1		;GET SHARE COUNT IN BLOCK
	CAMN P2,COUNT		;IS COUNT IN BLOCK CORRECT ?
	RET			;YES, CHECK WITH COUNT IN BLOCK
	AOS ERRCNT		;INCREMENT # OF ERRORS DETECTED
	O.STR <
? Incorrect share count in Account Block At >
	O.OCT Q1		;OUTPUT ADDRESS OF BLOCK
	O.CRLF			;OUTPUT A CRLF
	CALL PUTACT		;OUTPUT THE ACCOUNT BLOCK
	O.STR <
	Computed share count is >
	O.OCT COUNT		;OUTPUT THE COUNT
	O.STR <
	Share count in block is >
	MOVEI P1,.ABCNT(Q1)	;GET ADR OF SHARE COUNT
	GETMPW P2,P1		;GET SHARE COUNT IN BLOCK
	O.OCT P2		;OUTPUT SHARE COUNT
	O.CRLF			;OUTPUT A CRLF
	RET			;RETURN TO WHENCE WE CAME ...
; CHKUNS - ROUTINE TO DETERMINE IF A GIVEN USER NAME BLOCK IS
;	   POINTED TO BY EITHER A SYMBOL TABLE ENTRY OR AN FDB.
;
; CALL:		MOVE Q1,USER NAME BLOCK ADDRESS TO LOOK FOR
;		CALL CHKUNS
;		RETURN, ERROR MESSAGE ISSUED IF USER NAME BLOCK
;		  WAS NOT FOUND ...

CHKUNS:	STKVAR <UNSEXT,UNSCNT>	;ALLOCATE TEMPORARY STORAGE
	SETZM UNSCNT		;INITIALIZE COMPUTED COUNT
	CALL FNDUNS		;DOES SYMBOL TABLE ENTRY EXIST ?
	  JRST CHKU00		;ENTRY EXISTS, GO CHECK POINTERS
	AOS ERRCNT		;INCREMENT # OF ERRORS DETECTED
	O.STR <
? No Symbol Table entry exists for User Name Block at >
	O.OCT Q1
	O.CRLF			;OUTPUT A CRLF
	CALL PUTUNS		;GO OUTPUT THE USER NAME BLOCK
	O.CRLF			;OUTPUT A CRLF

CHKU00:	MOVEI P1,.UNCNT(Q1)	;GET ADDRESS OF SHARE COUNT
	GETMPW P2,P1		;GET SHARE COUNT FROM BLOCK
	JUMPN P2,CHKUN0		;COUNT SHOULD BE NON-ZERO
	AOS ERRCNT		;INCREMENT # OF ERRORS DETECTED
	O.STR <
? User Name Block at >
	O.OCT Q1		;OUTPUT ADDRESS OF BLOCK
	O.STR < has a share count of 0 !
>
	CALL PUTUNS		;GO OUTPUT THE USER NAME BLOCK

CHKUN0:	LOAD I1,DIRBOT		;GET ADDRESS OF START OF TABLE
	ADDI I1,STHSIZ		;COMPUTE ADDRESS OF FIRST ENTRY
CHKUN1:	LOAD P1,DIRTOP		;GET TOP ADR OF SYMBOL TABLE
	CAMG P1,I1		;CHECKED ALL ENTRIES YET ?
	JRST CHKUN5		;YES, GO VERIFY SHARE COUNT

	GETSYM P1,I1		;GET ENTRY TYPE AND ADDRESS
	LDB P2,[POINTR P1,.STMSK] ;GET JUST THE TYPE CODE
	CAIE P2,.STNAM		;IS THIS AN FDB ENTRY ?
	JRST CHKUN4		;NO, GO CHECK NEXT ENTRY
	LDB P1,[POINTR P1,.STPTR] ;GET POINTER TO FDB
CHKUN2:	MOVEM P1,UNSEXT		;SAVE ADR OF HEAD OF EXT CHAIN

CHKUN3:	MOVEI P2,.FBAUT(P1)	;GET ADDRESS OF AUTHOR POINTER
	GETMPW P3,P2		;GET POINTER TO USER NAME BLOCK
	CAMN P3,Q1		;IS THIS DESIRED POINTER ?
	AOS UNSCNT		;YES, INCREMENT THE COUNT
	MOVEI P2,.FBLWR(P1)	;GET ADDRESS OF LAST WRITER POINTER
	GETMPW P3,P2		;GET POINTER TO USER NAME STRING BLOCK
	CAMN P3,Q1		;IS THIS THE DESIRED POINTER ?
	AOS UNSCNT		;YES, INCREMENT COUNT OF POINTERS FOUND
	MOVEI P2,.FBGNL(P1)	;GET ADR OF NEXT GEN POINTER
	GETMPW P1,P2		;GET POINTER TO NEXT GEN FDB
	JUMPN P1,CHKUN3		;GO CHECK NEXT FDB ON GEN CHAIN

	MOVE P1,UNSEXT		;GET ADR OF CURRENT CHAIN HEAD
	MOVEI P2,.FBEXL(P1)	;GET ADR OF POINTER TO NEXT EXT
	GETMPW P1,P2		;GET POINTER TO NEXT EXT FDB
	JUMPN P1,CHKUN2		;GO COUNT POINTERS ON NEXT CHAIN

CHKUN4:	ADDI I1,STESIZ		;COMPUTE ADDRESS OF NEXT ENTRY
	JRST CHKUN1		;NO, GO BACK, CHECK NEXT ENTRY

CHKUN5:	MOVEI P1,.UNCNT(Q1)	;GET ADDRESS OF SHARE COUNT
	GETMPW P2,P1		;GET SHARE COUNT IN BLOCK
	CAMN P2,UNSCNT		;IS COUNT IN BLOCK CORRECT ?
	RET			;YES, CHECK WITH COUNT IN BLOCK
	AOS ERRCNT		;INCREMENT # OF ERRORS DETECTED
	O.STR <
? Incorrect share count in User Name Block at >
	O.OCT Q1		;OUTPUT ADDRESS OF BLOCK
	O.CRLF			;OUTPUT A CRLF
	CALL PUTUNS		;OUTPUT THE USER NAME BLOCK
	O.STR <
	Computed share count is >
	O.OCT COUNT		;OUTPUT THE COUNT
	O.STR <
	Share count in block is >
	MOVEI P1,.UNCNT(Q1)	;GET ADR OF SHARE COUNT
	GETMPW P2,P1		;GET SHARE COUNT IN BLOCK
	O.OCT P2		;OUTPUT SHARE COUNT
	O.CRLF			;OUTPUT A CRLF
	RET			;RETURN TO WHENCE WE CAME ...
; PUTACT - ROUTINE TO OUTPUT AN ACOUNT BLOCK
;
; CALL:		MOVE Q1, ADR OF ACCOUNT BLOCK
;		CALL PUTACT
;		RETURN


PUTACT:	O.STR <	>		;OUTPUT A TAB
	MOVEI P1,.ABTYP(Q1)	;GET ADDRESS OF FIRST WORD
	GETMPW T2,P1		;GET FIRST WORD OF BLOCK
	MOVE T3,[1B0+10]	;PRINT MAGNITUDE, USE OCTAL
	CALL PUTHLF		;GO OUTPUT TWO HALFWORDS
	O.STR <
	>			;OUTPUT MORE PUNCTUATION
	MOVEI P1,.ABCNT(Q1)	;GET ADDRESS OF SHARE COUNT
	GETMPW T2,P1		;GET SHARE COUNT
	O.OCT T2		;OUTPUT SHARE COUNT
	O.STR <
	>			;YET MORE PUNCTUATION
	MOVE T1,OUTJFN		;GET OUTPUT JFN
	HRROI T2,2(Q1)		;GET FILE ADDRESS OF STRING
	ADD T2,FDBOFS		;POINT TO MEMORY ADDRESS
	SETZM T3		;TERMINATE ON NULL
	SOUT			;OUTPUT ACCOUNT STRING
	O.CRLF			;OUTPUT A CRLF
	RET			;RETURN TO WHENCE WE CAME ...
; PUTUNS - ROUTINE TO OUTPUT A USER NAME BLOCK
;
; CALL:		MOVE Q1, ADR OF USER NAME BLOCK
;		CALL PUTUNS
;		RETURN


PUTUNS:	O.STR <	>		;OUTPUT A TAB
	MOVEI P1,.UNTYP(Q1)	;GET ADDRESS OF FIRST WORD
	GETMPW T2,P1		;GET FIRST WORD OF BLOCK
	MOVE T3,[1B0+10]	;PRINT MAGNITUDE, USE OCTAL
	CALL PUTHLF		;GO OUTPUT TWO HALFWORDS
	O.STR <
	>			;OUTPUT MORE PUNCTUATION
	MOVEI P1,.UNCNT(Q1)	;GET ADDRESS OF SHARE COUNT
	GETMPW T2,P1		;GET SHARE COUNT
	O.OCT T2		;OUTPUT SHARE COUNT
	O.STR <
	>			;YET MORE PUNCTUATION
	MOVE T1,OUTJFN		;GET OUTPUT JFN
	HRROI T2,2(Q1)		;GET FILE ADDRESS OF STRING
	ADD T2,FDBOFS		;POINT TO MEMORY ADDRESS
	SETZM T3		;TERMINATE ON NULL
	SOUT			;OUTPUT USER NAME STRING
	O.CRLF			;OUTPUT A CRLF
	RET			;RETURN TO WHENCE WE CAME ...
; CKACTE - ROUTINE TO DETERMINE IF A GIVEN ACCOUNT BLOCK IS
;	   POINTED TO BE ANY FDB ON A GIVEN EXTENSION CHAIN.
;
; CALL:		MOVE Q1,ADDRESS OF ACCOUNT BLOCK
;		MOVE FB,ADDRESS OF FDB AT HEAD OF CHAIN
;		CALL CKACTE
;		  RETURN NON-SKIP IF ACCOUNT BLOCK NOT FOUND
;		RETURN SKIP IF ACCOUNT BLOCK IS ON CHAIN


CKACTE:	STKVAR <SAVEFB>		;ALLOCATE TEMPORARY STORAGE
	MOVEM FB,SAVEFB		;SAVE INITIAL VALUE OF FB

CKACE1:	CALL CKACTG		;SEE IF BLOCK IS ON GEN CHAIN
	  JRST CKACE2		;NOT ON THIS GEN CHAIN, GO ON
	JRST CKACE3		;BLOCK FOUND, GO RETURN

CKACE2:	MOVEI P1,.FBEXL(FB)	;GET ADDRESS OF EXTENSION WORD
	GETMPW FB,P1		;GET EXTENSION WORD FROM FDB
	JUMPN FB,CKACE1		;GO CHECK NEXT GEN CHAIN
	MOVE FB,SAVEFB		;BLOCK NOT FOUND, RESTORE FB
	RET			;RETURN TO WHENCE WE CAME ...

CKACE3:	MOVE FB,SAVEFB		;RESTORE ORIGINAL VALUE OF FB
	RETSKP			;RETURN TO WHENCE WE CAME +1 ...



; CKACTG - ROUTINE TO DETERMINE IF A GIVEN ACCOUNT BLOCK
;	   IS POINTED TO BY ANY FDB ON A GIVEN GENERATION
;	   CHAIN.
;
; CALL:		MOVE Q1,ACCOUNT BLOCK ADDRESS
;		MOVE FB,ADDRESS OF HEAD OF GEN CHAIN
;		CALL CKACTG
;		  RETURN NON-SKIP IF ACCOUNT BLOCK NOT FOUND
;		RETURN SKIP IF ACCOUNT BLOCK FOUND ON CHAIN


CKACTG:	MOVE P1,FB		;COPY ADDRESS OF HEAD OF CHAIN

CKACG1:	MOVEI P2,.FBACT(P1)	;GET ADDRESS OF ACCOUNT WORD
	GETMPW P3,P2		;GET ACCOUNT WORD FROM FDB
	JUMPL P3,CKACG2		;IF NUMERIC ACCOUNT, GO ON
	CAMN Q1,P3		;GOT CORRECT POINTER ?
	RETSKP			;YES, RETURN FOUND
CKACG2:	MOVEI P2,.FBGNL(P1)	;GET ADDRESS OF GENERATION WORD
	GETMPW P1,P2		;GET GEN LINK WORD FROM FDB
	JUMPN P1,CKACG1		;GO CHECK NEXT FDB ON CHAIN
	RET			;END-OF-CHAIN, RETURN NOT FOUND
; FNDACT - ROUTINE TO LOOK THROUGH THE SYMBOL TABLE FOR AN
;	   ENTRY FOR A GIVEN ACCOUNT.
;
; CALL:		MOVE Q1,POINTER TO ACCOUNT BLOCK
;		CALL FNDACT
;		  RETURN NON-SKIP IF ACCOUNT ENTRY FOUND
;		RETURN SKIP IF NO ENTRY IN SYMBOL TABLE


FNDACT:	LOAD I1,DIRBOT		;GET BOTTOM ADR OF SYMBOL TABLE
	ADDI I1,STHSIZ		;POINT TO FIRST ENTRY

FNDAC1:	LOAD P1,DIRTOP		;GET TOP ADDRESS IN SYMBOL TABLE
	CAMG P1,I1		;AT END-OF-TABLE YET ?
	RETSKP			;YES, RETURN SKIP

	GETSYM P1,I1		;GET A SYMBOL TABLE ENTRY
	LDB P2,[POINTR P1,.STMSK] ;GET JUST THE TYPE CODE
	CAIE P2,.STACT		;IS THIS AN ACCOUNT ENTRY ?
	JRST FNDAC2		;NO, GO CHECK NEXT ENTRY
	HRRZ P2,P1		;YES, GET POINTER TO BLOCK
	CAMN P2,Q1		;IS THIS THE DESIRED ENTRY ?
	RET			;YES, RETURN FOUND

FNDAC2:	ADDI I1,STESIZ		;POINT TO NEXT ENTRY
	JRST FNDAC1		;GO CHECK NEXT ENTRY IN TABLE
; FNDUNS - ROUTINE TO LOOK THROUGH THE SYMBOL TABLE FOR AN
;	   ENTRY FOR A GIVEN USER NAME BLOCK.
;
; CALL:		MOVE Q1,POINTER TO USER NAME BLOCK
;		CALL FNDUNS
;		  RETURN NON-SKIP IF ENTRY FOUND
;		RETURN SKIP IF NO ENTRY IN SYMBOL TABLE


FNDUNS:	LOAD I1,DIRBOT		;GET BOTTOM ADR OF SYMBOL TABLE
	ADDI I1,STHSIZ		;POINT TO FIRST ENTRY

FNDUN1:	LOAD P1,DIRTOP		;GET TOP ADDRESS IN SYMBOL TABLE
	CAMG P1,I1		;AT END-OF-TABLE YET ?
	RETSKP			;YES, RETURN SKIP

	GETSYM P1,I1		;GET A SYMBOL TABLE ENTRY
	LDB P2,[POINTR P1,.STMSK] ;GET JUST THE TYPE CODE
	CAIE P2,.STUNS		;IS THIS AN USER NAME ENTRY ?
	JRST FNDUN2		;NO, GO CHECK NEXT ENTRY
	HRRZ P2,P1		;YES, GET POINTER TO BLOCK
	CAMN P2,Q1		;IS THIS THE DESIRED ENTRY ?
	RET			;YES, RETURN FOUND

FNDUN2:	ADDI I1,STESIZ		;POINT TO NEXT ENTRY
	JRST FNDUN1		;GO CHECK NEXT ENTRY IN TABLE
SUBTTL	LIST AND OUTPUT COMMANDS

.LIST:	STKVAR <LPTJFN>
	MOVEI T1,CMDBLK		;GET ADDRESS OF COMMAND STATE BLOCK
	MOVEI T2,[FLDDB. (.CMNOI,,<TXT(OUTPUT ON PRINTER)>)]
	COMND			;PARSE NOISE FIELD
	MOVEI T1,CMDBLK		;GET ADDRESS OF COMMAND STATE BLOCK
	MOVEI T2,[FLDDB. (.CMCFM)] ;GET CONFIRMATION FUNCTION
	COMND			;PARSE END OF COMMAND
	TXNE T1,CM%NOP		;END OF COMMAND PARSED OK ?
	CALLRET COMER2		;NO, GO ISSUE ERROR MESSAGE

; HERE TO GET A JFN FOR THE PRINTER

	MOVX T1,GJ%FOU!GJ%SHT	;GET FLAGS
	HRROI T2,[ASCIZ/LPT:DIRTST.TXT/] ;GET NAME OF OUTPUT FILE
	GTJFN			;GET A JFN FOR THE PRINTER
	 JRST [	JSERR		;UNEXPECTED ERROR
		RET ]		;RETURN

	HRRZM T1,LPTJFN		;SAVE OUTPUT JFN
	SKIPE T1,OUTJFN		;GET PREVIOUS JFN
	CLOSF			;CLOSE LAST OUTPUT JFN
	 JFCL			;IGNORE ERRORS
	SKIPE T1,OUTJFN		;GET OUTPUT JFN AGAIN
	RLJFN			;RELEASE JFN
	 JFCL			;IGNORE ERRORS
	MOVE T1,LPTJFN		;RESTORE NEW LPT JFN
	MOVEM T1,OUTJFN		;SAVE NEW OUTPUT JFN
	RET			;RETURN TO PARSER


; OUTPUT COMMAND

.OUTPT:	MOVEI T1,CMDBLK		;GET ADDRESS OF COMMAND STATE BLOCK
	MOVEI T2,[FLDDB. (.CMNOI,,<TXT(OUTPUT TO FILE)>)]
	COMND			;PARSE NOISE
	MOVEI T1,CMDBLK		;GET ADDRESS OF COMMAND STATE BLOCK
	MOVEI T2,[FLDDB. (.CMOFI,,,,<DIRTST.TXT>)]
	COMND			;PARSE FILE SPEC
	TXNN T1,CM%NOP		;PARSED OK ?
	JRST OUTPT5		;YES, GO ON
	CALL TSTCOL		;NO, ISSUE NEW LINE IF NEEDED
	TMSG <? DIRTST: Invalid filespec, >
	MOVX T1,.PRIOU		;GET PRIMARY OUTPUT JFN
	HRLOI T2,.FHSLF		;THIS FORK, LAST ERROR
	SETZM T3		;
	ERSTR			;OUTPUT ERROR FROM JSYS
	 JFCL			;IGNORE ERRORS HERE
	 JFCL			;IGNORE ERRORS HERE
	TMSG <
>				;OUTPUT CRLF
	RET			;RETURN TO WHENCE WE CAME ...

; HERE ON A GOOD FILESPEC

OUTPT5:	STKVAR <OTPJFN>		;ALLOCATE SPACE FOR OUTPUT JFN
	MOVEM T2,OTPJFN		;SAVE JFN
	MOVEI T1,CMDBLK		;GET ADDRESS OF COMMAND STATE BLOCK
	MOVEI T2,[FLDDB. (.CMCFM)] ;GET CONFIRM FUNCTION
	COMND			;PARSE END OF COMMAND
	TXNE T1,CM%NOP		;PARSED OK ?
	CALLRET COMER2		;NO, GO ISSUE MESSAGE
	SKIPE T1,OUTJFN		;GET PREVIOUS JFN
	CLOSF			;CLOSE LAST OUTPUT JFN
	 JFCL			;IGNORE ERRORS
	SKIPE T1,OUTJFN		;GET OUTPUT JFN AGAIN
	RLJFN			;RELEASE JFN
	 JFCL			;IGNORE ERRORS
	MOVE T1,OTPJFN		;GET NEW OUTPUT JFN AGAIN
	MOVEM T1,OUTJFN		;SAVE GOOD OUTPUT JFN
	RET			;RETURN TO PARSER

; TYPE COMMAND

.TYPE:	MOVEI T1,CMDBLK		;GET ADDRESS OF COMMAND STATE BLOCK
	MOVEI T2,[FLDDB. (.CMNOI,,<TXT(OUTPUT ON TERMINAL)>)]
	COMND			;PARSE NOISE
	MOVEI T2,[FLDDB. (.CMCFM)] ;GET CONFIRMATION FUNCTION
	COMND			;PARSE END OF COMMAND
	TXNE T1,CM%NOP		;PARSED OK ?
	CALLRET COMER2		;NO, ISSUE MESSAGE
	SKIPE T1,OUTJFN		;GET PREVIOUS JFN
	CLOSF			;CLOSE LAST OUTPUT JFN
	 JFCL			;IGNORE ERRORS
	SKIPE T1,OUTJFN		;GET OUTPUT JFN AGAIN
	RLJFN			;RELEASE JFN
	 JFCL			;IGNORE ERRORS
	MOVEI T1,.PRIOU		;GET PRIMARY OUTPUT JFN
	MOVEM T1,OUTJFN		;SAVE NEW OUTPUT JFN
	RET			;RETURN TO PARSER
SUBTTL	HELP AND EXIT COMMANDS

; HELP COMMAND

.HELP:	MOVEI T1,CMDBLK		;GET ADDRESS OF COMMAND STATE BLOCK
	MOVEI T2,[FLDDB. (.CMCFM)] ;GET FUNCTION BLOCK FOR CONFIRMATION
	COMND			;WAIT FOR CONFIRMATION
	TXNE T1,CM%NOP		;VALID END-OF-COMMAND SEEN ?
	CALLRET COMER2		;NO, ISSUE ERROR MESSAGE AND RETURN
	HRROI T1,HLPMSG		;GET POINTER TO HELP MESSAGE
	PSOUT			;OUTPUT HELP MESSAGE
	RET			;GO PARSE NEXT COMMAND

; EXIT COMMAND

.EXIT:	MOVEI T1,CMDBLK		;GET ADDRESS OF COMMAND BLOCK
	MOVEI T2,[FLDDB. (.CMNOI,,<TXT(TO MONITOR)>)]
	COMND			;PARSE NOISE PHRASE
	MOVEI T2,[FLDDB. (.CMCFM)] ;GET FUNCTION BLOCK FOR CONFIM
	COMND			;PARSE CONFIRMATION
	TXNE T1,CM%NOP		;VALID END-OF-COMMAND SEEN ?
	CALLRET COMER2		;NO, ISSUE ERROR MESSAGE AND RETURN
	SETOM T1		;INDICATE ALL FILES SHOULD BE CLOSED
	CLOSF			;CLOSE ALL OPEN FILES
	 JSERR			;UNEXPECTED ERROR
	HALTF			;RETURN TO MONITOR
	JRST START		;IF CONTINUE'D, START OVER
SUBTTL	VERIFY (FILES) FILE-SPEC

.VERFY:	STKVAR <VFYJFN>
	HRROI T2,[ASCIZ /FILES/] ;GET GUIDE WORD
	CALL SKPNOI		;PARSE GUIDE WORD
	 RET			;FAILED
	MOVE T1,[GJFBLK,,GJFBLK+1] ;SET UP TO CLEAR GTJFN BLOCK
	SETZM GJFBLK		;CLEAR FIRST WORD OF BLOCK
	BLT T1,GJFBLK+GJFSIZ-1	;CLEAR GTJFN BLOCK
	MOVX T1,GJ%OLD!GJ%SHT!GJ%IFG ;GET FLAGS
	MOVEM T1,GJFBLK+.GJGEN	;SAVE FLAGS
	MOVEI T1,CMDBLK		;GET ADDRESS OF COMMAND STATE BLOCK
	MOVEI T2,[FLDDB. (.CMFIL)] ;FILESPEC FUNCTION
	COMND			;PARSE A FILESPEC
	 ERJMP R		;FAILED, RETURN
	TXNN T1,CM%NOP		;PARSED FILESPEC OK ?
	JRST VRFY10		;YES, GO SAVE JFN
	HRROI T1,[ASCIZ/Invalid filespec/]
	CALL TYPATM		;OUTPUT THE TEXT ENTERED
	TMSG <	>		;INDENT NEXT LINE
	CALLRET PUTERR		;AND ALSO TYPE JSYS ERROR MESSAGE

; HERE WITH A VALID FILESPEC

VRFY10:	MOVEM T2,VFYJFN		;SAVE JFN OF FILES TO VERIFY
	CALL ENDCOM		;PARSE END OF COMMAND
	 RET			;FAILED, RETURN
	MOVEI T1,.FHSLF		;GET OUR FORK HANDLE
	RPCAP			;READ OUR ENABLED CAPABILITIES
	TXNN T3,SC%WHL!SC%OPR	;WHEEL OR OPERATOR ENABLED ?
	JRST [	CALL TSTCOL	;NO, NEW LINE IF NEEDED
		TMSG <? DIRTST: WHEEL or OPERATOR capability required
>				;OUTPUT MESSAGE
		HALTF		;QUIT
		JRST START ]	;AND START AGAIN IF CONTINUE'D
IFN STANSW,<
	MOVE T1,OUTJFN		;GET JFN BACK AGAIN
	MOVX T2,<FLD(7,OF%BSZ)+OF%WR>
	OPENF			;OPEN THE FILE
	 JRST [	JSERR		;UNEXPECTED ERROR
		MOVE T1,OUTJFN	;GET JFN
		RLJFN		;RELEASE JFN
		 JFCL		;IGNORE ERRORS
		RET ]		;RETURN
>;IFN STANSW
VRFY20:	MOVE T1,VFYJFN		;RESTORE JFN
	CALL TYPFIL		;OUTPUT FILENAME IF CHANGED
	MOVE T1,VFYJFN		;GET JFN AGAIN
	CALL SETFIL		;GO SET UP TO VERIFY THIS FILE
	 RET			;FAILED, RETURN
	CALL VFYFIL		;GO CHECK THIS FILE
	MOVE T1,VFYJFN		;GET JFN AGAIN
	GNJFN			;GET NEXT JFN IN GROUP
	 ERJMP R		;DONE, RETURN
	JRST VRFY20		;GO DO NEXT FILE
	RET			;DONE, RETURN
;SETFIL - ROUTINE TO SET UP TO VERIFY A FILE
;
;ACCEPTS IN T1/	JFN
;		CALL SETFIL
;RETURNS: +1	 FAILED
;	  +2	SUCCESS, WITH T1/ FLAGS FROM FDB
;			      T2/ DEVICE DESIGNATOR FOR THIS FILE
;			      T3/ INDEX BLOCK ADR FROM FDB

SETFIL:	HRRZ T1,T1		;KEEP JUST THE JFN
	MOVE T2,[3,,.FBCTL]	;READ 3 FDB WORDS
	MOVEI T3,FILARG		;DESTINATION
	GTFDB			;DO IT
	 ERJMP R		;RETURN ON FAILURE

;GET STRUCTURE NAME FOR DSKOP

	MOVE T2,T1		;MOVE THE JFN
	HRROI T1,STRNAM		;WHERE TO PUT STRUCTURE NAME
	MOVX T3,1B2		;DEVICE NAME ONLY
	JFNS			;DO IT
	 ERJMP R		;RETURN ON FAILURE
	HRROI T1,STRNAM		;GET STR NAME
	STDEV			;GET DEVICE DESIGNATOR
	 ERJMP R		;RETURN ON FAILURE
	MOVE T1,FILARG		;GET FLAGS FOR THIS FILE
	MOVE T3,FILARG+2	;GET ADDRESS OF XB FOR THIS FILE
	RETSKP			;DONE, RETURN SUCCESS
;TYPFIL - ROUTINE TO OUTPUT THE NAME OF A FILE WHEN THE NAME CHANGES
;
;ACCEPTS IN T1/	JFN
;		CALL TYPFIL
;RETURNS: +1 ALWAYS

TYPFIL:	ASUBR <TPFJFN>

	O.STR < >		;INDENT OUTPUT ONE SPACE
	SETZ T3,		;OUTPUT THE NAME
	HRRZ T2,TPFJFN		;COPY JFN
	MOVE T1,OUTJFN		;GET OUTPUT JFN
	JFNS			;OUTPUT NAME
	 ERJMP R		;FAILED, RETURN
	O.STR < >		;ADD A DASH OF PUNCTUATION
	RET			;DONE, RETURN
;DSKRED - ROUTINE TO READ THE DISK
;
;ACCEPTS IN T1/	DISK ADDRESS TO READ
;           T2/	DEVICE DESIGNATOR
;	    T3/	DESTINATION ADDRESS FOR PAGE
;		CALL DSKRED
;RETURNS: +1	 ERROR, WITH T1/ ERROR TYPE
;	  +2	SUCCESS, WITH T1/ NON-ZERO IF RETRIES WERE NEEDED

DSKRED:	ASUBR <DRDADR,DRDDES>
	SAVEAC (P1,P2)
	MOVEM T1,LSTDSK		;SAVE DISK ADDRESS
	MOVEI P1,10		;MAX RETRIES WITH NO ERROR RECOVERY
SETUP1:	MOVEI T2,.DOPSR		;STR RELATIVE ADDRESSING
	STOR T2,DOP%AT,1	;STORE IT
	SETONE DOP%SN,1		;SAY DEVICE DESIGNATOR IN T4
	MOVEI T2,1000
	TXO T2,DOP%IR!DOP%IL	;INHIBIT ERROR RECOVERY
	MOVE T4,DRDDES		;DEVICE DESIGNATOR
	DSKOP			;DO IT
	JUMPN T1,[ MOVE T1,LSTDSK    ;GET LAST DISK ADDRESS AGAIN
		SOJGE P1,SETUP1      ;DO MAX RETRIES BEFORE GIVING UP
		SETONE DOP%SN,T1
		MOVEI P2,.DOPSR
		STOR P2,DOP%AT,T1    ;SET UP NEW ARGS
		TXZ T2,DOP%IR!DOP%IL ;ALLOW ERROR RECOVERY THIS TIME
		DSKOP		     ;TRY IT AGAIN
		RET]		     ;RETURN WITH CODE IN A
	CAIE P1,10	 	;ANY RETRIES?
	SETOM T1		;YES. REMEMBER THIS
	RETSKP			;NO
;VFYFIL - ROUTINE TO VERIFY THE PAGES IN ONE FILE
;
;ACCEPTS IN T1/	FLAGS FROM FDB
;	    T2/	DEVICE DESIGNATOR
;	    T3/	XB ADDRESS FROM FDB
;		CALL VFYFIL
;RETURNS: +1 ALWAYS, APPROPRIATE MESSAGES ISSUED

VFYFIL:	ASUBR <VFLFLG,VFLDEV,VFLXB,VFLERR>
	SAVEAC (P1,P2,P3)
	STKVAR <VFLMSG,VFLTYP>
	SETZM VFLMSG		;START BY ASSUMING [OK]

; DETERMINE IF THIS IS A LONG FILE

	MOVE T2,VFLFLG		;GET THE FDB FLAGS
	TXNN T2,FB%LNG		;IS THIS A LONG FILE?
	JRST [	MOVE T1,VFLXB	;NO, SAVE PT ADDRESS
		MOVEM T1,IDXPAG	; AS ONLY PTT ENTRY
		MOVSI P3,-1	;ONLY LOOK AT ONE ENTRY
		JRST VFL10]	;AND GO PROCESS THE PTT
	MOVE T1,VFLXB		;GET XB ADDRESS
	MOVE T2,VFLDEV		;GET DEVICE DESIGNATOR
	CALL REDPTT		;GO READ AND CHECK PTT
	 RET			;FAILED. THEN DON'T BOTHER WITH DATA
	MOVSI P3,-1000		;OK. CHECK ALL PAGE TABLES

; HERE TO CHECK EACH PAGE TABLE (JUST ONE IF FILE IS NOT LONG)

VFL10:	SKIPN T1,IDXPAG(P3)	;GET PAGE TABLE ADDRESS
	JRST VFL20		;NONE HERE.
	TLZ T1,777000		;IGNORE CHECKSUM
	JUMPE T1,VFL20		;SKIP IT IF NOTHING HERE
	MOVE T2,VFLDEV		;GET DEVICE DESIGNATOR
	MOVEI T3,PTPAGE		;WHERE TO PUT IT
	CALL DSKRED		;GET IT
	 JRST [	MOVEM T1,VFLERR	;SAVE ERROR FLAG
		HRROI T1,[ASCIZ /? Hard error reading PT # /]
		SKIPN T1	;WAS IT REALLY HARD ?
		HRROI T1,[ASCIZ /? Recoverable error reading PT # /]
		MOVE T1,OUTJFN	;GET OUTPUT JFN
		SETZM T3	;STOP ON NULL
		SOUT		;OUTPUT TEXT
		HRRZ Q1,P3	;GET JUST THE PT #
		O.OCT Q1	;OUTPUT PT #
		CALL PRTDSK	;OUTPUT DISK ADDRESS
		SKIPN VFLERR	;RECOVERABLE?
		JRST .+1	;YES. PROCEED
		JRST VFL20]
	SKIPE T1		;CLEAN READ?
	JRST [	O.STR <% Transient error reading PT # >
		HRRZ Q1,P3	;GET JUST THE PT #
		O.OCT Q1	;OUTPUT PT #
		CALL PRTDSK	;DISC ADDRESS
		JRST .+1]	;AND PROCEED
	MOVEI T1,PTPAGE		;THE PAGE WHERE THE XB IS
	CALL CHKSUM		;VERIFY IT
	 JRST [	O.STR <? Check sum error reading PT # >
		HRRZ Q1,P3	;GET JUST THE PT #
		O.OCT Q1	;OUTPUT PT #
		CALL PRTDSK	;OUTPUT DISK ADDRESS
		SETOM VFLMSG	;NOTE NOT TO SAY [OK]
		JRST VFL20]	;DO NEXT PT
	HRRZ T1,P1		;GET PAGE TABLE NUMBER
	MOVE T2,VFLDEV		;GET DEVICE DESIGNATOR
	CALL VFYPT		;GO CHECK DATA PAGES FOR THIS PT
	 SETOM VFLMSG		;FAILED, DO NOT SAY [OK]
VFL20:	AOBJN P3,VFL10		;LOOP OVER ALL PAGE TABLES
	SKIPE VFLMSG		;SAY [OK] ?
	RET			;DONE, RETURN
	O.STR <[OK]>		;OUTPUT INFORMATIVE MESSAGE
	O.CRLF			;AND NEW LINE
	RET			;DONE, RETURN
;REDPTT - ROUTINE TO READ AND CHECK A PAGE TABLE TABLE
;
;ACCEPTS IN T1/	DISK ADDRESS OF PAGE TABLE TABLE
;	    T2/	DEVICE DESIGNATOR
;		CALL REDPTT
;RETURNS: +1	 FAILED, PTT IS BAD
;	  +2	SUCCESS, PTT IS OK

REDPTT:	ASUBR <RDPADR,RDPDEV,RDPFLG>

	MOVEI T3,IDXPAG		;WHERE ITS GOING
	MOVE T2,RDPDEV		;GET DEVICE DESIGNATOR
	CALL DSKRED		;GO SET UP ARGS AND DO OPERATION
	 JRST [	MOVEM T1,RDPFLG	;SAVE ERROR FLAG
		HRROI T2,[ASCIZ /? Hard error reading PTT/]
		SKIPN T1	;WAS IT REALLY HARD?
		HRROI T2,[ASCIZ /? Recoverable error reading PTT/]
		SETZM T3	;STOP ON NULL
		MOVE T1,OUTJFN	;GET OUTPUT JFN
		SOUT		;OUTPUT TEXT
		CALL PRTDSK	;output disk address
		SKIPN RDPFLG	;HARD ERROR
		JRST .+1	;NO. GO ON
		RET ]		;YES, DONE.
	SKIPE T1		;CLEAN READ?
	JRST [	O.STR <% Transient error reading PTT>
		CALL PRTDSK	;PRINT ADDRESS
		JRST .+1]	;DONE

	MOVEI T1,IDXPAG		;THE PAGE WHERE XB IS
	CALL CHKSUM		;VERIFY BLOCK
	 JRST [	O.STR <? Checksum error on PTT>
		CALL PRTDSK	;PRINT DISK ADDRESS
		RET ]		;AND SKIP THE FILE
	RETSKP			;DONE, RETURN SUCCESS
;VFYPT - ROUTINE TO VERIFY THE PAGES IN ONE PAGE TABLE
;
;ACCEPTS IN T1/	PAGE TABLE NUMBER
;	    T2/	DEVICE DESIGNATOR
;		CALL VFYPT
;RETURNS: +1	 FAILED, PT OR DATA PAGE UNREADABLE
;	  +2	SUCCESS, PT AND DATA PAGES OK

VFYPT:	SAVEAC (P1,P2,P3)
	STKVAR <VFPFLG>
	SETZM VFPFLG		;ASSUME PT AND DATA PAGES ARE OK
	MOVE P2,T2		;SAVE DEVICE DESIGNATOR
	MOVE P3,T1		;SAVE PAGE TABLE NUMBER
	MOVSI P1,-1000		;LOOP OVER ALL DATA PAGES

VFPT10:	SKIPN T1,PTPAGE(P1)	;DO NEXT DATA PAGE
	JRST VFPT20		;NONE HERE
	TLZ T1,777000		;IGNORE CHECKSUM
	JUMPE T1,VFPT20		;IF NOW ZERO, IGNORE IT
	MOVE T2,P2		;GET DEVICE DESIGNATOR
	MOVEI T3,DATPAG		;WHERE TO PUT IT
	CALL DSKRED		;DO IT
	 JRST [	HRROI T2,[ASCIZ /? Hard error reading page # /]
		SKIPN T1	;REALLY HARD?
		HRROI T2,[ASCIZ /? Recoverable error reading page # /]
		SETZM T3	;STOP ON NULL
		MOVE T1,OUTJFN	;GET OUTPUT JFN
		SOUT		;OUTPUT STRING
		HRRZ Q1,P1	;GET JUST THE PAGE #
		O.OCT Q1	;OUTPUT PAGE #
		HRROI T2,[ASCIZ / of PT # /]
		SOUT		;OUTPUT STRING
		O.OCT P3	;OUTPUT PAGE TABLE NUMBER
		CALL PRTDSK	;OUTPUT DISK ADDRESS
		SETOM VFPFLG	;NOTE MESSAGE HAS BEEN OUTPUT
		JRST VFPT20]	;DO NEXT PAGE
	SKIPE T1		;ANY RETRIES NEEDED ?
	JRST [	O.STR <% Transient error reading page # >
		HRRZ Q1,P1	;GET JUST THE PAGE #
		O.OCT Q1	;OUTPUT PAGE #
		O.STR < of PT # >
		O.OCT P3	;OUTPUT PAGE TABLE NUMBER
		CALL PRTDSK	;output disk address
		SETOM VFPFLG	;NOTE MESSAGE HAS BEEN OUTPUT
		JRST .+1]
VFPT20:	AOBJN P1,VFPT10		;DO ALL OF IT
	SKIPE VFPFLG		;ANY MESSAGES OUTPUT ?
	RET			;YES, RETURN FAILURE
	RETSKP			;NO, RETURN SUCCESS
;PRTDSK - ROUTINE TO TYPE A DISK ADDRESS
;
;ACCEPTS IN LSTDSK/ LAST DISK ADDRESS READ
;		CALL PRTDSK
;RETURNS: +1 ALWAYS

PRTDSK:	O.STR <, Disk Address >
	MOVE T2,LSTDSK		;GET DISK ADDRESS TO OUTPUT
	MOVE T3,[1B0+10]	;GET NOUT FLAGS
	CALL PUTHLF		;OUTPUT DISK ADDRESS
	O.CRLF			;OUTPUT END OF LINE
	RET			;DONE, RETURN

;CHECK SUM SUBROUTINE
;	T1/ XB BLOCK ADDRESS

CHKSUM:	MOVSI T2,-4		;# OF WORDS TO DO
	HRRI T2,0(T1)		;GET ADDRESS
	MOVE T3,[POINT ^D9,T4]
	PUSH P,T1
CHKLOP:	LDB T1,[POINT ^D9,0(T2),8] ;GET NEXT PART
	IDPB T1,T3		;SAVE IT
	AOBJN T2,CHKLOP		;DO ALL 36 BITS
	POP P,T1		;GET BACK ADDRESS
	SETCA T4,		;GET COMPLEMENT OF CHECK SUM
	JCRY0 .+1
	MOVSI T3,-1000		;THE LOOP COUNTER
	HRLI T1,T3
CHKLO1:	MOVE T2,@T1		;GET NEXT ADDRESS
	LOAD T2,STGADR,T2	;GET ADDRESS PART ONLY
	SKIPN T2		;HAVE AN ADDRESS?
	HRRZ T2,T3		;NO. USE OFFSET IN XB THEN
	ADD T4,T2
	JCRY0 [AOJA T4,.+1]
CHKLO2:	AOBJN T3,CHKLO1		;DO THEM ALL
	CAME T4,[-1]		;GOOD CHECKSUM?
	RET			;NO
	RETSKP			;YES, RETURN SUCCESS
SUBTTL	PARSING SUBROUTINES

; ROUTINE TO PARSE AN END-OF-COMMAND
;
; CALL:		CALL ENDCOM
; RETURNS: +1	 BAD CONFIRMATION, MESSAGE ALREADY ISSUED
;	   +2	SUCCESS, COMMAND CONFIRMED

ENDCOM:	MOVEI T1,CMDBLK		;GET ADDRESS OF COMMAND STATE BLOCK
	MOVEI T2,[FLDDB. (.CMCFM)] ;GET FUNCTION BLOCK FOR CONFIM
	COMND			;PARSE CONFIRMATION
	 erjmp r		;error, go check for eof on take file
	TXNE T1,CM%NOP		;VALID END-OF-COMMAND SEEN ?
	JRST [ CALLRET COMER2 ]	;NO, ISSUE ERROR MESSAGE AND RETURN
	RETSKP			;SUCCESS, RETURN


; ROUTINE TO PARSE NOISE PHRASE
;
; CALL:	T2/ POINTER TO NOISE PHRASE
;		CALL SKPNOI
; RETURNS: +1	 ERROR, INVALID NOISE PHRASE
;	   +2 	SUCCESS, NOISE PHRASE PARSED OK

SKPNOI:	MOVE T1,[NOIFDB,,NOIFDB+1] ;SET UP TO CLEAR FUNCTION DESCRIPTOR BLOCK
	SETZM NOIFDB		;CLEAR FIRST WORD OF BLOCK
	BLT T1,NOIFDB+FDBSIZ-1	;CLEAR FUNCTION DESCRIPTOR BLOCK
	MOVX T1,.CMNOI		;GET FUNCTION TO PERFORM
	STOR T1,CM%FNC,NOIFDB	;STORE FUNCTION CODE IN FDB
	MOVEM T2,NOIFDB+.CMDAT	;STORE POINTER TO NOISE PHRASE IN FDB
	MOVEI T1,CMDBLK		;GET ADDRESS OF COMMAND STATE BLOCK
	MOVEI T2,NOIFDB		;GET ADDRESS OF FUNCTION BLOCK
	COMND			;PARSE NOISE WORD
	 ERJMP R		;ERROR, GO CHECK FOR EOF ON TAKE FILE
	TXNN T1,CM%NOP		;NOISE PHRASE PARSED OK ?
	RETSKP			;YES, RETURN SUCCESS
	CALL TSTCOL		;ISSUE NEW LINE IF NEEDED
	HRROI T1,[ASCIZ/Invalid guide phrase/]
	CALLRET TYPATM		;OUTPUT THE TEXT ENTERED AND RETURN
;TYPATM - ROUTINE TO TYPE THE CONTENTS OF THE ATOM BUFFER
;
;ACCEPTS IN T1/	POINTER TO ASCIZ PREFIX STRING TO BE TYPED
;		CALL TYPATM
;RETURNS: +1 ALWAYS

TYPATM:	STKVAR <ATOMPT>
	MOVEM T1,ATOMPT		;SAVE ATOM POINTER
	CALL TSTCOL		;ISSUE NEW LINE IF NEEDED
	TMSG <? DIRTST: >	;OUTPUT INITIAL PART OF MESSAGE
	MOVE T1,ATOMPT		;RESTORE ATOM POINTER
	PSOUT			;OUTPUT THE STRING
	TMSG < ">		;OUTPUT PUNCTUATION
	HRROI T1,ATMBFR		;GET POINTER TO THE ATOM BUFFER
	PSOUT			;OUTPUT THE TEXT ENTERED
	TMSG <"
>				;OUTPUT END OF LINE
	RET			;RETURN
SUBTTL	COMMAND ERROR SUBROUTINES

; INVALID END-OF-COMMAND

COMER2:	CALL TSTCOL		;TEST COLUMN POSITION
	TMSG <? DIRTST: Garbage at end-of-command
>				;OUTPUT ERROR MESSAGE
	RET			;RETURN TO WHENCE WE CAME ...


; SUBROUTINE TO TEST COLUMN POSITION AND OUTPUT CRLF IF NEEDED

TSTCOL:	movei t1,.priou		;get primary output designator
	rfpos			;read file position
	hrrz t2,t2		;keep just the column position
	JUMPE T2,R		;IF AT COLUMN 1 DO NOT OUTPUT CRLF
	tmsg <
>				;no, output a crlf
	RET			;RETURN TO WHENCE WE CAME ...
; PUTHLF - ROUTINE TO PRINT A 36-BIT QUANTITY AS TWO HALFWORDS.
;	   OUTPUT GOES TO JFN "OUTJFN"
;
; CALL:		MOVE T2,36-BIT QUANTITY
;		MOVE T3,RADIX AND CONTROL BITS
;		CALL PUTHLF
;		RETURN

PUTHLF:	STKVAR <VALUE,RAIDIX>	;ALLOCATE TEMPORARY STORAGE
	MOVEM T2,VALUE		;SAVE THE VALUE TO OUTPUT
	MOVE T1,OUTJFN		;GET JFN FOR OUTPUT
	HLRZ T2,T2		;GET LEFT HALFWORD TO OUTPUT
	NOUT			;OUTPUT THE LEFT HALFWORD
	  CALL TYPERR		;UNEXPECTED ERROR
	MOVEM T3,RAIDIX		;SAVE THE RAIDIX
	HRROI T2,[ASCIZ /,,/]	;GET PUNCTUATION
	SETZM T3		;TERMINATE ON NULL
	SOUT			;OUTPUT PUNCTUATION
	MOVE T3,RAIDIX		;RESTORE THE RAIDIX
	MOVE T2,VALUE		;RESTORE ORIGINAL QUANTITY
	HRRZ T2,T2		;GET JUST THE RIGHT HALF
	NOUT			;OUTPUT RIGHT HALFWORD
	  CALL TYPERR		;UNEXPECTED ERROR
	RET			;RETURN TO WHENCE WE CAME ...
SUBTTL		MAPPING SUBROUTINES

; MAPDP0 - ROUTINE TO MAP DIRECTORY PAGE 0 INTO THE
;	   ADDRESS SPACE OF THIS PROCESS.
;
; CALL:		[JFN FOR DIRECTORY FILE IS IN DIRJFN]
;		CALL MAPDP0
;		RETURN

MAPDP0:	HRLZ T1,DIRJFN		;GET DIRECTORY JFN,, FILE PAGE 0
	MOVSI T2,.FHSLF		;GET OUR FORK HANDLE
	MOVEI P1,DIRPG0		;GET CORE ADDRESS OF DIR PAGE 0
	LSH P1,-^D9		;CONVERT ADDRESS TO PAGE #
	HRR T2,P1		;COPY ADDRESS TO ARG AC FOR PMAP
	MOVX T3,PM%RD		;READ ACCESS ONLY
	PMAP			;MAP THE PAGES
	RET			;RETURN TO WHENCE WE CAME ...
; MAPDIR - ROUTINE TO MAP PAGES FROM THE DIRECTORY FILE INTO THE
;	   ADDRESS SPACE OF THIS PROCESS.
;
; CALL:		[JFN FOR DIRECTORY FILE IS IN DIRJFN]
;		MOVE MA,REQUIRED ADDRESS
;		CALL MAPDIR
;		RETURN

MAPDIR:	CALL SAVACS		;GO SAVE ALL AC'S
	HRLZ T1,DIRJFN		;GET DIRECTORY JFN
	MOVE P1,MA		;COPY ADDRESS REQUIRED
	LSH P1,-^D9		;CONVERT ADDRESS TO PAGE #
	HRR T1,P1		;GET PAGE # IN FILE
	MOVSI T2,.FHSLF		;GET OUR FORK HANDLE
	MOVEI P1,MAPPGS		;GET CORE ADDRESS OF DIR PAGE
	LSH P1,-^D9		;CONVERT ADDRESS TO PAGE #
	HRR T2,P1		;COPY ADDRESS TO ARG AC FOR PMAP
	MOVX T3,PM%RD!PM%CNT	;READ ACCESS ONLY, ITERATION CNT
	HRRI T3,FDBPGS		;GET # OF PAGES TO MAP
	LOAD P1,DIRFRE		;GET HIGHEST ADDRESS+1 FOR FDB'S
	SUBI P1,1		;COMPUTE HIGHEST ADR FOR FDB'S
	LSH P1,-^D9		;CONVERT ADDRESS TO PAGE #
	MOVE P2,MA		;GET DESIRED ADDRESS
	LSH P2,-^D9		;CONVERT ADDRESS TO A PAGE #
	SUB P1,P2		;COMPUTE # OF PAGES TO MAP-1
	ADDI P1,1		;COMPUTE # OF PAGES TO MAP
	CAIG P1,FDBPGS		;LESS THAN # OF MAPPING PAGES ?
	HRR T3,P1		;YES, USE LESSER # OF PAGES
	HRREI T4,-1(T3)		;SAVE # OF PAGES TO MAP-1
	PMAP			;MAP THE PAGES
	 ERJMP R		;FAILED
	MOVE P1,MA		;GET REQUIRED ADDRESS
	TRZ P1,777		;COMPUTE LOWEST ADDRESS MAPPED
	MOVEM P1,MAPBOT		;SAVE LOWEST ADDRESS MAPPED
	LSH P1,-^D9		;CONVERT LOWEST ADR TO PAGE #
	ADD P1,T4		;COMPUTE HIGHEST PAGE MAPPED
	LSH P1,^D9		;CONVERT PAGE # TO ADDRESS
	TRO P1,777		;COMPUTE HIGHEST ADR MAPPED
	MOVEM P1,MAPTOP		;SAVE HIGHEST ADR MAPPED
	MOVEI P1,MAPPGS		;GET ADDRESS OF MAPPED AREA
	HRRZ P2,T1		;GET PAGE # IN FILE
	LSH P2,^D9		;COMPUTE ADDRESS IN FILE
	SUB P1,P2		;COMPUTE MAPPED ADDRESS OFFSET
	MOVEM P1,FDBOFS		;SAVE OFFSET TO MAPPED ADDRESSES
	CALL RESACS		;GO RESTORE ALL THE AC'S
	RETSKP			;RETURN TO WHENCE WE CAME ...
; MAPSTB - ROUTINE TO MAP THE SYMBOL TABLE INTO THE ADDRESS
;	   SPACE OF THIS PROCESS.
;
; CALL:		[PAGE 0 OF DIRECTORY MUST BE MAPPED]
;		CALL MAPSTB
;		RETURN


MAPSTB:	HRLZ T1,DIRJFN		;GET JFN OF DIRECTORY FILE
	LOAD P1,DIRBOT		;GET START ADDRESS OF TABLE
	LSH P1,-^D9		;CONVERT ADDRESS TO PAGE #
	HRR T1,P1		;COPY PAGE # TO ARG AC FOR PMAP
	MOVSI T2,.FHSLF		;GET OUR FORK HANDLE
	MOVEI P1,SYMTAB		;GET ADDRESS TO MAP TABLE INTO
	LSH P1,-^D9		;CONVERT ADDRESS TO A PAGE #
	HRR T2,P1		;COPY PAGE # TO ARG AC FOR PMAP
	MOVX T3,<PM%CNT!PM%RD>	;MULTIPLE PAGES, READ
	LOAD P1,DIRBOT		;GET BOTTOM ADDRESS OF TABLE
	LOAD P2,DIRTOP		;GET TOP ADDRESS OF SYMBOL TABLE
	SUB P2,P1		;COMPUTE SIZE OF TABLE
	LSH P2,-^D9		;CONVERT # OF WORDS TO PAGES
	HRRI T3,1(P2)		;COPY # OF PAGES TO MAP
	PMAP			;MAP THE PAGES
	MOVEI P1,SYMTAB		;GET CORE ADR OF SYMBOL TABLE
	HRRZ P2,T1		;GET PAGE # IN DIRECTORY
	LSH P2,^D9		;CONVERT PAGE # TO ADDRESS
	SUB P1,P2		;COMPUTE REQUIRED OFFSET
	MOVEM P1,STBOFS		;SAVE OFFSET TO SYMBOL TABLE
	RET			;RETURN TO WHENCE WE CAME ...
; GETDIR - ROUTINE TO INPUT A DIRECTORY NAME, POSSIBLY WITH
;	   RECOGNITION.
;
; CALL:		CALL GETDIR
;		RETURN WITH DIRECTORY # IN CURDIR

GETDIr:	SAY (Directory file: )	;ASK FOR DIRECTORY NAME
	SETZM REPLY		;CLEAR FIRST WORD OF REPLY
	MOVE P1,[REPLY,,REPLY+1] ;GET SOURCE,,DESTINATION
	BLT P1,REPLY+REPSIZ-1	;CLEAR ENTIRE REPLY BUFFER
GTDJFN:	MOVE P1,[JFNBLK,,JFNBLK+1]  ;GET SOURCE,,DESTINATION
	SETZM JFNBLK		;CLEAR FIRST WORD OF GTJFN BLOCK
	BLT P1,JFNBLK+GJFSIZ-1	;CLEAR ENTIRE GTJFN BLOCK
	setzm jfnblk+.gjnam	;let user supply the name
	HRROI P1,[ASCIZ/ROOT-DIRECTORY/]
	MOVEM P1,JFNBLK+.GJDIR	;SAVE DIRECTORY
	HRROI P1,[ASCIZ/DIRECTORY/]  ;GET POINTER TO EXTENSION
	MOVEM P1,JFNBLK+.GJEXT	;STORE POINTER TO EXTENSION
	MOVX P1,GJ%old!gj%ifg	;GET old!gj%ifg FILE BIT
	MOVEM P1,JFNBLK+.GJGEN	;SAVE THE FLAGS
	movx P1,primry		;use primary input for name
	MOVEM P1,JFNBLK+.GJSRC	;STORE JFN'S
	MOVEI T1,JFNBLK		;GET POINTER TO GTJFN BLOCK
	SETZM T2		;NO MAIN STRING POINTER
	GTJFN			;GET A JFN FOR DIRECTORY FILE
	  CALL TYPERR		;UNEXPECTED ERROR
	MOVEM T1,DIRJFN		;SAVE DIRECTORY JFN
	MOVEM T1,DIRFLG		;SAVE FLAGS FOR GNJFN
	CALLRET OPNDIR		;GO OPEN THE DIRECTORY FILE
; OPNDIR - ROUTINE TO OPEN THE DIRECTORY FILE AND SET UP THE
;	   DIRECTORY NUMBER IN CURDIR.
;
; CALL:		CALL OPNDIR
;		RETURN WITH DIRECTORY FILE OPEN


OPNDIR:	HRRZ T1,DIRJFN		;GET JUST THE JFN
	MOVE T2,[440000,,202000] ;36 BIT BYTES, READ, THAWED
	OPENF			;OPEN THE FILE
	  CALL TYPERR		;UNEXPECTED ERROR
	SETZM NEXCNT		;INITIALIZE COUNT OF NEX FDB'S
	RET			;RETURN TO WHENCE WE CAME ...
; STRCMP - ROUTINE TO COMPARE TWO STRINGS
;
; CALL:		MOVE Q1,ADDRESS OF STRING 1
;		MOVE Q2,ADDRESS OF STRING 2
;		CALL STRCMP
;		RETURN WITH Q1:
;			-1 IF STRING 1 IS .LT. STRING 2
;			 0 IF STRING 1 IS .EQ. STRING 2
;			 1 IF STRING 1 IS .GT. STRING 2


STRCMP:	MOVEI P3,-1(Q1)		;GET ADR -1 OF STRING 2
	ANDI P3,777		;KEEP JUST LOW-ORDER PART
	ADDI P3,STRPG1		;FORM CORE ADDRESS OF STRING
	HRLI P3,(POINT 7,0,35)	;FORM POINTER TO STRING 1
	MOVEI P4,-1(Q2)		;GET ADR -1 OF STRING 2
	ANDI P4,777		;KEEP JUST THE LOW-ORDER PART
	ADDI P4,STRPG2		;FORM CORE ADDRESS OF STRING
	HRLI P4,(POINT 7,0,35)	;FORM POINTER TO STRING 2

	HRLZ T1,DIRJFN		;GET JFN OF DIRECTORY FILE
	MOVE P1,Q1		;GET ADDRESS DESIRED
	LSH P1,-^D9		;CONVERT ADDRESS TO A PAGE #
	HRR T1,P1		;GET FILE PAGE TO MAP
	MOVSI T2,.FHSLF		;GET OUR FORK HANDLE
	MOVEI P1,STRPG1		;GET ADDRESS OF CORE PAGE
	LSH P1,-^D9		;CONVERT ADDRESS TO PAGE #
	HRR T2,P1		;GET PAGE # IN CORE
	MOVX T3,PM%RD		;READ ACCESS ONLY
	PMAP			;MAP THE PAGE
	HRLZ T1,DIRJFN		;GET JFN OF DIRECTORY FILE
	MOVE P1,Q2		;GET ADDRESS DESIRED
	LSH P1,-^D9		;CONVERT ADDRESS TO A PAGE #
	HRR T1,P1		;GET FILE PAGE TO MAP
	MOVSI T2,.FHSLF		;GET OUR FORK HANDLE
	MOVEI P1,STRPG2		;GET ADDRESS OF CORE PAGE
	LSH P1,-^D9		;CONVERT ADDRESS TO PAGE #
	HRR T2,P1		;GET PAGE # IN CORE
	MOVX T3,PM%RD		;READ ACCESS ONLY
	PMAP			;MAP THE PAGE
STRCM1:	MAPTST Q1		;INSURE PAGE IS MAPPED
	ILDB P1,P3		;GET A CHARACTER FROM STRING 1
	JUMPE P1,STRCM2		;IF END-OF-STRING 1, CHECK FOR =
	MAPTST Q2		;INSURE THAT PAGE IS MAPPED
	ILDB P2,P4		;GET A CHARACTER FROM STRING 2
	CAIN P1,(P2)		;ARE THE CHARACTERS THE SAME ?
	JRST STRCM1		;YES, GO CHECK NEXT CHARACTERS
	SETOM Q1		;ASSUME STRING 1 .LT. STRING 2
	CAML P1,P2		;IS STRING 1 .LT. STRING 2 ?
	MOVEI Q1,1		;NO, STRING 1 .GT. STRING 2
	RET			;RETURN TO WHENCE WE CAME ... 

; HERE WHEN A MATCH OCCURRED

STRCM2:	MAPTST Q2		;INSURE THAT THE PAGE IS MAPPED
	ILDB P1,P4		;GET NEXT CHAR FROM STRING 2
	SETOM Q1		;ASSUME STRING 1 .LT. STRING 2
	SKIPN P1		;WAS THIS AN EXACT MATCH ?
	SETZM Q1		;YES, FLAG EXACT MATCH
	RET			;RETURN TO WHENCE WE CAME ...
;GTFILE - GET FILE NAME FOR THIS DIRECTORY AND GET A JFN ON IT
;
;ACCEPTS IN T1/	POINTER TO DIRECTORY SPEC
;	    T2/	DIRECTORY DESIGNATOR
;	CALL GTFILE
;RETURNS: +1	 FAILED
;	  +2	SUCCESS, WITH DIRJFN CONTAINING JFN OF DIRECTORY FILE

GTFILE:	TDZA T4,T4		;NOTE JFN WANTED
GTSTR:	SETOM T4		;NOTE STRING WANTED
	STKVAR <GTFPTR,GTFDIR,DOTPTR,BRKPTR,GTFFLG>
	MOVEM T1,GTFPTR		;SAVE POINTER TO DIRECTORY SPEC
	MOVEM T2,GTFDIR		;SAVE DIRECTORY DESIGNATOR
	MOVEM T4,GTFFLG		;SAVE FLAG

	SETZM DOTPTR		;INDICATE DOT NOT FOUND YET
	SETZM BRKPTR		;INDICATE BRACKET NOT FOUND YET
GTFIL1:	ILDB T2,T1		;GET NEXT CHARACTER IN STRING
	CAIN T2,"<"		;LEFT BRACKET?
	JRST [	MOVEM T1,BRKPTR	;YES. SAVE ITS POINTER
		JRST GTFIL1]	;GO GET NEXT CHARACTER
	CAIN T2,"."		;IS IT A DOT?
	JRST [	MOVEM T1,DOTPTR	;YES. SAVE ITS POINTER
		JRST GTFIL1]	;GO GET NEXT CHARACTER
	CAIE T2,">"		;IS IT A RIGHT BRACKET?
	JRST GTFIL1		;NO. GO GET NEXT CHARACTER
	SKIPN DOTPTR		;FOUND RIGHT BRACKET. HAVE WE SEEN A DOT?
	JRST GTFIL2		;NO. MUST BE IN <ROOT-DIRECTORY>

;HERE WHEN THIS IS A SUBDIRECTORY.  ;WE HAVE STR:<DIRECTORY.SUBDIRECTORY>.
;CONVERT TO STR:<DIRECTORY>SUBDIRECTORY.DIRECTORY

	DPB T2,DOTPTR		;REPLACE DOT WITH RIGHT BRACKET
	MOVEI T2,"."		;GET A DOT
	DPB T2,T1		;REPLACE RIGHT BRACKET WITH DOT
	HRROI T2,[ASCIZ/DIRECTORY/] ;T2/ SOURCE IS THIS STRING
	SETZ T3,		;T3/ STOP ON NULL
	SOUT			;FORM STR:<DIR>SUBDIR.DIRECTORY
	MOVE T2,GTFPTR		;GET POINTER TO DIRECTORY SPEC
	JRST GTFIL3		;GO GET JFN

;HERE WHEN DIRECTORY IS IN ROOT-DIRECTORY. FORM STR:<ROOT-DIRECTORY>DIR.DIRECTORY

GTFIL2:	HRROI T1,TMPSTR		;GET POINTER TO TEMPORARY STRING AREA
	HLRZ T2,GTFDIR		;GET STRUCTURE UNIQUE CODE
	HRLI T2,.DVDES		;FORM DEVICE DESIGNATOR
	DEVST			;GET STRING FOR STR
	 RET			;FAILED, RETURN FAILURE
	MOVX T2,":"		;GET STR PUNCTUATION
	IDPB T2,T1		;ADD STR PUNCTUATION
	HRROI T2,[ASCIZ/<ROOT-DIRECTORY>/]
	SETZM T3		;TERMINATE ON NULL
	SOUT			;ADD DIRECTORY TO STR STRING
	MOVE T2,BRKPTR		;POINT TO LEFT BRACKET
	MOVEI T3,^D40		;DIRECTORY NAME <=39 CHARACTERS
	MOVEI T4,">"		;STOP ON RIGHT BRACKET
	SOUT			;COPY DIRECTORY NAME
	SETOM T3		;BACK UP POINTER OVER THE BRACKET
	IBP T3,T1
	MOVEM T3,T1		;T1/ DESTINATION IS END OF DIRECTORY NAME
	HRROI T2,[ASCIZ/.DIRECTORY/] ;T2/ POINTER TO SOURCE
	SETZ T3,		;T3/ STOP ON NULL
	SOUT			;COPY ".DIRECTORY" TO END OF STRING
	HRROI T2,TMPSTR		;POINT TO START OF THIS STRING
	JRST GTFIL3		;GO GET JFN

;T2 POINTS TO FILE SPEC. GET A JFN ON THIS DIRECTORY FILE

GTFIL3:	SKIPE GTFFLG		;STRING WANTED ?
	RETSKP			;YES, RETURN STRING
	MOVX T1,GJ%PHY!GJ%SHT!GJ%OLD	;PHYSICAL ONLY, SHORT BLOCK
	GTJFN			;GET A JFN
	RET			;FAILED, RETURN ERROR
	HRRZM T1,DIRJFN		;SAVE JFN
	RETSKP			;DONE, RETURN
; ECHOFF - ROUTINE TO TURN OFF ECHOING FOR ESCAPES
;
; CALL:		CALL ECHOFF
;		RETURN


ECHOFF:	MOVEI T1,.PRIOU		;GET PRIMARY OUTPUT JFN
	RFCOC			;READ ECHOING BITS
	TRZ T3,3B19		;TURN OFF ESCAPE ECHOING
	SFCOC			;TELL MONITOR
	RET			;RETURN TO WHENCE WE CAME ...



; SAVACS - ROUTINE TO SAVE ALL 16 ACCUMULATORS.
;
; CALL:		CALL SAVACS
;		RETURN


SAVACS:	MOVEM 0,SAVE0		;SAVE ACCUMULATOR 0
	MOVE 0,[t1,,SAVET1]	;SET UP FOR BLT
	BLT 0,SAVET1+16		;SAVE NEXT 15 ACCUMULATORS
	RET			;RETURN TO WHENCE WE CAME ...



; RESACS - ROUTINE TO RESTORE ALL 16 ACCUMULATORS
;
; CALL:		CALL RESACS
;		RETURN


RESACS:	MOVE 0,[SAVET1,,T1]	;SET UP FOR BLT
	BLT 0,17		;RESTORE AC'S 1-17
	MOVE 0,SAVE0		;RESTORE AC 0
	RET			;RETURN TO WHENCE WE CAME ...
; TYPERR  - SUBROUTINE TO TYPE AN ERROR MESSAGE ON THE TERMINAL
;	   WHEN A JSYS GIVES AN ERROR RETURN.
;
; CALL:		CALL TYPERR
;		HALT THE PROCESS
;
; OR:		CALL PUTERR
;		RETURN
;
; PRESERVES ACCUMULATOR T1 - USES T2 AND T3


PUTERR:	SKIPA P1,[0]		;GET "RETURN TO CALLER" FLAG
TYPERR:	SETOM P1		;GET "STOP DEAD" FLAG
	MOVE P2,T1		;SAVE REGISTER T1
	HRROI T1,[ASCIZ/
? DIRTST: An unexpected error has occurred
/]
	PSOUT			;TYPE FIRST PART OF MESSAGE
	MOVEI T1,.CHTAB		;GET TAB CHARACTER
	PBOUT			;TYPE A TAB
	MOVEI T1,.PRIOU		;USE PRIMARY OUTPUT
	HRLOI T2,.FHSLF		;CURRENT FORK, LAST ERROR
	CLEAR T3,		;EXPAND PARAMETER VALUES
	ERSTR			;OUTPUT THE ERROR MESSAGE
	  JRST	TYPER1		;UNDEFINED ERROR NUMBER
	  JRST	TYPER2		;ERSTR ERROR
	CRLF
	MOVE T1,P2		;RESTORE REGISTER T1
	JUMPN P1,STOP		;GO STOP IF CALLED BY PUTERR
	RET			;  OR RETURN IF CALLED BY TYPERR

TYPER1:	HRROI T1,[ASCIZ/
? DIRTST: An unkown error has occurred
/]
	PSOUT			;TYPE THE MESSAGE
	MOVE T1,P2		;RESTORE REGISTER T1
	JUMPN P1,STOP		;GO STOP IF CALLED BY TYPERR
.POPJ:	RET			;  OR RETURN IF CALLED BY PUTERR
; HERE IF AN ERROR OCCURRED WHILE TYPING AN ERROR MESSAGE

TYPER2:	HRROI T1,[ASCIZ/
? DIRTST: Error occurred while typing an error message
/]
	PSOUT			;OUTPUT THE ERROR MESSAGE
	MOVE T1,P2		;RESTORE REGISTER T1
	JUMPE P1,.POPJ		;IF CALLED VIA PUTERR, RETURN
STOP:	HALTF			;HALT THIS PROCESS
	JRST STOP		;IN CASE OF CONTINUE
SUBTTL CONSTANT DATA

	.DIRECT FLBLST

HLPMSG:	ASCIZ /
FUNCTIONS

	DIRTST checks the format of directory files and reports any invalid
	or inconsistent data.

	DIRTST can verify the readability of files  by  "manually"  reading
	all of the pages in each file and performing  consistency checks on
	the files' page tables.

COMMANDS

	EXIT (TO MONITOR)
	HELP
	LIST (OUTPUT TO PRINTER)
	OUTPUT (TO FILE) File-specification
	TEST (DIRECTORY FILE) File-specification-of-directory-file
	TYPE (OUTPUT ON TERMINAL)
	VERIFY (FILES) File-specification

	LIST, OUTPUT, and TYPE affect  the  destination  of subsequent TEST
	or VERIFY commands.

EXAMPLES

	To test the consistency of directory PAYROL:<WEEKLY>,

	DIRTST>TEST (DIRECTORY FILE) PAYROL:<ROOT-DIRECTORY>WEEKLY.DIRECTORY


	To test the consistency of directory PS:<R.JONES>,

	DIRTST>TEST (DIRECTORY FILE) PS:<R>JONES.DIRECTORY


	To test the consistency of directory PS:<RESEARCH.PROJ3.SOURCES>,

	DIRTST>TEST (DIRECTORY FILE) PS:<RESEARCH.PROJ3>SOURCES.DIRECTORY


	To verify the readability of file STR:<LIBRARY>APPLICATION.EXE,

	DIRTST>VERIFY (FILES) STR:<LIBRARY>APPLICATION.EXE


	To verify the readability of all files in PS:<SYSTEM>,

	DIRTST>VERIFY (FILES) PS:<SYSTEM>*.*.*

RESTRICTIONS

	WHEEL or OPERATOR capability is required.
/
PDP:	IOWD PDLSIZ, PDL	;PUSH DOWN POINTER


; TABLE OF VALID BLOCK TYPES AND CHECKING ROUTINES


TYPTAB:	.TYFDB ,, CHKFDB
	.TYACT ,, CHKACT
	.TYNAM ,, CHKNAM
	.TYEXT ,, CHECKX
	.TYUNS ,, CHKUNS
	.TYSYM ,, R
	.TYDIR ,, R
	.TYFRE ,, R
	.TYLAC ,, R
	.TYGDB ,, R
	.TYFBT ,, R

	TYPSIZ== .-TYPTAB


; ENTRY VECTOR

ENTVEC:	JRST START
	JRST START
	VDIRTS

; PROMPT STRING

PROMPT:	ASCIZ /DIRTST>/

; COMMAND TABLE

CMDTAB:	CMDSIZ-1,,CMDSIZ-1

	XWD [ASCIZ/EXIT/], .EXIT
	XWD [ASCIZ/HELP/], .HELP
	XWD [ASCIZ/LIST/], .LIST
	XWD [ASCIZ/OUTPUT/], .OUTPT
	XWD [ASCIZ/TEST/], .TEST
	XWD [ASCIZ/TYPE/], .TYPE
	XWD [ASCIZ/VERIFY/], .VERFY

	CMDSIZ==.-CMDTAB


FDBLEN:	30		;VERSION 0 - LENGTH 30 OCTAL
	.FBLEN		;VERSION 1 - CURRENT LENGTH 37 OCTAL
OLDV1:	31		;VERSION 1 ALSO ALLOWS 31 OCTAL
SUBTTL	VARIABLE DATA STORAGE

DIRFDB:	FLD(.CMFIL,CM%FNC)+CM%DPP
	GJFBLK			;ADDRESS OF GTJFN BLOCK
	EXP 0
	EXP .-.			;DEFAULT POINTER, DIRECTORY COMMAND FILLS IN

PDL:	BLOCK PDLSIZ		;STACK
SAVE0:	BLOCK 1			;ACCUMULATOR 0 SAVED HERE
SAVET1:	BLOCK 17		;ACCUMULATORS 1-17 SAVED HERE
DIRBUF:	BLOCK ^D8		;NAME OF DIRECTORY TO TEST
CURNAM:	BLOCK ^D8		;DIRECTORY NAME BEING TESTED
TMPSTR:	BLOCK 50		;TEMPORARY STRING AREA
REPLY:	BLOCK REPSIZ		;BUFFER FOR USER REPLIES
LASTQ:	BLOCK 1			;POINTER TO LAST OUTPUT FOR ^R
OUTJFN:	BLOCK 1			;JFN FOR OUTPUT FILE
DIRJFN:	BLOCK 1			;JFN FOR DIRECTORY FILE
DIRFLG:	BLOCK 1			;FLAGS (AND JFN) FOR DIRECTORY
CURDIR:	BLOCK 1			;# OF DIRECTORY CURRENTLY MAPPED
STBOFS:	BLOCK 1			;ADDRESS OFFSET FOR SYMBOL TABLE
FDBOFS:	BLOCK 1			;ADDRESS OFFSET FOR FDB STORAGE
MAPBOT:	BLOCK 1			;LOWEST ADR MAPPED IN FDB AREA
MAPTOP:	BLOCK 1			;HIGHEST ADR MAPPED IN FDB AREA
JFNBLK:	BLOCK GJFSIZ		;GTJFN TABLE OF STRING POINTERS
INDENT:	BLOCK 1			;CURRENT # OF TABS TO INDENT
ERRCNT:	BLOCK 1			;NUMBER OF ERRORS DETECTED
NEXCNT:	BLOCK 1			; # OF FDB'S WITH FB%NEX ON
CMDBLK:	BLOCK .CMGJB+5		;COMMAND STATE BLOCK FOR COMND JSYS
BUFFER:	BLOCK BUFSIZ		;INPUT TEXT STORED HERE
ATMBFR:	BLOCK ATMSIZ		;ATOM BUFFER FOR COMND JSYS
GJFBLK:	BLOCK GJFSIZ		;GTJFN BLOCK FOR COMND JSYS
NUMDIR:	BLOCK 1			;DIRECTORY NUMBER
filarg:	block 3			;gtfdb words for verify function
strnam:	block 10		;structure name for verify function
lstdsk:	block 1			;last disk address read
NOIFDB:	BLOCK FDBSIZ		;FUNCTION DESCRIPTOR BLOCK FOR NOISE WORDS


; AREAS INTO WHICH PORTIONS OF THE DIRECTORY ARE MAPPED

	LOC DIRADR		;CHOOSE SOME HIGH ADDRESS,
				; OUT OF THE WAY OF THE PROGRAM


DIRPG0:	BLOCK PAGSIZ		;PAGE 0 OF THE DIRECTORY

MAPPGS:	BLOCK FDBPGS*PAGSIZ	;PAGES FOR MAPPING FDB'S

SYMTAB:	BLOCK STBPGS*PAGSIZ	;ENTIRE SYMBOL TABLE

STRPG1:	BLOCK PAGSIZ		;FIRST PAGE FOR STRING COMAPRES

STRPG2:	BLOCK PAGSIZ		;SECOND PAGE FOR STRING COMPARES

PTPAGE:	BLOCK PAGSIZ		;PAGE TO READ PAGE TABLES INTO
DATPAG:	BLOCK PAGSIZ		;PAGE TO READ DATA PAGES INTO
IDXPAG:	BLOCK PAGSIZ		;PAGE FOR XB'S

	RELOC

	END <3,,ENTVEC>