Google
 

Trailing-Edge - PDP-10 Archives - bb-k345a-sb - mondm4.mac
There are 7 other files named mondm4.mac in the archive. Click here to see a list.
	TITLE	MONDM4--DUMP USEFUL DATA FROM A 603 CRASH FILE
	SUBTTL	DEFINITIONS

	SEARCH	Q,MACTEN,UUOSYM
	SALL

;ACCUMULATORS
	F=0			;FLAGS
	T1=1			;TEMPORARIES
	T2=2
	T3=3
	T4=4
	T5=5
	T6=6
	P1=10			;PRESERVED
	P2=11
	P3=12
	P4=13
	P5=14
	CNT=15			;COUNTER (TEMPORARY AC)
	LVL=16			;SFD LEVEL
	P=17			;STACK POINTER

;I/O CHANNELS
	DSK=1			;FOR READING EXE FILE
	LPT=2			;FOR DUMPING DATA BASE

;FLAGS IN THE LEFT HALF OF AC F
	L.BHED==1B0		;SET IF HEADER TYPED FOR BIT TABLE CHECK
	L.MLST==1B3		;SET IF USER WANTS TO SPY ON MONITOR
	L.ACHK==1B4		;SET IF ONLY WANT TO ADDRESS CHECK
	L.DISK==1B5		;DUMP DISK DATA
	L.TTY==1B6		;DUMP TTY DATA
	L.NAME==1B7		;HAVE NAME
	L.PROJ==1B8		;HAVE PROJECT NUMBER
	L.ANY==1B9		;SAW ANYTHING
	L.NOPP==1B10		;DON'T TYPE DATA FOR THIS PPN
	L.NONM==1B11		;DON'T TYPE THIS NMB/AT
	L.OTTY==1B12		;OUTPUT TO TTY

;MACROS
	DEFINE ERROR(TEXT)
<	JRST [	OUTSTR	[ASCIZ	/?TEXT
/]
		JRST	BEGIN]>

;CONDITIONAL ASSEMBLY:
	ND	CSL,0		;NON-0 FOR CSL FEATURES

;*****POSSIBLE FUTURE IDEAS:
;1	ALLOW A PPN SUBSET FOR FILSER'S DATABASE, LIKE DATDMP
	SUBTTL	MONITOR DEPENDENT DEFINITIONS

;PPB OFFSETS
PPBNAM==0			;PPN
PPBSYS==1			;(LH) POINTER TO NEXT PPB, OR 0 IF LAST
PPBUFB==2			;(LH) POINTER TO FIRST UFB FOR THIS PPB
PPBNMB==3			;(LH) POINTER TO FIRST NMB FOR THIS PPB
PPBNLG==3			;BIT THAT MEANS A JOB IS LOGGED IN WITH THIS PPN
PPBCNT==4			;USE-COUNT
PPBKNO==5			;KNOW BIT WORD FOR UFDS
PPBYES==6			;YES BIT WORD FOR UFDS
PPBLOK==7			;UFD INTERLOCK BIT WORD

;UFB OFFSETS
UFBTAL==0			;BLOCKS FREE BEFORE FCFS+RESERVED QUOTA EXHAUSTED
UFBPPB==1			;(LH) POINTER TO NEXT UFB IN PPB, OR 0 IF LAST
UFBPRV==1			;PROTECTION OF UFD
UFBUN1==1			;BYTE WITH LOGICAL UNIT # WITHIN FILE STRUCTURE
UFB1PT==1			;BIT SET IF ONLY 1 RETRIEVAL POINTER FOR THIS UFD
UFBPT1==2			;FIRST RETRIEVAL POINTER TO UFD
UFBWRT==3			;# OF BLOCKS WRITTEN IN UFD ITSELF
UFBQTF==3			;FCFS QUOTA
UFBFSN==4			;FILE STRUCTURE NUMBER

;NMB OFFSETS
NMBNAM==0			;SIXBIT FILE NAME
NMBPPB==1			;ADDRESS OF NEXT NMB IN THIS UFB
NMBRNG==2			;POINTER TO NMB RING FOR THIS SFD
NMBCFP==2			;(RH) COPY OF COMPRESSED FILE POINTER
NMBACC==3			;(LH) POINTER TO ACCESS TABLES, OR TO SELF IF NONE
NMBEXT==3			;(RH) SIXBIT FILE EXTENSION
NMBFSN==4			;1ST FILE STRUCTURE FILE IS KNOWN TO BE ON
NMBKNO==5			;KNOW BIT WORD FOR FILE
NMBYES==6			;YES BIT WORD FOR FILE
NMBCNT==7			;NMB USE-COUNT

;ACC OFFSETS
ACCALC==0			;HIGHEST ALLOCATED BLOC (WITHOUT 2ND RIB)
ACCNMB==1			;(LH) POINTER TO NEXT ACC, OR SELF IF LAST
ACCABC==1			;BIT THAT SAYS THIS FILE ALWAYS HAS A BAD CHECKSUM
ACCLBS==1			;BYTE WITH # WORDS WRITTEN IN LAST BLOCK
ACC1PT==1			;BIT THAT IS SET IF ONLY 1 RETRIEVAL POINTER
ACCUN1==1			;BYTE WHICH IS FIRST LOGICAL UNIT IN FILE STRUCTURE
ACCDIR==1			;BIT SET IF THIS A DIRECTORY
ACCNDL==1			;BIT SET IF THIS FILE MAY NOT BE DELETED
ACCSBC==1			;SET IF THIS FILE SOMETIMES HAS A BAD CHECKSUM (UPDATE)
ACCPT1==2			;FIRST RETRIEVAL POINTER FOR FILE
ACCDOR==3			;(LH) NEXT DORMANT ACCESS TABLE.
				;(RH) PREVIOUS DORMANT ACCESS TABLE
ACCPPB==4			;(RH) POINTER TO PPB THIS ACC IS IN
ACCFSN==4			;BYTE WITH FILE STRUCTURE NUMBER
ACCWCT==4			;BYTE WITH WRITE COUNT FOR SIMULTANEOUS UPDATES
ACCADT==5			;ACCESS DATE
ACCNIU==5			;BIT THAT SAYS FILE NOT IN A UFD
ACCCNT==5			;COUNT OF USER CHANNELS THAT HAVE LOOKED UP FILE
ACCREN==5			;BIT THAT SAYS A RENAME IS IN PROGRESS FOR THIS FILE
ACCDEL==5			;BIT THAT MEANS DELETE FILE WHEN LAST READER CLOSES IT
ACCSTS==5			;ACCESS TABLE STATUS. 4=CREATE 2=SUPERSEDE 1=UPDATE
ACCSMU==5			;BIT THAT SAYS THIS FILE IS BEING SIMULTANEOUSLY UPDATED
ACCWRT==6			;HIGHEST BLOCK WRITTEN
ACCPRV==7			;FILE PROTECTION
ACCMOD==7			;MODE OF FILE
ACCCTM==7			;CREATION TIME
ACCCDT==7			;LOW PART OF CREATION DATE

;LDB OFFSETS
LDBDDB==0			;ADDRESS OF THIS LINES'S DDB
LDBBKU==1			;COPY OF LDBTIP AT LAST BREAK RECINT
LDBTIP==2			;TTY INPUT PUTTER
LDBTIT==3			;TTY INPUT TAKER
LDBTIC==4			;TTY INPUT COUNT
LDBBKC==5			;COUNT OF BREAK CHARS IN INPUT BUFFER
LDBTOP==6			;TTY OUTPUT PUTTER
LDBTOT==7			;TTY OUTPUT TAKER
LDBTOC==10			;TTY OUTPUT COUNT
LDBECT==11			;TTY ECHO TAKER
LDBECC==12			;TTY ECHO COUNT
LDBXNP==13			;XON POINTER
LDBFLP==14			;FILLER POINTER

LDBPBK==15			;PIM BREAK SET
LDBDCH==16			;DEVICE CHARACTERISTICS
LDBBYT==17			;VARIOUS BYTES
LDBBY2==20			;MORE BYTES
LDBPAG==21			;PAGE FLAGS
LDBISR==22			;INTERRUPT SERVICE ROUTINE
LDBREM==23			;5 WORDS FOR NETSER

IFN	CSL,<
LDBCSL==30			;CSL FLAGS
LDBTAB==31			;4 WORDS OF TABS
LDBOLK==35			;BUFFER LINKS

LDBLEN==36>			;LENGTH OF AN LDB

IFE	CSL,<
LDBLEN==33>			;LENGTH OF AN LDB
	SUBTTL	VARIABLES

	BEGLOW==.
TTCLST:	BLOCK	1		;# CHUNKS,,POINTER TO 1ST CHUNK
TTFREE:	BLOCK	1		;POINTER TO FREE CHUNKS
TTFREN:	BLOCK	1		;NUMBER OF FREE CHUNKS
LINPTR:	BLOCK	1		;-#LINES,,ADR OF LINTAB
CKADR:	BLOCK	1		;.TTCLST<0,18>
LWRDCN:	BLOCK	1		;.TTCLST<18,18>*4
LTBSIZ:	BLOCK	1		;SIZE OF BIT TABLE IN WORDS
CORNUM:	BLOCK	1		;NUMBER OF BLOCKS
SYSPPB:	BLOCK	1		;START OF CORE
SPPB:	BLOCK	1		;HAS LH(SYSPPB) IN ITS RH
SYSCOR:	BLOCK	1		;START OF FREE LIST
SYSDOR:	BLOCK	1		;DORMANT ACCESS TABLES
WRDCNT:	BLOCK	1		;.CORNUM*8
TABSIZ:	BLOCK	1		;SIZE OF BIT TABLE IN WORDS
CORPNT:	BLOCK	1		;POINTER TO AREA IN CORE WHERE INFO IS
BITTAB:	BLOCK	1		;POINTER TO BIT TABLE OF 8 WORD BLOCKS
DIRPNT:	BLOCK	1		;POINTER TO IN-CORE COPY OF FILE DIRECTORY
COROFF:	BLOCK	1		;OFFSET BETWEEN FILE ADDRESSES AND CORE ADDRESSES
LCRPNT:	BLOCK	1		;POINTER TO LINE DATA
LINTAB:	BLOCK	1		;POINTER TO TABLE OF LINE ADDRESSES
LBITTB:	BLOCK	1		;POINTER TO BIT TABLE FOR CHUNKS
LCOROF:	BLOCK	1		;TTY OFFSET BETWEEN FILE AND CORE
;WORK AREA
DBLOCK:	BLOCK	200		;WHERE DISK BLOCKS ARE READ INTO
TEMP:	BLOCK	1		;TEMPORARY VARIABLE
LPTOUT:	BLOCK	3		;LPT OUTPUT BUFFER HEADER
FRECNT:	BLOCK	1		;COUNT OF FREE BLOCKS
DORCNT:	BLOCK	1		;COUNT OF DORMANT ACCESS TABLES
TEMP1:	BLOCK	1		;ANOTHER TEMPORARY
LSTBLK:	BLOCK	1		;DISK BLOCK CURRENTLY IN DBLOCK
ONELIN:	BLOCK	1		;SINGLE LINE TO REPORT ON
NAME:	BLOCK	1		;PARTICULAR NAME (DSK DATA)
EXT:	BLOCK	1		;EXT WE'RE LOOKING FOR
PROJ:	BLOCK	1		;THE PROJECT NUMBER
PROG:	BLOCK	1		;PROGRAMMER NUMBER
;***DO NOT SEPERATE THE FOLLOWING LABELS!
IDEV:	BLOCK	3		;INPUT DEVICE OPEN BLOCK
IFILE:	BLOCK	4		;INPUT LOOKUP BLOCK
ODEV:	BLOCK	3		;OUTPUT DEVICE OPEN BLOCK
OFILE:	BLOCK	4		;OUTPUT DEVICE ENTER BLOCK
;***END OF DO NOT SEPARATE
PLIST:	BLOCK	60		;STACK
	ENDLOW==.-1		;END OF NORMAL VARIABLES
	SUBTTL	INITIALIZATION

