TITLE	DFCODE - FILE CODING AND DECODING PROGRAM FOR DECTAPE FILE SECURITY.
	SUBTTL	FROHREICH	R. J.			03-JUN-74

	LOC	<JOBVER== 137>
	BYTE	(3) 5 (9) 1 (6) 1 (18) 3	; V 1A(3)-5

	LOC	<JOBREN== 124>
	REST					; REENTRY POINT.

	RELOC	0

IFNDEF	PURE, <PURE== 1>			; ASSUME REENTRANT IF
						; PURE IS UNDEFIND.
	IFN	PURE, <TWOSEG>


IFNDEF	KWORD, <KWORD== 0>			; DEFAULT KEY WORD IS
						; THE FIRST WORD OF BLOCK
	IFN	KWORD, <KWORD== 1>		; IF NOT = 0, MAKE IT 1.


;	ACCUMULATOR ASSIGNMENTS.

	A=		0
	P=		1
	CT=		2
	DEV=		3
	NAME=		5
	EXT=		6
	IND=		7
	IND1=		10
	IND2=		11
	IND3=		12
	KEY=		13
	STATUS=		16
	PD=		17


;	I-O CHANNEL ASSIGNMENTS.

	INCH==		0

	OUTCH==		1


;	SINCE THE TAPE LOOKUP BLOCK (TLOOK) AND THE TAPE ENTER BLOCK
; (TENTR) ARE THE SAME, THEY WILL FREQUENTLY BE USED INTERCHANGEABLY.
;  THE SAME IS TRUE FOR THE DISK LOOKUP AND ENTER BLOCKS (DLOOK AND DENTR)

;	ALTHOUGH THE MAIN DEVICE MAY BE ANY DEVICE ON WHICH THE UNCODED
; VERSION OF THE FILE RESIDES OR IS TO RESIDE, IT WILL BE REFERRED TO
; FROM NOW ON AS "DISK".  THE STORAGE DECTAPE WILL BE REFERRED TO AS "TAPE".

IFN	PURE, <RELOC	400000>


ST:	OUTSTR	[ASCIZ*DFCODE V 1A(3)-5
*]					; TYPE VERSION #

REST:	RESET				; REENTER ADDRESS
	MOVE	A, [XWD DATA, TINM]
	BLT	A, DECO			; INITIALIZE PART OF LOW SEGMENT.


	MOVE	PD, [IOWD 12, STACK]	; SET UP PUSH DOWN POINTER
CD:	OUTSTR	[ASCIZ*CODE OR DECODE? (C OR D) : *]
	INCHWL	A			; GET A CHARACTER
	CAIE	A, "D"			; IS IT A D ?
	JRST	.+3			; NO - SEE IF C
	SETOM	DECO			; YES - SET TO DECODE.
	JRST	ASKDTA			; ASK FOR DRIVE
	CAIN	A, "C"			; IS IT A C ?
	JRST	ASKDTA			; YES - ASK FOR DRIVE.
	PUSHJ	PD, TTEAT		; NO - EAT UP REST OF LINE
	JRST	CD			; ASK AGAIN.
ASKDTA:	PUSHJ	PD, TTEAT		; EAT UP REST OF LINE
	SETZ	DEV,			; INITIALIZE DEVICE NAME
	OUTSTR	[ASCIZ*NAME OF STORAGE DECTAPE DRIVE : *]
	MOVNI	CT, 6			; INITIALIZE COUNTER
	MOVE	P, [POINT 6, DEV]	; INITIALIZE POINTER
GETDEV:	INCHWL	A			; GET A CHARACTER
	CAIN	A, ":"			; IS IT A : ?
	JRST	GETDEV			; YES - WE HAVE DEVICE.
	CAIN	A, 12			; IS IT A LINEFEED?
	JRST	GOTDEV			; YES - WE HAVE DEVICE
	CAIG	A, 40			; IS IT A CONTROL CHARACTER?
	JRST	GETDEV			; YES - DISCARD IT.
	AOJG	CT, GETDEV		; STEP UP COUNT AND SEE IF END.
	SUBI	A, 40			; MAKE CHARACTER SIXBIT
	IDPB	A, P			; PUT IT IN DEV
	JRST	GETDEV			; GO GET ANOTHER CHARACTER
GOTDEV:	MOVE	STATUS, DEV		; PUT DEVICE NAME IN STATUS.
	DEVCHR	STATUS,			; GET DEVICE CHARACTERISTICS
	TLNN	STATUS, 100		; IS IT A DECTAPE?
	JRST	NODT			; NO, ERROR, ASK AGAIN.
	MOVEM	DEV, TINM+1		; YES - PUT IT IN OPEN BLOCK.
	MOVEM	DEV, TOUTM+1		;        "      "       "
