TITLE USET LOW LEVEL DISK MANIPULATOR.
	SUBTTL THE HATFIELD POLYTECHNIC COMPUTER CENTRE--C.MITCHELL 1971

	;ACCUMULATORS.


	Q=0
	A=1
	B=2
	C=3
	X=4
	Z=5
	SUP=6
	TEMP=7		;MUST BE 7
	READ=10
	SAME=11
	FIND=12
	TEMP1=13
	TEMP2=14
	TEST1=15
	K=16
	P=17


	;UUO'S
	OPDEF	MESS[BYTE(9)1]
	OPDEF	CHRIN[BYTE(9)2]
	OPDEF	HOMUP[BYTE(9)3]
	OPDEF	NHOMUP[BYTE(9)4]
	OPDEF	CHROUT[BYTE(9)5]
	EXTERN	JOBFF
	TWOSEGS
	PAGE
	RELOC	400000
GSTART:	MOVSI	FIND,(SIXBIT /001/)
	MOVEM	FIND,EXT	;SET UP EXTENSION
	MOVE	FIND,[SIXBIT /USETI/]
	MOVEM	FIND,INFL
	MOVE	FIND,[SIXBIT /USETO/]
	MOVEM	FIND,OUTFL
	MOVEI	FIND,17		;SET CHANNELS FOR DUMP MODE
	MOVEM	FIND,CH2	;ONE
	MOVEM	FIND,CH3	;THEN THE OTHER
	MOVE	FIND,[IOWD 200,BLKBUF]
	MOVEM	FIND,COPYBK	;SET UP IOWDS IN LOW SEGMENT
	HRLI	FIND,-^D25600
	MOVEM	FIND,COPYST	;BOTH OF THEM
	SETZB	FIND,READ
START:	CALLI	0		;RESET
	MOVE	P,PLIST		;SET UP PUSH DOWN POINTER.
	INIT	1,1		;FIRST TRY USET
USTDEV:	SIXBIT	/USET/
	XWD	0,ITTY		;INPUT FIRST
	JRST	USETTY		;STRUCTURE DOES NOT EXIST
	INIT	4,0		;NOW ONE FOR OUTPUT
	SIXBIT	/USET/
	XWD	OTTY,0
	JRST	USETTY		;STRANGE!!!!!!
	JRST	SETBUF		;O.K. SO SET UP BUFFERS
USETTY:	INIT	1,1		;OPEN INPUT SIDE
TTDEV:	SIXBIT	/TTY/		;TELETYPE.
	XWD	0,ITTY	 	;INPUT ONLY
	JRST	ERR1		;CANNOT
	INIT	4,0		;OPEN OUTPUT SIDE
	SIXBIT	/TTY/		;TTY
	XWD	OTTY,0	 	;OUTPUT ONLY
	JRST	ERR1		;CANNOT
SETBUF:	MOVEI	A,TTYBUF	;SET FOR OUTPUT
	EXCH	A,JOBFF		;FOOL MONITOR.
	OUTBUF	4,1		;ONE BUFFER.
	MOVEI	B,TTYBUF+203	;AND INPUT
	MOVEM	B,JOBFF		;STORE LIMIT
	INBUF	1,1		;ONE BUFFER.
	EXCH	A,JOBFF		;RESET JOBFF
	MOVE	A,[PUSHJ P,UUOH];SET UP LOC 41
	MOVEM	A,41		;FOR UUO'S
	MOVE	A,EXT		;GET EXTENSION
	MOVEM	A,INFL+1	;MODIFY INPUT FILE NAME
	MOVEM	A,OUTFL+1	;AND OUTPUT FILE NAME
	LOOKUP	1,INFL	 	;LOOKUP FILE
	CALLI	12		;OUT
	ENTER	4,OUTFL		;ENTER RESULTS.
	JRST	ERR1		;FAILED
	MOVE	A,USTDEV	;GET USETI IN A
	CALLI	A,4		;GET CHARACTERISTICS
	JUMPN	A,CLRTFL	;EXISTS
	MOVE	A,TTDEV
	CALLI	A,4		;GET DEVICE CHARACTERISTICS
CLRTFL:	SETZM	TTYP		;CLEAR TTY FLAG IN CASE
	TLNE	A,10		;TTY?
	SETOM	TTYP		;YES!
NXTCMM: MESS	STRWRD		;OUTPUT CRLF*
GETSH:	CHRIN	A		;GET CHAR IN A.
	MOVEI	C,BOTTAB	;SET FOR COMMAND SCAN.
SCAN:	LDB	B,[XWD 350700,(C)];GET CHAR FROM TABLE.
	JUMPE	B,BAD		;ZERO MEANS END
	CAMN	B,A		;MATCH?
	JRST	@(C)		;DISPATCH
	AOJA	C,SCAN	 	;KEEP GOING
BAD:	MESS	[ASCIZ/
ILLEGAL COMMAND
/]
NEWFL:	MOVSI	A,1		;GET 1 IN LH
	ADDM	A,EXT		;BUMP EXTENSION
	RELEASE 1,		;CLOSE UP
	RELEASE 4,		;BOTH CHANNELS
	SETZM	INFL+2
	SETZM	INFL+3
	SETZM	OUTFL+2
	SETZM	OUTFL+3
	JRST	START		;RESTART