BEGIN:	JFCL			;NO CCL
	START	60,PLIST	;SET UP STACK
	SETZB	F,BEGLOW	;CLEAR FLAGS AND START OF CORE AREA
	MOVE	T1,[BEGLOW,,BEGLOW+1]	;BLT POINTER
	BLT	T1,ENDLOW	;TO END OF LOW SEG
	HLRZ	T1,.JBSA##	;GET INITIAL .JBFF
	MOVEM	T1,.JBFF##	;AND RESET IT
	MOVE	T1,['CRASH ']	;DEFAULT INPUT FILE IS XPN:CRASH.EXE
	MOVEM	T1,IFILE	;SO, SET UP THE DEFAULTS
	MOVSI	T1,'EXE'
	MOVEM	T1,IFILE+1
	SETZM	IFILE+2
	SETZM	IFILE+3
	MOVEI	T1,17
	MOVEM	T1,IDEV
	MOVSI	T1,'XPN'
	MOVEM	T1,IDEV+1
	MOVE	T1,['MONDMP']	;DEFAULT OUTPUT IS DSK:MONDMP.TXT
	MOVEM	T1,OFILE
	MOVSI	T1,'TXT'
	MOVEM	T1,OFILE+1
	SETZM	OFILE+2
	SETZM	OFILE+3
	SETZM	ODEV
	MOVSI	T1,'TTY'
	MOVEM	T1,ODEV+1
	MOVSI	T1,LPTOUT
	MOVEM	T1,ODEV+2
	PUSHJ	P,SCAN		;GET COMMAND LINE
	OPEN	LPT,ODEV	;GET THE OUTPUT DEVICE
	  ERROR	<Cannot OPEN output device>
	MOVS	T1,ODEV+1
	CAIN	T1,'TTY'	;IF OUTPUT IS TO TTY
	TXOA	F,L.OTTY	; LIGHT A BIT IN F
	TXZ	F,L.OTTY
	ENTER	LPT,OFILE	;ENTER THE FILE
	  ERROR	<Cannot ENTER output file>
	TXNE	F,L.MLST	;DID HE SAY /M?
	JRST	DODUMP		;YES--DON'T OPEN INPUT DEVICE.
	OPEN	DSK,IDEV	;OPEN THE INPUT DEVICE!
	  ERROR	<Can't open input device>
	LOOKUP	DSK,IFILE	;FIND THE FILE!
	  ERROR	<Can't lookup input file>
	PUSHJ	P,REDDIR	;READ DIRECTORY
	PUSHJ	P,REDGET	;READ GETTABS FROM FILE
	PUSHJ	P,REDDAT	;READ DATA BLOCK
	PUSHJ	P,BITSET	;ALLOCATE BIT TABLE
DODUMP:	PUSHJ	P,DUMP		;DUMP DATA BASE
	JRST	BEGIN		;NO
	SUBTTL	SCAN SUBROUTINES

SCAN:	OUTCHR	["*"]		;PROMPT
	SETOM	ONELIN		;ASSUME REPORT ON ALL LINES
	MOVEI	P1,ODEV		;POINT TO BLOCK FOR OUTPUT DEVICE
	CALL	ASKFIL		;GET FILE SPEC
	CAIE	T2,"="		;FOLLOWED BY = ?
	JRST	SCNSWT		;NO--SCAN SWITCHES
	MOVEI	P1,IDEV		;POINT TO INPUT DEVICE
	CALL	ASKFIL		;GET SPEC FROM USER
	TXO	F,L.ANY		;CANT USE SHORT FORM
	CAIN	T2,"]"		;LAST THING A PPN ON OUTPUT FILE?
	ASKSXB			;YES, STEP TO NEXT FIELD
SCNSWT:	CAIE	T2,"/"		;ANY SWITCHES?
	JRST	ENDSWT		;NO
	ASKSXB
	MOVE	T3,[-SWTLEN,,SWTTAB]
	MATCH
	  ERROR	<Unrecognized or ambiguous switch>
	XCT	SWTDSP(T3)	;HANDLE THE SWITCH
	TXO	F,L.ANY		;CANT USE SHORT FORM
	JRST	SCNSWT		;AND GET ANOTHER
ENDSWT:	TXNE	F,L.ANY		;SAW ANYTHING BEFORE TEXT?
	JRST	ANYTHG		;YES
	TXO	F,L.MLST	;DUMP MONITOR IF NO INPUT FILE, NO SWITCHES
	CAIN	T2,"("		;DON'T REQUIRE PARENS
	JRST	ANYTHG		;FIGURE WHAT TO DO IF "(" NEXT
	MOVE	T3,[SIXBIT /MONDMP/]
	CAME	T3,OFILE
	CAMN	T1,OFILE	;NAME MIGHT HAVE BEEN GOBBLED BY OUT-FILE TOUTINE
	JRST	RDSPEC		;JUST NAME SO FAR - STORE IT
	MOVE	T3,OFILE	;EXT - PICK UP NAME
	MOVEM	T3,NAME
	TXO	F,L.NAME	;INDICATE WE SAW A NAME - T1 HAS EXT
	JRST	RDSPEC
ANYTHG:	CAIE	T2,"("		;PARTICULAR DSK NAME, EXT, ETC?
	JRST	NOTWCH		;NO, DO ALL
WHLOOP:	ASKSXB			;GET NAME OR EXT
RDSPEC:	CAIN	T2,"*"
	JRST	WHLOOP		;* IS SAME AS BLANK FIELD
	TXOE	F,L.NAME
	JRST	NOTNAM
	MOVEM	T1,NAME		;NAME WE'RE LOOKING FOR
	CAIN	T2,"["		;PPN WITH NO EXT?
	JRST	PPLOOP		;YES
	JRST	WHLOOP
NOTNAM:	MOVEM	T1,EXT		;EXTENSION WE'RE LOOKING FOR
	TXNN	F,L.MLST	;IF READING FROM DISK
	TDZA	T1,T1		; LIST ALL PPNS
	GETPPN	T1,		;/MON - IF NO PPN TYPED
	HLRM	T1,PROJ		; LIST ONLY FILES IN USERS PPN
	HRRM	T1,PROG
	CAIE	T2,"["
	JRST	NOTWCH
PPLOOP:	ASKOCT
	TXOE	F,L.PROJ
	JRST	HAVPRG
	MOVEM	T1,PROJ
	JRST	PPLOOP		;STORE PROJECT, GET PROG
HAVPRG:	MOVEM	T1,PROG		;STORE PROG NUMBER
NOTWCH:	TXNN	F,L.DISK!L.TTY	;ANYTHING TO DO?
	TXO	F,L.DISK	;NO--ASSUME DISK STUFF
	CLEAR			;CLEAR TO EOL
	POPJ	P,		;RETURN

SWTTAB:	SIXBIT	/DISK/
	SIXBIT	/TTY/
	SIXBIT	/LINE/
	SIXBIT	/MONITO/
	SWTLEN==.-SWTTAB

SWTDSP:	TXO	F,L.DISK
	TXO	F,L.TTY
	PUSHJ	P,GETLNO
	TXO	F,L.MLST

GETLNO:	SETOM	ONELIN		;ASSUME ALL LINES
	CAIE	T2,":"		;ARG?
	POPJ	P,		;NO
	ASKOCT
	SKIPE	T3		;ANYTHING THERE?
	MOVEM	T1,ONELIN	;YES--STORE LINE NUMBER
	POPJ	P,
ASKFIL:	ASKSXB			;GET A SIXBIT WORD
	CAIN	T2,32
	EXIT			;EXIT IF ^Z TYPED
	JUMPE	T3,NOTEXT	;IF NO CHARS READ, NOT A FILE NAME
	CAIE	T2,":"		;DELIMITER A COLON?
	JRST	NOTDEV		;NO--NOT A DEVICE
	MOVEM	T1,1(P1)	;YES--STORE DEVICE
	JRST	ASKFIL		;LOOP BACK
NOTDEV:	MOVEM	T1,3(P1)	;MUST BE A FILE NAME
	CAIE	T2,"."		;DELIMITER A .?
	JRST	NOTEXT		;NO
	ASKSXB			;YES--GET IT
	HLLZM	T1,4(P1)	;AND STORE IT
NOTEXT:	CAIE	T2,"["		;PPN FOLLOW?
	POPJ	P,		;NO
	ASKOCT			;YES--GET PROJECT
	HRLZ	P2,T1		;STORE PROJECT
	CAIE	T2,","		;DELIMITER A COMMA?
	POPJ	P,		;NO
	ASKOCT			;YES--GET PROGRAMMER
	HRR	P2,T1		;AND STORE IT
	CAIE	T2,"]"		;DELIMITER A ]?
	POPJ	P,		;NO
	MOVEM	P2,6(P1)	;STORE PPN
	POPJ	P,		;AND RETURN
	SUBTTL	ROUTINE TO READ THE BLOCK NUMBER IN T1

;REDBLK READS THE BLOCK NUMBER IN T1 OF THE FILE OPEN ON DSK, INTO DBLOCK
REDBLK:	CAMN	T1,LSTBLK	;IS THIS BLOCK CURRENTLY IN DBLOCK?
	JRST	.POPJ1		;YES--RETURN NOW
	USETI	DSK,(T1)	;TELL MONITOR WHAT BLOCK TO GET
	MOVE	T2,[-200,,DBLOCK-1]	;WHERE TO GET IT
	SETZ	T3,		;DUMP MODE
	IN	DSK,T2		;READ IT!
	  JRST	STOBLK		;SUCCESS! GIVE SKIP RETURN
TYPERR:	GETSTS	DSK,T2		;GET ERROR STATUS
	TXNE	T2,IO.EOF	;END OF FILE?
	JRST	BLKEOF		;YES--WHY?
	TYPE	<?I/O ERROR, STATUS = >
	TYPOCT	T2		;AND TYPE STATUS
TYPBLK:	SKIPE	T1		;BLOCK 0?
	JRST	NOTDIR		;NO--NORMAL BLOCK
	TYPE	< reading directory.>
	PJRST	TCRLF		;TYPE A CRLF AND RETURN
NOTDIR:	TYPE	< READING BLOCK >
	TYPDEC	T1		;TYPE BLOCK NUMBER
TCRLF:	CRLF
	POPJ	P,		;RETURN NOW

BLKEOF:	TYPE	<?UNEXPECTED END OF FILE>
	JRST	TYPBLK		;TYPE BLOCK NUMBER

STOBLK:	MOVEM	T1,LSTBLK	;STORE THIS BLOCK #
	JRST	.POPJ1		;AND GIVE A SKIP RETURN
	SUBTTL	ROUTINE TO READ THE FILE DIRECTORY INTO CORE

;REDDIR READS THE FILE DIRECTORY INTO CORE AND LEAVES POINTER TO IT IN DIRPNT.
REDDIR:	MOVEI	T1,1		;START WITH BLOCK 1
	PUSHJ	P,REDBLK	;READ IT
	  ERROR	<Cannot read directory>
	HLRZ	T1,DBLOCK	;GET EXE CODE
	CAIE	T1,1776		;GOOD EXE FILE?
	  ERROR	<Not an EXE file>
	HRRZ	T4,DBLOCK	;GET DIRECTORY SIZE
	AOS	T4		;INCLUDE HEADER WORD
	HRRZ	T1,.JBFF##	;GET FIRST FREE LOC IN LOW-SEG
	MOVEM	T1,DIRPNT	;THATS WHERE THE DIRECTORY WILL GO
	ADDI	T1,(T4)		;ADD IN DIRECTORY SIZE
	MOVEM	T1,.JBFF##	;UPDATE FIRST FREE
	SOS	T1		;POINT TO END WORD
	CAMG	T1,.JBREL##	;DO WE HAVE THE CORE?
	JRST	HAVCOR		;YES
	CORE	T1,		;NO--GET IT
	  ERROR	<No core to read directory>
HAVCOR:	HRRZ	T1,DIRPNT	;GET WHERE DIRECTORY GOES AGAIN
	HRLI	T1,DBLOCK	;AND WHERE IT IS
	MOVEI	T3,-1(T4)	;GET DIRECTORY SIZE
	CAILE	T3,177		;BIGGER THAN 177?
	MOVEI	T3,177		;YES.
	ADD	T3,DIRPNT	;ADD IN OFFSET
	BLT	T1,(T3)		;TRANSFER THE WORDS!
	SUBI	T4,200		;DECREASE WORD COUNT
	JUMPLE	T4,.POPJ	;RETURN IF DONE
	MOVN	T1,T4		;NEGATIVE REMAINING WORD COUNT
	HRLZS	T1		;IN LEFT HALF
	HRR	T1,DIRPNT	;WHERE WORDS ARE
	ADDI	T1,177		;ONE BEFORE START
	SETZ	T2,		;CLEAR 2ND WORD OF DUMP LIST
	IN	DSK,T1		;READ THE REST OF THE DIRECTORY
	  POPJ	P,		;GOOD--RETURN
	SETZ	T1,		;FAKE FOR TYPERR
	JRST	TYPERR		;REPORT PROBLEM
	SUBTTL	ROUTINE TO DO GETTABS FROM A CRASH

REDGET:	MOVEI	P3,410		;ABSOLUTE 410 HAS ADDRESS OF .GTSLF
	PUSHJ	P,GETWRD	;GET IT
	  JRST	GETERR
	HRRZ	P5,T2		;SAVE ABSTAB ADR IN P5
	PUSHJ	P,DSKGET	;READ DISK GETTABS
	PUSHJ	P,TTYGET	;AND TTY GETTABS
	POPJ	P,		;RETURN
DSKGET:	TXNN	F,L.DISK	;DUMPING DISK DATA?
	POPJ	P,		;NO
	HRRZ	P3,P5		;GET ABSTAB
	ADDI	P3,.GTLVD	;WHICH TABLE
	PUSHJ	P,GETWRD	;GET THE WORD
	  JRST	GETERR
	MOVE	P4,T2		;SAVE START OF LEVELD TABLE
	MOVEI	P3,5(P4)	;SAVE FOR LATER
	PUSHJ	P,GETWRD	;GET SYSPPB
	  JRST	GETERR		;NO?
	MOVEM	T2,SYSPPB
	HLRZM	T2,SPPB		;STORE THE LH(SYSPPB) FOR ADD/SUB
	MOVEI	P3,11(P4)	;POINTER TO CORNUM
	PUSHJ	P,GETWRD	;READ CORNUM
	  JRST	GETERR
	MOVEM	T2,CORNUM
	MOVEI	P3,76(P4)	;GET ADDRESS OF FREE LIST HEADER
	PUSHJ	P,GETWRD	;GET SYSCOR
	  JRST	GETERR
	MOVEM	T2,SYSCOR	;AND STORE POINTER
	MOVEI	P3,75(P4)	;GET ADDRESS OF FREE LIST HEADER
	PUSHJ	P,GETWRD
	  JRST	GETERR
	MOVEM	T2,SYSDOR	;AND STORE POINTER
	POPJ	P,		;RETURN