STACOD:	OUTSTR	[ASCIZ*STANDARD CODE WITHOUT A PASSWORD? (Y OR CR) : *]
	INCHWL	A			; GET A CHARACTER
	CAIN	A, "Y"			; IS IT A Y?
	JRST	GOTCOD			; YES - USE THE DEFAULT PASSWORD
	PUSHJ	PD, TTEAT		; EAT UP CHARACTERS UP TO LINEFEED
	SETO	STATUS,			; SET STATUS TO -1 FOR THIS TTY
	GETLCH	STATUS			; GET TTY CHARACTERISTICS
	TLO	STATUS, 4		; SET TTY NO ECHO NEXT.
	SETLCH	STATUS			; SET TTY NO ECHO.
	MOVNI	CT, 6			; INITIALIZE COUNTER
	MOVE	P, [POINT 6, CODE]	; SET UP POINTER
	OUTSTR	[ASCIZ*PASSWORD: *]	; ASK FOR PASSWORD
GETCOD:	INCHWL	A			; GET A CHARACTER
	CAIN	A, 15			; IS IT A CARRIAGE RETURN?
	JRST	GOTCOD			; YES - WE HAVE THE PASSWORD
	SUBI	A, 40			; MAKE CHARACTER SIXBIT
	IDPB	A, P			; USE IT AS PART OF CODE
	AOJL	CT, GETCOD		; STEP UP COUNT, DON'T USE AFTER 6
GOTCOD:	PUSHJ	PD, TTEAT		; DISCARD REST OF LINE.
	SETO	STATUS,			; SET STATUS TO -1 FOR THIS TTY
	GETLCH	STATUS			; GET TTY CHARACTERISTICS
	TLZ	STATUS, 4		; SET TTY ECHO NEXT
	SETLCH	STATUS			; SET TTY  ECHO
ASKFIL:	OUTSTR	[ASCIZ*FILE NAMES : *]
	SETZB	NAME, EXT		; INITIALIZE NAME AND EXT.
	MOVE	P, [POINT 6, NAME]	; SET UP POINTER
	MOVE	A, [XWD DATA1, TLOOK]	; SET TO INIT REST OF LOW SEG.
	BLT	A, FILL			; INITIALIZE REST OF LOW SEGMENT.
	MOVNI	CT, 6			; INITIALIZE COUNTER