NXTCM:	PUSHJ	P,GARB	 	;CLEAR UP
	MOVE	P,PLIST		;SET UP PUSH DOWN POINTER
	JRST	NXTCMM		;GET NEXT COMMAND


BOTTAB: XWD	15_13,GETSH	;IGNORE CR
	XWD	12_13,NXTCMM	;GET NEXT COMMAND.
	XWD	"R"_13,READD	;READ A BLOCK
	XWD	"W"_13,WRITE	;WRITE A BLOCK
	XWD	"E"_13,EXAMIN 	;EXAMINE THE LOCATION
	XWD	"D"_13,DEPOSI 	;DEPOSIT IN LOCATION
	XWD	"S"_13,SEARCH 	;SEARCH FOR WORD.
	XWD	"L"_13,LIST	;LIST CURRENT MODES.
	XWD	"C"_13,COPY	;COPY DSK TO DSK
	XWD	"F"_13,NEWFL	;EXIT
	XWD	"P"_13,POINTR	;SET RETRIEVAL POINTER
	XWD	"G"_13,GROPE	;GROE AROUND
	XWD	"H"_13,CHOME	;CHANGE HOM BLOCK
	Z			;ZERO MEANS END.
	PAGE
UUOH:	PUSH	P,A		;STORE A
	LDB	A,[XWD 331100,40];GET UUO NUMBER.
	CAIG	A,TOPUUO	;IN RANGE?
	JRST	@UUOTAB-1(A)	;DISPATCH
OUTUUO: POP	P,A		;RESTORE A
	POPJ	P,		;AND RETURN

UUOTAB: Z	MESSG		;OUTPUT MESSAGE
	Z	CHIN		;INPUT CHARACTER.
	Z	HOMUPD		;UPDATE SIXBIT HOM ENTRY
	Z	NHOMD		;UPDATE NUMERICAL HOM ENTRY
	Z	CHOUT		;OUTPUT CHARACTER.
TOPTAB:
	TOPUUO=TOPTAB-UUOTAB

MESSG:	PUSH	P,B		;SAVE B
	MOVSI	B,440700	;SET UP BP
	HRR	B,40		;WITH MESSAGE
KEPON:	ILDB	A,B		;GET CHAR.
	JUMPE	A,FINUP		;ALL DONE
	SOSG	OTTY+2		;SPACE LEFT?
	OUTPUT	4,		;NO
	IDPB	A,OTTY+1	;STORE CHAR.
	JRST	KEPON		;KEEP GOING
FINUP:	SKIPE	TTYP		;DON'T FORCE OUTPUT UNLESS TTY
	OUTPUT	4,		;CLEAR UP
	POP	P,B		;RESTORE B
	JRST	OUTUUO		;RETURN.

CHIN:	SOSL	ITTY+2		;CHARS THERE?
	JRST	LFDEF		;YES
	IN	1,		;GET SOME THEN
	JRST	YUP		;O.K.
	STATZ	1,740000	;ERROR?
	JRST	ERR1		;YES
LFDEF:	SKIPE	CLRUP		;SKIP IF CLEARED UP
	SKIPE	ITTY+2		;SKIP IF EXACTLY ZERO
	JRST	YUP		;ELSE GET CHAR
	MOVEI	A,12		;LINE FEED DEFAULT (AL MODE)
	JRST	OUTCR		;EXIT
YUP:	ILDB	A,ITTY+1	;GET CHAR
	JUMPE	A,CHIN	 	;FORGET NULLS
OUTCR:	SETZM	CLRUP		;UNSET CLEAR FLAG
	EXCH	A,(P)		;EXCHANGE A WITH TOP OF STACK
	POP	P,@40		;CLEVER?
	SKIPE	TTYP		;SKIP IF NOT TTY
	JRST	OUTUUO+1	;RETURN
	PUSH	P,A		;ELSE PRINT INPUT IN THE LOG FILE
CHOUT:	MOVE	A,@40		;GET CHAR.
	SOSG	OTTY+2		;ROOM?
	OUTPUT	4,		;NO
	IDPB	A,OTTY+1	;STORE BYTE
	JRST	OUTUUO		;RETURN.


				;ADDRESS ON TOP OF STACK,MESS IN 40
HOMUPD: MOVE	A,@(P)	 	;GET CONTENTS OF HOM ENTRY
	MOVE	C,40		;GET MESS ADDRESS
	MESS	@C		;PRINT MESSAGE
	MESS	[ASCIZ/ IS /]
	PUSHJ	P,SIXOUT	;PRINT SIXBIT
	MESS	[ASCIZ / /]		;FORCE IT
	PUSHJ	P,GARB		;CLEAR UP FIRST
	PUSHJ	P,GETATM	;GET NEW VALUE
	SKIPA			;NOT ONE
	MOVEM	A,@(P)	 	;STORE NEW VALUE
	JRST	OUTUUO		;FINISH.