TTYGET:	TXNN	F,L.TTY		;DUMPING TTY DATA?
	POPJ	P,		;RETURN
	HRRZ	P3,P5		;GET ABSTAB AGAIN
	ADDI	P3,.GTCNF	;WHICH TABLE
	PUSHJ	P,GETWRD	;GET THE WORD!
	  JRST	GETERR		;NO?
	MOVE	P4,T2		;SAVE START OF CONFIG TABLE
	MOVEI	P3,27(P4)	;P3 IS ADDRESS OF CONFIG TABLE+27
	PUSHJ	P,GETWRD	;GET THE WORD!
	  JRST	GETERR
	MOVEM	T2,TTFREE
	MOVEI	P3,30(P4)	;POINT TO TTCLST
	PUSHJ	P,GETWRD
	  JRST	GETERR
	MOVEM	T2,TTCLST
	HRRZM	T2,CKADR
	MOVEI	P3,31(P4)	;POINT TO TTFREN
	PUSHJ	P,GETWRD
	  JRST	GETERR
	MOVEM	T2,TTFREN
	MOVEI	P3,33(P4)	;POINT TO LINPTR
	PUSHJ	P,GETWRD
	  JRST	GETERR
	MOVEM	T2,LINPTR
	POPJ	P,		;RETURN
GETWRD:	MOVE	T3,P3		;GET ADDRESS
	PUSHJ	P,FNDPAG	;WHAT DISK PAGE IS IT ON?
	  POPJ	P,		;NONE?
	PUSHJ	P,REDBLK	;READ THE BLOCK, IF NECESSARY
	  POPJ	P,		;NONE?
	LDB	T2,[POINT 7,P3,35]	;GET BLOCK OFFSET
	MOVE	T2,DBLOCK(T2)	;PICK UP THE WORD
	JRST	.POPJ1		;AND GIVE A GOOD RETURN

GETERR:	ERROR	<Cannot read GETTABS>
	SUBTTL	ROUTINE TO READ DATA BASE INTO CORE

;REDDAT READS THE DATA BASE INTO CORE AND LEAVES POINTER IN LCRPNT
REDDAT:	TXNN	F,L.DISK	;GETTING DISK DATA?
	JRST	GTTY		;NO
	MOVE	P2,CORNUM	;YES--GET NUMBER OF BLOCKS
	LSH	P2,3		;TIMES 8
	MOVEM	P2,WRDCNT	;STORE FOR LATER
	HLRZ	P1,SYSPPB	;GET WHERE IT IS IN THE FILE
	PUSHJ	P,RDATA		;AND GET IT!
	MOVEM	P1,CORPNT	;STORE ADDRESS
GTTY:	TXNN	F,L.TTY		;GETTING TTY DATA?
	POPJ	P,		;NO--RETURN
	HLRZ	P2,TTCLST	;GET NUMBER OF 4 WORD BLOCKS
	LSH	P2,2		;CONVERT TO NUMBER OF WORDS
	MOVEM	P2,LWRDCN	;AND STORE FOR LATER
	HRRZ	P1,TTCLST	;GET FIRST DATA ADDRESS
	PUSHJ	P,RDATA		;READ A DATA BLOCK!
	MOVEM	P1,LCRPNT	;STORE IT'S ADDRESS
	HLRE	P2,LINPTR	;GET # OF LINES
	MOVNS	P2		;THATS HOW MANY WORDS TO ALLOCATE
	HRRZ	P1,LINPTR	;P1 IS WHERE THEY ARE AT
	PUSHJ	P,RDATA		;READ LINTAB!
	MOVEM	P1,LINTAB	;AND STORE A POINTER TO IT
	MOVE	P5,LINPTR	;GET AN AOBJN POINTER
	HRR	P5,LINTAB	;POINT INTO OUR OWN CORE
LINLOP:	HRRZ	P1,(P5)		;GET THE ADDRESS OF AN LDB
	MOVEI	P2,LDBLEN	;GET ENTIRE LDB
	PUSHJ	P,RDATA		;READ THE LDB!
	HRRM	P1,(P5)		;STORE REAL ADDRESS OF LDB
	AOBJN	P5,LINLOP	;LOOP FOR ALL LINES
	POPJ	P,		;AND RETURN
RDATA:	MOVE	T3,P1		;GET START OF PAGE
	CAILE	T3,452000	;IN MONITOR'S HI SEG?
	JRST	HIPAGE		;YES, DO IT DIFFERENTLY
RDATA1:	TRZ	T3,177		;POINT TO FIRST ADR ON PAGE
	MOVE	P3,T3		;SAVE ADDRESS IN P3
	SUB	T3,P1		;GET NEGATIVE OFFSET OF DATA-BASE TO START OF PAGE
	MOVE	P4,P2		;PUT COUNT IN P4
	SUB	P4,T3		;INCREASE WORD COUNT TO GET THOSE WORDS
	HRRZ	T2,.JBFF##	;GET END OF CORE
	PUSH	P,T2		;SAVE START OF DATA AREA
	MOVEM	T2,TEMP		;AND INITIALIZE LOOP
	ADD	T2,P4		;ADD NUMBER OF WORDS IN DATA BASE
	MOVEM	T2,.JBFF##	;RESET FIRST FREE
	SOS	T2		;POINT TO LAST WORD OF AREA IN CORE
	CAMG	T2,.JBREL##	;DO WE HAVE THE CORE?
	JRST	HAVCR1		;YES
	CORE	T2,		;GET IT
	  ERROR	<No core to read data base.>
HAVCR1:	MOVE	T3,P1		;GET FIRST ADDRESS
PLOOP:	PUSHJ	P,FNDPAG	;FIND FILE BLOCK OF START OF AREA
	  ERROR	<Data base not in file.>
	MOVEM	T1,TEMP1	;SAVE BLOCK NUMBER
	USETI	DSK,(T1)	;POSITION FILE
	MOVE	T2,TEMP		;GET CORE ADDRESS TO READ INTO
	MOVE	T1,P4		;WORDS LEFT TO READ
	CAILE	T1,1000		;MORE THAN A PAGE?
	MOVEI	T1,1000		;YES--READ ONE PAGE AT A TIME
	ADDM	T1,TEMP		;UPDATE NEXT CORE ADDRESS
	MOVNS	T1		;MAKE NEGATIVE
	HRLZS	T1		;IN LEFT HALF
	HRRI	T1,-1(T2)	;1 BEFORE WHERE TO READ PAGE TO
	SETZ	T2,		;MAKE INTO A GOOD COMMAND LIST
	IN	DSK,T1		;READ THE PAGE!
	  JRST	GRET		;GOOD
	MOVE	T1,TEMP1	;RESTORE BLOCK NUMBER
	JRST	TYPERR		;AND REPORT PROBLEM
GRET:	SUBI	P4,1000		;DECREASE WORD COUNT
	JUMPLE	P4,MOVDAT	;DONE, SO RETURN
	ADDI	P3,1000		;INCREASE ADDRESS
	MOVE	T3,P3		;STORE WHERE EXPECTED
	JRST	PLOOP		;AND REPEAT
MOVDAT:	MOVE	T3,P1		;GET DATA ADDRESS
	TRZ	T3,177		;POINT TO START OF PAGE
	SUB	T3,P1		;GET NEGATIVE OFFSET
	POP	P,P1		;RESTORE START OF DATA
	JUMPE	T3,.POPJ	;DONE, IF 0
	ADDM	T3,.JBFF##	;MOVE DOWN FIRST FREE
	HRRZ	T1,P1		;GET WHERE THE WORD BLOCK IS
	SUB	T1,T3		;POINT TO ACTUAL FIRST DATA WORD
	HRLZS	T1		;PUT THAT IN THE LEFT HALF
	HRR	T1,P1		;PUT WHERE TO MOVE TO IN THE RIGHT HALF
	HRRZ	T2,P2		;GET NUMBER OF WORDS IN T2
	ADD	T2,P1		;ADD IN POINTER
	BLT	T1,-1(T2)	;AND MOVE THE WHOLE BLOCK!
	POPJ	P,		;RETURN NOW

;HERE TO READ A HIGH SEGMENT PAGE
HIPAGE:	ANDI	T3,777000
	LSH	T3,-12
	ADDI	T3,1000		;UPMP IS AT 1000 (KL10 ONLY)
	PUSH	P,P1
	PUSH	P,P2
	MOVE	P1,T3
	MOVEI	P2,1
	PUSHJ	P,RDATA
	MOVE	T2,(P1)
	POP	P,P2
	POP	P,P1
	TRNN	P1,1000
	HLRZS	T2
	ANDI	T2,7777
	LSH	T2,11
	ANDI	P1,777
	IOR	P1,T2
	MOVE	T3,T2
	JRST	RDATA1
	SUBTTL	ROUTINE TO CONVERT CORE WORD ADR TO FILE BLOCK #

;FNDPAG ACCEPTS A CORE PAGE NUMBER IN T3 AND RETURNS A FILE BLOCK NUMBER IN T1.
;DIRECTORY @DIRPNT.  SKIP RETURN IF SUCCESS.  USES ONLY T1, T2, T6, AND CNT.
FNDPAG:	HRRZ	T1,DIRPNT	;POINT TO IN-CORE DIRECTORY
	HRRZ	CNT,(T1)	;GET WORD COUNT IN CNT
	AOS	T1		;POINT TO FIRST ENTRY
	MOVE	T6,T3		;COPY WORD ADDRESS TO T6
	ANDI	T6,777		;MASK TO A PAGE
	LSH	T6,-7		;AND CONVERT TO BLOCK
	LSH	T3,-^D9		;CONVERT ORIGINAL ADDRESS TO BLOCK NUMBER
FLOOP:	LDB	T2,[POINT 27,1(T1),35]	;GET CORE PAGE NUMBER FROM DIRECTORY ENTRY
	CAMLE	T2,T3		;PAST DESIRED CORE PAGE?
	POPJ	P,		;YES--PAGE NOT IN FILE
	PUSH	P,T2		;NO--SAVE CORE PAGE NUMBER
	LDB	T2,[POINT 9,1(T1),8]	;GET REPEAT COUNT
	ADD	T2,0(P)		;ADD IN FIRST PAGE FOR THIS ENTRY
	CAML	T2,T3		;THIS POINTER INCLUDE THE PAGE?
	JRST	INPNTR		;YES
	POP	P,T2		;RESTORE STACK
	SUBI	CNT,2		;NO--DECREASE WORD COUNT
	CAIGE	CNT,2		;IS THERE ANOTHER ENTRY?
	POPJ	P,		;NO--RAN OUT OF DIRECTORY
	ADDI	T1,2		;POINT TO NEXT ENTRY
	JRST	FLOOP		;AND TRY AGAIN
INPNTR:	POP	P,T2		;RESTORE FIRST PAGE FOR THIS ENTRY
	SUB	T2,T3		;GET -DIFFERENCE BETWEEN 1ST PAGE AND DESIRED PAGE
	MOVMS	T2		;MAKE IT POSITIVE
	LDB	T1,[POINT 27,0(T1),35]	;PICK UP FILE PAGE NUMBER
	ADD	T1,T2		;ADD IN OFFSET
	LSH	T1,2		;CONVERT PAGES TO BLOCKS
	ADDI	T1,1(T6)	;(BUT NOT BLOCK 0) & INCLUDE WORD OFFSET
.POPJ1:	AOS	(P)		;SKIP RETURN
.POPJ:	POPJ	P,
	SUBTTL	ROUTINE TO ALLOCATE STORAGE FOR THE BIT TABLE

;BITSET ALLOCATES ENOUGH WORDS FOR THE BIT TABLE
BITSET:	TXNN	F,L.DISK	;DISK DATA?
	JRST	BITTTY		;NO
	MOVE	T1,CORNUM	;HOW MANY 8 WORD BLOCKS
	ADDI	T1,^D35		;ADD IN OFFSET
	IDIVI	T1,^D36		;NOW T1 HAS NUMBER OF WORDS NEEDED
	MOVEM	T1,TABSIZ	;SAVE FOR LATER
	MOVE	T2,.JBFF##	;GET FIRST FREE
	MOVEM	T2,BITTAB	;STORE POINTER
	ADDM	T1,.JBFF##	;UPDATE FIRST FREE
	ADDI	T2,-1(T1)	;POINT TO LAST WORD NEEDED
	CAMG	T2,.JBREL##	;HAVE ENOUGH CORE?
	JRST	BITTTY
	CORE	T2,		;NO--GET IT
	  ERROR	<No core for DSK bit table>