GETN:	INCHWL	A			; GET A CHARACTER
	CAIN	A, 12			; IS IT A LINEFEED?
	JRST	GOTALL			; YES - END OF COMMAND STRING.
	CAIN	A, ":"			; IS IT A :?
	JRST	COL			; YES - GO DO DEVICE FIRST.
	CAIN	A, ","			; IS IT A , ?
	JRST	GOTALL+1		; YES - END OF FILE SPEC BUT NOT COMMAND
	CAIN	A, "."			; IS IT A . ?
	JRST	GETEXT			; YES - GO SET UP TO GET EXT.
	CAIN	A, "<"			; IS IT A < ?
	JRST	LANG			; YES - GO GET PROTECTION.
	CAIN	A, "["			; IS IT A [ ?
	JRST	LSQB			; YES - GO GET PPN.
	CAIG	A, 40			; IS IT A CONTROL CHARACTER?
	JRST	GETN			; YES - DISCARD IT.
	AOJG	CT, GETN		; STEP UP COUNT AND TEST.
	SUBI	A, 40			; MAKE CHARACTER SIXBIT
	IDPB	A, P			; USE THE CHARACTER
	JRST	GETN			; GO GET ANOTHER CHARACTER.
GETEXT:	MOVNI	CT, 3			; SET COUNTER FOR 3 CHAR EXT
	MOVE	P, [POINT 6, EXT]	; INIT POINTER FOR EXT
	JRST	GETN			; GO GET A CHARACTER
LANG:	PUSH	PD, P			; SAVE POINTER
	PUSH	PD, CT			; SAVE COUNTER
	MOVE	P, [POINT 3, DENTR+2]	; SET UP POINTER FOR PROTECTION
	MOVNI	CT, 3			; INIT COUNTER.
GETPRO:	INCHWL	A			; GET A CHARACTER
	CAIN	A, 15			; IS IT A CARRIAGE RETURN?
	JRST	RANG			; YES - WE HAVE THE PROTECTION
	CAIN	A, ">"			; IS IT A > ?
	JRST	RANG			; YES - WE HAVE THE PROTECTION.
	AOJG	CT, GETPRO		; STEP UP COUNT AND TEST
	CAIGE	A, 60			; IS IT  > OR = ASCII 0 ?
	JRST	PROERR			; NO - ERROR, RESTART AT ASKFIL
	CAILE	A, 67			; IS IT < OR = ASCII 7 ?
	JRST	PROERR			; NO - ERROR, RESTART AT ASKFIL
	SUBI	A, 60			; MAKE IT AN OCTAL NUMBER.
	IDPB	A, P			; USE IT FOR PROTECTION.
	JRST	GETPRO			; GET ANOTHER CHARACTER.
RANG:	POP	PD, CT			; RESTORE COUNTER
	POP	PD, P			; RESTORE POINTER
	JRST	GETN			; BACK TO MAIN SEQ.
COL:	MOVE	DEV, NAME		; MOVE NAME TO NAME OF DEVICE.
	MOVEM	DEV, DINM+1		; USE IT FOR DISK OPEN BLOCK.
	MOVEM	DEV, DOUTM+1		;  "      "      "      "
	SETZ	NAME,			; REINITIALIZE NAME.
	MOVE	P, [POINT 6, NAME]	; RESTORE POINTER
	MOVNI	CT, 6			; RESTORE COUNTER
	JRST	GETN			; BACK TO MAIN SEQ.
LSQB:	PUSH	PD, P			; SAVE POINTER
	PUSH	PD, CT			; SAVE COUNTER
	SETZB	IND1, IND2		; INIT 2 ACS
	MOVE	P, [POINT 3, (IND)]	; INIT POINTER
	MOVEI	IND, IND1		; SET UP INDEX REGISTER
GETPPN:	SETZ	CT,			; INITIALIZE COUNT.
	INCHWL	A			; GET A CHARACTER
	CAIN	A, 15			; IS IT A CARRIAGE RETURN?
	JRST	RSQB			; YES - WE HAVE BOTH HALVES.
	CAIN	A, "]"			; IS IT A ] ?
	JRST	RSQB			; YES - WE HAVE BOTH HALVES.
	CAIN	A, ","			; IS IT A , ?
	JRST	COMA			; SET TO GET NEXT HALF
	ADDI	CT, 3			; ADD 3 BITS TO THE COUNT
	CAIG	CT, ^D18		; IS CT GREATER THAN A HALF WORD?
	JRST	.+3			; NO - SKIP NEXT 2 STEPS.
	MOVEI	CT, ^D18		; YES - MAKE CT = 18
	JRST	GETPPN+1		; GO GET NEXT CHARACTER
	CAIGE	A, 60			; IS IT > OR = ASCII 0 ?
	JRST	PPNERR			; NO - ERROR, RESTART AT ASKFIL
	CAILE	A, 67			; IS IT < OR = ASCII 7 ?
	JRST	PPNERR			; NO - ERROR, RESTART AT ASKFIL
	SUBI	A, 60			; MAKE IT OCTAL.
	IDPB	A, P			; USE IT FOR PROTECTION
	JRST	GETPPN+1		; GO GET ANOTHER BYTE.
COMA:	ROT	IND1, (CT)		; RIGHT JUSTIFY LEFT HALF
	MOVEI	IND, IND2		; SET TO DO RIGHT HALF
	MOVE	P, [POINT 3, (IND)]	; REINIT POINTER
	JRST	GETPPN			; GO DO IT ALL AGAIN.
RSQB:	ROT	IND2, (CT)		; RIGHT JUSTIFY RIGHT HALF
	MOVSS	IND2			; PUT RIGHT HALF IN LEFT HALF WORD
	LSHC	IND1, ^D18		; GET ALL OF PPN IN IND1.
	MOVEM	IND1, DLOOK+3		; USE IT IN LOOKUP BLOCK.
	POP	PD, CT			; RESTORE COUNTER
	POP	PD, P			; RESTORE POINTER
	JRST	GETN			; BACK TO MAIN SEQ.
GOTALL:	SETOM	DONE			; SIGNAL END OF COMMAND STRING
	MOVEM	NAME, TLOOK		; GIVE NAME TO LOOKUP & ENTER BLOCK
	MOVEM	EXT, TLOOK+1		;   "  EXT     "      "     "
	MOVEM	NAME, DLOOK		;   "  NAME    "      "     "
	MOVEM	EXT, DLOOK+1		;   "  EXT     "      "     "
	SKIPE	DECO			; IS DECODING TO BE DONE?
	JRST	OPEND			; YES - GO OPEN FOR DECODING.