NHOMD:	MOVE	A,@(P)	 	;GET CONTENTS OF HOM ENTRY
	MOVE	C,40		;GET MESS ADDRESS
	MESS	@C		;PRINT MESSAGE
	MESS	[ASCIZ/ IS /]
	PUSHJ	P,OCTOUT	;PRINT OCTAL NUMBER.
	MESS	[ASCIZ / O.K.? /]
	PUSHJ	P,GARB		;CLEAR UP
	PUSHJ	P,GETNUM	;GET NEW ONE
	SKIPA
	MOVEM	A,@(P)	 	;STORE VALUE
	JRST	OUTUUO		;FINISH

EXAMIN: SETZ	SUP,0		;CLEAR ZERO SUPPRESSOR.
	PUSHJ	P,GETNUM	;GET ADDRESS IN A
	JRST	DOALL		;DO ALL
	CAIG	A,177		;IN RANGE?
	JRST	PRNTEM		;YES.
	JRST	BAD		;NO
DOALL:	MESS	[ASCIZ /
DUMP OF BLOCK /]
	MOVE	Z,READ		;GET BLOCK NUMBER
	PUSHJ	P,PRNTIT	;PRINT IT
	MESS	[ASCIZ / ON DEVICE /]
	MOVE	A,DEVICE	;GET INPUT DEVICE
	PUSHJ	P,SIXOUT	;PRINT IT
	MESS	CARLF		;ONE CR LF THEN--
	MESS	CARLF		;FINISH OFF
	MOVE	A,[XWD-200,0] 	;SET UP COUNTER.
PRNTEM: PUSHJ	P,OUTWRD	;PRINT WORD.
	AOBJN	A,.-1		;KEEP GOING
	JRST	NXTCM		;ALL DONE

DEPOSI: PUSHJ	P,GETNUM	;GET FIRST HALF IN A
	JRST	BAD		;NONE THERE
	HRLZ	TEMP,A		;PUT IN LEFT HALF
	PUSHJ	P,GETNUM	;GET SECOND HALF IN A
	JRST	BAD		;NONE THERE
	HRR	TEMP,A		;STORE IT
	PUSHJ	P,GETNUM	;GET ADDRESS
	JRST	BAD		;NONE THERE!
	CAILE	A,177		;IN RANGE?
	JRST	BAD		;SO NEAR YET ---
	MOVEM	TEMP,BLKBUF(A)	;IN SHE GOES
	JRST	NXTCM		;AND OUT

WRITE:	PUSHJ	P,GETATM	;GET DEVICE IN A
	JRST	BOOB		;NO DEFAULT
	MOVEM	A,DEVIDE	;STORE DEVICE
	PUSHJ	P,GETNUM	;GET ADDRESS
	JRST	BOOB		;ERROR
	OPEN	3,CH3		;OPEN CHANNEL D
	JRST	BOOB		;FAILED
	USETO	3,A		;SET FOR OUTPUT
	MESS	[ASCIZ /
WRITE BLOCK NUMBER /]
	MOVE	Z,A		;GET NUMBER
	PUSHJ	P,PRNTIT	;PRINT OCTAL NUMBER
	MESS	[ASCIZ / ON DEVICE /]
	MOVE	A,DEVIDE	;GET DEVICE
	PUSHJ	P,SIXOUT	;PRINT DEVICE
	MESS	[ASCIZ /
CONFIRM?/]
	PUSHJ	P,GETANS	;GET ANSWER
	JRST	NXTCM		;NO
	OUT	3,COPYBK	;YES
	JRST	NXTCM		;O.K.
	JRST	BOOB		;FAILED

SEARCH: PUSHJ	P,GETNUM	;GET LEFT HALF
	JRST	STUPP		;USE PREVIOUS VALUE
	JUMPLE	K,.+3		;SKIP IF NOT INDIRECT
	MOVE	FIND,A		;ELSE GET WHOLE WORD
	JRST	STUPP		;AND CONTINUE
	HRRZ	FIND,A	 	;ELSE STORE LH IN RH
	PUSHJ	P,GETNUM	;GET RIGHT HALF
	SKIPA	A,FIND	 	;ONE HALF ONLY
	MOVSS	FIND		;SWAP HALVES
	HRR	FIND,A	 	;AND STORE RIGHT HALF
STUPP:	PUSHJ	P,STUP		;SEARCH
	JRST	NXTCM		;EXIT

STUP:	MOVE	A,[XWD -200,0]	;SET UP COUNTER
	MOVE	B,BLKBUF(A)	;GET WORD FROM BUFFER
	CAMN	B,FIND	 	;SAME?
	PUSHJ	P,PNTFND	;YES,PRINT IT
	AOBJN	A,.-3		;KEEP MOVING
	POPJ	P,		;RETURN

READD:	PUSHJ	P,GETATM	;GET DEVICE IN A
	AOJA	READ,INUSE	;NONE THERE,BUMP BLK NO.
	MOVEM	A,DEVICE	;STORE DEVICE
	PUSHJ	P,GETNUM	;GET BLOCK NO
	JRST	BOOB		;ILLEGAL
	PUSHJ	P,INBLK		;READ BLOCK
	JRST	NXTCM		;EXIT
INUSE:	PUSHJ	P,INBLK+1	;READ BLOCK
	JRST	NXTCM		;GET NEXT

INBLK:	MOVEM	A,READ	 	;STORE IT
	OPEN	2,CH2		;OPEN ANOTHER CHANNEL
	JRST	BOOB		;FAILED
	USETI	2,READ	 	;SET FOR INPUT
	IN	2,COPYBK	;READ BLOCK
	POPJ	P,		;EXIT