BITTTY:	TXNN	F,L.TTY		;TTY DATA?
	POPJ	P,		;AND RETURN
	HLRZ	T1,TTCLST	;HOW MANY 4 WORD BLOCKS
	MOVEM	T1,LTBSIZ	;SAVE FOR LATER
	MOVE	T2,.JBFF##	;GET FIRST FREE
	MOVEM	T2,LBITTB	;STORE POINTER
	ADDM	T1,.JBFF##	;UPDATE FIRST FREE
	ADDI	T2,-1(T1)	;POINT TO LAST WORD NEEDED
	CAMG	T2,.JBREL##	;HAVE ENOUGH CORE?
	POPJ	P,		;YES
	CORE	T2,		;NO--GET IT
	  ERROR	<No core for TTY bit table>
	POPJ	P,
	SUBTTL	ROUTINE TO DUMP DATA BASE FROM CORE

DUMP:	TXNE	F,L.MLST	;WANT TO SPY ON MONITOR
	PUSHJ	P,SPYSET	;YES--SET UP DATA BASE
	PUSHJ	P,INIDMP	;PERFORM INITIALIZATION
	PUSH	P,.JBFF##	;SAVE .JBFF SO CAN RECLAIM BUFFERS
	SETOVR	(\LPT,LPTOUT)	;TELL MACROS WHERE BUFFER HEADER IS
	PUSHJ	P,PUTHDR	;PUT FILE HEADER
	PUSHJ	P,PUTDSK	;PUT DISK STUFF
	PUSHJ	P,PUTTTY	;PUT TTY STUFF
	CLOSE	LPT,		;CLOSE THE FILE
	POP	P,.JBFF##	;RESET FIRST FREE
	POPJ	P,		;AND RETURN
	SUBTTL	DUMP INITIALIZATION

INIDMP:	TXNN	F,L.DISK	;DISK DATA?
	JRST	NDMPDS		;NO
	MOVE	T1,BITTAB	;GET START OF BIT TABLE
	SETZM	(T1)		;CLEAR THE FIRST WORD
	AOS	T1		;POINT TO 2ND WORD
	HRLI	T1,-1(T1)	;MAKE INTO A BLT POINTER
	MOVE	T2,BITTAB	;GET START ADR AGAIN
	ADD	T2,TABSIZ	;ADD IN SIZE OF TABLE
	BLT	T1,-1(T2)	;CLEAR THE WHOLE TABLE
	MOVE	P4,CORPNT	;GET START OF DATA
	SUB	P4,SPPB		;SUBTRACT DISK ADDRESS
	MOVEM	P4,COROFF	;SAVE OFFSET FOR LATER
NDMPDS:	TXNN	F,L.TTY		;TTY DATA?
	POPJ	P,		;NO
	MOVE	T1,LBITTB	;GET START OF BIT TABLE
	SETOM	(T1)		;INITIALIZE THE FIRST WORD
	AOS	T1		;POINT TO 2ND WORD
	HRLI	T1,-1(T1)	;MAKE INTO A BLT POINTER
	MOVE	T2,LBITTB	;GET START ADR AGAIN
	ADD	T2,LTBSIZ	;ADD IN SIZE OF TABLE
	BLT	T1,-1(T2)	;INITIALIZE THE WHOLE TABLE
	MOVE	P4,LCRPNT	;GET START OF DATA
	SUB	P4,CKADR	;SUBTRACT DISK ADDRESS
	MOVEM	P4,LCOROF	;SAVE OFFSET FOR LATER
	HLRE	T3,LINPTR	;GET -MAX NUM OF TTY LINES
	MOVNS	T3		;MAKE POSITIVE
	CAMGE	T3,ONELIN	;INVALID LINE REQUESTED?
	ERROR	<Invalid TTY line specified>
	POPJ	P,
	SUBTTL	FILE HEADER

PUTHDR:	TXNN	F,L.DISK	;DISK DATA?
	JRST	NDSKHD		;NO
	PUTSTR	LPT,<CORNUM=>
	PUTOCT	LPT,CORNUM
	PUTSTR	LPT,<  SYSPPB=>
	MOVE	T1,SYSPPB	;GET SYSPPB
	CALL	PUTHWD		;AND TYPE IN HALFWORDS
	HRRZ	P4,SYSPPB	;GET FIRST PPB TO SCAN
	JUMPE	P4,NOSCAN	;NONE, IF 0
	PUTSTR	LPT,< SCAN @>
	ADD	P4,COROFF	;ELSE, POINT TO OUR CORE
	MOVE	T1,P4		;STORE ADR WHERE EXPECTED
	CALL	ACHECK		;AND ADDRESS CHECK IT
	  JRST	NOSCAN		;OUT OF BOUNDS?
	CALL	PUTPPN		;TYPE THE PPN!
NOSCAN:	PUTSTR	LPT,<  SYSDOR=>
	MOVE	T1,SYSDOR
	CALL	PUTHWD		;TYPE AS HALF WORDS
	PUTSTR	LPT,<  SYSCOR=>
	MOVE	T1,SYSCOR
	CALL	PUTHWD		;AS HALF WORDS
	PUTTAB	LPT,
NDSKHD:	PUTSTR	LPT,<input file=>
	TXNE	F,L.MLST	;WANT TO SPY?
	PUTSTR	LPT,<running monitor>
	TXNE	F,L.MLST	;SAME QUESTION
	JRST	TYPPHD		;YES
	PUTSXB	LPT,IDEV+1
	PUTCHR	LPT,[":"]
	PUTSXB	LPT,IFILE
	PUTCHR	LPT,["."]
	HLLZ	T1,IFILE+1	;GET EXTENSION
	PUTSXB	LPT,T1
TYPPHD:	PUTSTR	LPT,< on >
	DATE	T1,		;GET TODAY'S DATE
	CALL	PUTDAT		;STICK IT IN OUTPUT BUFFER
	PUTSTR	LPT,< at >
	MSTIME	T1,		;GET TIME IN MILLISECONDS
	IDIVI	T1,^D60000	;CONVERT TO MINUTES
	CALL	PUTTIM		;STICK THAT IN BUFFER TOO
	PUTLF	LPT,
	POPJ	P,		;RETURN
	SUBTTL	DISK REPORTING

PUTDSK:	TXNN	F,L.DISK	;DISK STUFF?
	POPJ	P,		;NO
	PUTSTR	LPT,<
*****PPBs*****>
;NOW, LOOP THROUGH ALL PPB'S, TYPING UFB'S AND NMB'S.
	HLRZ	P4,SYSPPB	;GET START OF PPB'S
PPBLOP:	ADD	P4,COROFF	;MAKE INTO A CORE ADDRESS
	PUSHJ	P,PUTPPB	;REPORT ON THIS PPB
	  JRST	REPDOR		;ADDRESS CHECK
	HLRZ	P4,PPBSYS(P4)	;GET NEXT POINTER
	JUMPN	P4,PPBLOP	;IF NONE, REPORT DORMANT ACCESS TABLES
REPDOR:	PUSHJ	P,PUTDOR	;REPORT ON DORMANT ACCESS TABLES
	PUSHJ	P,PUTFRE	;AND FREE BLOCKS
	PUSHJ	P,CHKBIT	;CHECK THE BIT TABLE
	PUTLF	LPT,
	POPJ	P,		;RETURN
	SUBTTL	DISK PPN BLOCK REPORTING

PUTPPB:	MOVE	T1,P4		;GET PPB ADDRESS IN T1
	PUSHJ	P,SETBIT	;ACCOUNT FOR THIS BLOCK
	  POPJ	P,		;OUT OF BOUNDS
	HLRZ	T1,PPBNAM(P4)	;PROJ NUMBER
	SKIPE	PROJ
	CAMN	T1,PROJ		;DO WE WANT IT?
	TXZA	F,L.NOPP	;YES
	TXO	F,L.NOPP	;NO, SET A FLAG
	HRRZ	T1,PPBNAM(P4)	;PROGRAMMER NUMBER
	SKIPE	PROG
	CAMN	T1,PROG		;DO WE WANT IT?
	CAIA			;YES
	TXO	F,L.NOPP	;NO
	TXNE	F,L.NOPP	;PRINT PPB?
	JRST	UFBHED		;NO,CONTINUE WITH UFB'S
	PUTLF	LPT,
	PUTSTR	LPT,<PPB=>
	CALL	PUTPPN		;TYPE THE PPN
	MOVEI	T1,PPBKNO(P4)	;REPORT KNO/YES WORDS
	PUSHJ	P,PUTKYS
	PUTSTR	LPT,<
  NLG=>
	LDB	T1,[POINT 1,PPBNLG(P4),35]	;GET BIT
	PUTOCT	LPT,T1
	PUTSTR	LPT,< CNT=>
	PUTDEC	LPT,PPBCNT(P4)
	PUTSTR	LPT,< LOK=>
	MOVEI	T1,PPBLOK(P4)	;GET LOCK WORD
	PUSHJ	P,REPKNO	;REPORT AS A KNO WORD
	MOVE	T1,P4
	PUSHJ	P,REPADR
	PUTLF	LPT,
;HERE TO REPORT UFB'S
UFBHED:	HLRZ	P3,PPBUFB(P4)	;GET UFB POINTER
	JUMPE	P3,REPNMB	;NONE? DON'T EXPECT ANY NMBS, BUT CHECK...
	TXNE	F,L.NOPP	;IF NOT PRINTING PPN
	JRST	UFBLOP		; JUST SET BIT: FOR THE UFB
	PUTSTR	LPT,<    *****UFBs*****
>
UFBLOP:	ADD	P3,COROFF	;ADD CORRECT OFFSET
	PUSHJ	P,PUTUFB	;REPORT ON THIS UFB
	  JRST	REPNMB		;ADDRESS CHECK--LAST ONE.
	HLRZ	P3,UFBPPB(P3)	;GET NEXT POINTER TO UFB
	JUMPN	P3,UFBLOP	;IF NONE, REPORT NAME BLOCKS
REPNMB:	HLRZ	P3,PPBNMB(P4)	;GET POINTER TO NMBS
	JUMPE	P3,.POPJ1	;RETURN IF NONE
	TXNE	F,L.NOPP	;IF NOT PRINTING PPN
	JRST	NMBHED		; JUST SET BITS
	PUTSTR	LPT,<    *****NMBs*****
>
NMBHED:	SETZ	LVL,		;AT UFD LEVEL.
NMBLOP:	ADD	P3,COROFF	;ADD IN PROPER OFFSET
	PUSHJ	P,PUTNMB	;REPORT ON THE NMB
	  JRST	.POPJ1		;ADDRESS CHECK--LAST ONE.
	HLRZ	P3,NMBPPB(P3)	;GET NEXT NAME BLOCK
	TRZN	P3,2		;LAST NMB IN RING?
	JUMPN	P3,NMBLOP	;NO--REPORT ON NEXT
	JRST	.POPJ1		;YES--RETURN
	SUBTTL	DISK UFD BLOCK REPORTING

PUTUFB:	MOVE	T1,P3		;GET UFB ADDRESS IN T1
	PUSHJ	P,SETBIT	;AND ACCOUNT FOR THIS BIT
	  POPJ	P,		;OUT OF BOUNDS
	TXNE	F,L.NOPP
	JRST	.POPJ1		;DONE IF NOT PRINTING THIS PPN
	PUTSTR	LPT,<    TAL=>
	PUTDEC	LPT,UFBTAL(P3)	;AND TYPE IN DECIMAL
	PUTSTR	LPT,< PRV=>
	LDB	T1,[POINT 9,UFBPRV(P3),26]
	CALL	PUTPRV		;AND REPORT PRIVILEGE
	PUTSTR	LPT,< UN1=>
	LDB	T1,[POINT 4,UFBUN1(P3),31]
	PUTOCT	LPT,T1
	PUTSTR	LPT,< 1PT=>
	LDB	T1,[POINT 1,UFB1PT(P3),27]
	PUTOCT	LPT,T1
	PUTSTR	LPT,< PT1=>
	PUTOCT	LPT,UFBPT1(P3)
	MOVE	T1,P3
	PUSHJ	P,REPADR
	PUTSTR	LPT,<
     QTF=>
	LDB	T1,[POINT 27,UFBQTF(P3),26]
	PUTDEC	LPT,T1
	PUTSTR	LPT,< WRT=>
	LDB	T1,[POINT 9,UFBWRT(P3),35]
	PUTDEC	LPT,T1
	PUTSTR	LPT,< FSN=>
	LDB	T1,[POINT 6,UFBFSN(P3),5]
	PUTDEC	LPT,T1
	PUTLF	LPT,
	JRST	.POPJ1
	SUBTTL	DISK NAME BLOCK REPORTING

PUTNMB:	MOVE	T1,P3		;STORE ADDRESS IN T1
	PUSHJ	P,SETBIT	;AND SET A BIT IN THE BIT-TABLE
	  POPJ	P,		;LAST NMB
	TXNE	F,L.NOPP
	JRST	NMBTST
	SKIPN	NAME
	SKIPE	EXT
	SKIPA
	JRST	NMBHD2
	MOVE	T1,NMBNAM(P3)
	SKIPE	NAME
	CAMN	T1,NAME
	TXZA	F,L.NONM
	TXO	F,L.NONM
	HRLZ	T1,NMBEXT(P3)
	SKIPE	EXT
	CAMN	T1,EXT
	CAIA
	TXO	F,L.NONM
	TXNE	F,L.NOPP!L.NONM
	JRST	NMBTST