OPENC:	OPEN	INCH, DINM		; NO - OPEN DISK ON INCH
	JRST	DOPE			; IF ERROR, REPORT & STOP
	OPEN	OUTCH, TOUTM		; OPEN TAPE ON OUTCH
	JRST	TOPE			; IF ERROR, REPORT & STOP
	MOVEI	A, TBUFF		; SET TO SET POSITION OF TAPE BUFFER
	EXCH	A, .JBFF##		; TELL MONITOR TO PUT BUFFER AT TBUFF
	OUTBUF	OUTCH, 1		; PUT 1 BUFFER AT TBUFF.
	MOVEM	A, SVJBFF		; SAVE REAL JOBFF FOR LATER.
	MOVEM	A, .JBFF##		; RESTORE JOBFF.
	LOOKUP	INCH, DLOOK		; LOOKUP THE FILE ON DISK
	JRST	DLOOKE			; IF ERROR, REPORT & RESTART AT ASKFIL
	LDB	A, [POINT 12, DLOOK+2, 35] ; GET LOW CREATION DATE
	DPB	A, [POINT 12, TENTR+2, 35] ; PUT    "     "      "
	LDB	A, [POINT 3, DLOOK+1, 20] ; GET HIGH CREATION DATE
	DPB	A, [POINT 3, TENTR+1, 20] ; PUT    "      "      "
	ENTER	OUTCH, TENTR		; ENTER FILE ON TAPE
	JRST	TENTRE			; IF ERROR, REPORT & RESTART AT ASKFIL
	JRST	START			; GO START CODING.
OPEND:	OPEN	INCH, TINM		; OPEN TAPE ON INCH
	JRST	TOPE			; IF ERROR, REPORT & STOP
	OPEN	OUTCH, DOUTM		; OPEN DISK ON OUTCH
	JRST	DOPE			; IF ERROR, REPORT & STOP
	MOVEI	A, TBUFF		; SET TO SET POSITION OF TAPE BUFFER
	EXCH	A, .JBFF##		; TELL MONITOR TO PUT BUFFER AT TBUFF
	INBUF	INCH, 1			; PUT 1 BUFFER AT TBUFF.
	MOVEM	A, SVJBFF		; SAVE REAL JOBFF FOR LATER.
	MOVEM	A, .JBFF##		; RESTORE JOBFF
	LOOKUP	INCH, TLOOK		; LOOKUP FILE ON TAPE
	JRST	TLOOKE			; IF ERROR, REPORT & RESTART AT ASKFIL
	LDB	A, [POINT 12, TLOOK+2, 35] ; GET LOW DATE
	DPB	A, [POINT 12, DENTR+2, 35] ; PUT LOW DATE
	LDB	A, [POINT 3, TLOOK+1, 20] ; GET HIGH DATE
	DPB	A, [POINT 3, DENTR+1, 20] ; PUT HIGH DATE
	ENTER	OUTCH, DENTR		; ENTER FILE ON DISK
	JRST	DENTRE			; IF ERROR, REPORT & RESTART AT ASKFIL
START:	SKIPE	DECO			; IS DECODING TO BE DONE?
	JRST	DECODE			; YES - GO DECODE.
DOCODE:	SETZ	CT,			; INITIALIZE WORD COUNT
	PUSHJ	PD, GET			; GET A WORD
	CAIA				; NORMAL RETURN
	JRST	CLOSE			; CLOSE IF EOF & START OF TEMP BLOCK
	MOVEM	A, TEMP(CT)		; PUT WORD IN TEMP BLOCK
	AOJ	CT,			; STEP UP COUNT
	CAIGE	CT, 177			; GREATER THAN OR = TAPE BLOCK SIZE?
	JRST	DOCODE+1		; NO - GET NEXT WORD
	OUT	OUTCH,			; DUMMY OUT, THEN OUTPUT BLOCK
	CAIA				; NORMAL RETURN
	PUSHJ	PD, WERR		; IF ERROR, TELL USER & CONTINUE
	SETZ	IND,			; INITIALIZE WORD POSITION POINTER
	HRLZ	KEY, TEMP+KWORD*176	; GET THE KEY BITS IN LEFT HALF
	SUB	KEY, CODE		; MAKE THEM DEPEND ON PASSWORD
	ROT	KEY, 6			; RIGHT JUSTIFY 1ST CHARACTER
	TDZ	KEY, [-1,,777760]	; SAVE ONLY THE LAST 4 BITS
	MOVE	IND1, KEY		; MAKE A COPY OF KEY
	LSH	IND1, 3			; IMUL BY 8 FOR WORD POSITION
STCODE:	MOVE	A, TEMP+1-KWORD(IND)	; GET A WORD
	XOR	A, CODE			; CODE IT WITH PASSWORD
	ROT	A, (KEY)		; ROTATE IT
	TDNE	A, [1,,1]		; IS IT TO BE SWAPED?
	MOVSS	A			; YES - SWAP IT.
	MOVEM	IND1, IND2		; MAKE A COPY OF BLOCK ROTATION
	IDIVI	IND2, 176		; GET IND2 MOD 176
	MOVEM	A, TBLK+1-KWORD(IND3)	; PUT WORD IN NEW SLOT
	AOJ	IND,			; SET TO GET NEXT WORD
	AOJ	IND1,			; SET TO PUT NEXT WORD
	CAIGE	IND, 176		; HAVE ALL WORDS BEEN DONE?
	JRST	STCODE			; NO - GO DO NEXT WORD.
	MOVE	A, TEMP+KWORD*176	; GET THE KEY WORD
	MOVSM	A, TBLK+KWORD*176	; SWAP IT INTO OUTPUT BUFFER
	AOS	CNTBLK			; STEP UP BLOCK COUNT
	MOVEI	A, 177			; GET MAX BLOCK SIZE
	SUBM	A, FILL			; GET NO. OF DATA WORDS IN BLOCK
	MOVE	A, TB+1			; GET THE BUFFER BYTE POINTER
	ADD	A, FILL			; ADD NO. OF DATA WORDS
	MOVEM	A, TB+1			; TELL MONITOR HOW MANY WORDS
	SETZM	FILL			; RESTORE FILL FOR NEXT BUFFER
	JRST	DOCODE			; GO GET NEXT BLOCK