BOOB:	MESS	[ASCIZ /
FAILED!!
/]
	JRST	NXTCM		;NEXT TRY!

COPY:	SETZB	SAME,READ	;CLEAR THESE TWO FOR A MO
	PUSHJ	P,GETATM	;GET"FROM"DEVICE
	JRST	BAD		;ILLEGAL
	MOVEM	A,DEV1	 	;STORE IT
	PUSHJ	P,GETATM	;GET "TO" DEVICE
	JRST	BAD		;ILLEGAL
	MOVEM	A,DEV2	 	;STORE IT
	CAIN	B,175		;ALTMODE TERMINATION?
	SETOM	SAME		;YES,SET FLAG
	PUSHJ	P,INTAL		;INITIALIZE
	MESS	[ASCIZ/
COPY FROM DEVICE /]
	MOVE	A,DEV1	 	;GET "FROM"DEVICE
	PUSHJ	P,SIXOUT	;PRINT IT
	MESS	[ASCIZ/ TO DEVICE /]
	MOVE	A,DEV2	 	;GET "TO"DEVICE
	PUSHJ	P,SIXOUT	;PRINT IT
	SKIPE	SAME		;SKIP IF NOT SAME SET
	MESS	[ASCIZ / SETTING IDENTITY/]
	MESS	[ASCIZ /
CONFIRM? /]
	MOVEI	A,GETANS	;HORRIBLE FUDGE COMING UP
	JUMPE	SAME,.+2	;HELP!!!
	AOS	A		;DO NOT CLEAR UP IF ALTMODE
	PUSHJ	P,@A		;GET ANSWER
	JRST	NXTCM		;NO
	SKIPE	SAME		;RETAINING IDENTITY?
	PUSHJ	P,CHGHOM	;YES
	MOVEI	A,BLKBUF+^D25600
	CALLI	A,11		;EXPAND!!
	JRST	BOOB		;CANNOT
	SETZM	TEMP2		;CLEAR TEMP ACCUMULATOR
	JUMPE	SAME,RPTR	;IF NOT READING HOM BLOCK SKIP
	USETI	3,[XWD 0,1]	;SET FOR HOM BLOCK
	IN	3,COPYBK	;GET HOM
	SKIPA	B,BLKBUF+1	;GET UNIT IDENTITY
	JRST	BOOB		;FAILED TO READ
	MOVEM	B,ID		;STORE
	MOVE	B,BLKBUF+4	;GET STRUCTURE NAME
	MOVEM	B,STR		;STORE IT
	MOVE	B,BLKBUF+7	;GET STRUCTURE NUMBER
	MOVEM	B,STRNO		;AND STORE IT
	MOVE	B,BLKBUF+3	;GET POSITION IN SYS SEARCH LIST
	MOVEM	B,SYSCH		;SAVE IT
RPTR:	USETI	2,READ	 	;SET FOR INPUT
	USETO	3,READ	 	;SET FOR OUTPUT
	IN	2,COPYST	;GET ONE CYLINDER
	SKIPA			;OK
	JRST	SLOW		;FAILED
	JUMPE	SAME,.+3	;SKIP IF NOT CONVERTING
	MOVEI	TEMP,^D200	;SET FOR CONVERTER.
	PUSHJ	P,CONVRT	;AND CONVERT
	OUT	3,COPYST	;OUTPUT
	SKIPA			;OK
	JRST	SLOW		;SLOW UP
	ADDI	READ,^D200	;SET FOR NEXT CYLINDER
TST1:	CAIGE	READ,^D40000	;ALL DONE?
	JRST	RPTR		;NO
	JUMPE	SAME,COMPRS	;IF NOT RETAINING ID BYPASS
	USETI	3,[XWD 0,1]	;ELSE READ HOM BLOCK
	IN	3,COPYBK	;GET IT
	SKIPA	B,ID		;GET ID
	JRST	BOOB		;FAILED TO READ IT
	MOVEM	B,BLKBUF+1	;STORE ID
	MOVE	B,STR		;GET STRUCTURE
	MOVEM	B,BLKBUF+4	;STORE IT
	MOVE	B,STRNO		;GET STRUCTURE NUMBER
	MOVEM	B,BLKBUF+7	;STORE IT
	MOVE	B,SYSCH		;GET POSITION IN SYS SEARCH LIST
	MOVEM	B,BLKBUF+3	;RESTORE IT
	PUSHJ	P,UPDHOM	;WRITE THEM OUT
COMPRS: MOVEI	A,BLKBUF+200	;SET FOR CORE
	CALLI	A,11		;AND SQUEEEZZE!
	JRST	BOOB		;HELP!
	JRST	NXTCM+1		;GET NEXT COMMAND