NMBHD2:	CALL	PUTTSP		;PUT SOME TABS AND SPACES
	PUTSTR	LPT,<    NAM=>
	HRRZ	T1,NMBEXT(P3)	;GET THE EXTENSION
	CAIN	T1,'UFD'	;IS IT A UFD?
	JRST	TYPUFD		;YES--TYPE AS A PPN
	PUTSXB	LPT,NMBNAM(P3)	;TYPE IT IN SIXBIT
	JRST	TYPEXT		;NO--NORMAL EXTENSION
TYPUFD:	HLRZ	T1,NMBNAM(P3)	;GET PROJECT
	PUTOCT	LPT,T1		;IN OCTAL
	PUTCHR	LPT,<[","]>
	HRRZ	T1,NMBNAM(P3)	;AND PROGRAMMER
	PUTOCT	LPT,T1
TYPEXT:	PUTCHR	LPT,<["."]>	;AND A DOT
	HRLZ	T1,NMBEXT(P3)	;GET EXTENSION
	PUTSXB	LPT,T1		;TYPE IT TOO
DOCFP:	PUTSTR	LPT,< CFP=>
	HRRZ	T1,NMBCFP(P3)	;AND GET THE COMPRESSED FILE POINTER
	PUTOCT	LPT,T1
	PUTSTR	LPT,< CNT=>
	PUTDEC	LPT,NMBCNT(P3)
	PUTSTR	LPT,< FSN=>
	LDB	T1,[POINT 6,NMBFSN(P3),5]
	PUTDEC	LPT,T1
	MOVE	T1,P3
	PUSHJ	P,REPADR
	PUTSTR	LPT,<
     >
	CALL	PUTTSP		;PUT SOME TABS AND SPACES
	MOVEI	T1,NMBKNO(P3)	;REPORT KNO AND YES WORDS
	PUSHJ	P,PUTKYS
	PUTLF	LPT,
NMBTST:	HLRZ	P2,NMBACC(P3)	;GET POINTER TO ACC RING
	TRNE	P2,7		;LAST ONE?
	JRST	NXTNMB		;YES.
	TXNE	F,L.NOPP!L.NONM
	JRST	ACCLOP
	MOVE	T4,[ASCII /	/]
	PUTSTR	LPT,,T4
	CALL	PUTTSP		;SPACE OUT PROPER NUMBER OF SPACES
	PUTSTR	LPT,<*****ACCs*****
	>
ACCLOP:	ADD	P2,COROFF	;BRING ADR INTO OUR CORE
	PUSHJ	P,PUTACC	;DUMP ACC
	  JRST	NXTNMB		;THIS IS LAST ONE
	HLRZ	P2,ACCNMB(P2)	;GET NEXT ACCESS BLOCK
	TRNE	P2,7		;LAST ONE?
	JRST	NXTNMB		;YES--RETURN
	TXNE	F,L.NOPP!L.NONM
	JRST	ACCLOP
	PUTCHR	LPT,["	"]
	JRST	ACCLOP		;NO--REPEAT

NXTNMB:	HLRZ	P2,NMBRNG(P3)	;GET POINTER TO NMB LIST
	SKIPE	P2		;ANY SFD NMB-RING?
	TRZE	P2,2		;IS THIS THE LAST ONE?
	JRST	.POPJ1		;YES.
	PUSH	P,P3		;SAVE P3
	MOVE	P3,P2		;MOVE NEW P3 INTO PLACE
	AOS	LVL		;INCREASE LEVEL
NMLOOP:	ADD	P3,COROFF	;POINT INTO CORE
	PUSHJ	P,PUTNMB	;REPORT ON THIS NMB
	  JRST	LSTNMB		;ADR CHECK. REPORT ACC'S
	HLRZ	P3,NMBPPB(P3)	;POINT TO NEXT NMB
	TRZN	P3,2		;LAST IN RING?
	JRST	NMLOOP		;NO--REPORT NEXT
LSTNMB:	POP	P,P3		;RESTORE OLD NMB ADR
	SOS	LVL		;AND POP UP A LEVEL
	JRST	.POPJ1
	SUBTTL	DISK ACCESS TABLE REPORTING

PUTACC:	MOVE	T1,P2		;PUT INTO ARG AC
	CALL	SETBIT		;AND ACCOUNT FOR THE BLOCK!
	  POPJ	P,		;YES--THIS IS LAST ACC
	TXNE	F,L.NOPP!L.NONM
	JRST	.POPJ1
	CALL	PUTTSP		;GIVE SOME SPACES
	PUTSTR	LPT,<ALC=>
	PUTDEC	LPT,ACCALC(P2)
	PUTSTR	LPT,< ABC=>
	LDB	T1,[POINT 1,ACCABC(P2),18]
	PUTOCT	LPT,T1
	PUTSTR	LPT,< LBS=>
	LDB	T1,[POINT 8,ACCLBS(P2),26]
	PUTOCT	LPT,T1
	PUTSTR	LPT,< 1PT=>
	LDB	T1,[POINT 1,ACC1PT(P2),27]
	PUTOCT	LPT,T1
	PUTSTR	LPT,< UN1=>
	LDB	T1,[POINT 4,ACCUN1(P2),31]
	PUTDEC	LPT,T1
	PUTSTR	LPT,< DIR=>
	LDB	T1,[POINT 1,ACCDIR(P2),32]
	PUTOCT	LPT,T1
	PUTSTR	LPT,< NDL=>
	LDB	T1,[POINT 1,ACCNDL(P2),33]
	PUTOCT	LPT,T1
	PUTSTR	LPT,< SBC=>
	LDB	T1,[POINT 1,ACCSBC(P2),34]
	PUTOCT	LPT,T1
	PUTSTR	LPT,< PT1=>
	PUTOCT	LPT,ACCPT1(P2)
	SKIPE	ACCDOR(P2)
	PUTSTR	LPT,< ***dormant***>
	PUTSTR	LPT,<
        >
	CALL	PUTTSP		;GIVE SOME SPACES AND TABS
	PUTSTR	LPT,<  FSN=>
	LDB	T1,[POINT 6,ACCFSN(P2),5]
	PUTDEC	LPT,T1
	PUTSTR	LPT,< WCT=>
	LDB	T1,[POINT 8,ACCWCT(P2),13]
	PUTDEC	LPT,T1
	PUTSTR	LPT,< ADT=>
	LDB	T1,[POINT 15,ACCADT(P2),17]
	CALL	PUTDAT		;ACCESS DATE
	PUTSTR	LPT,< NIU=>
	LDB	T1,[POINT 1,ACCNIU(P2),18]
	PUTOCT	LPT,T1
	PUTSTR	LPT,< CNT=>
	LDB	T1,[POINT 9,ACCCNT(P2),27]
	PUTDEC	LPT,T1
	PUTSTR	LPT,< REN=>
	LDB	T1,[POINT 1,ACCREN(P2),28]
	PUTOCT	LPT,T1
	PUTSTR	LPT,< DEL=>
	LDB	T1,[POINT 1,ACCDEL(P2),29]
	PUTOCT	LPT,T1
	PUTSTR	LPT,< STS=>
	LDB	T1,[POINT 3,ACCSTS(P2),32]
	PUTOCT	LPT,T1
	PUTSTR	LPT,< SMU=>
	LDB	T1,[POINT 1,ACCSMU(P2),33]
	PUTOCT	LPT,T1
	PUTSTR	LPT,<
        >
	CALL	PUTTSP		;EXTRA SPACES, ACCORDING TO OUR LEVEL...
	PUTSTR	LPT,<  WRT=>
	PUTDEC	LPT,ACCWRT(P2)
	PUTSTR	LPT,< PRV=>
	LDB	T1,[POINT 9,ACCPRV(P2),8]
	CALL	PUTPRV
	PUTSTR	LPT,< MOD=>
	LDB	T1,[POINT 4,ACCMOD(P2),12]
	PUTOCT	LPT,T1
	PUTSTR	LPT,< CTM=>
	LDB	T1,[POINT 11,ACCCTM(P2),23]
	CALL	PUTTIM
	PUTSTR	LPT,< CDT=>
	LDB	T1,[POINT 12,ACCCDT(P2),35]
	LDB	T2,[POINT 3,ACCADT(P2),2]
	DPB	T2,[POINT 3,T1,23]
	CALL	PUTDAT		;CREATION DATE
	MOVE	T1,P2
	PUSHJ	P,REPADR
	PUTLF	LPT,
	JRST	.POPJ1
	SUBTTL	DORMANT ACCESS TABLE REPORTING

PUTDOR:	HLRZ	P1,SYSDOR	;GET POINTER TO FIRST DORMANT ACCESS TABLE
	SETZM	DORCNT		;AND CLEAR THE COUNTER
	JUMPE	P1,NODORM	;IF NO POINTER, NO DORMANT ACCS
DORLOP:	ADD	P1,COROFF	;PLACE ADR IN OUR CORE
	MOVE	T1,P1		;STORE ADR IN ARG AC
	CALL	ACHECK		;ADDRESS CHECK IT
	  JRST	TYPDOR		;OUT OF BOUNDS?
	AOS	DORCNT		;NO--COUNT UP
	HLRZ	P1,ACCDOR(P1)	;GET POINTER TO NEXT
	JUMPE	P1,TYPDOR	;IF NONE, REPORT
	JRST	DORLOP		;ELSE, LOOP BACK
NODORM:	PUTSTR	LPT,<
*****No dormant access tables.
>
	POPJ	P,		;RETURN
TYPDOR:	SKIPN	DORCNT		;COUNT ANY?
	JRST	NODORM		;NO
	PUTSTR	LPT,<
*****>
	PUTDEC	LPT,DORCNT
	PUTSTR	LPT,< dormant access tables*****
>
	POPJ	P,
	SUBTTL	FREE BLOCK REPORTING

PUTFRE:	HLRZ	P1,SYSCOR	;GET POINTER TO FIRST FREE CORE
	SETZM	FRECNT		;CLEAR COUNT OF BLOCKS
	JUMPE	P1,NOFREE	;NONE IF 0
FRELOP:	ADD	P1,COROFF	;ELSE, CONVERT DISK ADDRESS TO CORE ADDRESS
	MOVE	T1,P1		;PUT ADDRESS WHERE EXPECTED
	PUSHJ	P,SETBIT	;ACCOUNT FOR THIS BLOCK
	  JRST	TYPFRE		;OUT OF BOUNDS
	AOS	FRECNT		;AND COUNT THIS BLOCK
	HLRZ	P1,1(P1)	;GET NEXT BLOCK
	JUMPE	P1,TYPFRE	;IF NONE, REPORT COUNT
	JRST	FRELOP		;ELSE, LOOP BACK
NOFREE:	PUTSTR	LPT,<
*****No free blocks****
>
	POPJ	P,		;RETURN
TYPFRE:	SKIPN	FRECNT		;COUNT ANY?
	JRST	NOFREE		;NO
	PUTSTR	LPT,<
*****>
	PUTDEC	LPT,FRECNT	;YES--TYPE COUNT
	PUTSTR	LPT,< free blocks*****
>
	POPJ	P,
	SUBTTL	TTY REPORTING

PUTTTY:	TXNN	F,L.TTY		;TTY STUFF?
	POPJ	P,		;NO
	SKIPL	P2,ONELIN	;WANT A SINGLE LINE?
	JRST	ONLY1		;YES
	HLRE	P1,LINPTR	;GET - NUMBER OF LINES
	MOVNS	P1
	SETZ	P2,		;P2 IS CURRENT LINE NUMBER
TTYLOP:	HRRZ	P3,LINTAB	;GET POINTER TO LDB LIST
	ADD	P3,P2		;ADD IN LINE NUMBER
	HRRZ	P3,(P3)		;POINT TO LDB
	PUSHJ	P,REPLIN	;REPORT ON THIS LINE
	CAIGE	P2,-1(P1)	;DONE?
	AOJA	P2,TTYLOP	;AND CHECK NEXT LINE
	PUTLF	LPT,
	PUSHJ	P,PUTFCH	;REPORT ON FREE CHUNKS
	PUSHJ	P,CHKCHK	;CHECK THE BIT TABLE
	PUTLF	LPT,
	PUSHJ	P,PUTCHL	;PUT CHUNK LIST
	POPJ	P,		;RETURN
ONLY1:	HRRZ	P3,LINTAB	;GET ADDRESS OF AN LDB
	ADD	P3,P2		;(THE LDB FOR THE LINE WE WANT)
	HRRZ	P3,(P3)
	PUSHJ	P,REPLIN	;AND REPORT ON THE SINGLE LINE
	POPJ	P,		;RETURN
	SUBTTL	CHUNK REPORTING

;THIS ROUTINE CHECKS THE FREE CHUNK LIST
PUTFCH:	HRRZ	T6,TTFREE	;POINT TO FIRST FREE CHUNK
	SETZ	P3,		;CLEAR COUNT OF FREE CHUNKS