DECODE:	IN	INCH,			; INPUT A BLOCK FROM TAPE
	JRST	INGOOD			; NORMAL RETURN
	STATZ	INCH, 740000		; SEE IF ERROR BITS ARE ON
	CAIA				; YES
	JRST	CLOSE			; NO - END OF FILE
	PUSHJ	PD, RERR		; TELL USER AND CONTINUE
INGOOD:	SETZ	IND,			; INITIALIZE WORD POSITION POINTER
	HLLZ	KEY, TBLK+KWORD*176	; GET THE KEY BITS IN LEFT HALF
	SUB	KEY, CODE		; MAKE THEM DEPEND ON PASSWORD
	ROT	KEY, 6			; RIGHT JUSTIFY 1ST CHARACTER
	TDZ	KEY, [-1,,777760]	; USE ONLY LAST 4 BITS
	MOVE	IND1, KEY		; SAVE THE BITS
	MOVNS	KEY			; GET READY TO ROTATE BACK
	LSH	IND1, 3			; IMUL BY 8 FOR WORD POSITION
STDECO:	MOVEM	IND1, IND2		; MAKE A COPY OF BLOCK ROTATION
	IDIVI	IND2, 176		; GET IND2 MOD 176
	MOVE	A, TBLK+1-KWORD(IND3)	; GET REAL NEXT WORD OF BLOCK
	TDNE	A, [1,,1]		; HAS IT BEEN SWAPED?
	MOVSS	A			; SWAP IT BACK
	ROT	A, (KEY)		; ROTATE IT BACK
	XOR	A, CODE			; DECODE IT WITH PASSWORD
	MOVEM	A, TEMP+1-KWORD(IND)	; PUT IT IN THE CORRECT SLOT
	AOJ	IND1,			; SET TO GET NEXT WORD
	AOJ	IND,			; SET TO PUT NEXT WORD
	CAIGE	IND, 176		; HAVE ALL WORDS BEEN DONE?
	JRST	STDECO			; NO - GO DO NEXT WORD
	MOVE	A, TBLK+KWORD*176	; YES - GET THE KEY WORD
	MOVSM	A, TEMP+KWORD*176	; SWAP IT INTO TEMP
	AOS	CNTBLK			; STEP UP BLOCK COUNT
	SETZ	CT,			; INITIALIZE WORD COUNT
	MOVE	A, TEMP(CT)		; GET WORD FROM TEMP BLOCK
	PUSHJ	PD, PUT			; PUT IT IN OUTPUT BUFFER
	AOJ	CT,			; STEP UP COUNT
	CAMGE	CT, TB+2		; > OR = NO. OF DATA WORDS IN BUFFER?
	JRST	.-4			; NO - GO DO ANOTHER WORD
	JRST	DECODE			; YES - GO GET ANOTHER BLOCK

GET:	SOSGE	DB+2			; WORDS LEFT IN BUFFER?
	JRST	GETB			; NO - GET ANOTHER BUFFER
	ILDB	A, DB+1			; YES - GET A WORD FROM BUFFER
	POPJ	PD,			; RETURN
GETB:	SKIPE	FILL			; IS BLOCK BEING FILLED WITH NON DATA?
	JRST	EOF			; YES - GO TO EOF ROUTINE
	IN	INCH,			; NO - GET A BUFFER FULL
	JRST	GET			; OK. - GO GET A WORD
	STATZ	INCH, 740000		; ARE ERROR BITS ON?
	CAIA				; YES
	JRST	EOF			; NO - GO TO EOF ROUTINE
	PUSHJ	PD, RERR		; TELL USER ABOUT ERROR
	JRST	GET			; CONTINUE
EOF:	SKIPE	CT			; WAS EOF AT FIRST WORD READ?
	JRST	.+3			; NO
	AOS	(PD)			; SET FOR SKIP RETURN
	POPJ	PD,			; SKIP RETURN
	AOS	FILL			; ADD 1 TO COUNT OF FILLER WORDS
	MSTIME	A,			; MAKE A FILLER WORD
	POPJ	PD,			; RETURN WITH IT