CHGHOM:	USETI	3,[XWD 0,1]	;SET FOR HOM
	IN	3,COPYBK	;READ HOM
	SKIPA			;OK
	JRST	BOOB		;FAILED
	MESS	[ASCIZ /
FOR THE FOLLOWING PARAMETERS TYPE CARRIAGE RETURN IF O.K.
ELSE TYPE THE NEW VALUE
/]
	MOVEI	A,BLKBUF+1	;SET FOR ID CHANGE
	HOMUP	A,[ASCIZ/
UNIT ID/]			;UPDATE UNIT ID
	MOVEI	A,BLKBUF+4	;SET FOR STRUCTURE
	HOMUP	A,[ASCIZ/
STRUCTURE NAME/]		;UPDATE STRUCTURE NAME
	MOVEI	A,BLKBUF+7	;SET FOR STRUCTURE NUMBER.
	HOMUP	A,[ASCIZ/
STRUCTURE NUMBER/]		;UPDATE NUMBER
	MOVEI	A,BLKBUF+3	;UPDATE SYS SEARC LIST
	NHOMUP	A,[ASCIZ/
POSITION IN SYS SEARCH LIST/]	;UPDATE IFNECC
	JRST	UPDHOM		;WRITE OUT HOME BLOCKS

UPDHOM: USETO	3,[XWD 0,1]	;SET FOR OUTPUT
	MOVEI	B,1		;SET FOR FIRST
	MOVEM	B,BLKBUF+177	;STORE BLOCK
	OUT	3,COPYBK	;WRITE FIRST ONE
	SKIPA	B,[XWD 0,12]	;SET FOR SECOND
	JRST	BOOB		;FAILED!
	MOVEM	B,BLKBUF+177	;STORE ADDRESS
	USETO	3,[XWD 0,12]	;SET FOR OUTPUT
	OUT	3,COPYBK	;PRINT IT
	POPJ	P,		;RETURN
	JRST	BOOB		;OUT.

SLOW:	PUSHJ	P,INTAL		;RE-INIT DSKS.
	MOVEI	A,^D200(READ)	;SET UPPER LIMIT
RPT1:	USETI	2,READ	 	;SET FOR INPUT
	USETO	3,READ	 	;SET FOR OUTPUT
	IN	2,COPYBK	;READ ONE BLOCK
	SKIPA
	PUSHJ	P,TELL		;REPORT IT
	JUMPE	SAME,.+3	;SKIP IF NOT CONVERTING
	MOVEI	TEMP,1	 	;SET UP
	PUSHJ	P,CONVRT	;CONVERT
	OUT	3,COPYBK	;OUTPUT
	SKIPA
	PUSHJ	P,INTAL		;RE-INIT.
	ADDI	READ,1	 	;BUMP POINTER
	CAMGE	READ,A	 	;SKIP IF ALL DONE
	JRST	RPT1		;KEEP GOING
	JRST	TST1		;BACK TO CYLINDER MODE.

TSTRIB:	MOVE	TEST1,0(TEMP1) 	;GET FIRST WORD OF BLOCK
	CAME	TEST1,[XWD 777635,33];ONE OF THESE?
	JRST	NTRIB		;NOT A RIB,THEN
	MOVE	TEST1,176(TEMP1);GET PENULTIMATE WORD
	CAIE	TEST1,777777	;ONE OF THOSE?
	JRST	NTRIB		;NO
	MOVE	TEST1,177(TEMP1);GET LAST WORD.
	CAMN	TEST1,TEMP2	;THE ACID TEST,SAME BLOCK ADDRESS?
	AOS	(P)		;BUMP RETURN FOR YES
NTRIB:	POPJ	P,		;RETURN

CONVRT:	MOVEI	TEMP1,BLKBUF	;GET BASE ADDRESS
CONV2:	PUSHJ	P,TSTRIB	;CHECK FOR RIB
	JRST	NOSTR		;NO
	HLRZ	TEST1,3(TEMP1)	;GET EXT
	CAIN	TEST1,(SIXBIT /UFD/)
	JRST	NOSTR		;UFD
	MOVE	TEST1,STRNO	;GET STRUCTURE POSITION
	MOVEM	TEST1,16(TEMP1)	;STORE IT
NOSTR:	ADDI	TEMP1,200	;BUMP POINTER.
	AOS	TEMP2		;AND BLOCK ADDRESS.
	SOJG	TEMP,CONV2	;DO NEXT
	POPJ	P,		;RETURN.

TELL:	MESS	[ASCIZ /
BAD BLOCK NUMBER /]
	MOVE	Z,READ		;GET BLOCK NUMBER
	PUSHJ	P,PRNTIT	;PRINT IT
	MESS	[ASCIZ / ON DEVICE /]
	PUSH	P,A		;SAVE A
	MOVE	A,DEV1		;GET DEVICE
	PUSHJ	P,SIXOUT	;PRINT IT
	POP	P,A		;RESTORE A
	JRST	INTAL		;RE-INIT AND EXIT

POINTR:	PUSHJ	P,GETATM	;GET DEVICE NAME
	JRST	BAD		;ILLEGAL
	MOVEM	A,DEVICE	;ELSE STORE IT
	PUSHJ	P,GETNUM	;GET LEFT HALF
	JRST	BAD		;ILLEGAL
	JUMPLE	K,.+3		;SKIP IF NOT INDIRECT
	MOVE	TEMP,A		;ELSE GET WHOLE WORD
	JRST	STPNT		;AND CONTINUE
	HRLZ	TEMP,A		;STORE IT
	PUSHJ	P,GETNUM	;GET RIGHT HALF
	JRST	BAD		;ILLEGAL
	HRR	TEMP,A		;STORE IT