FRLOOP:	JUMPE	T6,TELLFR	;IF END OF LIST, REPORT COUNT
	ADD	T6,LCOROF	;ELSE, POINT INTO OUR CORE
	MOVE	T1,T6		;PUT WHERE EXPECTED
	MOVNI	P2,-2		;-2 IS THE CODE FOR A FREE BLOCK
	PUSHJ	P,SETCHK	;ACCOUNT FOR THIS BLOCK
	  JRST	TELLFR		;ALREADY USED!
	HRRZ	T6,(T6)		;ELSE, CHECK FORWARD LINK
	AOJA	P3,FRLOOP	;AND REPEAT
TELLFR:	JUMPE	P3,NFREE	;NONE FREE?
	PUTDEC	LPT,P3		;NO--TYPE NUMBER OF FREE CHUNKS
	PUTSTR	LPT,< free chunks.>
CHKMON:	CAMN	P3,TTFREN	;DOES THE MONITOR AGREE WITH US?
	JRST	GIVLF		;YES
	PUTSTR	LPT,< Monitor thinks there are >
	PUTDEC	LPT,TTFREN
	PUTSTR	LPT,< free chunks.>
GIVLF:	PUTLF	LPT,
	POPJ	P,		;RETURN
NFREE:	PUTSTR	LPT,<****No free chunks.>
	JRST	CHKMON		;SEE IF MONITOR AGREES
PUTCHL:	MOVE	P1,LBITTB	;POINT TO TABLE
	MOVE	P2,LTBSIZ	;HOW BIG IT IS
	HRRZ	P4,LCRPNT	;POINT TO THE FIRST CHUNK
LNLOOP:	MOVE	T1,P1		;GET CHUNK ADDRESS
	SUB	T1,LBITTB	;MAKE A OFFSET
	LSH	T1,2
	ADD	T1,CKADR	;MAKE A MONITOR ADDRESS
	PUTOCT	LPT,T1
	PUTSTR	LPT,<: >
	SKIPGE	T2,(P1)		;CHUNK USED?
	JRST	NOTINL		;NO
	PUTOCT	LPT,T2
GLF:	PUTTAB	LPT,
	MOVE	T1,(P4)		;GET POINTER WORD FROM CHUNK
	PUSHJ	P,PUTHWD	;TYPE IN HALF WORDS
	SKIPN	(P4)		;WAS THAT A 0,,0?
	PUTTAB	LPT,
	PUTTAB	LPT,
	HRRZI	T4,1(P4)	;POINT TO FIRST WORD OF CHARS
	HRLI	T4,(POINT 9,0)	;MAKE IT A BYTE POINTER
	MOVEI	T3,^D12		;12 CHARS
CLP:	ILDB	T2,T4		;GET A CHAR
	PUSHJ	P,PCHAR		;REPORT ON IT
	CAIE	T3,1		;LAST ONE?
	PUTCHR	LPT,<[","]>
	SOJG	T3,CLP		;TYPE WHOLE CHUNK
	PUTLF	LPT,
	ADDI	P4,4		;POINT TO NEXT CHUNK
	AOS	P1
	SOJG	P2,LNLOOP	;REPEAT FOR ALL CHUNKS
	POPJ	P,		;RETURN
NOTINL:	AOJE	T2,NOTACC	;IF -1, NOT ACCOUNTED FOR
	PUTSTR	LPT,<free>
	JRST	GLF
NOTACC:	PUTSTR	LPT,<unknown>
	JRST	GLF
	SUBTTL	DUMP SUBROUTINES

PUTKYS:	PUTSTR	LPT,< KNO=>
	PUSHJ	P,REPKNO	;REPORT THE KNO WORD
	PUTSTR	LPT,< YES=>
	MOVE	T4,0(T1)	;GET KNO WORD
	MOVE	T2,1(T1)	;GET YES WORD
	MOVEI	CNT,^D36	;HOW MANY BITS
KYSLOP:	SETZB	T1,T3		;CLEAR SOME WORDS
	LSHC	T1,1		;MOVE A BIT OF YES WORD INTO T1
	LSHC	T3,1		;AND THE CORRESPONDING BIT OF KNOW WORD INTO T3
	JUMPE	T3,DNTKNO	;IF KNO BIT IS 0, DON'T KNOW
	MOVEI	T5,"N"		;ASSUME NO.
	JUMPE	T1,DPCHAR	;IF YES BIT IS 0, GOOD
	MOVEI	T5,"Y"		;WRONG. USE A Y
	JRST	DPCHAR		;PUT IT IN THE BUFFER
DNTKNO:	MOVEI	T5,"0"		;ASSUME IS 0
	JUMPE	T1,DPCHAR	;GOOD GUESS?
	MOVEI	T5,"1"		;NO.
DPCHAR:	PUTCHR	LPT,T5
	CALL	PTSPC		;TYPE A SPACE AFTER EACH NINE
	SOJG	CNT,KYSLOP	;REPEAT FOR 36 BITS
	POPJ	P,		;RETURN NOW

REPADR:	SUB	T1,COROFF
	PUTSTR	LPT,< ADDRESS=>
	PUTOCT	LPT,T1
	POPJ	P,

REPKNO:	MOVE	T3,0(T1)	;GET KNO BITS IN T3
	MOVEI	CNT,^D36	;36 BITS
KNOLOP:	LSHC	T2,1		;GET A BIT IN T2
	MOVEI	T4,"N"		;ASSUME NO
	TRNE	T2,1		;RIGHT?
	MOVEI	T4,"Y"		;WRONG
	PUTCHR	LPT,T4
	CALL	PTSPC		;TYPE A SPACE AFTER EACH NINE
	SOJG	CNT,KNOLOP	;REPEAT
	POPJ	P,		;RETURN

PUTPRV:	LSHC	T1,-^D9		;LEFT JUSTIFY IN T2
	MOVEI	CNT,3		;3 DIGITS
PRVLOP:	SETZ	T1,		;CLEAR DIGIT
	LSHC	T1,3		;PICK UP AN OCTAL DIGIT
	ADDI	T1,"0"		;CONVERT TO ASCII
	PUTCHR	LPT,T1		;PRINT IT
	SOJG	CNT,PRVLOP	;REPEAT TWICE MORE
	POPJ	P,		;RETURN

PTSPC:	CAIE	CNT,^D10	;TYPED 9?
	CAIN	CNT,^D19	;OR 18?
	JRST	PSPC		;YES
	CAIE	CNT,^D28	;OR 27?
	POPJ	P,		;NO
PSPC:	PUTCHR	LPT,[" "]
	POPJ	P,

PUTPTR:
PUTHWD:	HLRZ	T2,T1		;GET LH(T1)
	PUTOCT	LPT,T2
	PUTSTR	LPT,<,,>
	HRRZ	T2,T1		;AND RH(T1)
	PUTOCT	LPT,T2
	POPJ	P,

PUTTSP:	JUMPE	LVL,.POPJ	;NOTHING EXTRA AT LEVEL 0
	MOVE	T4,[ASCII /    /]
	MOVE	T1,LVL
PUTTLP:	PUTSTR	LPT,,T4
	SOJGE	T1,PUTTLP	;REPEAT FOR EACH LEVEL
	POPJ	P,		;RETURN

PUTPPN:	HLRZ	T1,PPBNAM(P4)	;GET PROJECT NUMBER
	PUTOCT	LPT,T1		;PRINT IT
	PUTCHR	LPT,<[","]>	;AND A COMMA
	HRRZ	T1,PPBNAM(P4)	;GET PROGRAMMER
	PUTOCT	LPT,T1
	POPJ	P,		;RETURN

PUTTIM:	IDIVI	T1,^D60		;GET HOURS AND MINUTES
	PUTDEC	LPT,T1		;HOURS FIRST
	PUTCHR	LPT,[":"]
	IDIVI	T2,^D10		;SPLIT MINUTES INTO 2 DIGITS
	PUTDEC	LPT,T2
	PUTDEC	LPT,T3
	POPJ	P,		;RETURN

	DEFINE	LISTL(ARG),<
	IRP	ARG,<ASCII	/ARG/>>

MONTAB:	LISTL	<Jan,Feb,Mar,Apr,May,Jun,Jul,Aug,Sep,Oct,Nov,Dec>

PUTDAT:	IDIVI	T1,^D31		;GET DAY NUMBER-1
	AOS	T2		;GET DAY NUMBER
	PUTDEC	LPT,T2		;TYPE IT
	PUTCHR	LPT,["-"]
	IDIVI	T1,^D12
	PUTSTR	LPT,,MONTAB(T2)
	PUTCHR	LPT,["-"]
	ADDI	T1,^D1964
	PUTDEC	LPT,T1
	POPJ	P,
	SUBTTL	TTY DUMP SUBROUTINES

REPLIN:	PUTSTR	LPT,<
Line >
	PUTOCT	LPT,P2		;TYPE THE LINE NUMBER
	PUTLF	LPT,
	PUSHJ	P,REPLDB	;REPORT ON THE LDB FOR THIS LINE
	MOVE	T1,LCOROF	;GET THE OFFSET BETWEEN MONITOR CORE AND OURS
	DEFINE	ADDOFF(OFFSET)
<	SKIPE	LDB'OFFSET(P3)	;DOES THIS POINTER EXIST?
	ADDM	T1,LDB'OFFSET(P3)	;YES--CONVERT TO OUR CORE
>
	ADDOFF	TIT
	ADDOFF	TIP
	ADDOFF	TOT
	ADDOFF	TOP
	ADDOFF	ECT
	SKIPN	T1,LDBTIP(P3)	;IS THERE AN INPUT STRING?
	JRST	NOINST		;NO
	SUB	T1,LCOROF	;POINT BACK AT MONITOR
	TRNN	T1,3		;POINTING TO A LINK WORD?
	SUBI	T1,4		;YES--POINT TO ACTUAL LINK
	TDZ	T1,[-1,,3]	;POINT TO LINK WORD!
LOPIN:	ADD	T1,LCOROF	;POINT INTO CORE
	HLRZ	T2,(T1)		;GET BACKWARDS LINK
	JUMPE	T2,FSTIN	;IF NONE, AT START OF STRING
	MOVE	T1,T2		;ELSE, FOLLOW THE CHAIN
	JRST	LOPIN
FSTIN:	PUTSTR	LPT,<Input string: >
	PUSHJ	P,TYPSTR	;TYPE THE STRING!
DOOUTS:	PUTLF	LPT,
	SKIPN	T1,LDBTOP(P3)	;GET ADR OF OUTPUT STRING
	JRST	NOOUTS		;JUMP IF NONE
	SUB	T1,LCOROF	;POINT BACK TO MONITOR
	TRNN	T1,3		;AT A LINK WORD?
	SUBI	T1,4		;YES--BACK UP
	TDZ	T1,[-1,,3]	;POINT TO LINK OF THIS CHUNK
LOPOUT:	ADD	T1,LCOROF	;POINT INTO CORE
	HLRZ	T2,(T1)		;GET BACKWARD LINK
	JUMPE	T2,FSTOUT	;JUMP IF DONE
	MOVE	T1,T2		;STORE CHUNK ADR IN T1
	JRST	LOPOUT		;AND REPEAT
FSTOUT:	PUTSTR	LPT,<Output string: >
	PUSHJ	P,TYPSTR
	PUTLF	LPT,		;GIVE A CRLF
	POPJ	P,		;RETURN

NOINST:	PUTSTR	LPT,<***No input string.>
	JRST	DOOUTS
NOOUTS:	PUTSTR	LPT,<***No output string.
>
	POPJ	P,

TYPSTR:	MOVE	T6,T1		;SAVE ADDRESS
	PUSHJ	P,SETCHK	;CHECK IF BLOCK ALREADY USED
	  POPJ	P,		;YES??!!??
	MOVEI	CNT,3		;3 WORDS OF CHARS
CLOOP:	MOVEI	T5,1(T6)	;GET A WORD OF CHARS
	PUSHJ	P,PUTCHK	;TYPE IT
	CAIE	CNT,1		;LAST WORD IN A CHUNK?
	PUTCHR	LPT,<[","]>
	AOS	T6		;POINT TO NEXT WORD
	SOJG	CNT,CLOOP	;REPEAT
	HRRZ	T1,-3(T6)	;GET FORWARD LINK
	JUMPE	T1,.POPJ
	PUTCHR	LPT,<[","]>
	ADD	T1,LCOROF	;MAKE INTO A CORE ADDRESS
	JRST	TYPSTR		;AND REPEAT FOR NEXT CHUNK