PUT:	SOSGE	DB+2			; SPACE LEFT IN BUFFER?
	JRST	PUTB			; NO - OUTPUT THE BUFFER
	IDPB	A, DB+1			; YES - PUT WORD IN BUFFER
	POPJ	PD,			; RETURN
PUTB:	OUT	OUTCH,			; OUTPUT THE BUFFER
	JRST	PUT			; CONTINUE
	PUSHJ	PD, WERR		; ERROR, TELL USER, CONTINUE
	JRST	PUT			; CONTINUE

;	GO HERE TO CLOSE OUT FILE OR REPORT

CLOSE:	RELEAS	INCH,			; WRITE DIRECTORY NOW SINCE
	RELEAS	OUTCH,			; MAY BE ERROR LATER.
	MOVE	A, SVJBFF		; GET REAL JOBFF
	MOVEM	A, .JBFF##		; RECLAIM BUFFER SPACE.
	SKIPN	DONE			; END OF LINE?
	JRST	ASKFIL+1		; NO - GO GET NEXT FILE
	OUTSTR	[ASCIZ*
TOTAL OF *]
	MOVE	0, CNTBLK		; GET BLOCK COUNT
	PUSHJ	PD, TYDEC		; TYPE IT IN DECIMAL
	OUTSTR	[ASCIZ* DECTAPE BLOCKS PROCESSED

*]
	OUTSTR	[ASCIZ*MORE TO DO? (Y OR CR) : *]
	INCHWL	A			; GET A CHARACTER
	CAIE	A, "Y"			; IS IT A Y ?
	JRST	.+4			; YES - GO EXIT PROGRAM
	OUTSTR	[ASCIZ*

*]					; DOUBLE SPACE
	PUSHJ	PD, TTEAT		; EAT UP REST OF LINE
	JRST	REST			; RESTART AT REENTER ADDRESS

	PUSHJ	PD, TTEAT		; EAT UP REST OF LINE
	EXIT				; EXIT PROGRAM.

;	TYPE AC0 IN DECIMAL

TYDEC:	IDIVI	0, 12			; DIVIDE BY 10
	PUSH	PD, 1			; SAVE THE REMAINDER
	SKIPE	0			; SEE IF END
	PUSHJ	PD, TYDEC		; GO DIVIDE AGAIN
TYDEC1:	POP	PD, 0			; GET THE REMAINDER
	ADDI	0, 60			; MAKE IT ASCII
	OUTCHR	0			; TYPE IT
	POPJ	PD,			; DO IT AGAIN UNTIL DONE

;	DISCARD CHARACTERS UP TO LINEFEED.

TTEAT:	CAIN	A, 12			; IS THE CHAR IN (A) A LINEFEED?
	POPJ	PD,			; YES - RETURN
	INCHWL	A			; NO - GET A CHARACTER
	JRST	TTEAT			; GO TEST IT AGAIN

;	DATA FOR LOW SEGMENT.

DATA:	EXP	14, 0, <XWD 0, TB>	; TINM:
	EXP	14, 0, <XWD TB, 0>	; TOUTM:
	EXP	14, SIXBIT/DSK/, <XWD 0, DB>  ;DINM:
	EXP	14, SIXBIT/DSK/, <XWD DB, 0>  ;DOUTM:
	SIXBIT	A%#)!\"A		; CODE:
	0				; DONE:
	0				; CNTBLK:
	0				; DECO:

DATA1:	BLOCK	4			; TLOOK: AND TENTR:
	EXP	0, 0, <177000,,0>, 0	; DLOOK: AND DENTR:
	0				; FILL:

;	ERROR ROUTINES

NODT:	OUTSTR	[ASCIZ*
? DEVICE IS NOT A DECTAPE.

*]
	JRST	ASKDTA+1		; ASK FOR DRIVE AGAIN.



DOPE:	OUTSTR	[ASCIZ*
? OPEN ERROR FOR MAIN DEVICE.
*]
	CLRBFI				; CLEAR TTY INPUT BUFFER.
	RESET
	OUTSTR	[ASCIZ* TYPE "REE" TO REENTER.
*]
	EXIT	1,			; EXIT TO MONITOR.


TOPE:	OUTSTR	[ASCIZ*
? OPEN ERROR FOR STORAGE DECTAPE.
*]
	CLRBFI				; CLEAR TTY INPUT BUFFER.
	RESET
	OUTSTR	[ASCIZ* TYPE "REE" TO REENTER.
*]
	EXIT	1,			; EXIT TO MONITOR.