STPNT:	MOVEM	TEMP,POINAR+4	;RETAIN
	PUSHJ	P,GETDSK	;GET DISK CHARACTERISTICS
	MESS	[ASCIZ /
POINTER SHOWS /]
	LDB	Z,POINAR	;GET CLUSTER COUNT
	PUSHJ	P,PRNTIT	;PRINT IT
	MESS	[ASCIZ /CLUSTERS (/]
	IMUL	Z,POINAR+3	;CONVERT TO BLOCKS
	PUSHJ	P,PRNTIT	;PRINT IT
	MESS	[ASCIZ /BLOCKS) STARTING AT BLOCK NUMBER /]
	LDB	Z,POINAR+2	;GET LOGICAL ADDRESS
	IMUL	Z,POINAR+3	;CONVERT TO BLOCKS
	PUSHJ	P,PRNTIT	;PRINT IT
	MESS	CARLF		;FINISH OFF
	JRST	NXTCM		;EXIT

GETDSK:	MOVEI	A,1		;SET FOR HOME BLOCK
	EXCH	A,READ		;RETAIN OLD BLOCK NUMBER
	PUSHJ	P,INBLK+1	;READ BLOCK
	EXCH	A,READ		;RESET
	MOVE	A,[XWD BLKBUF+16,POINAR] ;SET FOR BLT
	BLT	A,POINAR+3	;AND BLTIT
	JRST	INBLK+1		;RE-READ BLOCK AND RETURN

CHKSUM:	SKIPE	SUMCHK		;SKIP IF FIRST ONE
	POPJ	P,		;ELSE IGNORE IT
	MOVE	TEMP,BLKBUF		;GET FIRST WORD
	MOVE	B,POINAR+1	;GET BYTE POINTER
	LDB	C,[POINT 6,B,11];GET SIZE OF CHECKSUM FIELD
	MOVNS	C		;NEGATE IT
	TLZA	B,770000	;SET FOR BIT 35
CHKSM1:	ADD	TEMP,K		;SECOND TIME AROUND ADD BYTE
	LDB	K,B		;ELSE GET BYTE
	LSH	TEMP,(C)	;LOSE BYTE
	JUMPN	TEMP,CHKSM1	;KEEP GOING IF MORE
	JUMPE	K,.+3		;SKIP IF ZERO
	MOVEM	K,SUMCHK	;ELSE STORE SUMCHK
	POPJ	P,		;AND RETURN
	SETOM	SUMCHK		;FLAG ZERO SUMCHK
	POPJ	P,

GROPE:	SKIPN	POINAR+4	;POINTER SET?
	JRST	DOPFST		;NO TELL HIM
	PUSHJ	P,GETNUM	;NEW SEARCH WORD
	JRST	GRP		;NO
	JUMPLE	K,.+3		;SKIP IF NOT INDIRECT
	MOVE	FIND,A		;ELSE GET WHOLE WORD
	JRST	GRP		;AND CONTINUE
	HRRZ	FIND,A		;GET FIRST HALF
	PUSHJ	P,GETNUM	;GET NEXT HALF
	SKIPA	A,FIND		;NONE THERE
	MOVSS	FIND		;ELSE SWAP HALVES
	HRR	FIND,A		;SET RIGHT HALF
GRP:	MOVE	TEMP,POINAR+4	;GET POINTER
	LDB	TEMP2,POINAR+2	;GETT START BLOCK
	IMUL	TEMP2,POINAR+3	;CONVERT TO PHYSICAL BLOCK NUMBER
	LDB	Q,POINAR	;GET CLUSTER COUNT
	IMUL	Q,POINAR+3	;CONVERT TO BLOCKS
	SETZM	SUMCHK		;CLEAR CHECK SUM
HEDER:	MOVE	A,TEMP2		;GET BLOCK NUMBER
	PUSHJ	P,INBLK		;READ IT
	SETOM	PNTHDD		;SET FLAG
	PUSHJ	P,STUP		;SEARCH IT
	MOVEI	TEMP1,BLKBUF	;SET BASE OF BUFFER
	PUSHJ	P,TSTRIB	;RIB?
	PUSHJ	P,CHKSUM	;CHECKSUM IT
	AOS	TEMP2		;BUMP READ
	SOJG	Q,HEDER		;MORE TO DO?
	SETZM	PNTHDD		;CLEAR FLAG
	MESS	[ASCIZ /

CFP IS /]
	MOVE	TEMP,POINAR+4	;GET POINTER
	SETCM	A,SUMCHK	;GET COMPLEMENT OF SUMCHK
	SKIPN	A		;SKIP IF NOT ZERO
	SETZM	SUMCHK		;ELSE CLEAR SUMCHK
	LDB	A,POINAR+1	;GET CHECKSUM
	CAME	A,SUMCHK	;SAME?
	JRST	.+3		;NO
	MESS	[ASCIZ /CORRECT
/]
	JRST	NXTCM		;GET NEXT COMMAND
	MOVE	A,SUMCHK	;GET CHECKSUM
	DPB	A,POINAR+1	;STORE IT
	MESS	[ASCIZ /INCORRECT
CORRECT VERSION IS /]
	HLRZ	Z,TEMP		;GET LEFT HALF
	PUSHJ	P,PRINIT	;PRINT IT
	HRRZ	Z,TEMP		;GET RIGHT HALF
	PUSHJ	P,PRINIT	;PRINT IT
	MESS	CARLFLF		;FINISH UP
	JRST	NXTCM		;EXIT