REPLDB:	PUTSTR	LPT,<***LDB at: >
	HRRZ	T1,P3		;GET LDB ADDRESS
	SUB	T1,LCOROF	;CONVERT TO A MONITOR ADDRESS
	PUTOCT	LPT,T1		;AND TYPE IT IN OCTAL
	PUTLF	LPT,
	PUTSTR	LPT,<	DDB=>
	MOVE	T1,LDBDDB(P3)	;GET POINTER TO DDB
	PUSHJ	P,PUTHWD	;TYPE IT IN HALFWORDS
	PUTSTR	LPT,<
	BKU=>
	MOVE	T1,LDBBKU(P3)	;GET POINTER TO BREAK CHAR
	PUSHJ	P,PUTPTR	;TYPE AS A POINTER
	PUTSTR	LPT,<	BKC=>
	PUTDEC	LPT,LDBBKC(P3)
	PUTSTR	LPT,<	XNP=>
	MOVE	T1,LDBXNP(P3)	;GET XON POINTER
	PUSHJ	P,PUTPTR
	PUTSTR	LPT,<	FLP=>
	MOVE	T1,LDBFLP(P3)	;GET FILLER POINTER
	PUSHJ	P,PUTPTR
	PUTSTR	LPT,<
	TIP=>
	MOVE	T1,LDBTIP(P3)	;GET INPUT PUTTER
	PUSHJ	P,PUTPTR	;TYPE AS A POINTER
	PUTSTR	LPT,<	TIT=>
	MOVE	T1,LDBTIT(P3)	;GET INPUT TAKER
	PUSHJ	P,PUTPTR	;TYPE AS A POINTER
	PUTSTR	LPT,<	TIC=>
	PUTDEC	LPT,LDBTIC(P3)
	PUTSTR	LPT,<
	TOP=>
	MOVE	T1,LDBTOP(P3)	;GET OUTPUT PUTTER
	PUSHJ	P,PUTPTR	;TYPE AS A POINTER
	PUTSTR	LPT,<	TOT=>
	MOVE	T1,LDBTOT(P3)	;GET OUTPUT TAKER
	PUSHJ	P,PUTPTR	;TYPE AS A POINTER
	PUTSTR	LPT,<	TOC=>
	PUTDEC	LPT,LDBTOC(P3)
	PUTSTR	LPT,<
	ECT=>
	MOVE	T1,LDBECT(P3)	;GET ECHO TAKER
	PUSHJ	P,PUTPTR	;TYPE AS A POINTER
	PUTSTR	LPT,<	ECC=>
	PUTDEC	LPT,LDBECC(P3)
	PUTSTR	LPT,<	PBK=>
	SKIPA	T2,LDBPBK(P3)	;GET PIM BREAK CHARS
PLP:	PUTCHR	LPT,<[","]>
	SETZ	T1,		;CLEAR TO SHIFT INTO
	LSHC	T1,^D9		;GET NEXT CHAR
	PUTOCT	LPT,T1
	JUMPN	T2,PLP		;REPEAT IF MORE
	PUTSTR	LPT,<	DCH=>
	MOVE	T1,LDBDCH(P3)	;GET DEVICE CHARACTERISTICS
	PUSHJ	P,PUTHWD	;TYPE IN HALF WORDS
	PUTSTR	LPT,<
BYT:	OFL=>
	MOVE	T2,LDBBYT(P3)	;GET A WORD OF BYTES
	SETZ	T1,
	LSHC	T1,1		;GET FIRST BIT
	PUTOCT	LPT,T1
	PUTSTR	LPT,<	FLC=>
	SETZ	T1,
	LSHC	T1,2		;GET FILLER CLASS
	PUTDEC	LPT,T1
	PUTSTR	LPT,<	OHPOS=>
	SETZ	T1,
	LSHC	T1,3
	PUTOCT	LPT,T1
	PUTSTR	LPT,<	SVC=>
	SETZ	T1,
	LSHC	T1,^D9		;GET SAVED CHAR
	PUTOCT	LPT,T1
	PUTSTR	LPT,<	TIM=>
	SETZ	T1,
	LSHC	T1,5
	PUTDEC	LPT,T1
	PUTSTR	LPT,<	HPOS=>
	SETZ	T1,
	LSHC	T1,^D8		;GET HORIZONTAL POSITION
	PUTDEC	LPT,T1
	PUTSTR	LPT,<	ECK=>
	SETZ	T1,
	LSHC	T1,^D8		;GET ECHO CHECK
	PUTOCT	LPT,T1
	PUTSTR	LPT,<
BY2:	BITS=>
	MOVE	T2,LDBBY2(P3)	;GET 2ND WORD OF BYTES
	SETZ	T1,
	LSHC	T1,^D9		;GET BITS
	LSH	T1,^D9		;POSITION IN A NATURAL POSITION
	PUTOCT	LPT,T1
	PUTSTR	LPT,<	DSC=>
	SETZ	T1,
	LSHC	T1,^D9		;GET INDEX INTO DSCTAB
	PUTOCT	LPT,T1
	PUTSTR	LPT,<	WID=>
	SETZ	T1,
	LSHC	T1,^D9		;GET CARRIAGE WIDTH
	PUTDEC	LPT,T1
	PUTSTR	LPT,<	RCS=>
	SETZ	T1,
	LSHC	T1,^D9		;GET MOST RECENTLY RECEIVED CHARACTER
	PUTOCT	LPT,T1
	PUTSTR	LPT,<
PAG:	BITS=>
	MOVE	T2,LDBPAG(P3)	;GET PAGE WORD
	SETZ	T1,
	LSHC	T1,^D10		;GET BITS
	LSH	T1,^D8
	PUTOCT	LPT,T1
	PUTSTR	LPT,<	ACRLF=>
	SETZ	T1,
	LSHC	T1,^D8
	PUTDEC	LPT,T1
	PUTSTR	LPT,<	LF=>
	SETZ	T1,
	LSHC	T1,6
	PUTDEC	LPT,T1
	PUTSTR	LPT,<	PSZ=>
	SETZ	T1,
	LSHC	T1,6
	PUTDEC	LPT,T1
	PUTSTR	LPT,<	PCT=>
	SETZ	T1,
	LSHC	T1,6
	PUTDEC	LPT,T1
	PUTLF	LPT,
	PUTLF	LPT,
	POPJ	P,		;RETURN
PUTCHK:	MOVEI	T4,4		;4 CHARS PER WORD
	HRLI	T5,(POINT 9,0)	;MAKE INTO A BYTE POINTER
CHULOP:	DEFINE	PCHK(OFFSET)
<	CAMN	T5,LDB'OFFSET(P3)	;;IS THIS A SPECIAL POINTER?
	PUTSTR	LPT,<**'OFFSET'**>
>
	PCHK	TIT
	PCHK	TIP
	PCHK	TOT
	PCHK	TOP
	PCHK	ECT
	ILDB	T2,T5		;GET A CHAR!
	PUSHJ	P,PCHAR		;TYPE THE CHAR!
	CAIE	T4,1		;LAST ONE?
	PUTCHR	LPT,<[","]>
	SOJG	T4,CHULOP
	PCHK	TIT
	PCHK	TIP
	PCHK	TOT
	PCHK	TOP
	PCHK	ECT
	POPJ	P,

PCHAR:	TRZE	T2,400		;IMAGE MODE?
	PUTCHR	LPT,["I"]	;YES
	TRZE	T2,200		;PARITY?
	PUTCHR	LPT,["P"]	;YES
	CAIG	T2,137		;LOWER CASE?
	JRST	ISUC		;NO
	PUTCHR	LPT,["L"]	;YES--INDICATE FOR UPPER CASE LINE PRINTERS
	SUBI	T2,40		;AND CONVERT TO UPPER CASE
ISUC:	CAIGE	T2,40		;CONTROL CHAR?
	JRST	CTLCH		;YES
	PUTCHR	LPT,["<"]
	PUTCHR	LPT,T2
	PUTCHR	LPT,[">"]
	POPJ	P,

CTLTAB:	ASCIZ	/NUL/
	ASCIZ	/^A/
	ASCIZ	/^B/
	ASCIZ	/^C/
	ASCIZ	/^D/
	ASCIZ	/^E/
	ASCIZ	/^F/
	ASCIZ	/BEL/
	ASCIZ	/BS/
	ASCIZ	/TAB/
	ASCIZ	/LF/
	ASCIZ	/VT/
	ASCIZ	/FF/
	ASCIZ	/CR/
	ASCIZ	/^N/
	ASCIZ	/^O/
	ASCIZ	/^P/
	ASCIZ	/^Q/
	ASCIZ	/^R/
	ASCIZ	/^S/
	ASCIZ	/^T/
	ASCIZ	/^U/
	ASCIZ	/^V/
	ASCIZ	/^W/
	ASCIZ	/^X/
	ASCIZ	/^Y/
	ASCIZ	/^Z/
	ASCIZ	/ESC/
	ASCIZ	/^\/
	ASCIZ	/^]/
	ASCIZ	/^^/
	ASCIZ	/^_/

CTLCH:	PUTCHR	LPT,["<"]
	PUTSTR	LPT,,CTLTAB(T2)	;TYPE THE APPROPRIATE THING
	PUTCHR	LPT,[">"]
	POPJ	P,
	SUBTTL	ROUTINE TO SET UP TO SPY ON MONITOR

SPYSET:	HLRZ	T1,.JBSA##	;GET INITIAL FIRST FREE
	MOVEM	T1,.JBFF##	;AND RESET IT
	MOVX	T1,%CNSIZ	;SIZE OF MONITOR
	GETTAB	T1,		;FIND IT
	  JRST	GETERR		;COULD NOT
	SOS	T1		;POINT TO LAST WORD OF MONITOR'S LOW SEG
	SPY	T1,		;AND MAKE IT OUR HIGH SEG
	  ERROR	<SPY failed>
	PUSHJ	P,SPYDSK	;GET DISK STUFF
	PUSHJ	P,SPYTTY	;AND TTY STUFF
	PUSHJ	P,BITSET	;SET UP BIT TABLE
	POPJ	P,		;AND RETURN
SPYDSK:	TXNN	F,L.DISK	;DISK DATA?
	POPJ	P,		;NO
	MOVE	P4,400410	;GET ADDRESS OF .GTSLF
	MOVE	P3,400000+.GTLVD(P4)	;GET ADDRESS OF LEVEL-D TABLE
	MOVE	T1,400000+11(P3)	;GET NUMBER OF BLOCKS
	MOVEM	T1,CORNUM	;STORE FOR LATER
	LSH	T1,3		;CONVERT TO WORDS
	MOVEM	T1,WRDCNT	;STORE FOR LATER
	MOVE	T2,.JBFF##	;GET CURRENT FIRST FREE
	MOVEM	T2,CORPNT	;STORE.
	ADDB	T1,.JBFF##	;UPDATE FIRST FREE
	SOS	T1		;POINT TO LAST WORD
	CAMG	T1,.JBREL##	;HAVE THE CORE?
	JRST	HCORE7		;YES
	CORE	T1,		;NO--GET IT
	  ERROR	<No core to copy monitor's data base>
HCORE7:	HLRZ	T1,400000+5(P3)	;GET START OF DATA BASE
	MOVEM	T1,SPPB		;STORE FOR LATER
	HRLI	T1,400000(T1)	;PUT IN LH(T1)
	HRR	T1,CORPNT	;MAKE INTO A BLT POINTER
	HRRZ	T2,CORPNT	;GET THAT START ADR AGAIN
	ADD	T2,WRDCNT	;POINT 1 PAST END OF DATA
	BLT	T1,-1(T2)	;AND COPY THE DATA BASE!
	MOVE	T1,400000+5(P3)	;GET SYSPPB AGAIN
	MOVEM	T1,SYSPPB	;AND STORE IT
	MOVE	T1,400000+76(P3);GET SYSCOR
	MOVEM	T1,SYSCOR	;STORE
	MOVE	T1,400000+75(P3);GET SYSDOR
	MOVEM	T1,SYSDOR	;AND STORE FOR LATER
	POPJ	P,
SPYTTY:	TXNN	F,L.TTY		;TTY STUFF?
	POPJ	P,		;NO
	MOVE	P4,400410	;GET ADDRESS OF .GTSLF
	MOVE	P3,400000+.GTCNF(P4)	;GET ADDRESS OF CONFIGURATION TABLE
	MOVE	T1,400027(P3)	;GET TTFREE
	MOVEM	T1,TTFREE
	MOVE	T1,400031(P3)	;GET TTFREN
	MOVEM	T1,TTFREN
	MOVE	T1,400033(P3)
	MOVEM	T1,LINPTR
	MOVE	T1,400030(P3)	;GET NUMBER OF BLOCKS
	MOVEM	T1,TTCLST	;STORE FOR LATER
	HRRZM	T1,CKADR	;AND ADDRESS
	HLRZ	T1,TTCLST	;BLOCK COUNT IN RH
	LSH	T1,2		;CONVERT TO WORDS
	MOVEM	T1,LWRDCN	;STORE FOR LATER
	HLRE	T1,LINPTR	;GET NEGATIVE NUMBER OF LINES
	HRRZ	T2,.JBFF##	;AND POINTER TO FIRST FREE
	MOVEM	T2,LINTAB	;WHICH IS WHERE WE WILL PUT LINTAB
	SUB	T2,T1		;ADD IN NUMBER OF LINES
	MOVEM	T2,.JBFF##	;TO GET NEW FIRST FREE
	SOS	T2		;-1
	CAMG	T2,.JBREL##	;DO WE HAVE THE CORE?
	JRST	HCORE0		;YES
	CORE	T2,		;NO--GET IT
	  ERROR	<No core to load LINTAB>