DLOOKE:	OUTSTR	[ASCIZ*
? LOOKUP ERROR ON MAIN DEVICE FILE *]
	MOVE	STATUS, [POINT 6, TLOOK]
	PUSHJ	PD, TNAME		; TYPE FILE NAME.
	MOVE	STATUS, DLOOK+1		; GET ERROR CODE.
	PUSHJ	PD, TYSTAT		; TYPE IT.
	MOVE	DEV, [SIXBIT/DSK/]	; GET DEFAULT MAIN DEVICE.
	MOVEM	DEV, DINM+1		; RESTORE MAIN DEVICE.
	MOVEM	DEV, DOUTM+1		; RESTORE MAIN DEVICE.
	CLRBFI				; CLEAR TTY INPUT BUFFER.
	JRST	ASKFIL			; GO ASK FOR FILES AGAIN.
TENTRE:	OUTSTR	[ASCIZ*
? ENTER ERROR ON STORAGE TAPE FILE *]
	MOVE	STATUS, [POINT 6, TLOOK]
	PUSHJ	PD, TNAME		; TYPE FILE NAME.
	MOVE	STATUS, TENTR+1		; GET ERROR CODE.
	PUSHJ	PD, TYSTAT		; TYPE IT.
	MOVE	DEV, [SIXBIT/DSK/]	; GET DEFAULT MAIN DEVICE.
	MOVEM	DEV, DINM+1		; RESTORE MAIN DEVICE.
	MOVEM	DEV, DOUTM+1		; RESTORE MAIN DEVICE.
	CLRBFI				; CLEAR TTY INPUT BUFFER.
	JRST	ASKFIL			; GO ASK FOR FILES AGAIN.


TLOOKE:	OUTSTR	[ASCIZ*
? LOOKUP ERROR ON STORAGE TAPE FILE *]
	MOVE	STATUS, [POINT 6, TLOOK]
	PUSHJ	PD, TNAME		; TYPE FILE NAME.
	MOVE	STATUS, TLOOK+1		; GET ERROR CODE.
	PUSHJ	PD, TYSTAT		; TYPE IT.
	MOVE	DEV, [SIXBIT/DSK/]	; GET DEFAULT MAIN DEVICE.
	MOVEM	DEV, DINM+1		; RESTORE MAIN DEVICE.
	MOVEM	DEV, DOUTM+1		; RESTORE MAIN DEVICE.
	CLRBFI				; CLEAR TTY INPUT BUFFER.
	JRST	ASKFIL			; GO ASK FOR FILES AGAIN.


DENTRE:	OUTSTR	[ASCIZ*
? ENTER ERROR ON MAIN DEVICE FILE *]
	MOVE 	STATUS, [POINT 6, TLOOK]
	PUSHJ	PD, TNAME		; TYPE FILE NAME.
	MOVE	STATUS, DENTR+1		; GET ERROR CODE.
	PUSHJ	PD, TYSTAT		; TYPE IT.
	MOVE	DEV, [SIXBIT/DSK/]	; GET DEFAULT MAIN DEVICE.
	MOVEM	DEV, DINM+1		; RESTORE MAIN DEVICE.
	MOVEM	DEV, DOUTM+1		; RESTORE MAIN DEVICE.
	CLRBFI				; CLEAR TTY INPUT BUFFER.
	JRST	ASKFIL			; GO ASK FOR FILES AGAIN.


WERR:	OUTSTR	[ASCIZ*
? WRITE ERROR FOR *]
	MOVE	STATUS, [POINT 6, TLOOK]
	PUSHJ	PD, TNAME		; TYPE FILE NAME.
	GETSTS	OUTCH, STATUS		; GET ERROR STATUS.
	PUSHJ	PD, TYSTAT		; TYPE IT.
	TRZ	STATUS, 740000		; CLEAR ERROR BITS.
	SETSTS	OUTCH, (STATUS)		; TELL THE MONITOR.
	POPJ	PD,			; RETURN TO MAIN SEQ.
RERR:	OUTSTR	[ASCIZ*
? READ ERROR FOR *]
	MOVE	STATUS, [POINT 6, TLOOK]
	PUSHJ	PD, TNAME		; TYPE FILE NAME.
	GETSTS INCH, STATUS		; GET ERROR STATUS
	PUSHJ	PD, TYSTAT		; TYPE IT.
	TRZ	STATUS, 740000		; CLEAR ERROR BITS.
	SETSTS	INCH, (STATUS)		; TELL THE MONITOR.
	POPJ	PD,			; RETURN TO MAIN SEQ.


PROERR:	OUTSTR	[ASCIZ*
? INCORRECT PROTECTION CODE FOR *]
	MOVE	STATUS, [POINT 6, NAME]
	PUSHJ	PD, TNAME		; TYPE FILE NAME.
	OUTSTR	[ASCIZ*

*]
	MOVE	DEV, [SIXBIT/DSK/]	; GET DEFAULT MAIN DEVICE.
	MOVEM	DEV, DINM+1		; RESTORE MAIN DEVICE.
	MOVEM	DEV, DOUTM+1		; RESTORE MAIN DEVICE.
	CLRBFI				; CLEAR TTY INPUT BUFFER.
	JRST	ASKFIL			; GO ASK FOR FILES AGAIN.