DOPFST:	MESS	[ASCIZ /
PLEASE SET POINTER FIRST
/]
	JRST	NXTCM

CHOME:	PUSHJ	P,GETATM	;GET DEVICE
	JRST	BAD		;NONE THERE
	MOVEM	A,DEV2		;STORE IT
	OPEN	3,CH3		;OPEN A CHANNEL
	JRST	BOOB		;CANNOT
	PUSHJ	P,CHGHOM	;CHANGE HOM BLOCKS
	JRST	NXTCM		;NEXT PLEASE

PNTFND:	SKIPN	PNTHDD		;PRINT HEADER?
	JRST	JSTNUM		;NO
	SETZM	PNTHDD		;CLEAR FLAG
	MESS	[ASCIZ /

BLOCK NUMBER /]
	MOVE	Z,READ		;GET BLOCK NUMBER
	PUSHJ	P,PRNTIT	;PRINT IT
	MESS	CARLFLF
JSTNUM:	MOVE	Z,A		;GET WORD ADDRESS
	JRST	PRNTIT		;PRINT IT

	PAGE
GETATM: SETZ	A,0		;CLEAR A
	MOVE	X,[XWD 440600,A];SET UP BP
NEXT:	CHRIN	Z		;GET CHR IN Z
	CAIL	Z,"0"		;DIGIT?
	CAILE	Z,"9"		;ANY OF THEM?
	SKIPA			;NO
	JRST	OMIT		;YES
	CAIL	Z,"A"		;LETTER?
	CAILE	Z,"Z"		;ANY OF THEM
	JRST	DONE		;NO
OMIT:	SUBI	Z,40		;SIXBITIT
	TLNE	X,770000	;ALL IN?
	IDPB	Z,X		;NO,STORE IT
	JRST	NEXT		;GET NEXT
DONE:	CAIN	Z,40		;SPACE
	JUMPE	A,NEXT	 	;IF LEADING,IGNORE
	MOVE	B,Z		;LAST CHAR IN B
	SKIPE	A		;SKIP IF ONE NOT FOUND
	AOS	(P)		;SKIP RETURN
	POPJ	P,		;RETURN.

GETNUM: SETZB	A,K		;CLEAR A
TAGN:	CHRIN	Z		;GET CHAR IN Z
	CAIL	Z,"0"		;DIGIT
	CAILE	Z,"7"		;ANY OF THEM(OCTAL)
	JRST	DUN		;NO
	LSH	A,3		;LEFT SHIFT A
	SUBI	Z,60		;DIGITISE IT
	SETOM	K		;SET K
	ADD	A,Z		;ADD IT IN
	JRST	TAGN		;GET NEXT
DUN:	CAIE	Z,"@"		;INDIRECT?
	JRST	.+3		;NO
	MOVE	A,BLKBUF(A)	;GET ENTRY FROM BUFFER
	MOVEM	Z,K		;SET INDIRECT FLAG
	JUMPN	K,CPOPJ		;SKIP IF NUMBER PRESENT
	CAIN	Z,40		;SKIP IF NOT SPACE
	JRST	TAGN		;IGNORE LEADERS
	CAIE	Z,"/"		;SLASH?
	JRST	.+3		;NO
	MOVE	X,[XWD 220600,A];SET MINI BP
	JRST	NEXT		;GET SIXBIT CHARS
	CAIE	Z,15		;CR?
	CAIN	Z,12		;LF?
	JUMPE	K,.+2		;SKIP IF NUMBER FOUND.
CPOPJ:	AOS	(P)		;SKIP RETURN WITH NUMBER
TPOPJ:	POPJ	P,		;RETURN


OUTWRD: 			;OCTAL DUMP WORD IN BUFFER
				;INDEXED BY A.
	MOVE	B,BLKBUF(A)	;GET WORD
	JUMPN	B,NOTZER	;SKIP IF NOT ZERO
	JUMPN	SUP,TPOPJ	;OUT IF SUPPRESSING.
	SETO	SUP,0		;ELSE SET SUP.
	JRST	CRLF		;AND PRINT ONLY CRLF
NOTZER: SETZ	SUP,0		;CLEAR SUPPRESSOR.
	SETOM	SUPRES		;SET FLAG
	HRRZ	Z,A		;GET ADDRESS
	PUSHJ	P,PRINIT	;PRINT IT
	HLRZ	Z,B		;GET LH OF WORD.
	PUSHJ	P,PRINIT	;PRINT IT
	HRRZ	Z,B		;GET RH OF WORD
	PUSHJ	P,PRINIT	;PRINT IT
CRLF:	MESS	CARLF		;PRINT CARLF
	POPJ	P,		;RETURN

PRNTIT:	SETZM	SUPRES		;DON'T WANT LEADING ZEROS
PRINIT: MOVE	X,[XWD 220300,Z];SET BP
GETCH:	ILDB	C,X		;GET DIGIT
	JUMPN	C,.+3		;SKIP IF NOT ZERO
	SKIPN	SUPRES		;SKIP IF NOT SUPRESSING
	JRST	TESTMR		;ELSE IGNORE IT