HCORE0:	HRRZ	T1,LINPTR	;GET ADDRESS OF LINTAB IN THE MONITOR
	HRLI	T1,400000(T1)	;POINT INTO OUR ADDRESS SPACE
	HRR	T1,LINTAB	;MAKE INTO A BLT POINTER
	HLRE	T2,LINPTR	;GET NUMBER OF LINES
	MOVNS	T2		;POSITIVE NUMBER
	ADD	T2,LINTAB	;END OF TABLE
	BLT	T1,-1(T2)	;COPY THE TABLE!
	SUB	T2,LINTAB	;CONVERT TO LINE COUNT AGAIN
	IMULI	T2,LDBLEN	;HOW MANY WORDS TO GET
	HRRZ	P4,.JBFF##	;GET ADDRESS OF FIRST LDB
	ADDB	T2,.JBFF##	;AND UPDATE FIRST FREE
	SOS	T2		;POINT TO LAST NEEDED WORD
	CAMG	T2,.JBREL##	;DO WE HAVE IT?
	JRST	HCORE6		;YES
	CORE	T2,		;NO--GET IT
	  ERROR	<No core to read LDBs>
HCORE6:	HLRE	P2,LINPTR	;GET NEGATIVE COUNT OF LINES
	MOVN	P3,P2		;POSITIVE NUMBER IN P3
HLOOP2:	MOVE	T1,P2		;NEGATIVE LINE # IN T1
	ADD	T1,P3		;NO, POSITIVE
	ADD	T1,LINTAB	;ADDRESS OF CORRECT LINTAB ENTRY
	HRRZ	T2,(T1)		;GET WHERE LDB IS
	HRRM	P4,(T1)		;STORE WHERE WE WILL PUT IT
	HRLZI	T1,400000(T2)	;LH(T1) IS MONITOR ADR
	HRR	T1,P4		;RH(T1) IS OUR ADR
	BLT	T1,LDBLEN-1(T1)	;COPY THE LDB
	ADDI	P4,LDBLEN	;POINT TO NEXT SLOT
	AOJL	P2,HLOOP2	;AND REPEAT
	MOVE	T1,LWRDCN	;RETRIEVE SIZE OF DATA BASE
	MOVE	T2,.JBFF##	;GET CURRENT FIRST FREE
	MOVEM	T2,LCRPNT	;STORE.
	ADDB	T1,.JBFF##	;UPDATE FIRST FREE
	SOS	T1		;POINT TO LAST WORD
	CAMG	T1,.JBREL##	;HAVE THE CORE?
	JRST	HCORE1		;YES
	CORE	T1,		;NO--GET IT
	  ERROR	<No core to copy monitor's data base>
HCORE1:	HRRZ	T1,TTCLST	;GET START OF DATA BASE
	MOVEM	T1,CKADR	;STORE FOR LATER
	HRLI	T1,400000(T1)	;PUT IN LH(T1)
	HRR	T1,LCRPNT	;MAKE INTO A BLT POINTER
	HRRZ	T2,LCRPNT	;GET THAT START ADR AGAIN
	ADD	T2,LWRDCN	;POINT 1 PAST END OF DATA
	BLT	T1,-1(T2)	;AND COPY THE DATA BASE!
	POPJ	P,
	SUBTTL	ROUTINE TO ADDRESS CHECK A BLOCK & SET IN BIT TABLE

;HERE WITH T1 HAVING A CORE ADDRESS OF AN 8 WORD BLOCK.  SET THE
;CORRESPONDING BIT IN THE BIT TABLE
ACHECK:	TXO	F,L.ACHK	;SET BIT WHICH SAYS JUST ADR CHECK
SETBIT:	MOVE	T5,T1		;COPY ADDRESS
	SUB	T5,COROFF	;CONVERT TO DISK ADR
	SUB	T1,CORPNT	;GET OFFSET INTO TABLE
	JUMPL	T1,SETBI5	;OUT OF RANGE IF NEGATIVE
	CAMLE	T1,WRDCNT	;OR TOO BIG?
	JRST	SETBI5		;YUP
	TXZE	F,L.ACHK	;DONE ENOUGH?
	JRST	.POPJ1		;YES--GIVE A GOOD RETURN
	TRZN	T1,7		;CLEAR RIGHT-MOST 3 BITS
	JRST	SETBI2		;ALREADY CLEAR
	TXNE	F,L.OTTY
	TXNE	F,L.NOPP!L.NONM
	CAIA
	JRST	SETBI1		;ONLY ONE MESSAGE IF OUTPUT IS TO TTY
	TYPE	<%Low order bits set for >
	TYPOCT	T5
	CRLF
SETBI1:	PUTSTR	LPT,<%Low order bits set for >
	PUTOCT	LPT,T5
	PUTLF	LPT,
SETBI2:	LSH	T1,-3		;NOW DIVIDE BY 8 TO GET BLOCK NUMBER
	IDIVI	T1,^D36		;CHOOSE WORD OFFSET AND BIT NUMBER
	ADD	T1,BITTAB	;POINT TO PROPER WORD
	MOVEI	T3,1		;BIT TO SHIFT
	MOVNS	T2		;MAKE T2 BE A - NUMBER
	ADDI	T2,^D35		;T2 IS NOW HOW MANY BITS TO SHIFT
	LSH	T3,(T2)		;SHIFT THE 1 BIT!
	TDNE	T3,(T1)		;IS IT ALREADY SET?
	JRST	SETBI4		;YES!
	IORM	T3,(T1)		;NO--SET IT NOW
	JRST	.POPJ1		;GIVE A GOOD RETURN
SETBI3:	TXNE	F,L.OTTY
	TXNE	F,L.NOPP!L.NONM
	CAIA
	JRST	SETBI4
	TYPE	<%Bit already set for >
	TYPOCT	T5
	CRLF
SETBI4:	PUTSTR	LPT,<%Bit already set for >
	PUTOCT	LPT,T5
	PUTLF	LPT,
	POPJ	P,		;GUARD AGAINST LOOPS
SETBI5:	TXNE	F,L.OTTY
	TXNE	F,L.NOPP!L.NONM
	CAIA
	JRST	SETBI6
	TYPE	<%Address out of range: >
	TYPOCT	T5
	CRLF
SETBI6:	PUTSTR	LPT,<%Address out of range: >
	PUTOCT	LPT,T5
	PUTLF	LPT,
	POPJ	P,


;HERE WITH T1 HAVING A CORE ADDRESS OF A 4 WORD CHUNK.  SET THE
;CORRESPONDING BIT IN THE BIT TABLE. P2 MUST BE THE LINE NUMBER THAT
;HAS THIS CHUNK. (-2 IF FREE)
SETCHK:	MOVE	T5,T1		;COPY ADDRESS
	SUB	T5,LCOROF	;CONVERT TO DISK ADR
	SUB	T1,LCRPNT	;GET OFFSET INTO TABLE
	JUMPL	T1,SETCH3	;OUT OF RANGE IF NEGATIVE
	CAMLE	T1,LWRDCN	;OR TOO BIG?
	JRST	SETCH3		;YUP
	TXZE	F,L.ACHK	;DONE ENOUGH?
	JRST	.POPJ1		;YES--GIVE A GOOD RETURN
	TRZN	T1,3		;CLEAR RIGHT-MOST 2 BITS
	JRST	SETCH0		;ALREADY CLEAR
	TYPE	<%Low order bits set for >
	TYPOCT	T5
	CRLF
	PUTSTR	LPT,<%Low order bits set for >
	PUTOCT	LPT,T5
	PUTLF	LPT,
SETCH0:	LSH	T1,-2		;NOW DIVIDE BY 4 TO GET BLOCK NUMBER
	ADD	T1,LBITTB	;POINT TO PROPER WORD
	SETO	T3,		;SET AC TO -1
	CAME	T3,(T1)		;IS THIS BLOCK USED?
	JRST	SETCH2		;YES!
	MOVEM	P2,(T1)		;NO--STORE THIS LINE NUMBER
	JRST	.POPJ1		;GIVE A GOOD RETURN
SETCH2:	TYPE	<%Bit already set for >
	TYPOCT	T5
	CRLF
	PUTSTR	LPT,<%Bit already set for >
	PUTOCT	LPT,T5
	PUTLF	LPT,
	POPJ	P,		;GUARD AGAINST LOOPS
SETCH3:	TYPE	<%Address out of range: >
	TYPOCT	T5
	CRLF
	PUTSTR	LPT,<%Address out of range: >
	PUTOCT	LPT,T5
	PUTLF	LPT,
	POPJ	P,
	SUBTTL	ROUTINES TO CHECK BIT TABLES

;HERE TO CHECK IF ALL DSK BITS ARE SET IN THE BIT TABLE
CHKBIT:	MOVEI	CNT,1		;CHECK 1ST 1ST
	MOVE	P1,BITTAB	;GET THE ADDRESS
CBTLOP:	CAMLE	CNT,TABSIZ	;STILL IN TABLE?
	JRST	FINUP		;NO--FINISH UP AND LEAVE
	MOVE	T1,(P1)		;GET A WORD
	CAMN	CNT,TABSIZ	;ON LAST WORD?
	JRST	LSTWRD		;YES--SPECIAL TREATMENT
FULWRD:	SETCA	T1,T1		;COMPLEMENT WORD
	JUMPN	T1,NOTZER	;AH HAH! UNSET BITS
NXTWRD:	AOS	P1		;POINT TO NEXT WORD
	AOJA	CNT,CBTLOP	;INCREMENT COUNTER, AND LOOP
NOTZER:	TXNE	F,L.BHED	;TYPED HEADER?
	PUTCHR	LPT,<[","]>	;YES--COMMA
	TXON	F,L.BHED	;TYPED HEADER?
	PUTSTR	LPT,<
*****Blocks unaccounted for:
>
ZERLOP:	JFFO	T1,CNVBIT	;GET NEXT SET BIT
	JRST	NXTWRD		;NONE.
CNVBIT:	MOVEI	T3,-1(CNT)	;GET ACTUAL WORD OFFSET
	IMULI	T3,^D36		;ADD IN BITS FROM PREVIOUS WORDS
	ADD	T3,T2		;AND LEADING BITS FOR THIS WORD
	LSH	T3,3		;*8
	ADD	T3,CORPNT	;ADD IN POINTER TO MAKE A CORE ADDRESS
	SUB	T3,COROFF	;CONVERT FROM CORE ADDRESS TO DISK ADDRESS
	PUTOCT	LPT,T3		;AND PRINT IT IN OCTAL
	MOVSI	T4,400000	;SET SIGN BIT
	MOVNS	T2		;NEGATE LEADING BIT COUNT
	LSH	T4,(T2)		;AND POSITION BIT
	TDZ	T1,T4		;CLEAR THE BIT IN T1
	JUMPE	T1,NXTWRD	;IF 0, MOVE TO NEXT WORD
	JRST	NOTZER		;ELSE, CONTINUE IN SAME WORD
LSTWRD:	MOVE	T3,CORNUM	;GET NUMBER OF BLOCKS
	IDIVI	T3,^D36		;DETERMINE NUMBER OF WORDS OF BITS
	MOVNS	T4		;NEGATIVE NUMBER OF VALID BITS
	JUMPE	T4,FULWRD	;IF 0, LAST WORD IS FULL
	MOVSI	T3,400000	;ELSE, SET SIGN BIT...
	ASH	T3,1(T4)	;AND PROPAGATE IT TO THE RIGHT
	SETCA	T3,T3		;COMPLEMENT MASK
	IOR	T1,T3		;AND SET ALL UNUSED BITS
	JRST	FULWRD		;AND ACT AS IF WE HAVE A FULL WORD
FINUP:	TXZN	F,L.BHED	;DID WE TYPE A HEADER?
	PUTSTR	LPT,<
*****All blocks accounted for*****>
	PUTLF	LPT,
	POPJ	P,


;HERE TO CHECK IF ALL WORDS ARE USED IN THE TTY CHUNK TABLE
CHKCHK:	MOVEI	CNT,1		;CHECK 1ST 1ST
	MOVE	P1,LBITTB	;GET THE ADDRESS
CHLOPA:	CAMLE	CNT,LTBSIZ	;STILL IN TABLE?
	JRST	FINUP0		;NO--FINISH UP AND LEAVE
	SKIPGE	T1,(P1)		;BLOCK USED?
	AOJE	T1,NZER	;MAYBE ON FREE LIST..
NWRD:	AOS	P1		;POINT TO NEXT WORD
	AOJA	CNT,CHLOPA	;INCREMENT COUNTER, AND LOOP
NZER:	TXNE	F,L.BHED	;TYPED HEADER?
	PUTCHR	LPT,<[","]>	;YES--COMMA
	TXON	F,L.BHED	;TYPED HEADER?
	PUTSTR	LPT,<
*****Blocks unaccounted for:
>
	MOVEI	T3,-1(CNT)
	LSH	T3,2		;*4
	ADD	T3,LCRPNT	;ADD IN POINTER TO MAKE A CORE ADDRESS
	SUB	T3,LCOROF	;CONVERT FROM CORE ADDRESS TO DISK ADDRESS
	PUTOCT	LPT,T3		;AND PRINT IT IN OCTAL
	JRST	NWRD
FINUP0:	TXZN	F,L.BHED	;DID WE TYPE A HEADER?
	PUTSTR	LPT,<
*****All blocks accounted for*****>
	PUTLF	LPT,
	POPJ	P,
	UTIL
	END	BEGIN