PPNERR:	OUTSTR	[ASCIZ*
? INCORRECT PPN FOR *]
	MOVE	STATUS, [POINT 6, NAME]
	PUSHJ	PD, TNAME		; TYPE FILE NAME.
	OUTSTR	[ASCIZ*

*]
	MOVE	DEV, [SIXBIT/DSK/]	; GET DEFAULT MAIN DEVICE.
	MOVEM	DEV, DINM+1		; RESTORE MAIN DEVICE.
	MOVEM	DEV, DOUTM+1		; RESTORE MAIN DEVICE.
	CLRBFI				; CLEAR TTY INPUT BUFFER.
	JRST	ASKFIL			; GO ASK FOR FILES AGAIN.

;	TYPE FILE NAME AND EXT.

TNAME:	PUSH	PD, A			; SAVE A
	PUSH	PD, CT			; SAVE CT
	SETZ	CT,			; INITIALIZE COUNTER.
TN:	ILDB	A, STATUS		; THE POINTER IS IN STATUS
	JUMPE	A, .+3			; DON'T TYPE IF SPACE
	ADDI	A, 40			; MAKE IT ASCII
	OUTCHR	A			; TYPE IT OUT
	AOJ	CT,			; ADD 1 TO COUNT
	CAIGE	CT, ^D6			; IS CT > OR = 6
	JRST	TN			; NO - GET ANOTHER CHARACTER
	OUTCHR	["."]			; YES - TYPE A DOT
TE:	ILDB	A, STATUS		; GET A BYTE
	JUMPE	A, .+3			; DON'T TYPE IF SPACE
	ADDI	A, 40			; MAKE IT ASCII
	OUTCHR	A			; TYPE IT OUT
	AOJ	CT,			; ADD 1 TO COUNT
	CAIGE	CT, ^D9			; IS CT > OR = 9
	JRST	TE			; NO - GET ANOTHER BYTE
	POP	PD, CT			; YES - RESTORE CT
	POP	PD, A			; RESTORE A
	POPJ	PD,			; RETURN TO ERROR ROUTINE

;	TYPE ERROR STATUS IN OCTAL.

TYSTAT:	PUSH	PD, A			; SAVE A
	PUSH	PD, P			; SAVE P
	PUSH	PD, CT			; SAVE CT
	OUTSTR	[ASCIZ* (*]
	MOVNI	CT, 6			; SET UP COUNTER
	MOVE	P, [POINT 3,STATUS,17]	; SET UP POINTER
	ILDB	A, P			; GET A BYTE
	ADDI	A, 60			; MAKE IT ASCII
	OUTCHR	A			; TYPE IT OUT
	AOJL	CT, .-3			; STEP UP CT & JUMP IF NOT END
	OUTSTR	[ASCIZ*)
*]
	POP	PD, CT			; RESTORE CT
	POP	PD, P			; RESTORE P
	POP	PD, A			; RESTORE A
	POPJ	PD,			; RETURN TO ERROR ROUTINE

;	LOW SEGMENT SYMBOLS

IFN	PURE, <RELOC	0>

TINM:	BLOCK	3			; TAPE INPUT OPEN BLOCK
TOUTM:	BLOCK	3			; TAPE OUTPUT OPEN BLOCK
DINM:	BLOCK	3			; DISK INPUT OPEN BLOCK
DOUTM:	BLOCK	3			; DISK OUTPUT OPEN BLOCK
CODE:	BLOCK	1			; PASSWORD
DONE:	BLOCK	1			; END OF LINE SWITCH
CNTBLK:	BLOCK	1			; DECTAPE BLOCK COUNT
DECO:	BLOCK	1			; DECODE SWITCH

TLOOK:					; TAPE LOOKUP BLOCK
TENTR:	BLOCK	4			; TAPE ENTER BLOCK
DLOOK:					; DISK LOOKUP BLOCK
DENTR:	BLOCK	4			; DISK ENTER BLOCK
FILL:	BLOCK	1			; COUNT OF NON DATA WORDS


TB:	BLOCK	3			; TAPE BUFFER HEADER
DB:	BLOCK	3			; DISK BUFFER HEADER
TBUFF:	BLOCK	3			; FIRST 3 WORDS OF TAPE BUFFER
TBLK:	BLOCK	177			; REST OF BUFFER.
STACK:	BLOCK	12			; PUSH DOWN STACK
TEMP:	BLOCK	177			; TEMP BLOCK FOR WORK.
SVJBFF:	BLOCK	1			; SAVE JOBFF HERE.

;	BACK TO HIGH SEGMENT FOR LITERALS.

IFN	PURE, <RELOC>

	LIT

	END	ST