PNTLST:	SETOM	SUPRES		;AND SET FLAG
	ADDI	C,60		;ASCIIFY IT
	CHROUT	C		;OUTPUT CHAR.
TESTMR:	TLNE	X,770000	;ALL DONE?
	JRST	GETCH		;GET NEXT
	SKIPN	SUPRES		;SKIP IF CHAR PRODUCED
	JRST	PNTLST		;ELSE PRINT ZERO
SPSOUT:	CHROUT	[EXP 40]	;PRINT SPACE
	POPJ	P,		;RETURN
	PAGE
ERR1:	TTCALL	3,[ASCIZ/
CANNOT INIT TTY CHANNEL
/]
	CALLI	12		;EXIT

GARB:	SETOM	CLRUP		;SET CLEAR UP
	CHRIN	A		;GET CHAR
	CAIE	A,12		;LF?
	JRST	GARB		;NO
	POPJ	P,		;RETURN.

LIST:	MESS	[ASCIZ/
CURRENT INPUT DEVICE /]
	MOVE	A,DEVICE	;GET DEVICE
	PUSHJ	P,SIXOUT	;PRINT NAME
	MESS	[ASCIZ/
LAST BLOCK READ WAS /]
	MOVE	Z,READ	 	;GET NUMBER
	PUSHJ	P,PRNTIT	;PRINT IT
	MESS	[ASCIZ/
CURRENT SEARCH WORD /]
	HLRZ	Z,FIND
	PUSHJ	P,PRINIT	;PRINT IT
	HRRZ	Z,FIND	 	;GET RIGHT HALF
	PUSHJ	P,PRINIT	;PRINT IT
	MESS	CARLFLF
	JRST	NXTCM		;GET NEXT COMMAND.

SIXOUT: MOVE	X,[XWD 440600,A];SET BP
	ILDB	C,X		;GET CHAR.
	ADDI	C,40		;ASCIIFY IT
	CHROUT	C		;PRINT CHAR.
	TLNE	X,770000	;ALL DONE?
	JRST	SIXOUT+1	;DO NEXT
	JRST	SPSOUT		;PRINT SPACE

OCTOUT: HLRZ	Z,A		;GET LEFT HALF
	SETOM	SUPRES		;FORCE 12 CHARS
	PUSHJ	P,PRINIT	;PRINTIT
	HRRZ	Z,A		;GET RIGHT HALF
	JRST	PRINIT		;PRINTIT AND RETURN.

GETANS: PUSHJ	P,GARB		;CLEAR UP
	CHRIN	Z		;GET CHAR
	CAIN	Z,"Y"		;YES?
	AOSA	(P)		;SKIP
	CAIN	Z,"N"		;NO?
	POPJ	P,		;RETURN
	MESS	[ASCIZ/
PLEASE ANSWER Y OR N
?/]
	JRST	GETANS+1	;TRY AGAIN.

INTAL:	OPEN	2,CH2		;OPENINPUT CHANNEL
	JRST	BAD		;CANNOT
	OPEN	3,CH3		;AND THE OUTPUT CHANNEL
	JRST	BAD		;CANNOT
	POPJ	P,		;RETURN
	PAGE
	;I/0 LISTS ETC
PLIST:	IOWD	10,STACK	;PUSH DOWN POINTER
STRWRD: XWD	064245,200000	;CR LF*
CARLFL:	XWD	064241,200000	;CR LF LF
CARLF:	XWD	064240,0	;CR LF
	LIT			;EXPAND LITERALS HERE
	PAGE




	;WORK AREA
	RELOC	0

COPYBK:	BLOCK	2
COPYST:	BLOCK	2
CH2:	BLOCK	1
DEVICE:
DEV1:	BLOCK	1
	BLOCK	1
CH3:	BLOCK	1
DEVIDE:
DEV2:	BLOCK	1
	BLOCK	1
INFL:	BLOCK	4
OUTFL:	BLOCK	4
EXT:	BLOCK	1
STR:	BLOCK	1			;FOR FILE STRUCTURE NAME
STRNO:	BLOCK	1			;FOR FILE STRUCTURE NUMBER
ID:	BLOCK	1			;UNIT IDENTITY
SYSCH:	BLOCK	1			;SYS SEARCH LIST POSITION
CLRUP:	BLOCK	1
TTYP:	BLOCK	1			;IF NON ZERO OUTPUT IS TO TTY
SUPRES:	BLOCK	1			;IF ZERO SUPRESS LEADING 0'S
PNTHDD:	BLOCK	1
SUMCHK:	BLOCK	1
POINAR:	BLOCK	5		;CONTAINS DISK CHARACTERISTICS FROM HOM
ITTY:	BLOCK	3		;INPUT BUFFER HEADER
OTTY:	BLOCK	3		;OUTPUT BUFFER HEADER
TTYBUF: BLOCK	406		;INPUT/OUTPUT BUFFERS.
STACK:	BLOCK	10		;PUSH DOWN STACK
BLKBUF: BLOCK	200		;EXPANDIBLE BUFFER.
	RELOC
	END	GSTART