Google
 

Trailing-Edge - PDP-10 Archives - BB-F493Z-DD_1986 - 10,7/failsa.mac
There are 6 other files named failsa.mac in the archive. Click here to see a list.
TITLE  FAILSA       /RT/MGM/RCC/CM/SP/JEF	1 APRIL 73
;COPYRIGHT 1969,1970,1971,1972, 1973 DIGITAL EQUIPMENT CORP., MAYNARD, MASS.
SUBTTL 

EDITNO=="@"
;THE EDIT - ION OF THIS CUSP

TECONO==47
;THE # TIMES TECO-ED

;NO EDIT NUMBER
AARDVARK==100
VERSION=EDITNO-"@"+AARDVARK*100,,TECONO
	MLON




	.JBVER==137
	LOC .JBVER
	VERSION

; . . . EDIT HISTORY . . .
;
; EDIT 32 - PROVIDES PROPER OPERATION OF /K WITH /F. PREVIOUSLY
;           SAVED AND DELETED FILES ACCESSED AFTER RATHER THAN
;           BEFORE THE /F DATE.
;           AREAS AFFECTED: CUSPPN, MORE10

; EDIT 33 - REMOVES UNCONDITIONAL DEFINITION OF ALFLEX.
;            AREAS AFFECTED: ALFLEX
;

; EDIT 34 - REINITIALIZES THE TTY PRIOR TO ATTEMPTING ERROR
;           MESSAGE PRINT ON OUTPUT FILE LOOKUP FAILURE.
;           AREAS AFFECTED: PRINT

; EDIT 35 - ADDS A CONTROL-Z TRAP.
;           AREAS AFFECTED: ILCH, NOTYET

; EDIT 36 - MASKS DATE TO 15 BITS. THIS IS A PATCH TO THE
;           DATE75 CODE.
;           AREAS AFFECTED: YRSMOS

; EDIT 37 - EXTENDS THE CRITERIA FOR EXEMPTING FILES FROM A /K
;           PURGE TO INCLUDE ALL PROJECTS<10.
;           AREAS AFFECTED: UNCONS

; EDIT 40 - ZERO THE PROTECTION FIELD WHEN PREFORMING ENTER FOR
;	    FAILSA.DIR.  PREVENTS SUBSEQUENT ENTERS FROM FAILING.

; EDIT 41 - DONT CHECK THE VERSION NUMBER WHEN SAVING FILES AT
;	    THE CHKCRE ROUTINE. THIS FIX ALLOWS THE "/E" SWITCH
;	    TO WORK PROPERLY.

; EDIT 42 - ARGUMENTS FOR DSKCHR AT "X:" ARE NOT INITIALIZED

; EDIT 43 - "SWAPQ" ROUTINE REENTERS THE "TAPFL4" ROUTINE AT THE
;           WRONG POINT. THIS PROBLEM OCCURES WHEN SAVING WITH
;           A /G OR /O SWITCH AND EOT IS ENCOUNTERED.

; EDIT 44 - /E STILL DOESN'T WORK. THE TIME FIELDS ARE NOT ALIGNED
;           BEFORE THEY ARE COMPARED.

; EDIT 45 - FIXES "ADDRESS CHECK FOR DPA0..." WHEN COMMAND WAS
;           "/W/U/W/U" AND NO FILES WERE SAVED FOR THE LAST FILE
;           STRUCTURE IN THE SEARCH LIST

; EDIT 46 - FIXES EDIT 37 WHICH CAUSED ALL PROJECTS .GE. 10
;	    TO BE SAVED AND DELETED IF IN "/K" MODE.

; EDIT 47 - THIS PATCH CAUSES FAILSA TO SAVE ALL FILES WITH
;		A CREATION OR ACCESS DATE OLDER THAN 1/1/67 OR
;		WITH A DATE EQUAL TO 1/5/75. THIS IS DONE WITHOUT
;		REGARD TO /E OR /F SWITCH SETTINGS IN AN ATTEMPT
;		TO PREVENT THE USER FROM LOSING FILES DUE TO DATE75
;		BUGS. IN A /K/U SAVE FILES WITH "FUNNY" DATES ARE NOT
;		DELETED OR SAVED SINCE THEY ARE ASSUMED TO BE NEW FILES.



	RELOC
		;ASSEMBLY PARAMETERS

	IFNDEF	DEBUG,<DEBUG==0>		;IF NOT DEBUGGING = PRODUCTION
	IFN DEBUG,<
SUBTTL	BUG HUNT IS ON
>
	IFNDEF	PAGING,<PAGING==0>		;IF DESIRED, TYPE OUT
						;TEXT CAN BE HELD IN THE LITERAL
						;POOL
						;NOTE THAT THE
						;LINK WORD CAN SOMETIMES
						;BE AS LONG AS THE MESSAGE
						;
	IFNDEF	NONSTP,<NONSTP==0>		;NON-0 = MULTIPLE PASSES
						;NON-0 IS THE HOOK FOR
						;IMPLEMENTING AN AUTOMATIC
						;SWITCH-OVER FROM DRIVE
						;N TO DRIVE N+1
						;NORMALLY (FOR THE
						;PRESENT, LEAVE = 0)
	IFNDEF	PRIVL,<PRIVL==0>		;NON-0=ONLY 1,2
						;CAN FIDDLE AROUND WITH OTHER
						;PEOPLES' DISK AREAS

	IFNDEF	REWIND,<REWIND==0>		;0=NO AUTOMATIC REWINDS
	IFNDEF	SFDDIR,<SFDDIR==0>		;SUB-FILE DIRECTORIES
	IFNDEF	ALPJ1S,<ALPJ1S==1>		;NORMALLY, PJ 1 ALWAYS BYPASSES
						;THE /E /F CRITERIA CHECK
						;ON SAVE
	IFNDEF	ALPJ1R,<ALPJ1R==1>		;NORMALLY, PJ 1 LIKEWISE BYPASSES
						;CHECK FOR /F & /E
						;ON RESTORE


	IFNDEF	UNLOAD,	<UNLOAD==1>		;UNLOAD TAPE FROM DRIVE
						;ON FULL REEL AT RESTORE
						;AND SAVE TIME


	IFNDEF	LOCK,	<LOCK==1>		;TRY TO LOCK YOURSELF IN CORE
						;DURING /S (SAVE) TIME
						;RATIONALE BEHIND NOT DOING
						;SAME DURING /R IS THAT 
						;THIS (/R) WILL BE DONE
						;PRETTY CLOSE TO STAND ALONE

 
						;ALL FILES LESS THAN OR =
						;ALFLEX WORDS(!) ARE
						;RESTORED
	IFNDEF	ALFLEX,<ALFLEX==0>		;

						;NO FILES ARE RESTORED OR SAVED
						;UNCONDITIONALLY
						;HOWEVER, FILES
						;LESS THAN OR = ALFLEX
						;WILL BYPASS THE /E & /F CHECKS




	IFNDEF	BELL,<BELL==0>			;IF BELL IS ASSEMBLED
						;POSITIVE, GENERATE
						;CODE TO GIVE ^G + *
						;INSTEAD OF JUST *
						;WHENEVER A COMMAND HAS
						;BEEN PROCESSED

	IFNDEF	COMUFD,<COMUFD==0>		;NORMALLY (COMUFD=0)
						;COMPRESS UFD'S.. DEALLOCATE
						;UNUSED BLOCKS


	IFNDEF	COMFIL,<COMFIL==0>		;CONTRARIWISE, FILES ARE NORMALLY
						;LEFT "EXPANDED".


	IFNDEF	MINREL,<			;ATTEMPT TO MINIMIZE
	MINREL==0			;NUMBER OF RELEASE UUOS
>
;ACCUMULATOR ASSIGNMENTS
	TMP=0
	Q=1	;R-1
	R=2	;COMMAND INPUT COUNT
	S=3	;R+1	;COMMAND BYTE POINTER
	PAKNAM=4	;DEVNAM FOR DSKCHR UUO
	WASTE=5		;USED BY DSKCHR UUO
	PAKFRE=6	;# OF FREE BLKS RETURNED BY DSKCHR UUO
	T=7	;WORD BEING TRANSFERRED
	F=10	;FLAG AC
	A=11	;SCRATCH ;JSP ON ME TO PRINT ROUTINES
	B=12	;A+1 ;SCRATCH ;BYTE PTR IN PRINT ROUTINES
	CH=13	;B+1	;CHAR
	D=14	;NUMBER FOR SWITCHES
	U=15	;FIRST WORD ON A READ
	W=16	;SECOND WORD ON A READ
	P=17	;PUSHDOWN POINTER

;PARAMETER ASSIGNMENTS
	PDSIZ==60	;PUSHDOWN LIST SIZE
	SLPMIN==^D60	;MINUTES BETWEEN CONSECUTIVE SAVES WITH /M
	XLOOKN==40	;NO. OF ARGS FOR EXTENDED LOOKUP/ENTER
	IFNDEF	NUMSTR,<
	NUMSTR==^D25	;NUMBER OF STRUCTURES RETURNED BY SYSSTR UUO
	>

;CALLI ADDRESSES
	RESET==0
	DEVCHR==4
	WAIT==10
	CORE==11
	EXIT==12
	DATE==14
	MSTIME==23
	GETPPN==24
	PJOB==30
	SLEEP==31
	DSKCHR==45
	SYSSTR==46
	JOBSTR==47		;UUO FOR FINDING OUT SUCCESSIVE STR'S IN
				;THIS JOB'S EARCH LIST

	STRUUO==50
	GOBSTR==66		;RETURN SUCCESSIVE STR'S FOR SYS OR A PARTICULAR JOB

	LOKUUO==60
	MTCHR.==112		;MTA BIT DENSITY
	UNLOCK==120		;UUO TO ATTEMPT TO UNLOCK THE JOB THAT WAS
				;LOCKED IN CORE

EXTERN	.JBFF,.JBDDT,.JBREN
;I/O PARAMETERS
;DEVICE ASSIGNMENTS
	MES==0	;.HLP MESSAGE OUT ON THIS CHANNEL
	TTO==1	;TTY AND LISTING DEVICE OUTPUT
	TTI==2	;TTY INPUT
	TAP==3	;MAGNETIC TAPE FOR READ OR WRITE
	MFD==4	;DISK FOR MASTER FILE DIRECTORY
	UFD==5	;DISK FOR USER FILE DIRECTORY
	FIL==6	;DISK FOR USER FILE
	CHK==7	;DISK FOR FILE DATE CHECK
	DGA==10 ;DON'T GO AWAY CHANNEL, SEE BELOW
						;A PHANTOM CHANNEL IS
						;OPENED UP TO
						;GET FILSER TO RETAIN SOME
						;MORE-THAN-NORMALLY-KEPT-IN
						;CORE INFORMATION IN CORE.
						;
						;BY OPENING UP THIS
						;SHADOW CHANNEL, WE EFFECTIVELY
						;DO A DEFAULT PATH UUO,
						;EXCEPT THAT IF WE CRASH 
						;WE DO NOT LEAVE
						;USER X SET TO 1,2!!!!!
;NUMBER OF BUFFERS/CHANNEL


	TTYINN==2
	TTON==^D22
	TAPN==^D06
	MFDN==2
	UFDN==^D5		;NOTE THAT BY GRABBING MOST OF THE UFD AT
				;ONCE, A STATIC PICTURE OF THE PPN'S
				;DISK AREA IS TAKEN... I.E., FILES THAT
				;APPEAR "LATE" IN THE UFD ARE
				;NOT SAVED AT A SIGNIFICANTLY LATER TIME
				;THAN FILES WHICH APPEAR "EARLY" IN THE UFD
				;FOR EXAMPLE, THE .BAK AND ORIGINAL FILES
				;WHICH TECO MAKES WOULD BE SAVE AT THE
				;SAME (OR NEARLY SO) INSTANT, AND
				;THE PROBLEM OF THE ORIGINAL BEING SAVED
				;EARLIER (LESS RECENT) THAN THE .BAK IS
				;AVOIDED.


	ALTFLN=4			;NUMBER OF BUFFERS FOR A NON-
					;1/2 OPERATION SAVE OR RESTORE
	FILN==^D20
					;IF CORE IS TO E CONSERVED
						;CONSIDER FEWER DISK BUFFERS
					;FIRST
					;@@@@@@@@@@@@@@@@ NOTE WELL ^^^^@@@@
					;NOTE WELL ^^^^^^^  @@@@@@@

				;DISK THROUGHPUT IS MAXIMIZED
				;WHENEVER NUMBER OF BUFFERS
				;= 2*CCWMAX [CCWMAX IS DEFINED IN COMMOD.MAC, AS
				;THE MAXIMUM # OF CHANNEL
				;COMMAND WORDS FOR A DF-TYPE DEVICE].
				;EMPIRICAL RESULTS SHOW
				;FAILSAFE(!) THROUGH PUT DOES
				;NOT IMPROVE AFTER 5 BUFFERS ARE
				;ALLOCATED [I.E., 20 DISK BUFFERS
				;DOES NOT SPEED UP A STAND-ALONE SAVE,
				;EVEN USING A TU-30].
				;BUT
				;WITH THE MAXIMUM NUMBER OF BUFFERS
				;ACTIVE, FAILSAFE WILL NOT BOTHER
				;THE CHANNEL-COMMAND
				;ORGANIZER AS OFTEN AND,
				;WHEN A DISK PACK GETS ON-CYLINDER FOR
				;A FAILSAFE TRANSFER, IT WILL TRANSFER
				;A COMPLETE CYLINDER 'ROUND.
				;
;SIZE OF BUFFERS/DEVICE
	TTYSIZ==23
	TTOSIZ==TTOLEN-3
	TTOSIZ==TTOSIZ*^D5		;NUMBER OF CHUNKS PER BUFFER
					;=
					;NUMBER OF DATA WORDS *
					;NUMBER OF CHUNKS (BYTES) PER WORD
				;SIZ IN THIS CASE IS THE # CHARACTERS
	TTOLEN=^D6
				;THE TTY OUTPUT BUFFERS ARE 10 ASCII CHARACTERS
				;LONG ..  NOTE THAT JOB GOES INTO QUASI-TTY SLEEP
				;WHENEVER 100 OR SO CHARACTERS
				;GAVE BEEN ACCUMULATED BUT NOT OUTPUT.
				;HAVE ABOUT 90 CHARACTER BUFFER CAPACITY

	TAPLEN=1003
	TAPSIZ=TAPLEN-3		;SIZ OF USEFUL BUFFER SPACE IN CHUNKS OR
				;BYTES
	LPTSIZ==25
	DSKSIZ==203

;I/O STATUS BIT ASSIGNMENTS
	ASCII=0
	AL==1		;ASCII LINE MODE
	BUFBIN==14	;BUFFERED BINARY MODE
	DUMP=17		;DUMP MODE
	NOCNT==20	;MONITOR IS NOT TO COMPUTE BUFFER WORD COUNT
	IOEND==20000	;END OF FILE
	IOTBOT==4000	;BEGINNING OF TAPE
	IOTEND==2000	;END OF TAPE
	IOBAD==740000	;I/O ERROR
	DONXFR==40	;DON'T XFER  ON  CLOSING
	BTL==40000	;BLOCK TOO LARGE FOR BUFFER
	DNC==10		;DO NOT CHG ACCESS DATE
	DONDAL==04	;DON'T DE-ALLOCATED UNUSED BLOCKS WHEN RESTORING
			;ON AN OUTPUT CLOSE

;EXTENDED LOOKUP FILE STATUS BITS
	.RPDIR==400000	;(RH) UFD BIT
	.RPNFS==40000	;(RH) DO-NOT-SAVE BIT
	.RPBFA==10	;(BOTH HALVES OF UFD - RH FOR OTHER) BAD FILE ACC. BIT
	URBLGI==400000	;(LH) LOGGED IN BIT
;STATUS BITS RETURNED BY DSKCHR UUO

	.UPRHB==1B18		;MONITOR MUST REREAD HOME BLOCK
	.UPOFL==1B19		;UNIT IS OFF-LINE
	.UPHWP==1B20		;UNIT IS HARDWARE WRITE PROTECTED
	.UPSWP==1B21		;UNIT IS SOFTWARE WRITE PROTECTED
	.UPSAF==1B22		;UNIT IS SINGLE ACCESS
	.UPZMT==1B23		;ZERO MOUNT COUNT FOR THIS UNIT
	.UPNNA==1B28		;UNIT BELONGS TO A FILE STRUCTURE FOR WHICH THE
				;OPERATOR HAS REQUESTED NO MORE NEW
				;INIT'S LOOKUPS ENTERS ON
	.UNIAWL==1B29		;STRUCTURE IS WRITE PROTECTED FOR ALL JOBS







;OFFSETS WITHIN ENTER/LOOKUP BLOCK
	.RBZRO==0	;COUNT OF ARGS FOLLOWING IN RIGHT HALF
			;IF LEFT HALF NON-ZERO, 4-WORD
			;ENTER-BLOCK
	.RBPPN==1	;PROJ-PROG WHO OWNS FILE
	.RBNAM==2	;SIXBIT NAME OF FILE
	.RBEXT==3	;EXTENSION IN LEFT HALF, POSSIBLE ERROR CODE
			;ON LOOKUP RETURNED IN RIGHT HALF

	.RBPRV==4	;PRIVILEGE
			;MODE
			;CREATE
			;TIME+DATE

	.RBSIZ==5	;OFFSET FROM 1ST WORD IN ENTER BLOCK FOR SIZE
			;IN WORDS
	.RBVER==6	;OCTAL VERSION NUMBER
	.RBFUT==7	;RESERVED
	.RBEST==10	;OFFSET FOR ESTIMATED SIZE (IN BLOCKS)
	.RBALC==11	;OFFSET FOR HIGHEST RELATIVE BLOCK NUMBER
			;WITHIN FILE STRUCTURE ALLOCATED
	.RBPOS==12	;LOGICAL BLOCK NUMBER OF FIRST BLOCK
	.RBFT1==13	;RESERVED

	.RBNCA==14	;RESERVED FOR CUSTOMER
	.RBMTA==15	;TAPE!!LABEL IF ON A BACKUP TAPE


	.RBDEV==16	;UNIT NAME ON WHICH THE FILE IS LOCATED
	.RBSTS==17	;STATUS BITS
	;SEE COMMOD.MAC  MONITOR LISTING FOR FULL DESCRIPTION
			;IN THE STATUS WORD:
			RIPLOG==400000;(LEFT HALF) A 1 IF LOGGED IN
			RIPBDA==1	;A 1 IF ANY FILE IN UFD
				;FOUND BAD BY DAMAGE ASSESSMENT PROG
			RIPCRH==4	;A 1 IF ANY FILE CLOSED AFTER
				;A CRASH
			RIPBFA==10	;A 1 IF FILE(S) FOUND BAD BY ME, FAILSAFE[NOT USED]
			RIPHRE==100	;A 1 IF READ DATA ERROR IS HARD
			RIPHWE==200	;WRITE DATA ERROR IS HARD
		RIPSCE=400	;A 1 ID SOFTWARE CHECKSUM ERROR


	.RBELB==20	;BAD LOGICAL BLOCK
	.RBEUN==21	;ERROR INFO
	.RBQTF==22	;UFD ONLY -- FCFS LOGGED IN QUOTA IN BLOCKS
	.RBQTO==23	;UFD ONLY -- LOGGED OUT QUOTA IN BLOCKS

	.RBQTR==24	;UFD ONLY -- RESERVED LOGGED IN QUOTA
	.RBUSD==25	;UFD ONLY -- # OF BLOCKS USED AT LAST LOGOUT
	.RBAUT==26	;AUTHOR PROJECT-PROGRAMMER #
	.RBNXT==27	;NEXT FILE STRUCTURE NAME IF FILE CONTINUED

	.RBPRD==30	;PREDECESSOR FILE STUCTURE
	.RBPCA==31	;RESERVED FOR CUSTOMER
	.RBUFD==32	;RIB INFO



			;;TO ALLOCATE



	;MISCELLANEOUS EXTENDED ENTER PARAMETER ASSIGNMENTS
	FRAGER==17		;FRAGMENTATION ERROR CODE
				;RETURNED IN ENTER EFFECTIVE ADDRESS
				;+3, RIGHT HALF

	NOROOM==14		;SIMILAR TO FRAGER, BUT SIGNIFIES THAT
				;THAT THERE IS NO MORE ROOM FOR USER

;FLAG ASSIGNMENTS (LH OF AC F)
;	NAME & DEF	MEANING= 1

	SWITCH==400000	;SWITCH MODE
	SLASH==200000	;SWITCH MODE ENTERED W/ SLASH
	CSSW==100000	;CHAR SEEN AND STASHED INTO IDENT
	NAMESW==40000	;DO NOT COMPARE NAME OF FILE
	EXTSW==20000	;DO NOT COMPARE EXT OF FILE
	FIRSW==10000	;FIRST TAPE 
	PERSW==4000	;PERIOD SEEN
	PPFSW==2000	;PROJ-PROG AREA FOUND ON TAPE

	POPGOT==1000	;NEED TO POPJ, NOT GO FURTHER

	ETWASW==400	;SOMETHING SEEN ON THIS LINE
	ALLFSW==200	;ALL FILES CHAR SEEN
	MFDDNE==100	;SET WHEN THRU WITH MFD
	FILFND==40	;A FILE WAS SAVED FOR THIS USER
	LOCKER==20	;LOCK REQUEST
	TENDF==10	;END OF TAPE FOUND
	ACCESS==4	;RESET ACCES DATE WORD
	NEWRSW==4	;DON'T CHECK DISK FILE DATES ON RESTORE
	USRDNE==2	;ON MULTIPLE SAVE, TAPE ENDS BY ENDING A USER AREA
	KILLSW==1	;ON /S OR /U ZONK ALL FILES FROM DISK WHICH ARE SAVED ON TAPE
			;ONLY SAVE THOSE FILES WHOSE ACCESS DATES ARE LESS THAN
			;ACCDAT. DON'T SAVE FILES BELONGING TO 1,1

;POSITIONING FLAGS (MARKING POSITION PROGRAM FOR REENTER) RH OF F

	SLRESW==1	;PROGRAM IS SELECTIVELY RESTORING
	RESTSW==2	;PROGRAM IS IN RESTORING PROCESS (/R ISSUED)
	LISTSW==4	;PROGRAM IS LISTING (/L ISSUED)
	SAVSW==10	;PROGRAM IS IN SAVING PROCESS (/S ISSUED)
			;ABOVE ARE USED AS A MAGIC OCTAL #.
			; DO NOT CHANGE.
	CONTSW==20	;CONTINUING ON NEW TAPE
	PRNTSW==40	;PRINT TAPE DIRECTORY ON DEVICE LST
	USRSW==100	;SINGLE USER ONLY SAVE
	UUOERR==200	;UUO ERROR FLAG
	DOINGJ==400	;SET WHEN /J IN PROGRESS SO TAPIN CAN IGNORE
			;MISCELLANEOUS MINUS VALUES THAT MIGHT BE AT START OF
			;BOOTSTRAP FILE
	MFDI==1000	;MFD INPUT IN PROGRESS
	UFDI==2000	;UFD INPUT IN PROGRESS
	FILI==4000	;FILE INPUT IN PROGRESS (ALL FROM DSK)
	TAPO==10000	;TAPE OUTPUT IN PROGRESS
	TAPI==20000	;TAPE INPUT IN PROGRESS
	UFDO==40000	;UFD OUTPUT IN PROGRESS
	FILO==100000	;USER FILE OUTPUT IN PROG. (TO DSK)
	IFNDEF	LEVELC,<
	LEVELC==000000	;IF ENABLED FOR 5-SERIES TO 4-SERIES RESTORES
	>
				;LEVELC=200000
				;OTHERWISE, (IF LEVELC NOT = 200000,)
				;RIG FOR 5-SERIES ONLY
	IFLE	LEVELC,
	<
	AARDVARK=AARDVARK+1
VERSION=EDITNO-"@"+AARDVARK*100,,TECONO
	LOC	.JBVER
	VERSION
	RELOC
	>

	XSWITC==400000	;E"X"TRACT PROJECT-PROGRAMMER NUMBERS
			;FROM THIS TAPE



	SYNCH=40		;SYNCHRONOUS INPUT/OUTPUT

	SECVER=30		;VERSION NUMBER INCLUDING AND AFTER
				;WHICH SECONDS AS WELL AS HOURS AND MINUTES
				;ARE GIVEN
	FST5S=27		;1ST OF THE FIVE-SERIES FAILSAFES WAS VERSION 27
	TRACK7=1B33		;IT'S A 7/9 CHANNEL DRIVE ON/OFF
	ITSTTY=10		;10 RETURNED IN LEFT HALF OF
	LPT=40000
				;DEVCHR UUO SAYS DEVICE IS A TTY
				;






;MACRO DEFINITIONS


	DEFINE	TYPES		(ARG)	<
	MOVEI	CH,"ARG"
	PUSHJ	P,TYPEA
	PUSHJ	P,SPACE
	>


	DEFINE	SETBUF	(ARG)<

	IFGE	ARG'N-4<

	MOVEI	B,ARG'N-1
	SKIPA	A,[	XWD	ARG'LEN-2,ARG'BUF+1+ARG'LEN]
	HRRI	A,ARG'LEN(A)
	SETZM	-ARG'LEN-1(A)
	MOVEM	A,-ARG'LEN(A)
	SOJG	B,.-3

	MOVEI	B,(A)
	SETZM	-1(B)
	HRRI	A,ARG'BUF+1
	MOVEM	A,(B)

	>


	IFL	ARG'N-4<
	IFL	ARG'N-2<
	SETZM	ARG'BUF
	MOVE	A,[ARG'LEN-2,,ARG'BUF+1]
	MOVEM	A,ARG'BUF+1
	>
	IFGE	ARG'N-2<
	M=1
	N=M
	SETZM	ARG'BUF
	MOVE	A,[XWD	ARG'LEN-2,ARG'LEN+ARG'BUF+1]
	MOVEM	A,ARG'BUF+1

	REPEAT	ARG'N-2,<
	N=M
	M=M+1
	HRRI	A,M*ARG'LEN+ARG'BUF+1
	MOVEM	A,N*ARG'LEN+ARG'BUF+1
	SETZM	N*ARG'LEN+ARG'BUF
	>
	>
	HRRI	A,ARG'BUF+1
	MOVEM	A,M*ARG'LEN+ARG'BUF+1
	SETZM	M*ARG'LEN+ARG'BUF

	>
	>




		DEFINE	LOADPT	<
		IFE	REWIND,<
		PUSHJ	P,REWJMP>
		IFN	REWIND,<
		EMTAPE	1>
		>

	IFN	LEVELC,
	<
	DEFINE	CLOSE	(IT,UP)
	<
	TARGET==-IT
	IFNDEF	FINISH,<
	OPDEF	FINISH	[OCT	070000000000]
	>
	IFIDN	<IT><FIL>,<
	TARGET==IT>
	IFIDN	<IT><UFD>,<
	TARGET==IT>
	IFIDN	<IT><MFD>,<
	TARGET==IT>
	IFN	IT+TARGET,<
	PUSHJ	P,[
		TRNE	F,LEVELC		;IS LEVEL-C UP /
		JRST	[
			FINISH	IT,0		;YES!
			POPJ	P,
			]
		FINISH	IT,UP			;NO!
		POPJ	P,
		]
		>
		IFE	IT+TARGET,<
		FINISH	IT,UP
		>

		>
		>


	IFN	LEVELC,
	<
	DEFINE	FIXDEV<
	TRNE	F,LEVELC		;PUT THIS IN FRONT OF
					;EVERY 5-SERIES-TYPE INIT
	PUSHJ	P,[
	MOVE	A,(P)			;GET ADDRESS OF PUSHJ P,
	HRLI	A,(SIXBIT/DSK/)		;GENERATE DSK
	HLLZM	A,1(A)			;DUMP DSK BACK INTO CALL + 2
					;WHICH IS DEVICE NAME
					;SLOT
	POPJ	P,			;RETURN
	]
	>
	>




	IFLE	LEVELC,
	<
	DEFINE	FIXDEV<
	>
	>

DEFINE	PRLIN1(B)
<	XLIST
	JSP	A,PRLIN
	IFN PAGING,
	<
	JFCL	[SIXBIT	+B+]
	>
	IFE	PAGING,
	<
	SIXBIT	+B+
	>
	LIST
>


	IFN	LEVELC,
	<
	DEFINE	FIX	(IT)
	<
	TRNE	F,LEVELC
	PUSHJ	P,[
		MOVE	A,IT
		TLNE	A,-1
		POPJ	P,


		MOVE	CH,IT+1		;SAVE PPN
		MOVE	A,[XWD	IT+2,IT]
		BLT	A,IT+2
		MOVEM	CH,IT+3		;INSERT PPN
		POPJ	P,
		]
	>
	>

	IFLE	LEVELC,
	<
	DEFINE	FIX	(IT)
	<
	>
	>

					;IF LEVELC
					;AND WE ARE NOT
					;PRINTING
					;OR LISTING
					;SWAP HEADER-INFO
	IFN	LEVELC,
	<
	DEFINE	UNFIX	(IT)
	<
	TRNE	F,LEVELC!PRNTSW!LISTSW		;ARE WE IN LEVEL-C OUTPUT MODE ?
	PUSHJ	P,[
		TRNE	F,PRNTSW!LISTSW
		POPJ	P,

		MOVE	A,IT
		TLNN	A,-1			;ALREADY SWAPPED ?
		POPJ	P,


		EXCH	A,IT+2
		MOVEM	A,IT+4
		MOVE	A,IT+3
		EXCH	A,IT+1
		MOVEM	A,IT+3
		MOVEI	A,XLOOKN
		MOVEM	A,IT
		POPJ	P,
		]
		>
		>



	IFLE	LEVELC,
	<
	DEFINE	UNFIX		(IT)
	<>
		>

DEFINE	PR1(B)
<	XLIST
	JSP	A,PR
	IFN	PAGING,
	<
	JFCL	[SIXBIT	+B+]
	>
	IFE	PAGING,
	<
	SIXBIT	+B+
	>
	LIST
>
DEFINE	EMTAPE(B)
<	XLIST
	MTAPE	TAP,B
	MTAPE	TAP,0
	LIST
>
DEFINE	PRCHAR(B)
<	XLIST
	MOVEI	CH,"B"
	PUSHJ	P,TYPEA
	LIST
>



DEFINE GETBAD	(AC),
<	XLIST
	HRRZ	AC,(P)	;CALLED BY A PUSHJ FOLLOWING EXTENDED
			;ENTER, NOW GET ENTER'S EFFECTIVE ADDRESS
	MOVEI	AC,@-2(AC);AC POINTED TO ENTER +2
			;(A)-2 POINTS TO ENTER, INDIRECT BIT
			;STARTS CHAIN TO FINAL ENTER EFFECTIVE
			;ADDRESS
	IFN	LEVELC,<
	HLL	AC,(AC)	;GET LEFT HALF OF 1ST WORD OF ENTER/LOOKUP BLOCK
	TLNE	AC,-1	;IS IT = 0 ?
	JRST	LOOKER		;IF NON-ZER IN LEFT HALF
				; A FOUR-WORD ENTER
				;= A LEVELC-ENTER/LOOKUP
				;FORGET FRAGMENTATION & OTHER STRUCTURES
	>
	HRRZ	AC,3(AC);GET EFFECTIVE ADDRESS +3, RIGHT HALF
	CAIN	AC,FRAGER;FRAGMENTATION ERROR ?
	JRST	FIXFRG	;FRAGMENTATION, FIT IT
	POP	P,AC	;NOPE FIND OUT WHAT'S THE MATTER
	LIST
	>
;INITIALIZATION
;CODE MAY BE LOADED BEFORE THIS, BUT NOT AFTER... DUE TO
;CORE EXPANSION-CONTRACTION

START:	CALLI	RESET		;STOP THE WORLD
	MOVEI	A,TAPBUF+VSTBUF
	HRRM	A,GLEEP
	MOVSI	A,400000	;THE NOT USED YET BIT
	IORM	A,FILHED
	IORM	A,TAPHED	;FOR TAPE TOO
	MOVE	P,[ IOWD	PDSIZ,PDL]
	SETZM	ACCDAT#		;CLEAR ACCESS DATE WORD ON START ONLY
	SETZM	STARPT		;RESET WE HAVE SEEN A STARTING POINT
	SETZM	FNDBEG		;RESET WE HAVE SEEN THE HEADER RECORD
	SETZB	D,CRDATE#	;CLEAR DATE WORD ON START ONLY
	PUSHJ	P,DINSTD	;SETUP FOR STANDARD DENSITY
				;NOTE THAT THE SKIP IS TAKEN
	JFCL			;NEVER REACHED DUE TO SKIP
	MOVEI	A,RENTER	;REENTER ADDRESS
	MOVEM	A,.JBREN
	CALLI	A,GETPPN	;GET USER'S PROJ-PROG #
	  JFCL			;BE DEFENSIVE
	MOVEM	A,USRPPN#
	MOVEM	A,SLGPPN#		;SOUGHT PPN
	MOVEM	A,SLOPPN#		;DESIRED DESTINATION PPN
	SETZB	F,ONEFIL		;RESET FLAGS
					;RESET WE HAVE ALREADY OPENED SHADOW CHANNEL
					;AND SWITCHES
				;
				;I AM LOGGED IN AS XX,YY
				;MY USER PPN GOES INTO USRPPN
				;I HAVE THE RIGHT TO DO SO, SO I
				;ELECT TO GET (/G) ANOTHER'S AREA
				;SO, WITH /G, I GRAB MM,NN
				;AND I MY ALSO OVERWRITE THE 
				;AREA GRABBED (MM,NN) BY USING
				;THE /O SWITCH.... THUSLY
				;/OAA,BB
				;THE NET EFFECT IS THAT
				;AS XX,YY   I   CAN
				;GRAB  MM,NN'S AREAS
				;AND WRITE THEM OUT AS IF THEY BELONGED TO
				;AA,BB
					;N.B.
				;IF THE STRUCTURES ARE NOT THE SAME IN ALL CASES,
				;AND IF ACCESS IS NOT ALLOWED TO
				;AA,BB OR MM,NN
				;THE SAVE   AND/OR   RESTORE WILL
				;NOT WORK.
	PUSHJ	P,TTYINI	;INIT THE TTY

;BEGIN OPERATIONS
;ALSO VARIOUS REENTRY POINTS

FS1:	IFE	REWIND,<PRLIN1 (REWINDS ARE NOT AUTOMATIC.#)
	MOVE	A,[JRST	FS1.1]
	MOVEM	A,FS1			;SET SWITCH TO JUMP AROUND REWIND MESSSAGE
>;	END OF IFE REWIND
FS1.1:	IFN	LEVELC,
	<
	MOVE	A,[XWD	17,11]
	GETTAB	A,
	MOVEI	A,0
	TLNN	A,(7B9)
	TROA	F,LEVELC		;SETUP FOR LEVEL C
	TRZ	F,LEVELC
	>
	PRLIN1	<FAILSAFE VERSION#>
	MOVE	TMP,.JBVER		;FAILSAFE BRAND INTO TMP FOR PRINTING
	PUSHJ	P,PRPPN1

FS1.1A:	PR1	<; FOR HELP, READ SYS:FAILSA.HLP, OR TYPE /H@>
	MOVE	A,[JRST	[PUSHJ	P,CRLF
			JRST	FS1.1B]]
	MOVEM	A,FS1.1A
FS1.1B:	SETZM	TALKER#		;TELL TALK SWITCH TO BE QUITE
	SETZM	RECIRC#		;TELL REWJMP: TO REWIND 
	SETZM	JFLAG		;TELL THE /J CO-ORDINATOR THAT THERE
	SETZM	FNDBEG#
				;HAVEN'T BEEN ANY /J'S SO FAR
FS1.2:	TLZ	F,PPFSW		;PREVIOUS TAPE POSITION IGNORED
FS1AA:	MOVE	P,[IOWD PDSIZ,PDL]	;RESET PDL IN CASE OF REENTRY
FS1A:	SETZM	TTYI+2		;FLUSH PREVIOUS INPUT
	PUSHJ	P,ASTRSK	;TYPE "*"
GLEEP:	MOVEI	A,TAPBUF+VSTBUF	;ENOUGH CORE FOR TTY BUFS
				;AND VESTIGIAL BUFFER AREA
				;FOR MTAPE TAPE OPERATIOJNS
				;AND ANY DANGLING INFORMATION
				;LEFT IN MAG TAPE BUFS
PGLEEP:	MOVEI	B,MFDBUF	;BUT 1ST TIME THROUGH
	HRRM	B,GLEEP		;LEAVE ENOUGH CORE FOR TTY BUFS ONLY
	IFN	LOCK,<
	TLNE	F,LOCKER
	JRST	FS1B
		>
	IFE	DEBUG,<
	CALLI	A,CORE		;GET SOME MEMORY
	>
	IFN	DEBUG,<
	CAIA			;ALWAYS HAVE ENOUGH MEMORY
	>
	JRST	NOCORE		;NO CORE FOR YOU
FS1B:	TRZ	F,-1-LEVELC		;NO IO IN PROGRESS
	TLZ	F,SWITCH!SLASH!ETWASW!ALLFSW!FILFND!NEWRSW!MFDDNE	;ST NORML MOD
FS1.5:	TLZ	F,CSSW!PERSW!TENDF!KILLSW!USRDNE!ALLFSW!NAMESW!EXTSW!POPGOT
	;RDY FOR NXT IDNTIFIR
	HRROI	R,-6		;INIT NEXT IDENTIFIER SCAN
FS1.7:	MOVE	S,[POINT 6,IDENT#]
	SETZM	IDENT
;INPUT CHARACTER DISPATCH

FS2:	SETZM	SYNCIN		;RESET SYNCHRONOUS INPUT FLAG
				;SWITCH

	PUSHJ	P,TYI		;GET A COMMAND CHARACTER
	MOVE	A,CH		;DISPATCH ON COPY
	IDIVI	A,11		;ARRANGE ENTRY INTO MATRIX
	LDB	A,FS3(A+1)	;GET CLASSIFICATION CODE
	JUMPE	A,ILCH		;ZERO IS AN ILLEGAL CHAR
	CAIGE	A,4		;SHIFT CODES GREATER THAN 4
	TLNN	F,SWITCH	;TO ALLOW SPACE FOR SWITCH MODE
	MOVEI	A,3(A)
	CAIGE	A,10		;RH OR LF DISPATCH ?
	SKIPA	B,FS5-1(A)	;RIGHT HAND
	HLRZ	B,FS5-10(A)	;LEFT HAND DISPATCH
	JRST	(B)		;GO AWAY

;INPUT CHARACTER DISPATCH MATRIX

FS3:	POINT	4,FS4(A),3	;BYTE POINTERS TO CLASSIFICATION TABLE
	POINT	4,FS4(A),7
	POINT	4,FS4(A),11
	POINT	4,FS4(A),15
	POINT	4,FS4(A),19
	POINT	4,FS4(A),23
	POINT	4,FS4(A),27
	POINT	4,FS4(A),31
	POINT	4,FS4(A),35



;	CLASSIFICATION TABLE FOR INPUT CHARACTERS
;	ADD 3 TO CODE IF NOT IN SWITCH MODE
;	SECOND ALPHABET SET REPRESENTS LOWER CASE CHARACTER CODES

;	NUL SOH STX ETX EOT ENQ ACK BEL BS
;	HT  LF  VT  FF  CR  SO  SI  DLE DC1
;	DC2 DC3 DC4 NAK SYN ETB CAN EM  SUB
;	ESC FS  GS  RS  US  SP  !   "   #
;	$   %   &   '   (   )   *   +   ,
;	-   .   /   0   1   2   3   4   5
;	6   7   8   9   :   ;   <   =   >
;	?   @   A   B   C   D   E   F   G
;	H   I   J   K   L   M   N   O   P
;	Q   R   S   T   U   V   W   X   Y
;	Z   [   \   ]   ^   _   '   A   B
;	C   D   E   F   G   H   I   J   K
;	L   M   N   O   P   Q   R   S   T
;	U   V   W   X   Y   Z   173 174 175   
;	176 DEL

FS4:	BYTE	(4)4,0,0,0,0,0,0,0,0
	BYTE	(4)4,13,4,4,13,0,0,0,0
	EXP	0
	BYTE	(4)13,0,0,0,0,4,0,4,0
	BYTE	(4)0,0,0,0,5,3,6,0,11
	BYTE	(4)0,7,12,2,2,2,2,2,2
	BYTE	(4)2,2,2,2,2,0,0,10,0
	BYTE	(4)0,0,1,1,1,1,1,1,1
	BYTE	(4)1,1,1,1,1,1,1,1,1
	BYTE	(4)1,1,1,1,1,1,1,1,1
	BYTE	(4)1,0,0,0,0,10,0,0,0
	EXP	0
	EXP	0
	BYTE	(4)0,0,0,0,0,0,0,0,13
	BYTE	(4)13,4

;	BYTE	DISP	CLASSIFICATION

;	00	00	ILLEGAL CHARACTER

;	01	01	LETTER, SWITCH MODE
;	02	02	NUMBER, SWITCH MODE
;	03	03	ESCAPE CHAR, SWITCH MODE

;	01	04	LETTER, NORMAL MODE
;	02	05	NUMBER, NORMAL MODE
;	03	06	ESCAPE CHAR, NORMAL MODE

;	04	07	IGNORED CHAR
;	05	10	ENTER SWITCH MODE CHAR
;	06	11	ALL FILES CHAR
;	07	12	FILE EXTENSION DELIMITER
;	10	13	OUTPUT SPEC DELIMITER(=,_)
;	11	14	FILE DELIMITER
;	12	15	NEXT CHAR A SWITCH CHAR
;	13	16	LINE TERMINATION

FS5:	XWD	SENTER,SLETTR	;10,1
	XWD	ALLFIL,SDIGIT	;11,2
	XWD	EXTDLM,SLEAVE	;12,3
	XWD	NOTYET,NLETTR	;13,4
	XWD	COMMA,NLETTR	;14,5
	XWD	SLENTR,ILCH	;15,6
	XWD	LINTER,FS2	;16,7
SUBTTL ***SWITCH PROCESSOR***
;SWITCH MODE DISPATCHING

SDIGIT:	MOVEI	CH,133-60(CH)	;OFFSET NUMERIC VALUE PAST Z FOR SWITAB
SLETTR:	LDB	A,[POINT 9,.JBVER,11]		;INSURE HEADER KNOWS
						;WHICH VERSION YOU ARE
						;BEFORE EACH SWITCH ACTION
	HRLM	A,FIRBLK
	XCT	SWITAB-"A"(CH)				;PERFORM THE SWITCH FUNCTION
SLENTR:	TLOA	F,SLASH		;ENTER SLASH MODE
	TLZN	F,SLASH		;STAY IN SWITCH MODE?
SENTER:	TLOA	F,SWITCH	;ENTER SWITCH MODE
SLEAVE:	TLZ	F,SWITCH	;LEAVE SWITCH MODE
	MOVEI	D,0		;COUNTER OR MTAPE REGISTER
	JRST	FS2		;LOOK AT NEXT CHAR

SWITAB:	PUSHJ	P,SWSKIP	;A - ADVANCE THE MAGTAPE ONE FILE
	PUSHJ	P,SWBAKF	;B - BACKSPACE THE MAGTAPE ONE FILE
	PUSHJ	P,CONTIN	;C - CONTINUE
	PUSHJ	P,CALDDT	;D - GO TO DDT (IF EXTANT)
	PUSHJ	P,SETCRE	;E - SET CREATION DATE CHECK TIME AND DATE
	PUSHJ	P,SETACC	;F - SET ACCESS DATE CHECK DATE
	PUSHJ	P,AREA		;G - GET PROJECT-PROGRAMMER NUMBER
	PUSHJ	P,HELPER	;H - THE HELP MESSAGE FROM SYS:FAILSA.HLP
	PUSHJ	P,DINSTD	;I - DENSITY = INSTALLATION STANDARD
IFE	REWIND,<
	PUSHJ	P,JUMPSV	;J - JUMP TO NEXT TRAILER RECORD
	>
IFN	REWIND,<
	JRST	ILSW		;J - ILLEGAL
	>
	TLOA	F,KILLSW	;K - KILL ALL OLD DISK FILES SAVED ON TAPE
	PUSHJ	P,LIST		;L - LIST USERS FILES FROM TAPE
	JRST	MNYSAV		;M - MULTIPLE SAVES EVERY SLPMIN MINUTES
	TLOA	F,NEWRSW	;N - INHIBIT DISK FILE DATE CHECK ON RESTORE
	PUSHJ	P,SLOSWT	;O - OVERWRITE THE PERSON NAMED IN /G
	PUSHJ	P,PRINT		;P - PRINT DIRECTORY OF ALL FILES ON DEVICE LST
	PUSHJ	P,[SETZM TALKER	;Q - TURN OFF THE /T SWITCH
		JRST	CPOPJ1]
	PUSHJ	P,UNSAVE	;R - RESTORE THE DISK FROM MAGTAPE
	PUSHJ	P,SAVE		;S - SAVE THE DISK ON MAGTAPE
	PUSHJ	P,[SETOM TALKER	;T - TELL USER WHAT FILES WERE FOUND / XFERED
		JRST	CPOPJ1]
	PUSHJ	P,USAVE		;U - SAVE A USERS AREA
	IFNDEF	LOCK<
	JRST	ILSW		;V - ILLEGAL
	>
	IFN	LOCK,<
	PUSHJ	P,LOC		;V - VERY FAST SAVE (?) LOCK JOB IN CORE
				;    IF /S AND ALLOWED TO LOCK AS WELL AS /V
	>
	PUSHJ	P,SWREW		;W - REWIND THE MAGTAPE
	PUSHJ	P,GOTANX	;X - E"X"TRACT PROJECT PROGRAMMER NUMBERS
	SETZM	RECIRC		;Y - RECIRCULATE THE TAPE (REWIND IT)
				;Y AND Z FACILITATE MANUAL POSITIONING
				;OF THE TAPE TO JUST BEFORE THE NEXT
				;TRAILER RECORD, DOING A /J TO GET
				;TO THE END OF THE CURRENT SAVE SET,
				;AND THEN BEING ABLE TO GET AROUND THE
				;PROBLEM OF FAILSAFE'S THINKING THAT
				;THERE IS BUT 1 SAVE SET (1 /J DONE)
				;WHEN HT REWINDS AND DOES AUTOMATIC
				;/J'S.  ALSO SAVES TIME...
	SETOM	RECIRC		;Z - DEFEAT THE REWINDING OF THE TAPE
	JRST	NILSW		;0 - ILLEGAL
	JRST	NILSW		;1 - ILLEGAL
	PUSHJ	P,D200		;2 - DENSITY = 200 BPI
	JRST	NILSW		;3 - ILLEGAL
	JRST	NILSW		;4 - ILLEGAL
	PUSHJ	P,D556		;5 - DENSITY = 556 BPI
	JRST	NILSW		;6 - ILLEGAL
	JRST	NILSW		;7 - ILLEGAL
	PUSHJ	P,D800		;8 - DENSITY = 800 BPI
	JRST	NILSW		;9 - ILLEGAL
;"/H" SWITCH - TYPE <SYS:FAILSA.HLP>

HELPER:	OPEN	MES,HELPS
	JRST	ILSW
	MOVE	B,FS6BIT
	MOVSI	CH,(SIXBIT	/HLP/)
	LOOKUP	MES,B		;'FAILSA.HLP'
	  JRST	[PRLIN1 <"SYS:FAILSA.HLP" FILE NOT FOUND@>
		JRST	FS1.1	]
MORHLP:	INPUT	MES,
	STATZ	MES,20000	;EOF ON FAILSA.HLP (FINISHED ?)
	JRST	RELMES
	HRRZ	R,HELPIT+1
	OUTSTR	1(R)
	JRST	MORHLP

RELMES:	RELEAS	MES,0		;RELEAS THE CHANNEL
	JRST	CRLF

;"/V" SWITCH
	IFN	LOCK, <
LOC:	MOVEI	TMP,1
	TLNE	F,LOCKER		;LOCKED ALREADY ?
	JRST	UNLOC		;IF LOC & /V TYPED, TRY UNLOCKING JOB
	MOVEI	B,ENDIF2	;GET ALL THE CORE YOU WANT NOW!
	CALLI	B,CORE
	  JRST	NOCORE		;OOPS NO CORE
	TLOA	F,LOCKER		;SET THE FLAG AND POPJ
UNLOC:	CALLI	TMP,UNLOCK
	POPJ	P,
	TLZ	F,LOCKER		;AOK, RESET LOCK FLAG
	POPJ	P,			;AND RETURN
		>
;"/A /B /W" SWITCH - MAGTAPE OPERATIONS

SWBAKF:	MOVEI	D,1(D)		;BACKSPACE FILE (MTAPE 17)
SWSKIP:	MOVEI	D,15(D)		;SKIP FILE (MTAPE 16)
SWREW:	SKIPG	TAPHED		;SAY, DO WE NEED TO INIT THIS MTA /
				;WHEN IT WAS LOADED? IF SO, NO INIT DONE
	PUSHJ	P,SETI
				;(EITHER SETI OR SETO WILL DO)
				;(JUST BE SURE YOU HAVE AN MTA)
				;SETIN WILL
	MTAPE	TAP,1(D)	;REWIND + FUNCTION IN D
	IFG	LEVELC,<	;LEVELC MAY NOT ALLOW SUCCESSIVE MTAPES
				;WITHOUT WAITING
	MTAPE	TAP,0		;WAIT TIL DONE
	>

	RELEAS	TAP,0		;RELEASE TAPE.. WILL FORCE AN INIT
				;LATER WHICH IS NECESSARY DUE
				;TO OUR HAVING DESTROYED THE CORRELATION
				;BETWEEN PHYSICAL TAPE AND BUFFERS



	TLZ	F,PPFSW		;MOVED TO NEW PLACE ON TAPE
IFE	REWIND,<
	TRNN	D,-1		;REWIND ?
	SETZM	JFLAG		;YES, CLEAR /J CTR
	>
	TRZN	D,-1		;IF /A OR /B, DO NOT DESTROY RECORD OF HAVING
				;FOUND FIRST HEADER.. LET HIM HANG HIMSELF
RSTFBG:	SETZM	FNDBEG		;YES... RESET YOU'VE FOUND FIRST HEADER
	JRST	CPOPJ1		;RETURN AT SLENTR+1

;"/2 /5 /8" SWITCH - ROUTINES TO SET MAGTAPE DENSITY

D800:	MOVEI	D,1(D)		;DENSITY BITS = 11
D556:	MOVEI	D,1(D)		;DENSITY BITS = 10
D200:	MOVEI	D,1(D)		;DENSITY BITS = 01
DINSTD:	DPB	D,[POINT	2,INIT1,28]
	JRST	CPOPJ1		;RETURN AT SLENTR+1

;"/D" SWITCH - ENTER DDT

CALDDT:	SKIPE	A,.JBDDT	;DOES DDT EXIST
	JRST	(A)		;YES,GO TO IT
	PRLIN1	<$NO DDT@>
	JRST	CPOPJ1		;RETURN AT SLENTR+1

;"/M" SWITCH - DO A /S AT TIMES 00:00 + N*SLPMIN

MNYSAV:	PUSHJ	P,SAVE		;SAVE ENTIRE DISK
	JFCL			;RETURNS TO NEXT INSTRUCTION
	CALLI	A,MSTIME	;GET TIME IN MILLISECS
				;GET TIME IN MINUTES
	IDIVI	A,^D1000*^D60	;GET MINUTES TO NEXT SAVE INTO B
	IDIVI	A,SLPMIN	;NOW GET RESIDUE
SLP1:	MOVEI	A,^D60		;SLEEP ONE MINUTE
	CALLI	A,SLEEP
	SOJG	B,SLP1		;CONTINUE SLEEPING UNTIL B RUNS OUT
	JRST	MNYSAV		;WAKE UP & SAVE AGAIN

;"/J" SWITCH - JUMP TO THE BEGINNING OF THE NEXT SAVE SET

IFE	REWIND,<
JUMPSV:	SETZM	STARPT		;DOING A /J NULLIFIES OUR REMEMBERING
				;WHERE WE STARTED READING FROM ON THE TAPE
JMPSAV:	TRO	F,DOINGJ		;TURN ON /J FLAG
JMPINN:	PUSHJ	P,SETIN			;OOPS, NOT QUITE READY FOR INPUT
					;WE GOT HERE IF LAST DOING OUTPUT
					;OR INPUT DONE LAST, BUT CLOSE (AND POSSIBLY
					;A RELEASE !!!!!) DONE

JMP1:	PUSHJ	P,SKPTAP		;LOOK FOR SOMETHING LIKE A
					;DIRECTORY RECORD
					;(MIGHT BE A HEADER/TRAILER/OR DIRECTORY)
	MOVE	B,TAPHED
	HRRE	A,4(B)			;THIS A HEADER-TRAILER,  WHICH OF THE 2
	JUMPG	A,JMP1			;JUMP IF A HEADER
JMP4:	PUSHJ	P,GETEOF		;SKIP TO NEXT EOF
	AOS	JFLAG#		;UP /J COUNTER
	TRZ	F,DOINGJ	;TURN OFF /J
	JRST	RSTFBG		;RETURN
				;AFTER RESETTING
				;THAT YOU HAVE SEEN THE HEADER
				;RECORD FOR THIS
				;SAVE SET... YOU HAVE JUST SUCCESSFULLY
				;LEFT THIS SAVE SET


>
;SAVE OR RESTORE ONLY THOSE FILES CREATED ON OR LATER THAN
;DATE SPECIFIED IN /E COMMAND
;SAVE OR RESTORE ONLY THOSE FILES ACCESSED ON OR LATER THAN
;DATE SPECIFIED IN /F COMMAND

;IF /K IS USED WITH /S OR /U, TRANSFER ONLY THOSE FILES WHOSE ACCESS
;DATES ARE LESS THAN THAT SPECIFIED BY /F COMMAND.
;AND DELETE SUCH FILES FROM DISK.
;DON'T DO ANYTHING TO FILES BELONGING TO 1,1.
;COMMAND FORMAT IS

;/EMM/DD/YY,TTTT<CARRIAGE RETURN>

;WHERE MM = NUMERICAL MONTH (MAY BE SINGLE DIGIT)
;WHERE DD = NUMERICAL DAY (MAY BE SINGLE DIGIT)
;WHERE YY = TWO DIGIT YEAR
;WHERE TTTT = FOUR DIGIT MILITARY TIME

;IF COMMA IS TYPED,
;NULL DATE FIELD IMPLIES TODAY'S DATE
;NULL TIME FIELD IMPLIES 0000

;/E<CARRIAGE RETURN>  SETS TIME TO 1/1/64,0000

;D CONTAINS DECIMAL NUMBERS
;T CONTAINS TEMPORARY DATUM UNTIL COMMAND IS PROCESSED

;ON A /F COMMAND START AT SETACC AND SET A WORD WHICH IS COMPARED
;TO THE ACCESS DATE IN A LOOKUP BLOCK
;A NULL ARGUMENT WITHOUT COMMA SETS ACCESS DATE WORD TO 1/1/64
;A NULL ARGUMENT WITH COMMA SETS ACCESS DATE WORD TO TODAY'S DATE
;SET DATE AND TIME

;"/E /F" SWITCH
; ENTER AT SETACC ON /F
; ENTER AT SETCRE ON /E

SETACC:	TLO	F,ACCESS	;SET ACCESS DATE WORD ON /F
SETCRE:	SETZB	T,MONAT#
	SETZB	D,TAG#
				; FALL INTO GCHAR
;COMMAND INTERPRETER FOR /E OR /F COMMAND

G1CHAR:	MOVEI	D,0		;CLEAR D
GCHAR:	PUSHJ	P,TYI		;GET A CHAR
	MOVE	A,CH		;PROCESS IT IN A
	IDIVI	A,^D9		;SET UP FOR DISPATCH
	LDB	A,FS3(A+1)	;GET CHAR CODE
	CAIGE	A,6		;WHICH HALF OF THE TABLE ?
	SKIPA	B,CHRDSP(A)	;RIGHT HALF
	HLRZ	B,CHRDSP-6(A)	;LEFT ONE, NOW GET IT
	CAIN	CH,":"		;COLONS ARE NOT DIGITS		[44]
	MOVEI	B,GCHAR		; SO IGNORE IT		[44]
	CAIN	CH," "		;SPACES ARE IGNORED SO IT'S	[44]
	JUMPN	D,ILCH		; ILLEGAL AS A DATE TERMINATOR	[44]
	JRST	(B)		;NO, DISPATCH

;CHARACTER DISPATCH TABLE FOR /E OR /F COMMAND

CHRDSP:	XWD	ILCH,ILCH	;6,0
	XWD	ILCH,ILCH	;7,1
	XWD	ILCH,DIGIT	;10,2
	XWD	ACOMMA,ILCH	;11,3
	XWD	SLA,GCHAR	;12,4
	XWD	TERM,ILCH	;13,5

;COMPILE DECIMAL NUMBERS

DIGIT:	IMULI	D,^D10		;MUL LAST DIGIT BY 10
	ADDI	D,-60(CH)	;ADD DECIMAL VALUE OF NEW DIGIT
	JRST	GCHAR		;GET NEXT CHARACTER

;GET MONTH OR DAY PRECEDING SLASH

SLA:	SKIPE	MONAT		;DO WE HAVE MONTH YET?
	JRST	SLADAY		;YES, GO CHECK DAY
	JUMPE	D,COMERR	;NO, D = 0 IMPLIES COMMAND ERROR
	CAILE	D,^D12		;MONTH IN RANGE?
	JRST	NUMOUT		;NO, ERROR
	MOVEM	D,MONAT		;YES, SAVE VALUE
	JRST	G1CHAR		;GET NEXT CHARACTER

SLADAY:	SKIPE	TAG		;DO WE HAVE DAY YET?
	JRST	COMERR		;YES, COMMAND ERROR
	JUMPE	D,COMERR	;NO, VALUE = 0 IMPLES COMMAND ERROR
	CAILE	D,^D31		;DAY IN RANGE?
	JRST	NUMOUT		;NO, ERROR
	MOVEM	D,TAG		;SAVE VALUE
	JRST	G1CHAR		;GET NEXT CHAR
;PROCESS /E OR /F FIELD TERMINATORS

;COMMA SEPARATES DATE FROM TIME

ACOMMA:	PUSHJ	P,GETDAT	;COMPILE DATE
	TLNN	F,ACCESS	;/F OR /E?
	JRST	GCHAR		;/E, GO LOOK FOR TIME
ACOMM3:	MOVEM	T,ACCDAT	;/F, SAVE ACCESS DATE
	JRST	FS1AA		;GET NEXT COMMAND

;CARRIAGE RETURN TERMINATES /E OR /F

TERM:	JUMPN	T,.+2		;IF WE HAVE DATE ALREADY, GET TIME
	PUSHJ	P,GETDAT	;COMPILE DATE
	IDIVI	D,^D100		;GET HOURS IN D, MINUTES IN U
	IMULI	D,^D60		;CONVERT HOURS TO MINUTES
	ADD	D,U		;TOTAL MINUTES
	CAIL	D,^D24*^D60	;LESS THAN ONE DAY?
	JRST	NUMOUT		;NO, OUT OF RANGE
	LSH	D,^D15		;MOVE TO TIME FIELD
	ADD	T,D		;COMBINE TIME WITH DATE
	TLNE	F,ACCESS	;/F OR /E?
	JRST	ACOMM3		;/F
	MOVEM	T,CRDATE	;/E
	JRST	FS1AA		;RETURN FOR NEXT COMMAND

;COMPILE DATE

GETDAT:	SKIPE	TAG		;DAY SPECIFIED?
	JRST	GETDA1		;YES, COMBINE MONTH & YEAR
	SKIPN	MONAT		;NO, HAS MONTH BEEN SPECIFIED?
	JUMPN	D,COMERR	; OR YEAR?
				;PARTIAL DATE
	CAIN	CH,","		;IF TERM. CHAR. WAS CR, LEAVE T=0
	CALLI	T,DATE		;NULL DATE WITH COMMA IMPLIES TODAY
	POPJ	P,
GETDA1:	SKIPE	MONAT		;MONTH SPECIFIED?
	JUMPE	D,COMERR	; OR YEAR?
				;PARTIAL DATE
	SUBI	D,^D64		;SUBTRACT BASE YEAR (1964)
	JUMPL	D,NUMOUT	;YEAR OUT OF RANGE
	IMULI	D,^D12		;CALCULATE DATE: YEAR*12
	SOS	MONAT		;MONTH-1
	ADD	D,MONAT
	IMULI	D,^D31		;((Y-64)*12+M-1)*31
	SOS	T,TAG		;DAY-1
	ADD	T,D
	SETZ	D,		;CLEAR NUMBER REGISTER
	POPJ	P,
;"/G" SWITCH - GET PROJECT-PROGRAMMER NUMBER
;TO ALLOW /U OR /L OR SELECTIVE RESTORE
;ON AN AREA DIFFERENT FROM HIS OWN

AREA:	SETZB	D,SLGPPN	;INIT
AREA0:	PUSHJ	P,TYI		;GET CHAR FOLLOWING /G
	MOVE	A,CH		;(JUST LIKE GCHAR)
	IDIVI	A,11
	LDB	A,FS3(A+1)
	CAIGE	A,6		;WHICH 1/2 OF DISPATCH TABLE ?
	SKIPA	B,ARADSP(A)	;RIGHT
	HLRZ	B,ARADSP-6(A)
	JRST	(B)

;CHARACTER DISPATCH TABLE FOR /G

ARADSP:	XWD	ILCH,ILCH	;6,0
	XWD	ILCH,ILCH	;7,1
	XWD	ILCH,ADIGIT	;10,2
	XWD	ARACOM,ILCH	;11,3
	XWD	ILCH,AREA0	;12,4
	XWD	ATERM,ILCH	;13,5

;COMPILE NUMBRS FOR /G

ADIGIT:	IMULI	D,10		;PREVIOUS * 8
	ADDI	D,-60(CH)	;+ NEW
	JRST	AREA0

;STORE PROJECT # WHEN COMMA SEEN

ARACOM:	HRLZM	D,SLGPPN
	SETZ	D,
	JRST	AREA0

;STORE PROGRAMMER # WHEN CR SEEN

ATERM:	HRRM	D,SLGPPN
	XLIST
	IFN	PRIVL,
	<LIST
	MOVE	D,USRPPN		;CHECK OUT TO SEE IF WE SHOULD
				;ALLOW USER TO PLAY
	CAMN	D,FSPP		;FAILSAFE PROJECT PROGRAMMER NO
				;MAY TRY ANYHTING
	JRST	FS1AA		;ANDRETURN
	CAME	D,SLGPPN		;WELL, IF NOT FAILSAFE
	JRST	OHNO		;SEE IF HE IS TRYING TO GET HIMSELF
	LIST
	>
	LIST
	JRST	FS1AA		;RETURN FOR NEXT COMMAND
;"/O" SWITCH - WRITE FILES ON THIS PPN'S DSK AREA

SLOSWT:	SETZB	D,SLOPPN		;ZERO OUT BOTH
OSLASH:	PUSHJ	P,TYI			;GET SOME INPUT
	MOVE	A,CH			;SAVE WHAT YOU  GOT
	IDIVI	A,^D9			;DIVIDE BY 9
	LDB	A,FS3(A+1)		;COPIED DIRECTLY FROM /G
	CAIGE	A,6
	SKIPA	B,SLASHO(A)
	HLRZ	B,SLASHO-6(A)
	JRST	(B)


;CHARACTER DISPATCH TABLE FOR /O

SLASHO:	XWD	ILCH,ILCH		;6,0
	XWD	ILCH,ILCH		;7,1
	XWD	ILCH,DIGGIT		;10,2
	XWD	COMMER,ILCH		;11,3
	XWD	ILCH,OSLASH		;12,4
	XWD	TERMAL,ILCH		;13,5



DIGGIT:	IMULI	D,10
	ADDI	D,-60(CH)
	JRST	OSLASH

COMMER:	HRLZM	D,SLOPPN
	SETZ	D,
	JRST	OSLASH


TERMAL:	HRRM	D,SLOPPN
	XLIST
	IFN	PRIVL,
	<
	LIST
	MOVE	D,USRPPN
	CAMN	D,FSPP		;IF FAILSAFE IS RUNNING, LET HIM DO
				;ANYTHING
	JRST	FS1AA		;AOK
	CAME	D,SLOPPN		;HE CAN ONLY OVERWRITE HIMSELF
	JRST	OHNO
	>
	LIST
	CAME	D,SYSPP		;SEE IF THIS GUY IS TRYING
				;SOMETHING FUNNY WITH 1,1

	JRST	FS1AA			;RETURN FOR NEXT COMMAND

	PRLIN1	<?ONLY 1,2 MAY ACCESS THE MFD,#>
	JRST	NONO

	XLIST
	IFN	PRIVL,<
	LIST
OHNO:	PRLIN1	<?ONLY 1,2 MAY ACCESS OTHER USERS' FILES,#>
	>
	LIST
NONO:	MOVE	TMP,USRPPN
	PUSHJ	P,PRPPN1		;PRINT OUT PR-PPN
	JRST	REINFO
SUBTTL ***SAVE CODE***
;"/U" SWITCH - SAVE COMMAND EXECUTION

USAVE:	TRO	F,USRSW		;SINGLE USER SAVE
				;NOW CHECK FOR /G PPN = /O PPN
	MOVE	A,SLGPPN
	CAMN	A,SLOPPN
	JRST	SAVE1		;/G=/O....
	PRLIN1	<SAVING#>
	MOVE	TMP,SLGPPN
	PUSHJ	P,PRPPN1
	PUSHJ	P,CRLF		;BUG POINTED OUT IN QAR
	JRST	SAVE1

;"/S" SWITCH

SAVE:	CALLI	A,GETPPN
	  JFCL			;BE DEFENSIVE
	CAME	A,FSPP		;LOGGED IN AS 1,2?
	JRST	NOTFS		;NO, TELL USER
SAVE1:	TRO	F,SAVSW		;/S IN PROGRESS
	TRZ	F,RESTSW	;TURN OFF IN CASE OF /C
	IFE	REWIND,<	SETZM	JFLAG		;CLEAR /J CTR
	>
	SETZM	TAPNUM#		;FIRST TAPE IS #1
	SETZM	DSKNAM		;CLR DSKNAM BLK
	MOVE	A,[XWD DSKNAM,DSKNAM+1]
	BLT	A,DSKNME-1
	MOVE	A,[POINT 6,DSKNAM]	;SET SEMI-DYNAMIC POINTER
	MOVEM	A,DSKNPT#
	HRROI	Q,-NUMSTR	;NAME STORE CTR

;DISPATCH ROUTINE FOR READING FILE STRUCTURE NAMES AFTER /S,/U

SAVLST:	HRROI	R,-6		;NAME CHAR CTR
	MOVE	S,DSKNPT	;NAME STORE PTR
SAVLS0:	PUSHJ	P,TYI		;JUST LIKE GCHAR
	MOVE	A,CH
	IDIVI	A,11
	LDB	A,FS3(A+1)
	CAIGE	A,6
	SKIPA	B,STRDSP(A)
	HLRZ	B,STRDSP-6(A)
	JRST	(B)

STRDSP:	XWD	ILCH,ILCH	;6,0
	XWD	ILCH,SCHAR	;7,1
	XWD	ILCH,SCHAR	;10,2
	XWD	SCOMMA,ILCH	;11,3
	XWD	ILCH,SSPACE	;12,4
	XWD	STERM,ILCH	;13,5
;IGNORE SPACE OR TAB AFTER /S,/U

SSPACE:	CAIE	CH,11		;TAB?
	CAIN	CH,40		;SPACE?
	JRST	SAVLS0		;YES
	JRST	ILCH		;OTHERWISE, BAD CHAR

;STORE CHARACTER OF FILE STRUCTURE NAME

SCHAR:	AOJG	R,SAVLS0	;IGNORE AFTER 6TH
	MOVEI	CH,-40(CH)	;MAKE 6-BIT
	CAIE	CH,32		;IS IT A : ?
	IDPB	CH,S		;STORE IN DSKNAM
	JRST	SAVLS0

;FILE STRUCTURE DELIMITER

SCOMMA:	AOS	DSKNPT		;MOVE PTR TO NEXT WORD
	AOJL	Q,SAVLST	;GET NEXT
	JRST	TOOMNY


					;NOW CHECK /U
ASLUSV:	CAME	D,SLGPPN		;IF /G NOT = PPN RUNNING THIS
					;JOB, THEN JOBSTR NOT GOING TO WORK
					;SO USE SYSSTR,,  TO RETURN ALL STRUCTURES IN SYSTEM
					;YOU CANNOT GET THE SEARCH LIST OF
					;A JOB NOT LOGGED IN, SO YOU MUST
					;USE SYSSTR
					;ASSUMPTION:
					;YOU CAN ALWAYS JOBSTR ON YOUR OWN
					;PPN
					;BECAUSE TO DO SO, YOU MUST BE RUNNING

	JRST	STRLUP			;HAVE TO USE SYSSTR



	MOVE	CH,[1,,U]		;SET UP FOR JOBSTR UUO
					;1ST THEN SUBSEQUENT FILES
JOBLUP:	CALLI	CH,JOBSTR
	JRST	BEGSAV			;ALL THROUGH
	AOJE	U,BEGSAV		;DONE IF -1 IS RETURNED
	SUBI	U,1			;  RESTORE U
	MOVEM	U,(R)
	JUMPE	U,BEGSAV		;THROUGH
	AOBJN	R,JOBLUP
	JRST	BEGSAV			;THROUGH
;FILE STRUCTURE LIST TERMINATOR

STERM:	SKIPE	B,DSKNAM		;DSK STR NAMES EXPLICITLY GIVEN?
					;CLEAR B IF DSKNAM = 0
	JRST	BEGSAV		;YES
	MOVE	R,[XWD	-NUMSTR,DSKNAM]
				;NO GET ALL NAMES WITHIN SYSSTR UUO
	MOVSI	A,(SIXBIT /DSK/)	;DEFAULT = "DSK"
	MOVEM	A,DSKNAM
				;START WITH AC = 0<1ST STRUCTURE>
	SETZM	DSKNAM+1	;AND MARK THE END OF THE LIST
	SETOI	U,			;1ST THEN SUBSEQUENT STRUCTURES
	MOVE	D,USRPPN		;LOAD D WITH JOB RUNNING US
					;USED BY SEVERAL ROUTINES
	TRNE	F,USRSW			;IS THIS /S OR /U ?
					;/S = SAVSW 
					;/U = SAVSW&USRSW
	JRST	ASLUSV			;A SLASH U SAVE

					;SKIPE AT STERM LOADED B WITH 0
					;IF WE GOT HERE.. NOW, GET
					;1ST THEN SUBSEQUENT NAMES
STRLUP:	CALLI	B,SYSSTR		;GET 1ST & SUBSEQUENT STR IS SYS
					;SEARCH LIST
	  JRST	BEGSAV			;ERROR

	TRNE	F,USRSW		;/U SAVE ?
	JRST	[		CAME	D,FSPP		;ONLY 1,2
				JRST	X			;SHOULD DO
				JRST	Y	]		;A /U ON A
								;SINGLE ACCESS FILE
								;STRUCTURE
X:	MOVE	U,B		;SETUP U FOR DSKCHR	[42]
	MOVE	A,[XWD 1,U]
	CALLI	A,DSKCHR	;GET DISK CHARACTERISTICS	[42]
	JFCL			;WE KNOW IT'S THERE
	TLNE	A,.UPSAF	;PRIVATE PACK?
	JRST	STRLUP		;YES, SAVE ONLY PUBLIC PACKS
				;IF DOING A /S (SYSTEM SAVE) OR IF /U & NOT 1,2
Y:	MOVEM	B,(R)		;PUT NAME ON LIST
	JUMPE	B,BEGSAV	;THROUGH
	AOBJN	R,STRLUP
BEGSAV:	SETZM	STRNDX#		;INIT INDEX TO DSKNAM BLK
	TLO	F,FIRSW		;INDICATE FIRST TAPE
	MOVEM	P,SAVMFD#	;SAVE PDP FOR ENDTAP

	;FALL INTO SAVE2
;START A NEW TAPE

SAVE2:	PUSHJ	P,GETCOR		;FIRST TAPE NEEDS CORE + INIT
OTHERS:	PUSHJ	P,SETOU			;OTHER TAPES NEED INIT

	IFN	REWIND,<	EMTAPE	1		;REWIND THE MAGTAPE
	>
	IFN	LOCK,<
	MTAPE	TAP,0		;IF LOCK OPTION ASSEMBLED
				;INSURE THAT WE CAN GET TO MAG TAPE BEFORE
				;TRYING TO LOCK SO THAT SLEEP DURING REWIND
				;AND THEREFORE SWAPPING OF THIS JOB POSSIBLE

	MOVEI	TMP,1		;SET UP FOR POSSIBLE LOCK UUO
				;SAY WE HAVE ONLY THE LOW SEGMENT
	TLNE	F,LOCKER		;NO /V, NO ATTEMPT TO LOCK
	CALLI	TMP,LOKUUO
	JRST	PSEUDL		;SKIP AROUND LOCKED MESSAGE

	PRLIN1 <LOCKED@>

	>

PSEUDL:	SETZM	FNDBEG		;RESET FOUND HEADER RECORD FLAG
	PUSHJ	P,LOOKDT	;GET DATE & TIME RETURNED IN AC A
	SKIPGE	FIRBLK+3	;CONTINUE TAPE BIT SET IN LAST TRAILER?
	TLO	A,400000	;YES, KEEP IT IN THIS HEADER
	MOVEM	A,FIRBLK+3	;STASH AWAY IN HEADER LABEL
	PUSHJ	P,DAYTIM	;PRINT THEM OUT
	PUSHJ	P,TAPNO		;PRINT TAPE NUMBER
	AOS	A,TAPNUM		;INCREMENT TAPE NUMBER
	HRRM	A,FIRBLK+2		;PLACE CUM. TOTAL IN HEADER
	PUSHJ	P,PRNUM
	PUSHJ	P,SPACE
	MOVEI	CH,"@"
	PUSHJ	P,TYPEA
	PUSHJ	P,SPACE

	PUSHJ	P,LABBLT	;WRITE OUT HEADER
	TLNN	F,FIRSW		;FIRST TAPE ?
	JRST	TAPMES		;NOPE

	PUSHJ	P,TAPMES	;PUT TAPE BPI &
				;CHANNEL # OUT ONLY AFTER
				;YOU ARE SURE THERE HAS BEEN AN INTERRUPT
				;SO THAT THE DEVSTS UUO WORKS PROPERLY

	JRST	SAVE0		;FIRST TAPE PROCEEDES
TAPMES:	MOVEI	B,TAP		;GET TAPE INFO.
	DEVSTS	B,0			;SEE IF DEVSTS WILL RETURN INFO
					;ON CHANNELS
					;NO
	JRST	NOTELL			;NOT IMPLEMENTED
TELLCH:	MOVEI	CH,"7"
	TRNN	B,TRACK7				;CHECK 7 CH BIT
	MOVEI	CH,"9"		;OOOPS, 9 - TRACK

	PUSHJ	P,TYPEA
	PR1	< CH &#>
				;
NOTELL:	MOVEI	A,TAP		;GET DENSITY EITHER FROM CALLI
				;OR
	CALLI	A,MTCHR.
	LDB	A,[POINT 2,INIT1,28]	;ERROR SO GET DENSITY BITS FROM THE INIT
	ANDI	A,3		;STRIP OFF
				;

	MOVE	B,BPITXT(A)
	PUSHJ	P,PR3CHR			;GIVE BPI SEETING
	PR1	< BPI@>
	POPJ	P,


BPITXT:	SIXBIT	/STD   /
	SIXBIT	/200   /
	SIXBIT	/556   /
	SIXBIT	/800   /




	;RETURN IN (A) TIME, BITS 4-20, AND DATE, 21-35
LOOKDT:	CALLI	A,MSTIME		;TIME IN JIFFIES
	IDIVI	A,^D1000		;BASH A+1 WITH REMAINDER
	CALLI	B,DATE			;LOAD BASHED AC WITH DATE
	ANDI	B,377777		;ALL BUT THE SIGN BIT, PLEASE
	LSH	A,^D15			;MAKE ROOM FOR DATE
					;SHIFT LEFT 15 DECIMAL
	IORI	A,(B)			;SIGN BIT IS FREE, BUT TIME AND
					;DATE FILL REST OF WORD
	POPJ	P,			;
					;0-CONTINUATION BIT
					;4-20 TIME (HRS:MIN:SEC
					;21-35 DATE
TAPNO:	MOVE	B,[SIXBIT	/TAPE #/]
	PUSHJ	P,PRNAME
	JRST	SPACE
;LOOP TO SAVE EACH FILE STRUCTURE ON LIST

ENDMFD:	AOSA	A,STRNDX		;BUMP POINTER INTO NAMES TABLE
SAVE0:	MOVE	A,STRNDX	;GET NEXT NAME
	SKIPN	A,DSKNAM(A)	;GET NAME IF NOT NULL
	JRST	ENDMF0	;NULL NAME.. THROUGH

	MOVEM	A,CURSTR	;SAVE NAME
	MOVEM	A,ACTSTR	;ACTIVE FILE STRUCTURE
				;CURSTR IS THE NAME OF THE CURRENT STRUCTURE
				;ACTSTR = BY DEFINITION CURSTR, EXCEPT
				;THAT IT IS IN MFDSPK FOR THE OPEN ON MFD

	MOVEI	A,MFDHED
	MOVEM	A,MFDSPK+2
	OPEN	MFD,MFDSPK	;WANT TO READ MFD FOR THIS STR
	JRST	NOMFD		;HAVE TO SKIP THIS ONE
	MOVEI	A,MFDBUF	;SET UP BUFFERS
	MOVEM	A,.JBFF
	INBUF	MFD,MFDN
	MOVE	A,SYSPP		;LOOK FOR MFD
	MOVEM	A,MFDDIR+3	;IN THE MFD
	MOVEM	A,MFDDIR
	MOVSI	A,(SIXBIT /UFD/)
	MOVEM	A,MFDDIR+1
	SETZM	MFDDIR+2	;ERROR BITS, ETC GO AWAY
	LOOKUP	MFD,MFDDIR	;(OLD STYLE LOOKUP)
	JRST	BADMFD		;NOT ALL TOGETHER THERE
	MOVEM	P,SAVUFD#	;SAVE PDP FOR ENDUFD
MORE1:	PUSHJ	P,MFD2		;GET TWO WORDS FROM MFD
	HLRZ	W,W		;SECOND WORD
	CAIE	W,(SIXBIT /UFD/)	;IS HE A UFD?
	JRST	MORE1		;NO, TRY AGAIN
	TRNE	F,USRSW		;SINGLE USER SAVE?
	CAMN	U,SYSPP		;1,1.UFD?
	JRST	MORE6
	CAME	U,SLGPPN	;USER UFD?
	JRST	MORE1		;NO


MORE6:	MOVE	A,SLOPPN		;SEE IF /GPPN = /O PPN
	CAME	A,SLGPPN		;=?
	CAME	U,A			;/O NOT = /G
					;POSSIBILITY OF DUPLICATE UFD ENTRIES
					;IN MFD EXISTS, CHECK FURTHER
					;IS UFD PRESENTLY IN HAND (IN U)
					;THE SAME AS THE ONE TO BE BUILT
					;OUT OF THE /G /O SEQUENCE?
					;THEN (IF SO) TWO UFD'S
					;COULD BE WRITTEN ON THE
					;TAPE, THE ORIGINAL ONE AND
					;THE ONE CREATED BY THE /G/O PROCESS
MORE6A:	SKIPA	A,CURSTR		;ONE IN HAND NOT THE
					;SAME AS THE /O FELLOW
					;OR /G AND /O ARE THE SAME
	JRST	MORE1		;WHAT HO, AVAST! TWO UFD'S WILL BE
				;CREATED IF WE DON'T SKIP ONE
				;SKIP THIS ONE!


	MOVEM	A,MORE61
	MOVEM	A,MORE72	;SETUP DEVICE NAMES
	MOVEM	U,UFDDIR+2	;YES, LET'S HAVE A LOOKUP AT IT
	MOVEM	U,DGADIR	;PROJECT-PROGRAMMER # INTO 4-WORD ENTRY
				;HEADING
	INIT	UFD,BUFBIN	;IS IT AVAILABLE
MORE61:	SIXBIT	/DSK/
	XWD	0,UFDHED	;INPUT ONLY
	PUSHJ	P,LOOKER	;DISP. CORRECTLY AFTER ERROR MSG.


	MOVEI	A,UFDBUF	;GET BUFS
	MOVEM	A,.JBFF
	INBUF	UFD,UFDN


	MOVE	A,SYSPP		;LOOK FOR UFD
	MOVEM	A,UFDDIR+1	;IN THE UFD
	MOVEM	A,FILDIR+1	;AND INTO THE FILE NAME'S OWNER SLOT
				;THIS IS TO CUE THE PRNMEX ROUTINE
				;THAT IT SHOULD LOOK AT UFDDIR FOR THE
				;FILE'S NAME
	MOVEI	A,XLOOKN	;EXT. LOOKUP
	MOVEM	A,UFDDIR
	MOVSI	A,(SIXBIT /UFD/)
	MOVEM	A,UFDDIR+3
	TRO	F,UFDI		;UFD INPUT MODE FOR REENTER
	LOOKUP	UFD,UFDDIR	;IS IT STILL THERE
	PUSHJ	P,LOOKER	;ERROR RECOVERY ROUTINE


	TDZ	F,[XWD	FILFND,UFDI]	;NO FILES SAVED YET FOR THIS USER,,OUT OF UFD INPUT STATE



	SETZM	ONEFIL#		;OPEN SWITCH FOR AUXILLIARY CHANNEL

	MOVEM	P,SAVFIL#	;REMEMBER PDP FOR ENDFIL
MORE2:	PUSHJ	P,UFD2		;GET TWO WORDS FROM UFD
	HLRZ	W,W		;SECOND WORD LH
	CAIE	W,(SIXBIT /TMP/)	;TEMPORARY?
	CAIN	W,(SIXBIT /SFD/)	;OR AN SFD
	JRST	MORE2		;YES, DONT DUMP

;IF NO, FALL INTO MORE5
MORE5:	MOVEI	A,XLOOKN	;EXT. LOOKUP
	MOVEM	A,FILDIR
	MOVEM	U,FILDIR+2	;FIND THE FILE
	HRLZM	W,FILDIR+3
	MOVE	A,UFDDIR+2	;PROJ-PROG NUMBER
	MOVEM	A,FILDIR+1
	TRNE	F,USRSW		;SINGLE USER SAVE?
	CAME	A,SYSPP		;1,1?
	JRST 	MORE7		;MASS(/S) SAVE AND NOT 1,1
	CAIN	W,(SIXBIT /UFD/)	;UFD?
	CAME	U,SLGPPN		;PERSON TO BE GOTTEN ?
				;OR SINGLE USER SAVE
	JRST	MORE2		;NO, DON'T SAVE

				;NOW SEE IF /G PPN = /O PPN
				;IF SO, SAVE, AS NO DUPLICATION
				;OF UFD'S CAN RESULT THIS WAY
				;IF
				;ON THE OTHER HAND, /G NOT = /O,
				;CHECK TO SEE IF THIS FELLOW (IN U)
				;IS THE /O PPN.  IF SO, THE /G/O
				;PROCESS WILL DO THE SAVE OF /O
				;(CREATING /O FROM /G, EXPRESSED OR
				;IMPLIED).  IF U=SLOPPN, DON'T
				;SAVE AS A DUPLICATION WILL RESULT
MORE7:	MOVE	A,SLOPPN		;SEE IF/G=/O
	CAME	A,SLGPPN		;SKIP IF =
	CAME	U,A		;/O NOT = /G, SO IS THIS FELLOW THE /O GUY TO BE

	SKIPA	A,CURSTR	;DO THE INIT ON THE RIGHT STR
	JRST	MORE2		;SKIP DUPLICATE SAVE!!!!!!!!
	MOVEM	A,MORE71
	INIT	FIL,BUFBIN	;SET TO GET FILE
MORE71:	SIXBIT	/DSK/
	XWD	0,FILHED	;INPUT ONLY
	PUSHJ	P,LOOKER	;DISK NOT THERE
	PUSHJ	P,GETFBF	;GET BUFS FOR FILE
	INBUF	FIL,(CH)	;NUMBER OF BUFFERS RETURNED IN CH
	TRO	F,FILI		;ENTER FILE INPUT STATE
	LOOKUP	FIL,FILDIR	;IS IT THERE?
	PUSHJ	P,LOOKER	;GO TO SEE WHY LOOKUP FAILED(RTN TO MORE2)
	TRZ	F,FILI		;EXIT FROM FILE INPUT STATE
	SKIPN	ONEFIL		;IS THIS THE FIRST TIME THRU THE
				;USER ?  IF SO,
				;OPEN UP A SHADOW CHANNEL
				;ON ANY ONE FILE (IN THIS CASE, WE PICK
				;THE FIRST) IN HIS UFD.
				;
				;
				;THIS CAUSES THE UFD INFORMATION TI REMAIN
				;IN CORE
				;REDUCING THE NUMBER OF SEEKS
				;
	PUSHJ	P,KINCOR	;FIRST TIME THRIUGH, KEEP
				;INFORMATION IN CORE
				;BY OPENING UP AUXILLIARY CHANNEL
	MOVE	A,FRBSTS	;GET FILE STATUS
	TRNE	A,.RPNFS	;DO-NOT-SAVE BIT ON?
	JRST	MORE2		;YES
				;GOT A GOOD FILE TO SAVE
	XLIST
	IFG	ALPJ1S,
	<
	LIST
	HLRZ	A,FILDIR+1
	SOJE	A,UNCONS		;IT'S PROJECT 1
	>
	LIST

	XLIST
	IFG	ALFLEX,
	<
	LIST
	HRRZ	A,FILDIR+.RBSIZ	;GET # OF WORDS WRITTEN
	CAIG	A,ALFLEX		;A IS + OR ZERO AT THIS TIME
	JRST	UNCONS			;IS + OR 0 FOR JUMPL TO FAIL TO JUMP

	>
	LIST
	LDB	S,[POINT 3,CRDATE,23]	;INITALIZE R,S,U + W FOR CHKCRE
	LDB	W,[POINT 3,FILDIR+3,20]
	MOVE	R,CRDATE
	MOVE	U,FILDIR+4		;IS FILE NEWER THAN SET TIME AND DATE ?
	PUSHJ	P,CHKCRE
	 JRST	[LDB	W,[POINT 3,FILDIR+3,20]	;[47]BRING
		LDB	U,[POINT 12,FILDIR+4,35];[47] CREATION
		LSH	W,14		;[47] DATE
		IOR	U,W		;[47] TOGETHER
		CAIE	U,10000		;[47] DATE = 1/5/75 OR
		CAIGE	U,2134		;[47] LESS-THAN 1/1/67 ?
		CAIA			;[47] YES - SAVE THE FILE
		JRST	MORE2		;[47] CRDATE .GT. FILE'S CREATE-DATE
		SETZ	A,		;[47] TO PASS ACCESS DATE CHECK
		JRST	UNCONS	]	;[47] SAVE IT
	 JFCL				;DATES ARE EQUAL
	LDB	A,[POINT 15,FILDIR+3,35]	;GET ACCESS DATE OF FILE
							;/F CRITERIA
	CAIE	A,10000		;[47] IF DATE = 1/5/75 OR
	CAIGE	A,2134		;[47] OR LESS-THAN 1/1/67
	JRST	UNCONS		;[47] SAVE FILE ELSE
	SUB	A,ACCDAT	;COMPARE TWO DATES
UNCONS:	TLNN	F,KILLSW	;ARE WE IN KILL MODE?
	JRST	MORE10		;NO
;UNCONS+2 REPLACED 4 INSTRUCTIONS WITH THE FOLLOWING 2 [37]
	HLRZ	B,UFDDIR+2	;[37] GET THE PROJECT #
	CAIGE	B,10		;[37] IGNORE IF < 10
	JRST	MORE2		;DONT XFER ANY PROJECT .LT. 10	[46]

;CUSPPN+2 INSERTED 2 NEW INSTRUCTIONS [EDIT#32] SPR:10-11,965
	JUMPGE	A,MORE2		;DO NOT SAVE IF RECENTLY USED	[ED#32]
	JRST	.+2		;OLD FILE - SAVE & DELETE	[ED#32]
MORE10:	JUMPL	A,MORE2		;IF A 0 OR + SAVE FILE
				;SAYS THAT ACCESS DATE CRITERIA FROM
				;SWITCH & DISK IS O.K. FOR SAVE
				;OR THIS IS SAVE OF PROJECT 1,,*
				;OR THAT A FILE LESS THAN OR = TOLERANCE
				;IS BEING CONSIDERED

	PUSHJ	P,DIRBLT	;BLT DIRECTORY INTO TAPE BUFFER
	SETZM	RECCNT		;RESET # RECORDS OUTPUT SINCE LASST
				;EOF OR DIRECTORY RECORD
	HLRZ	W,FILDIR+3
	CAIN	W,(SIXBIT /UFD/)	;UFD FILE?
	JRST	ENDFLA		;YES, SAVE ONLY LOOKUP INFO
	TLO	F,FILFND	;FOUND US A FILE FOR THIS USER
;******************______________*****************************
	SKIPN	PAKFRE,FILHED+2		;SEE IF WE HAVE SOME INPUT
	JRST	ACFIL2			;GUESS NOT
	SKIPN	PAKNAM,TAPHED+2		;GET WORD COUNT
	JRST	ACTAP2			;OOPPS.. NO WORD COUNT
					;REFRESH IT
FASTAC:	HRLZ	S,FILHED+1
	HRR	S,TAPHED+1		;FROM,,TO
					;WHAT WE ARE ABOUT TO DO
		;IS AS FOLLOWS
		;BLT FROM INPUT BUFFER TO OUT BUFFER
		;THE LESSER OF THE 
		;TWO WORD COUNTS
		;UPDATE THE BYTE POINTERS
		;AND WORD COUNTS
		;AND CONTINUE

FAST:	CAIGE	PAKNAM,(PAKFRE)		;IF TAPE BUFFER IS
					;BIGGER (CAN TAKE MORE THAN DISK CAN GIVE)
					;BLT AS MUCH AS THE DISK HAS
	SKIPA	WASTE,PAKNAM		;SET TO TAPE AS SMALLER
					;WORD COUNT
					;OOOPS, NOT ENOUGH ROOM
					;IN DISK BUFFER,
					;SO ONLY BLT AS MUCH AS DISK
					;CAN GIVE YOU
	MOVEI	WASTE,(PAKFRE)		;SET UP INDIRECT ADDRESS TO
					;POINT TO TERMINAL WORD OF XFER
	HRRM	S,ACFAST		;GET POINTER TO CONTENTS OF TAPHED+1
					;# WORDS XMIT'ED =
					;E -AC(RIGHT)+1
	;WORDS XMIT'ED = [(PAKFRE) OR (PAKNAM) <WHICH IS IN RIGHT HALF OF WASTE>]+
	;[BITS 18-35 OF ACFAST:]
	;WHICH IS THE CONTENTS OF TAPHED + 1
	;=EFFECTIVE ADDRESS, E_
	;
	;-(AC <RIGHT HALF>) = CONTENTS OF <TAPHED +1>  + 1
;	SO THAT..
	;E[(TAPHED+1) + #WORDS WHICH CAN BE TRANSFERRED
	;-(AC<RIGHT>=(TAPHED+1)+1)
	;+1
	;
	;OR
	;[(TAPHED+1) + MINIMUM OF THE TWO WORD COUNTS -<(TAPHED+1)+1>+1]=# WORDS TO BLT'ED
	;WHICH IS...
	;[(TAPHED+1)-(TAPHED+1)-1  +1] +[MINIMUM OF THE TWO WORD COUNTS]
	;
	;THE MINIMUM OF THE TWO WORD COUNTS IS FROM EITHER
	;PAKNAM OR PAKFRE, BUT IS  LEFT IN  WASTE!
	;SO THAT IN THE END........
	;WORDS XMIT'ED = [(PAKNAM) OR (PAKFRE)]
					;WHICH WILL BE BUMPED BY 1
					;TO SIMULATE THE INCREMENT
					;OF AN ILDB/IDPB 
	AOBJP	S,ACFAST		;BUMP AWAY
					;WHICH IS WHERE BLT STARTS TO
ACFAST:	BLT	S,0(WASTE)		;BLT UNTIL YOU HAVE XMIT'ED
					;TO FLOOR LIMIT OF THE
					;TWO WORD COUNTS
					;BUT FIRST BUMP BOTH BYTE POINTERS
					;BY NUMBER OF WORDS MOVED
					;SO WE CAN
	SUBI	PAKNAM,(PAKFRE)		;GET HOW MANY WORDS LEFT AFTER BLT
	JUMPGE	PAKNAM,ACFIL		;PAKFRE IS = OR LESS THAN
					;PAKNAM, THEREFORE
					;PAFKRE (DISK FILE) RAN OUT FIRST
	MOVNM	PAKNAM,FILHED+2		;YOU SUBTRACTED
					;SMALLER FROM LARGER.... OH WELL,
					;MOVE THE NEGATIVE OF THE - NUMBER
					;INTO WORD COUNT FOR BUFFER
					;HEADER
	SETZM	TAPHED+2		;WE USED ALL  WORD COUNT
	ADDM	WASTE,FILHED+1		;REPOINT FILE HEADER TO
					;REFLECT BLT

ACTAP2:	PUSHJ	P,TAPOUT		;OUT TO TAPE
	SKIPN	PAKFRE,FILHED+2		;SAY, DID THE DISK RUN DRY JUST
					;AS THE TAPE FILLED UP
	JRST	ACFIL2			;YEP
	HRRZ	PAKNAM,TAPHED+2
	JRST	FASTAC
ACFIL:	HRRZM	PAKNAM,TAPHED+2		;AND SAVE IT
	ADDM	WASTE,TAPHED+1		;REPOINT TAPHED TO REFLECT BLT
ACFIL2:	PUSHJ	P,FILIN
	SKIPN	PAKNAM,TAPHED+2		;DID THE  TAPE FILL UP JUST
					;AS THE DISK RAN DRY ?
	JRST	ACTAP2			;YEP!
	HRRZ	PAKFRE,FILHED+2		;GET REFRESHED DISK WORD COUNT
	JRST	FASTAC
;**********************_____________*********************
KINCOR:	MOVE	A,[XWD	FILDIR+2,DGADIR]	;COPY INFORMATION FROM FILDIR
				;(EXTENDED LOOKUP) TO DGADIR (4-WORD LOOKUP)
				;
	BLT	A,DGADIR+2
	MOVE	A,FILDIR+1	;GET PPN
	MOVEM	A,DGADIR+3
				;NOW INIT THE DEVICE
	INIT	DGA,DUMP
MORE72:	SIXBIT	/DSK/		;STUFF DEVICE NAME

	XWD	0,DGAHED	;INPUT ONLY
	POPJ	P,		;SUSPECT THAT THERE MIGHT BE
				;TROUBLE HERE, SINCE WE JUST DID A
				;SUCCESSFUL EXTENDED LOOKUP (FOLLOWING
				;A SUCCESSFUL INIT)
				;ON THIS DEVICE....
	LOOKUP	DGA,DGADIR
	POPJ	P,			;OK, ON RESTORE & NO 1ST FILE
					;THIS LOOKUP WILL FAIL IN AREA
					;IS EMPTY AT START... SO TRY AGAIN NEXT 'ROUND
					;TO HELP FILSER
	SETOM	ONEFIL
	POPJ	P,		;CLOSE SWITCH AND RETURN

;READ MFD

MFD3:	PUSHJ	P,GETMFD	;INCREMENT TO FIRST OF NEXT PAIR
MFD2:	PUSHJ	P,GETMFD	;GET THE FIRST WORD
	SKIPN	U,W		;SKIP TO NEXT NON-ZERO
	JRST	MFD3
GETMFD:	TRO	F,MFDI
	SOSG	MFDHED+2	;ANY MORE WORDS IN BUFFER
	PUSHJ	P,MFDIN		;NO, GET ANOTHER BUFFER
	ILDB	W,MFDHED+1	;NEXT WORD INTO W
	TRZ	F,MFDI
	POPJ	P,

MFDIN:	IN	MFD,		;READ ANOTHER BUFFER
	POPJ	P,		;HAPPY, RETURN
	STATO	MFD,IOBAD	;END OF BUFFER?
	JRST	ENDMFD		;GO DO WRAPUP
	STATZ	MFD,BTL		;IS BLOCK TOO LARGE
	PUSHJ	P,BLOCKT	;BLOCK TOO LARGE MESSAGE
RMFDIN:	PRLIN1	<ERROR READING MFD@>
	SKIPLE	TAPHED			;IF BUFFERS ACTIVE, CLOSE TAPE
	CLOSE	TAP,0			;DUMP WHAT YOU HAVE
	JRST	ENDMFD			;STRUGGLE ONWARD AND UPWARD
;READ UFD

UFD3:	PUSHJ	P,GETUFD	;INCREMENT TO FIRST OF NEXT PAIR
UFD2:	PUSHJ	P,GETUFD	;GET THE FIRST WORD
	SKIPN	U,W		;PLACE IN FIRST WORD REGISTER
	JRST	UFD3
GETUFD:	TRO	F,UFDI
	SOSG	UFDHED+2	;ANY MORE WORDS IN BUFFER?
	PUSHJ	P,UFDIN		;NO, GET SOME
	ILDB	W,UFDHED+1	;NEXT WORD
	TRZ	F,UFDI
	POPJ	P,

UFDIN:	IN	UFD,		;READ ANOTHER BUFFER
	POPJ	P,		;HAPPY, RETURN
	STATO	UFD,IOBAD	;END OF FILE?
	JRST	ENDUFD		;YES, GO DO WRAPUP
	STATZ	UFD,BTL		;BLOCK TOO LARGE?
	PUSHJ	P,BLOCKT	;BLOCK TOO LARGE MESSAGE
RUFDIN:	PRLIN1	<ERROR READING UFD FOR#>
	PUSHJ	P,PRPP		;PRINT UFD NUMBER
	JRST	ENDUFD		;SEE IF THERE IS ANYTHING TO DUMP
				;RESET P,
				;AND TRY MORE UFD'S
BLOCKT:	PRLIN1	<BLOCK TOO LARGE#>
	POPJ	P,

;DISK FILE INPUT

FILIN:	TRO	F,FILI
	IN	FIL,		;GET NEXT BUFFER
	JRST	FILIN2		;HAPPY, RETURN
	TRZ	F,FILI
	STATZ	FIL,IOBAD	;END OF FILE? SKIP IF NO ERRORS(WHICH =EOF CONDITION)
	PUSHJ	P,UFLERR	;PRINT ERROR MESSAGE AND FILE NAME
RFLAIN:	JRST	ENDFIL

FILIN2:	TRZ	F,FILI		;SUCCESSFUL INPUTS
	POPJ	P,

;MAG TAPE OUTPUT

TAPOUT:	TRO	F,TAPO
	MOVEI	A,TAPLEN-4	;DATA WORDS/BUFFER
	SUBB	A,TAPHED+2	;COMPUTE # WORDS USED
	JUMPLE	A,NULTAP	;NONE USED, DONT OUTPUT
	AOS	CH,TAPHED+2	;TOTAL # WORDS IN BUFFER =
				;# WORDS FOLLOWING 1ST (CHECK)
				;WORD IN BUFFER + THE HEADER (CHECK) WORD
				;ITSELF
	HRRZ	B,TAPHED	;ADDR OF BUFFER CURRENTLY IN USE
	HRRZM	CH,1(B)		;UPDATE BUFFER
				;WORD COUNT
	HRRM	A,2(B)		;INTERNAL WORD COUNT INTO HEADER WORD
TAPOU1:	OUT	TAP,		;WRITE ANOTHER RECORD
	JRST	TAPO33		;SUCCESSFUL OUTPUT: NO ERRORS, NO EOT

	STATZ	TAP,100000+40000;SKIP IF
				;NO DATA ERRORS OR BLOCK NOT TOO LARGE
	JRST	FINTPO		;BAD NEWS ... CHECK FOR EOT;
				;IF EOT IS ON, WE CANNOT ERASE
				;TAPE, HAVE TO BACK UP TO
				;LAST BEGINNING OF RECORD
				;TRY NOT TO RUN OFF END
				;OF TAPE

	STATZ	TAP,IOTEND	;END OF TAPE?
	JRST	ENDTAP		;YES, DO WRAPUP
	STATZ	TAP,400000	;NO, WRITE-LOCKED TAPE?
	JRST	WRLOK		;YES, PRINT MESSAGE & WAIT 'TIL /C
	STATZ	TAP,200000	;NO, PHYSICAL DEVICE ERROR?
	JRST	DEVERR		;YES, TELL OPERATOR
RTAPOU:	GETSTS	TAP,A		;SEE WHERE YOU ARE
	TRZE	A,IOTEND		;EOT UP ?
	JRST	RRNTPO		;AT EOT!

					;(IF EOT IS UP [WE TOOK THE JUMP]
					;...DON'T TRY TO WRITE 3"
					;OF BLANK TAPE, YOU MAY RUN OFF THE
					;END OF THE REEL
					;SO, IF EOT IS UP FORGET 3" OF BLANK TAPE
				;BESIDES:
				;YOU WON'T BE WRITING AS MUCH INFORMATION
				;WITH THE TRAILER, SO YOU WON'T
				;FIND THIS AREA AFTER BACKSPACING
RRTAPO:	PRLIN1	<TAPE WRITE ERROR ON#>
	PUSHJ	P,PRUFL
	PR1	<ATTEMPTING RECOVERY@>
	PUSHJ	P,CRLF
				;DO NOT(!) WRITE 3" BLANK TAPE
				;SINCE YOU DON'T KNOW
				;WHERE YOU ARE AT THIS TIME


				;CONIDER:
				;MAG TAPE SERVICE HAS ATTEMPTED
				;TO WRITE THIS RECORD
				;BUT HAS FAILED
				;IT HAS ATTEMPTED TO WRITE ENOUGH
				;BLANK TAPE
				;TO COVER THE OFFENDING AREA
				;AND RETRIED SEVERAL TIME TO PUT
				;THE RECORD CORRECTLY ON TAPE
				;LET MTASRX
				;DO THE WORK
				;AND DON'T TRY TO OUTSMART
				;IT

	GETSTS	TAP,B		;CLEAR ERROR BITS
	ANDCMI	B,760000
	SETSTS	TAP,(B)

	JRST	NULTAP		;RESET BUFFER WORD COUNT
				;IT IS BETTER TO BE TOO SHORT ON
				;RECORD COUNTS THAN TOO LONG AS WE BACK UP
				;WHEN CONFUSED

FINTPO:	STATO	TAP,IOTEND		;END OF TAPE?
				;BAD WRITE _
				;CHECK FOR END OF TAPE
	JRST	RRTAPO		;ADVISE & TRY FIX
				;AND WRAP UP
RRNTPO:	TLOE	F,TENDF		;LITE THE EOT SWITCH
				;IN THE AC
	POPJ	P,		;RESET AND RETURN TO CALLER VIA POPJ P,

	PRLIN1	<"CAUTION! END OF TAPE HAS BAD SPOTS@>
	JRST	ERRENT		;ENTER WRAP-UP ROUTINES
				;NOTE THAT RECORD COUNT MAY BE 1 TOO GREAT
				;AT THIS POINT SINCE
				;ERRENT WILL BUMP RECORD COUNT BY 1... TO
				;"ACCOUNT FOR THIS SUPPOSEDLY 'GOOD' RECORD
				;OOUTPUT.  THIS WILL CAUSE US
				;TO BACK UP 1 TOO MANY, BUT IF MAGTAPE
				;SERVICE HAS BECOME CONFUSED, WE MAY
				;BACK UP JUST ENOUGH....
;WRITE HEADER OR TRAILER ON TAPE

LABBLT:	MOVSI	A,FIRBLK	;ADDR OF HEADER
	HRR	A,TAPHED+1	;GET BUFFER DATA ADDR FROM BYTE PTR
				;OF INCREMENT AND LOAD BYTE
	MOVEI	B,4(A)		;SET STOP AT 5TH DATA WORD
	BLT	A,(B)		;BLT HEADER INTO BUFFER

	HRRM	B,TAPHED+1	;RESET BYTE POINTER
	HRROI	A,-4		;RESET COUNT
				;WORDS XFERRED =
				;E - AC(RIGHT) + 1
				;DON'T HAVE TO COMPENSATE FOR COUNT
				;'CAUSE IT IS NOT "COMPENSATED FOR" LATER ON
				;AS PER NUMBER OF IDPB'S AND SOSG'S SIMULATED
	ADDM	A,TAPHED+2
CLSUSR:	PUSHJ	P,TAPOUT	;WRITE ONE RECORD
	TLNE	F,TENDF		;EOT MODE ?
	JRST	EOTMOD		;YEP!
	SKIPLE	RECCNT		;HAS ANYONE WRITTEN(!!) ANYTHING THIS TIME AROUND
	SKIPG	TAPHED		;OR DO WE HAVE A LIVE , USED BUFFER RING
	JRST	NULTAP		;NOPE NULL TAPE.. SKIP FLUSH & EOF
				;NOW
				;SCRAMBLE AROUND THE BUFFER RING AND
				;AS MANY TIMES AS YOU HAVE BUFFERS,
				;SEE WHAT YOU CAN DUMP
	MOVEI	A,TAPN-1	;NUMBER OF TRIES
BUFCKR:	OUTPUT	TAP,0
	SOJG	A,BUFCKR	;ANY MORE ?

	MTAPE	TAP,3		;MARK 1 EOF
	SETZM	RECCNT		;# OF OUTSTANDING RECORDS SINCE LAST EOF
				;OR DIRECTORY RECORD IS 0
	JRST	NULTAP		;BEFORE YOU

TAPO33:	AOSA	RECCNT		;ACCOUNT FOR ANOTHER GOOD RECORD OUTPUT
NNLTAP:	OUTPUT	TAP,		;DUMMY OUTPUT
NULTAP:	MOVSI	B,400000	;RESET VIRGIN BIT
	ANDCAB	B,TAPHED
	MOVEI	A,2(B)		;SET BYTE POINTER TO BEGINNING OF BUFFER
	HRRM	A,TAPHED+1	;BYTE POINTER POINTS TO PRESENT BUFFER

TAPOU3:	MOVEI	A,TAPLEN-4	;DATA WORDS/BUFFER -1
	MOVEM	A,TAPHED+2	;BUFFER COUNT
	TRZ	F,TAPO
TAPPOP:	POPJ	P,		;RETURN

EOTMOD:	AOS	TAPHED+2		;SHOW MONITOR WE HAVE 0 WORDS
					;TO GO OUT
					;IN THE LAST BUFFER OF THAT
	CLOSE	TAP,0			;CLOSE UP OUR TAPE
	POPJ	P,
;BLT HEADERS INTO TAPE BUFFER

DIRBLT:	MOVSI	A,FILMRK	;HEADER WORD FOR DIRECTORY
	HRR	A,TAPHED+1	;GET BUFFER DATA ADDR FROM BYTE PTR
	MOVEI	B,XLOOKN+2(A)	;SET STOP AT LAST RETRIVAL WORD
	BLT	A,(B)		;STUFF TAPE
				;WITH WHAT YOU FOUND ON DISK
	HRRM	B,TAPHED+1	;RESET BYTE POINTER
				;NOW RESET DISK INFO
				;FOR TAPE
	SETZM	.RBPOS+2-XLOOKN-2(B)	;LOGICAL BLOCK # OF FIRST BLOCK TO
				;ALLOCATE WITHIN FILE STRUCTURE _ 0

	MOVE	A,.RBSIZ+2-XLOOKN-2(B)	;CH _ # WORDS WRITTEN
	LSH	A,-^D7		;WORDS / 200(OCTAL) = BLOCKS
	CAMGE	A,.RBALC+2-XLOOKN-2(B)	;WHICH IS LARGER
				;#WRITTEN
				;OR ESTIMATED LENGTH (BOTH IN BLOCKS NOW)
	MOVE	A,.RBALC+2-XLOOKN-2(B)
	MOVEM	A,.RBEST+2-XLOOKN-2(B)
	SETZM	.RBALC+2-XLOOKN-2(B)	;AND ZERO OUT # BLOCKS ALLOCATED

	MOVSI	A,URBLGI!RIPSCE!RIPHWE!RIPHRE!RIPBFA!RIPCRH!RIPBDA
				;RESET LOGGED IN BIT, IF ON
				;AND ERROR BITS IF THEY ARE ON
				;KEEP OFF IF OFF
				;PREVENTATIVE MEASURE IN CASE SYSTEM
				;CRASHED DURING RESTORE
				;OF THIS USER'S FILES
	ANDCAM	A,.RBSTS+2-XLOOKN-2(B)



	HRROI	A,-XLOOKN-2-1+1	;RESET COUNT
				;NORMALLY, THE NUMBER
				;OF WORDS BLT-ED IS THE NUMBER OF SOSG'S
				;YOU HAVE TO SIMULATE, HOWEVER, IN THIS
				;CASE, THE FIRST WORD IS ALREADY COUNTED
				;-1,777 OVERLAYS 1ST WORD IN BUFFER**
				;THEREFORE, # WORDS BLT'ED =
				;EFFECTIVE ADDRESS - AC(RIGHT) + 1
				;OR 42 + 1
				;BUT ONE OF THOSE DOESN'T COUNT IF YOU
				;ARE GOING TO KEEP FROM COUNTING IT TWICE
				;ERGO: BUMP BYTE POINTER BY 42 BY
				;GETTING (TAPHED+1) + 42 INTO B
				;THESE 42 PLUS THE SIMULATED IDPB
				;THE NECESSARY 43


	ADDM	A,TAPHED+2	;FINALLY, BUMP THAT POINTER


	MOVE	A,FILDIR+1	;OK, SEE IF THIS IS 1,1
	CAMN	A,SYSPP		;REALLY?
	MOVEI	B,1(B)		;MOVE POINTER TO FILE NAME IFF 1,1
				;SINCE WE WILL BE CHANGING
				;THE FILE'S NAME
				;NOT THE OWNER'S
SWAPO:	MOVE	A,.RBPPN+2-XLOOKN-2(B)	;GET GUY YOU ARE LOOKING FOR
	CAMN	A,SLGPPN		;SAME?
	MOVE	A,SLOPPN		;YES, PREFORM SWAP
	MOVEM	A,.RBPPN+2-XLOOKN-2(B)	;OR REPLACE USER PPN WITH ITSELF
	POPJ	P,

				;OWNER		_ FILDIR +1
				;FILNAME	_ FILDIR +2
				;EXT		_ FILDIR + 3
				;WHEN IT'S 1,1, LOOK AT FILE NAME
				;WHICH IS THE UFD NUMBER FOR THE PPPN
				;IN QUESTION
				;WHEN OWNER IS NOT 1,1
				;LOOK AT OWNER AND SWITCH/SWAP
				;OWNER TO DESIRED #
ENDFLA:	MOVE	B,TAPHED+1
				;GET POINTER TO TAPE INFO
				;WHICH IS SET TO NEXT INSERTION

	SKIPG	.RBSIZ+2-XLOOKN-2(B)		;ANY WORDS ?
					;EITHER ESTIMATED OR ACTUALLY
					;USED
				;SPR 10-5520
	JRST	[PUSHJ	P,NULTAP	;RESET TAPE BUFFER & POINTERS
		JRST	ENDFI1		;CONTINUE
			]

			;NO WORDS, SKIP SAVING THIS UFD
	TLO	F,FILFND	;UFD OK FOUND & SAVED
ENDFIL:	PUSHJ	P,TAPOUT	;OUTPUT LAST BUFFER
	CAIN	W,(SIXBIT /UFD/)	;SKIP KILL IF UFD
	JRST	ENDFI1
	TLNN	F,KILLSW	;DO WE KILL DISK FILES SAVED ON TAPE?
	JRST	ENDFI1		;NO
	CLOSE	FIL,DNC		;CLOSE FOR RENAME
	SETZM	FILDIR			;IST WORD ZONKED
	MOVE	A,[XWD FILDIR,FILDIR+1]	;ZERO TO KILL FILE
	BLT	A,FILDIR+XLOOKN
	RENAME	FIL,FILDIR	;KILL FILE
	PUSHJ	P,RENERR	;WE FAILED SOMEHOW
ENDFI1:	CLOSE	FIL,DNC
	IFN	MINREL,<
	RELEASE	FIL,		;GIVE UP USER FILE DDB
	>
	TRNE	F,CONTSW	;ARE WE IN CONTINUATION PROCESS?
	JRST	APOPJ		;YES, RETURN TO RESAVE
	MOVE	P,SAVFIL	;RESET PDP
	JRST	MORE2		;GO READ NEXT USER FILE

ENDUFD:	TRZ	F,UFDI
	TLZN	F,FILFND	;ANY FILES FOR THIS USER?
	JRST	NULFIL		;NOPE
ENUFD1:	PUSHJ	P,CLSUSR	;WRITE EOFS ON TAPE
	MOVE	U,UFDDIR+2
	TRNE	F,USRSW
	CAME	U,SYSPP
	PUSHJ	P,PRPP		;PRINT PROJ-PROG #
CLOSER:	CLOSE	UFD,DNC
	IFN	MINREL,<
	RELEASE	UFD,		;GIVE UP UFD DDB
	>

	CLOSE	DGA,DNC
	IFN	MINREL,<
	RELEASE	DGA,
		>
				;CLOSE ON PHANTOM CHANNEL
	TRNE	F,CONTSW	;WE IN CONTINUATION PROCESS?
	POPJ	P,		;YES, RETURN
	MOVE	P,SAVUFD	;RESET PDP
	JRST	MORE1		;GO READ NEXT UFD


NULFIL:	CLOSE	FIL,DNC		;CLOSE THE DSK	[45]
	TRNN	F,USRSW		;IS THIS A SINGLE USER SAVE ?
	JRST	CLOSER		;NOPE, /S SAVE, DON'T SWEAT THE
				;NULL USER AREA IN THIS CASE
	MOVE	A,UFDDIR+2
	CAMN	A,SYSPP
	JRST	ENUFD1
	PR1	<NO FILES SAVED FOR#>
	MOVE	TMP,SLGPPN
	PUSHJ	P,PRPPN1
	PUSHJ	P,SPACE
	MOVE	B,CURSTR	;GET STRUCTURE
	PUSHJ	P,FIXSPA	;RIGHT JUSTIFY SIXBIT ITEM IN "B"
	PUSHJ	P,PRNAME	;PRINT OUT
	PUSHJ	P,CRLF

				;<CR>
				;LF
	JRST	CLOSER
ENDMF0:	TRZ	F,MFDI		;FREE UP MFD
	CLOSE	MFD,DNC

	IFN	MINREL,<
	RELEASE	MFD,
		>
	TLO	F,MFDDNE	;INDICATE FINISHED WITH MFD
	PUSHJ	P,LOOKDT		;LOOKUP THE DATE AND TIME
	TLZ	A,400000		;SHUT OFF THE CONTINUED BIT
					;THIS IS THE LAST TAPE
	MOVEM	A,TIMOUT
	MOVEM	A,FIRBLK+3	;AND PUT IT ON TAPE AS WELL
				;AS ON TTY
	MOVN	A,TAPNUM	;NEGATE TAPE #
	HRRM	A,FIRBLK+2
	MTAPE	TAP,7		;BAKSP OVER EOF
	TLO	F,TENDF		;INSURE THAT YOU DON'T GO THROUGH
				;END-OF-TAPE PROCEDURES TWICE
				;FORCE THIS TRAILER
				;OUT!
	PUSHJ	P,LABBLT	;WRITE TRAILER RECORD
ENDMF2:	HLRZ	A,FIRBLK		;GET VERSION NUMBER
	HRRZM	A,VERNO#			;AND SAVE IT!

	IFN	REWIND,<	EMTAPE	1		;REWIND IT
	>
	PRLIN1	<$SAVE COMPLETED WITH#>
	PUSHJ	P,ENDMES
	PUSHJ	P,TUNREL		;RELEASE TAP (& UNLOCK IF LOCK ASSEMBLED IN)
	IFE	NONSTP,
	<
	MOVE	P,SAVMFD	;RETURN
	>

	IFN	NONSTP,
	<
	JRST	START		;RETURN FOR MORE PASSES
	>
	AOS	(P)
	JRST	LFCRLF
;ROUTINE TO CONTINUE A SINGLE USER SAVE OR 
;ENTIRE DISK SAVE WHEN EOT IS REACHED

;IF WE BELIEVE WE HAVE JUST FINISHED OUTPUTTING A
;USER AREA, ENTER AT ENDTP1
;IF WE REACH EOT IN THE PROCESS OF FILE OUTPUT
;WE ENTER AT ENDTAP


ENDTAP:	TLOE	F,TENDF		;IF WE HAVE JUST OUTPUT TRAILER,
	POPJ	P,		;EVENTAULLY POPJ P, BACK TO CLSUSR + 1
				;WHAT HAPPENED WAS AS FOLLOWS...
				;YOU TRIED TO WRITE A TRAILER BLOCK
				;WITH EOT FLAG STILL UP
				;(OR EOT CAME UP WHILE WRITING TRAILER BLOCK)
				;AND EOT GAVE THE ERROR RETURN
				;FROM THE OUT UUO AT TAPOU1:.....
				;

				;WHICH TRANSFERRED YOU TO ENDTAP:
				;THE CLOSE AT CLSUSR WILL FINISH UP THE
				;TRAILER BLOCK AND THE POPJ P,0 AT TAPPOP: WILL
				;RETURN YOU TO
				;ENDTP2:
				;
				;
ERRENT:	TLZE	F,MFDDNE	;OTHERWISE PREPARE TO SWITCH TO NEW TAPE
	JRST	ENDMF2		;WE WERE WRITING LAST TRAILER - MERELY FINISH

				;SAVE DIRECTORY
	MOVE	A,[FILDIR-1,,WATBUF]
	BLT	A,WATBUF+XLOOKN+2-1
	PUSHJ	P,TAPFIL	;FIND FILE ON TAPE AND POSITION FOR TRAILER OUTPUT

	PUSHJ	P,TRLOUT	;SET UP TRAILER AND
ENDTP2:	PUSHJ	P,MESOUT	;OUTPUT MESSAGES AND REWIND
	IFE	NONSTP,
	<
RELINK:	PUSHJ	P,CWAIT		;WAIT FOR /C TO CONTINUE
	>

	IFN	NONSTP,
	<
RELINK:
	>
	JRST	RESAVE		;RESAVE WATCH RING FILES AND CONTINUE

;ROUTINE TO POINT B TO WATCH BLOCK OF FILE WHICH
;WILL BEGIN NEXT TAPE
;
;ROUTINE TO FIND FILE ON TAPE AND POSITION
;TAPE FOR TRAILER OUPUT
;T BACKSPACES FOR RECORDS OUTPUT
;EOF MARKS COUNT AS RECORDS
TAPFIL:	CLOSE	FIL,DNC		;CLOSE UP THE FILE
	SETZM	ONEFIL		;SAY THAT YOU REALLY HAVEN'T GO THE
				;SHADOW CHANNEL OPEN
	CLOSE	DGA,DNC		;'CAUSE YOU'VE JUST CLOSE IT UP
				;
				;THE REASON IS TO ALLOW A SWITCH IN THE
				;SEQUENCING OF TAPES (E.G.,
				;TAPE1 , TAPE 3, TAPE 7, TAPE 2)
				;FROM THE "NORMAL," AND THAT THE
				;SHADOW CHANNELS OPEN FOR EACH REEL WILL BE #RIGHT#
				;SINCE  THE SHADOW CHANNEL WILL BE
				;OPENED ON THE APPROPRIATE UFD FOR EACH REEL

	CLOSE	TAP,0		;CLOSER UP, BOSS
	AOS	T,RECCNT	;BUMP RECORD COUNT TO ACCOUNT
				;FOR EOF MARK
TAPFL2:	MTAPE	TAP,7		;BACKSPACE A RECORD
	SOJGE	T,TAPFL2	;UNTIL T RECORDS BACKSPACED... NOTE
				;THAT WE ARE POINTING IN FRONT OF
				;THE LAST DIRECTORY RECORD
	MTAPE	TAP,7		;GET TO JUST IN FRONT OF THE PLACE WHERE
				;YOU STOPPED WITH ALL O.K.
	PUSHJ	P,SETSYN		;SET SYN INPUT

	SETOM	FNDBEG		;AND SET SWITCH THAT SAYS YOU HAVE
				;FOUND THE HEADER RECORD

	TRO	F,TAPI!LISTSW!DOINGJ		;NOW YOU ARE DOING TAPE INPUT
					;AND DUMMY UP A REQUEST FOR LIST
					;AND LIKEWISE DUMMY UP A DOINGJ
					;SO THE TAPE INPUT ROUTINE WILL
					;READ TAPE INSPITE OF ERRORS,
					;NOW IS NOT THE TIME TO GET PICKY
					;ABOUT READING
					;TO DEFEAT /G _/O SWAPPING IN READING
	TRZ	F,TAPO		;NO LONGER DOING TAPE OUTPUT
				;OR SAVING.. TEMPORARILY JUST READIN'

TAPFL3:	TLZ	F,TENDF		;TURN OFF THE EOT FLAG
					;WE WANT TO  READ REGUARDLESS OF
					;EOT CONDITION
					;WHICH MAY SUPRIOUSLY BE UP IF 
					;THIS IS A
					;UN-ECO-ED TU/30
	PUSHJ	P,TAPIN		;GET 1 ROUND OF INPUT
	JRST	EOFIN		;O.K, THEN ADSORB THE EOF
				;FROM THE GUY IN FRONT OF YOU
				;ON THE TAPE
				;AND APPEND THE TRAILER RECORD TO HIS AREA

				;MEANS EOF CAME UP WHILE
				;WRITING AN EOF
				;WHICH COULD HAPPEN, BUT WE DON'T GET
				;STSTUS UNTIL WE DO OUT'S
				;THEREFORE CANNOT  SEE  HOW WE CAN
				;HAVE EOF COMING UP, UNLESS
				;TU-30 IS DOING US IN (9-TRACK?)

TPFL4A:	SKIPA	T,[XWD	FILDIR-1,WATBUF]	;RESTORE WATCH-BLOCK POINTER
				;USE ALREADY GENERATED LITERAL FOR ITS RIGHT HALF
	JRST	TPFL3A		;OOOPS, NO GO!
				;WE HAVE GOT THE DATA FROM PREVIOUS
				;FILE ?


	MOVEI	B,1(T)		;BUMP POINTER, SAVE ORIGINAL VALUE
TAPFL4:	ILDB	S,TAPHED+1	;GET DATA WORD
	CAME	S,-1(B)		;ARE DATA WORDS =?
	JRST	SWAPQ		;COULD THIS BE
						;DIFFERENT
						;BECAUSE OF SWAPPED PPN'S
TAPFL5:	CAIGE	B,6(T)			;ALL WORDS COMPARED?	[43]
	AOJA	B,TAPFL4		;OK SO FAR, TRY SOME MORE
				;JUMP IF NOT COMPLETELY DONE LOOKING
	CLOSE	TAP,0		;CLOSE TAPE UP
	MTAPE	TAP,7		;BACKSPACE OVER RECORD WHEN THROUGH COMPARING
	MOVE	B,-4(B)		;GET PPN
	MOVEM	B,UFDDIR+2	;YES
	PUSHJ	P,PRPP		;PRINT PROJ-PROG #
	TYPES	(&)		;&+SPACE

EOFPRT:	PR1	<THOSE FOLLOWING ARE ON THE NEXT TAPES.#>
	TDO	F,[XWD	TENDF,CONTSW!TAPO]	;SET CONTINUATION FLAG
				;AND TAPE OUT SWITCH
				;AND END OF TAPE SWITCH
	TRZ	F,TAPI!LISTSW!DOINGJ		;NO LONGER DOING INPUT
					;OR DUMMY-ING UP A LIST
						;OR DUMMY-ING UP A /J
	SETZM	SYNCIN		;BACK TO BUFFERED MODE, PLEASE
SETITO:	JRST	SETOU		;RE-INIT TAPE & SET VIRGIN HEADER
				;AFTER DOING A DUMMY OUTPUT


EOFIN:	MTAPE	TAP,17		;ADSORB THAT EOF
	JRST	EOFPRT			;AND PRINT IT OUT


BADIN:	MTAPE	TAP,7		;BACK UP A RECORD
	MTAPE	TAP,7		;BACK UP TO THE ONE IN FRONT OF THE BAD ONE
	JRST	EOFPRT		;YOU ARE SLIGHTLY CONFUSED, GET OUT WHILE
				;THE GETTIN'S GOOD
TPFL3A:	PUSHJ	P,TAPIN		;WE NEED A DIRECTORY
					;NOT AN EOF
	JRST	BADIN			; _ EOF
	JRST	TPFL4A			;DIRECTORY
					;NOT A BUNCH OF DATA
	JRST	BADIN			; _ DATA

SWAPQ:	MOVE	A,SLGPPN		;GET SOURCE PPN
	CAMN	S,SLOPPN
	CAME	A,-1(B)				;SEE WHETHER
	JRST	TPFL3A				;SEE IF ANY MORE DIRECTORIES..
						;DIRECTORIES ARE A POINT OF REFERENCE
						;WE SPOOL DOWN THE TAPE UNTIL
						;WE RUN OUT OF DIRECTORIES
						;THEN WE BACK PEDDEL
						;UNTIL WE FIND DIRECTORIES
						;IN FRONT OF THE STARTING
						;PLACE.
						;WE THEN MOVE
						;FOWARD UNTIL WE EITHER
						;BOMB OUT COMPLETELY
						;OR UNTIL WE
						;BACK INTO
						;A DIRECTORY THAT
						;MATCHES
	JRST	TAPFL5				;/G AND /O	[43]
;OUTPUT TRAILER BLOCK

TRLOUT:	PUSHJ	P,LOOKDT	;GET DATE & TIME
	TRNE	F,CONTSW	; CONTINUATION FLAG IS ON
	TLO	A,400000
	MOVEM	A,FIRBLK+3
	MOVEM	A,TIMOUT#	;SAVE ENDING TIME FOR THIS TAPE
				;TO BE SAVED, (TEMPORARILY
				;FORGETTING ABOUT /E AND /F), A
				;FILE MUST HAVE BEEN CREATED BEFORE
				;STARTING TIME <AS NOTED IN THE
				;HEADER TEXT
				;OR
				;THERE IS STILL A CHANCE
				;IF IT HAD BEEN CREATED DURING THE
				;FIRST FEW MOMENTS OF FAILSAFE-RUN
				;
				;IT CANNOT BE ON THE TAPE IF IT HAS A
				;CREATION TIME OF LATER
				;THAN THE TIME IN TIMOUT
				;BEFORE START TIME ... YEP, IT'S ON TAPE
				;AFTER START TIME BUT BEFORE END TIME ...
				; YEP, THEN MAYBE IT'S ON TAPE
				;AFTER END TIME ... YEP, THEN IT IS NOT ON THE TAPE


	MOVN	A,TAPNUM	;NEGATE TAPE #
	HRRM	A,FIRBLK+2	;RESET TRAILER
	PUSHJ	P,LABBLT	;WRITE TRAILER, EOFS, RETURN
	HLRZ	A,FIRBLK		;GET THE VERSION NUMBER
	HRRZM	A,VERNO			;SAVE IT
	POPJ	P,		;AND RESET FOR OUTPUTS AFTER CLOSING
;OUTPUT MESSAGES AND REWIND TAPE

MESOUT:	TLZ	F,TENDF		;CLEAR EOT BIT
	IFDEF	UNLOAD,<
	MTAPE	TAP,11		;START REWIND AND UN-LOAD PROCEDURE
	>
	IFNDEF	UNLOAD,<
	MTAPE	TAP,1		;OR JUST REWIND PROCEDURE
	>
	PUSHJ	P,TUNREL	;UNLOCK ??
				;RELEASE TAP, ANWWAY

	PRLIN1	<$COMPLETED FAILSAFE#>
	PUSHJ	P,ENDMES	;CR & LF BEFORE YOU RETURN HERE
REMESS:	PR1	<TO CONTINUE, REASSIGN LOGICAL DEVICE FAILSA (IF YOU WISH)@>
	PR1	<& TYPE /C@>
	JRST	ASTRSK		;TYPE "*" THEN POPJ

TUNREL:	RELEAS	TAP,			;GIVE UP DDB SO REASSIGN CAN
					;BE DONE SO TAPES CAN BE MADE ON
					;VARIOUS DRIVES
	IFN	LOCK,<
TUNLOC:	MOVEI	TMP,1			;LOW SEG OUT OUT & AWAY
					;SKIP TEMPORARY UNLOCK
	TLNE	F,LOCKER		;IF NOT LOCKED
	CALLI	TMP,UNLOCK		;TRY IT
	POPJ	P,			;WELL, YOU TRIED & LOST
	>
	POPJ	P,			;WELL, YOU TRIED & WON

ENDMES:	PUSHJ	P,TAPNO		;"TAPE #"
	MOVE	A,TAPNUM	;GET OUR REEL NUMBER
	PUSHJ	P,PRNUM		;OUTPUT DECOMAIL #
	PUSHJ	P,CRLF		;KEEP THE LINES SHORT
				;SINCE MUCH
				;OF THE RIGHT HAND HALF
				;MAY BE CUT OFF IF THE
				;OPERATOR KEEPS THE OUTPUT INSIDE
				;THE TAPE CANISTER
	MOVE	A,TIMOUT	;GET WRAPUP TIME
	HRRZ	B,VERNO		;GET THAT VERSION NUMBER!
	CAIGE	B,SECVER	;YOU HAVE SECONDS & MINUTES IN TIME
	JRST	DATIME		;NOPE! JUST MINUTES
	JRST	DAYTIM		;YEP!! BOTH
				;SECONDS AND MINUTES
				;CR + LF AND THEN POPJ AFTER
				;PRINTING WRAPUP TIME AND DATE
;CHECK FOR SPECIAL /C
;IF NOT, PROCESS AS USUAL

CWAIT:	INPUT	TTI,		;GET COMMAND
	PUSH	P,TTYI+1	;SAVE JUST IN CASE
	ILDB	CH,TTYI+1	;GET FIRST CHAR
	CAIE	CH,"/"		;IS IT A SLASH?
	JRST	RUSURE		;ARE YOU SURE ? /C NOT RECEIVED... CHECK
	ILDB	CH,TTYI+1	;YES
	CAIE	CH,"C"		;IS IT A C?
	JRST	RUSURE		;NOT "C"... CHECK!
	JRST	APOPJ		;RETURN
POPBAK:	POP	P,TTYI+1
	POP	P,TMP		;SLUFF PUSHJ P, RETURN
	JRST	FS1B		;GO PROCESS USUAL COMMAND

	;RESAVE FILES WE THOUGHT WE HAD SAVED
RUSURE:	CAIN	CH,"C"		;FORGET THE / ?
	JRST	APOPJ			;YEP
	POP	P,TMP		;FORGET SAVED BYTE POINTER
	POP	P,TMP			;FORGET RETURN ADDRESS
	CAIN	CH,"V"			;/V IS ALLOWED DURING BREAK
						;BETWEEN TAPES
	JRST	[PUSHJ	P,LOC			;TRY TO TOGGLE LOC SWITCH REQUEST
		PUSHJ	P,ASTRSK		;*
		JRST	RELINK
			]		;RETURN FOR MORE INPUT
	PRLIN1	<$ARE YOU SURE ?  "Y" STOPS SAVE ; ANY OTHER CHARACTER ALLOWS RESCAN@>
	INPUT	TTI,		;GET HIS ANSWER
	ILDB	CH,TTYI+1	;TERMINAL CHARACTER?
	CAIN	CH,"Y"		;DID HE SAY, "YES, ABORT SAVE?"
	JRST	FS1B		;YES, ABORT
	MOVEI	CH,044		;"$"
	PUSHJ	P,TYPEA
					;SET UP FOR POPJ FROM ASTERISK
	PUSH	P,[RELINK]		;ON TO PUSHDOWN LIST IT GOES
	JRST	REMESS		;AND LOOP UNTIL HE GIVES DEFINITIVE ANSWER

RESAVE:	MOVE	P,SAVMFD	;RESTORE PDP
	TLZ	F,FIRSW		;NOT FIRST TAPE ANYMORE
	PUSHJ	P,OTHERS		;WRITE OUT NEW HEADER
					;NO NEED TO SETUP FOR OUTPUT
					;OR DO DUMMY OUTPUT
					;SINCE TRLOUT: LEFT YOU SET UP

RESAV1:	TRZ	F,CONTSW		;TURN CONTSW OFF SO YOU WON'T POP P,A
					; THEN POPJ P,... RETURN 1 LEVEL TOO HIGH
RESAV2:	MOVE	U,WATBUF+2	;RESTORE PPN
	MOVS	S,[FILDIR-1,,WATBUF]
	BLT	S,FILDIR-1+XLOOKN+2-1
	JRST	MORE7

SUBTTL ***RESTORE CODE***
;"/R" SWITCH - RESTORE COMMAND EXECUTION

UNSAVE:	CALLI	A,GETPPN
	  JFCL			;BE DEFENSIVE
	CAME	A,FSPP		;LOGGED IN AS 1,2?
	JRST	NOTFS		;NO,NOTIFY USER AND EXIT
	TRO	F,RESTSW	;/R IN PROGRESS
	TRZ	F,SAVSW		;TURN OFF IN CASE OF /C
	PUSHJ	P,LOOKDT	;GO GET CURRENT DATE/TIME
	PUSHJ	P,DAYTIM	;  THEN TYPE IT FOR OPR
UNSAV2:	PUSHJ	P,SETIN		;INSURE BUFFERS
UNSAV3:	TRZ	F,CONTSW	;CLR CONTINUATION TAPE FLAG
IFN	REWIND,<	EMTAPE	1		;BEGINNING OF TAPE
	>
	PUSHJ	P,TAPIN		;READ FIRST RECORD
	JRST		[	PUSHJ	P,ILLFMT		;NOT FAILSAFE FORMAT
								;1ST REORD WAS EOF
				JRST	FORGIV
				JRST	FORGIV		;BUT WE'LL FORGIVE THE ERROR
						]

	JRST	DROK1			;DIRECTORY RECORD 1ST = AOK
	JRST		[	PUSHJ	P,ILLFMT
								;1ST RECORD WAS DATA RECORD
				JRST	FORGIV
				JRST	FORGIV]
DROK1:	MOVE	D,TAPHED		;GET ADDRESS OF BYTEPOINTER
	HLRZ	A,2(D)			;GET FORMAT CODE
	CAIN	A,-6			;CURRENT VERSION?
	JRST	FAILSC			;OLD FORMAT, BYE!
					;CONTINUE, IT'S A CURRENT FORMAT TAPE
	HLRE	A,2(D)		;XWD HEADER FLAG,INTERNAL WORD COUNT
	JUMPLE	A,	[	PUSHJ	P,ILLFMT	;INSIST ON HEADER FLAG (VERSION #)
				JRST	FORGIV
				JRST	FORGIV]		;FORGET CHECKING FAILSA PPN SINCE TAPIN
				;ROUTINE
				;CHECKS 1ST THREE WORDS FOR A MATCH
				;AND ACKNOWLWDGES APPROVAL
				;WITH 3 OUT OR 4, SO DON'T BOMB THE GUY
				;OUT IF HIS FIRST RECORD IS A LITTLE FLAKEY
				;ON THE 4TH HERE IF 3 OUT OF 4 WAS OK
				;AT TAPIN:
				;
	CAIGE	A,FST5S		;SAY, COULD THIS BE A LEGIT. 5-SERIES TAPE
				;?
	JRST	WRONGV		;WRONG VERSION OF FAILSAFE IS READ
				;OR THE WRONG ONE WROTE IT... AT ANY RATE
				;YOU ARE MIXING APPLES AND ORAGES AND GETTING
				;FRUIT SALAD.
	PRLIN1	<5-SERIES FAILSAFE TAPE RECORDED BY VERSION@>
	HLRZ	A,2(D)		;GET VERSION # THAT RECORDED YOU
	PUSHJ	P,PRNUM8	;OUT PUT THE OCTAL #

	PR1	< AT#>
	PUSHJ	P,PRTIME		;PRINT TIME AS HRS:MIN
					;OR HR:MIN:SEC, DEPENDING ON VERSION
					;WHICH AUTHORED THIS TAPE
	MOVEI	CH,042			;"
	PUSHJ	P,TYPEA
					;PRINT A "
					;TO QUEUE BATCH TO PUT MESSAGES
					;ON CONTROLLING TTY
	PUSHJ	P,TAPNO
	HRRE	A,4(D)		;GET TAPE NUMBER
	MOVM	A,A		;MAGNITUDE ONLY, PLEASE


	PUSHJ	P,PRNUM
	XLIST
	IFN	LEVELC,
	<
	LIST
	TRNE	F,LEVELC		;ARE WE LEVEL C ?
	PUSHJ	P,[
		PRLIN1	(OUTPUT MODE IS 4-SERIES@)
	POPJ	P,
	]
	>
	LIST


	SKIPGE	5(D)		;A CONTINUATION TAPE?
	TRO	F,CONTSW	;YES, SET FLAG

	PUSHJ	P,LFCRLF	;2 LINES SKIPED PLEASE
FORGIV:	TRNE	F,PRNTSW!LISTSW!SLRESW	;PRINTING?
					;OR LISTING
					;OR SELECTIVE RESTORING
	POPJ	P,			;YES, RETURN



	PRLIN1	<IF YOU WISH TO CONTINUE WITH THIS TAPE, TYPE "/C"@>
	SETZM	TTYI+2		;CLEAR ALL PREVIOUS INPUTS
	PUSHJ	P,ASTRSK
	POP	P,T		;RESTORE STACK LEVEL
	JRST	FS2		;GET NEXT COMMAND


;"/C" SWITCH - CONTINUE RECEIVED

CONTIN:	TRNN	F,RESTSW	;RESTORE?
	JRST	FS1.2		;NO, RESTART
	PUSHJ	P,CRLF		;YES,CONTINUE ENTIRE DISK RESTORE - FORMAT OUTPUT


	SKIPG	TAPHED		;TAPE NEED INIT-ING ?
	PUSHJ	P,SETIN		;YES!


	TRNE	F,CONTSW	;A CONTINUATION TAPE?
	JRST	UNSLPJ		;YES LEAVE SWITCH ON TO PREVENT DOUBLE OUTPUT OF PPN ON /C
ONEMOR:	PUSHJ	P,ITAPIN	;READ THE HEADER RECORD EOF
	JRST	SETSTR		;READ FIRST STRUCTURE'S FIRST FILES
	PUSHJ	P,ILLFMT		;BAD FORMAT
	JRST	SETSTR
	JRST	SETST1		;YOU ARE AT A DIRECTORY RECORD, NO NEED TO MOVE TAPE


;SET UP NEXT STRUCTURE

SETSTR:	PUSHJ	P,TAPIN		;SEE WHAT'S NEXT
					;WE NEED A DIRECTORY
					;+1 =EOF
					;+2 =DIRECTORY
					;+3 =DATA
	JRST	[	PUSHJ	P,ILLFMT		;BAD SHOW (EOF)
			JRST	SETSTR			;EOF RETURN
			JRST	SETST1			;DIRECTORY RETURN
			]

	JRST	SETST1			;DIRECTORY RECORD FOUND

	JRST	[	PUSHJ	P,ILLFMT
			JRST	SETSTR
			JRST	SETST1]

SETST1:	TRZ	F,TAPI
	MOVE	D,TAPHED		;GET STARTING POINT FOR BUFFER HEADER
	MOVE	A,3(D)			;GET STRUCTURE NAME
	MOVEM	A,CURSTR
	MOVEM	A,READPP
	MOVE	A,5(D)			;SEE WHO IT IS
	CAME	A,SYSPP			;SEE IF 1,1...IF NOT FORGET UFD'S
	JRST	UNSLUU			;NOT 1,1...
	MOVEM	A,UFDDIR+1

	FIXDEV				;FIX UP DEVICE
					;IF NECESSARY
	INIT	UFD,BUFBIN
READPP:	0			;SIXBIT /STRNAM/
	XWD	0,UFDHED	;LOOKUPS ONLY
	JRST	GETSTR		;THIS STR NOT AROUND ANYMORE
	PUSHJ	P,MKUFBF	;GET BUFS
	MOVEI	A,XLOOKN	;SET SPECS FOR LOOKUP
	MOVEM	A,UFDDIR
	MOVE	A,6(D)		;UFD NAME
	MOVEM	A,UFDDIR+2
	HLLZ	A,7(D)		;EXT="UFD"
	MOVEM	A,UFDDIR+3
	FIX	UFDDIR		;FIX UP UFDS

	LOOKUP	UFD,UFDDIR	;IS THIS UFD ON THIS STRUCTURE?
	JRST	FIXUFD		;NO, MAKE ONE LIKE THE ORIGINAL

;MOVE TO NEXT UFD

SETST2:	PUSHJ	P,FTAPIN	;IGNORE DATA RECORDS
	JRST	CHKTRL		;REAL EOF/ OR TRAILER ?
	JRST	SETST1		;NO, PROCESS NEXT UFD
FIXSET:	CLOSE	UFD,DNC		;GOT TRAILER - FINISH UP
	JRST	SYPPFS

CHKTRL:	TLNN	F,TENDF		;FLAG ON
	JRST	FIXSET		;NOPE, MUST BE REAL EOF
	JRST	SYPPFS		;GOT A TRAILER
;MAKE A UFD ON THIS STR WITH QUOTA FROM THE TAPE

FIXUFD:	MOVE	A,CURSTR
	MOVEM	A,FIX2
	FIXDEV			;FIX UP STRUCTURE NAME
				;IF NECESSARY
	INIT	MFD,BUFBIN
FIX2:	0			;SIXBIT/STRNAM/
	XWD	MFDHED,0
	JRST	GETSTR		;TRY ELSEWHERE
	PUSHJ	P,UFDSPK		;SET UP HEADER AGAIN
	FIX	MFDDIR		;FIX TO 4-SERIES IF NECESSARY
	ENTER	MFD,UFDDIR	;CREATE THIS UFD
	PUSHJ	P,MAYBE1	;CAN'T UNLESS THIS IS A FRAGMENTATION
				;ERROR, CHECK IT OUT
	PUSHJ	P,MAKU2		;RELEASE MFD
	JRST	SETST2

;SET UP SPECS TO CREATE A UFD

UFDSPK:	MOVSI	A,4(D)		;START OF SPECS IN TAPBUF
	HRRI	A,UFDDIR	;SPEC AREA
	BLT	A,UFDDIR+XLOOKN
	SETZM	URBPOS		;CLR SPECIAL ITEMS
	SETZM	URBNXT
	SETZM	URBPRD
	SETZM	URBUFD
	SETZM	URBELB
	SETZM	URBEUN
	SETZM	UFDDIR+.RBUSD	;SPR #10- 4398
				;SPR #10- 4275
	MOVEI	A,.RPDIR		;DIRECTORY BIT ON
	MOVEM	A,UFDDIR+.RBSTS	;SET UFD STATUS BITS
				;
				;BLOCK USED COUNT IS RESTORED SET
				;TO LAST ACCOUNT OF # BLOCKS
				;USED AT LAST LOGOUT
				;
	POPJ	P,

MAYBE1:	GETBAD	(A)		;POPJ BACK IF FRAGMENTATION ERROR,
				;POP OFF & FALL INTO GETSTR OTHERWISE
;CREATE A UFD ON SOME OTHER STRUCTURE IF POSSIBLE

GETSTR:	INIT	UFD,BUFBIN	;LOOK FOR UFD ANYWHERE
	SIXBIT	/DSK/
	XWD	0,UFDHED
	JRST	DNTAVL		;NO DISK
	MOVSI	A,(SIXBIT /DSK/)
	MOVEM	A,CURSTR	;NOW DSK IS CURRENT STRUCTURE
	PUSHJ	P,UFDSPK	;GET SPECS
	PUSHJ	P,MKUFBF	;GET BUFRS
	FIX	UFDDIR
	LOOKUP	UFD,UFDDIR
	PUSHJ	P,MAKUFD	;NOT AROUND - HAVE TO MAKE ONE
	JRST	SETST2		;FOUND ONE

;GET UFD BUFFERS

MKUFBF:	MOVEI	A,UFDBUF	;ALLOW THE LOOKUP SOME BUFFERS
	MOVEM	A,.JBFF
	INBUF	UFD,UFDN
	POPJ	P,

SYPPFS:	PUSHJ	P,TAB			;TAB OVER TO HELP SEPARATE
					;1 STRUCTURE FROM ANOTHER
UNSLU5:	MOVE	B,FILDIR+1
	MOVEM	B,UFDDIR+2
	TRZN	F,CONTSW	;SKIP 1ST PR-PPN OUTPUT ON /C
	PUSHJ	P,PRPP		;PRINT LAST USER RESTORED
	TRO	F,TAPI		;LITE THE TAPE INPUT FLAG
	SETZM	ONEFIL		;RESET THE "YOU HAVE A FOOT ON A FILE" FLAG
	TLZE	F,TENDF		;FOUND TRAILER YET ?
	JRST	TAPEND		;YEP!
				;CHECK BEFORE YOU GO,
	PUSHJ	P,ITAP		;GET INFORMATION (SKIP EOF'S UNTIL DIRECTORY OR TRAILER/HEADER)
				;AND AFTER YOU COME BACK, CHECK TRAILER
UNSLUU:	TLZE	F,TENDF		;FIND EOT (TRAILER RECORD ?)
	JRST	TAPEND
	TRZ	F,TAPI
	MOVE	D,TAPHED
	MOVE	A,3(D)		;GET 1ST STRUCTURE
					;MENTIONED ON THIS TAPE
	MOVEM	A,CURSTR
UNSLU3:	MOVE	D,TAPHED		;INSURE INDEX IS LOADED
	MOVE	A,5(D)		;GET PP#
	CAMN	A,SYSPP		;1,1?
	JRST	SETST1		;YES
	TRO	F,TAPI		;SET FOR RENTER
				;@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
	PUSHJ	P,USRUFD	;MAKE SURE USER HAS A HOME
				;THIS IS THE  GUTS OF THE /R SYSTEM
UNSLU1:	PUSHJ	P,XFER		;MOVE A USER FILE FROM TAPE TO DISK
	JRST	UNSLU5		;GOT AN EOF (OR TRAILER RECORD)
				;AT ANY RATE, FINISH THIS USERS AREA
RETRN:	TRZ	F,TAPI		;CLEAR AFTER XFER
	JRST	UNSLU1		;EXCELSIOR
UNSLPJ:	PUSHJ	P,FTAPIN	;MOVE TAPE FORWARD
	JRST	UNSLU5		;EOF OR TRAILER FOUND
	JRST	UNSLU1		;DIRECTORY-NEXT FILE

;MAKE A UFD WITH INFINITE QUOTA

MAKUFD:	PUSHJ	P,GETPAK	;INIT MFD FOR NEW UFD'S
	PUSHJ	P,UFDSPK
	HRLOI	A,377777	;LARGEST POSITIVE #
	MOVEM	A,URBQTO	;TO LOGGED-OUT QUOTA WORD
	MOVEM	A,URBQTI	;& LOGGED-IN QUOTA
	MOVEI	A,.RPDIR		;DIRECTORY BIT
	MOVEM	A,URBSTS
MAKU1:	TRO	F,UFDO
	MOVEI	A,MFDBUF	;ROOM FOR ENTER
	MOVEM	A,.JBFF
	OUTBUF	MFD,MFDN
	FIX	UFDDIR
	ENTER	MFD,UFDDIR	;CREATE A UFD
	PUSHJ	P,MAYBE2	;CAN'T UNLESS THIS IS A FRAGMENTATION
				;ERROR, CHECK IT OUT

MAKU2:	IFN	LEVELC,<
	TRNE	F,LEVELC		;IS IT LEVEL-C TIME ?
	JRST	[	OUTPUT	MFD,
		JRST	MAKU3			;YES
		]
	>

	USETO	MFD,2
MAKU3:	IFE	COMUFD,<	CLOSE	MFD,DNC!DONDAL>
	IFN	COMUFD,<	CLOSE	MFD,DNC>

	IFN	MINREL,<
	RELEAS	MFD,		;
		>
	TRZ	F,UFDO
	POPJ	P,
TAPEND:	CLOSE	TAP,		;CLEAR UP TAPE BUFFERS
	IFN	REWIND,<
	MTAPE	TAP,1		;START THE REWIND
	>
	PRLIN1	<$END OF FAILSAFE TAPE#>
	MOVE	D,TAPHED
	HRRE	A,4(D)		;GET TAPE NUMBER
	MOVM	A,A		;MAGNITUDE
	PUSHJ	P,PRNUM		;PRINT IT
	PR1	< FOR#>
	PUSHJ	P,PRTIME
	SETZM	FNDBEG		;NO LONGER KNOW ABOUT FIRST RECORD
	PUSHJ	P,LOOKDT	;GO GET CURRENT TIME/DATE
	PUSHJ	P,DAYTIM	;  & TELL IT TO THE OPR
	SKIPL	5(D)		;CONTINUED?
	JRST	FINTAP		;NO
IFE	REWIND,<
	IFDEF	UNLOAD,<
	MTAPE	TAP,11
	>
	IFNDEF	UNLOAD,<
	MTAPE	TAP,1		;REWIND
	>
	>
	PRLIN1	<TO CONTINUE RESTORING, MOUNT A NEW TAPE ON THE SAME NUMBERED DRIVE & TYPE /R@>
	JRST	FS1AA		;* AND WAIT FOR NEXT COMMAND
FINTAP:	CLOSE	FIL,DNC
	IFN	MINREL,<
	RELEASE	FIL,
		>
	CLOSE	DGA,DNC		;SHADOW TOO
	IFN	MINREL,<
	RELEAS	DGA,
		>

	CLOSE	UFD,DNC
	IFN	MINREL,<
	RELEASE	UFD,
		>


	RELEAS	TAP,			;AND TAPE

	PRLIN1	<THIS IS THE FINAL TAPE.@>
	PUSHJ	P,LFCRLF
	JRST	FS1AA

UFDFA2:	POP	P,A		;SET TO PROPER LEVEL
	PRLIN1	<CANNOT WRITE UFD:#>
	PUSHJ	P,PRPP
UNSLU4:	PUSHJ	P,FTAPIN	;MOVE TAPE FORWARD(NO INPUT)
	JRST	[	TLNN	F,TENDF
			JRST	UNSLU5		;REAL EOF
			JRST	TAPEND	;TRAILER
		]
	JRST	UNSLU4		;IGNOR INDIVIDUAL USERS' FILES

XFER:	MOVE	B,TAPHED	;WHERE TAPE BUFFER IS
	XLIST
	IFG	ALFLEX,<
	LIST
	HRRZ	A,11(B)		;GET # WORDS WRITTEN
	CAIG	A,ALFLEX		;LE TO TOLERENCE ?
	JRST	SKPCHK			;YEP!
	>
	LIST
	XLIST
	IFN	ALPJ1R,<
	LIST
	HLRZ	A,5(B)		;GET PPN
	SOJE	A,SKPCHK		;IS IT PROJECT 1 ?
		>

	LIST
	LDB	S,[POINT 3,CRDATE,23]	;INIT R,S,U + W FOR CHKCRE
	LDB	W,[POINT 3,7(B),20]
	MOVE	U,10(B)			;GET TIME AND DATE OF TAPE FILE
	MOVE	R,CRDATE		;GET TYPED IN TIME AND DATE
	PUSHJ	P,CHKCRE		;WHO IS OLDER
	JRST	[PUSHJ P,FNR		;[47] DONT RESTORE THIS FILE
		JRST FTAPIN]		;[47]
	JFCL
	LDB	A,[POINT	15,7(B),35]		;CHECK ACCESS DATE ON TAPE
	CAMGE	A,ACCDAT	;PRIOR TO SET DATE?
	JRST	[PUSHJ P,FNR1		;[47] YES, DON'T RESTORE THIS FILE
		JRST FTAPIN]	;[47]
SKPCHK:	MOVE	U,5(B)		;GET THIS GUY'S PPN
	CAMN	U,SLGPPN		;IS THIS THE ONE WE ARE GETTING ?
	MOVE	U,SLOPPN	;YOU BET!
	MOVEM	U,5(B)		;SETUP/ OR STAY SAME, DEPENDING ON CAMN
				;TRANSFER THE USER SELECTED
	MOVSI	U,4(B)		;FROM PART OF FROM ,, TO BLT POINTER
	HRRI	U,FILDIR	;TO 1)
	BLT	U,FILDIR+XLOOKN

	TLNE	F,NEWRSW	;IS N SWITCH ON
	JRST	XFER1		;YES, DON'T CHECK DISK FILE DATE
					;WILL NOT BE WHERE
					;IT IS EXPECTED
	MOVE	U,CURSTR	;GET WHERE WE HAVE RESOLVED THIS GUY
				;TO BE GOING
	MOVEM	U,CHKSTR	;SET UP FOR ACCESS/ CREATION CHECK
	FIXDEV
	INIT	CHK,DUMP		;INIT FOR DISK FILE DATE CHECK
CHKSTR:	SIXBIT	/DSK/
	XWD	0,CHKHED	;=UFDHED
	JRST	NODSK		;CAN'T INIT
	FIX	FILDIR
	LOOKUP	CHK,FILDIR	;CHECK CURRENT DISK FILE
	JRST	XFER3		;RESTORE FILE IF LOOKUP FAILS
	IFN	LEVELC,
	<
	TRNE	F,LEVELC
	SKIPA	R,FILDIR+2
	>
	LDB	S,[POINT 3,FILDIR+3,20]	;INIT R,S,U + W FOR CHKCRE
	LDB	W,[POINT 3,7(B),20]
	MOVE	R,FILDIR+4	;GET DISK DAT
	MOVE	U,10(B)		;GET TAPE DAT
	PUSHJ	P,CHKCRE	;TAPE FILE OLDER?
	JFCL			;YES, CLOSE CHK AND GET NEXT FILE
	JRST	[PUSHJ P,FNR	;[47] =, "FILE NOT RESTORED"
		JRST FTPIN1]	;[47]
	CLOSE	CHK,DNC		;NO, CLOSE DISK FILE
	IFN	MINREL,<
	RELEASE	CHK,		;GIVE UP DDB
		>
XFER3:	PUSHJ	P,RSTHDR	;RESTORE LOOKUP HEADER
XFER1:	MOVEI	A,XLOOKN+2	;REMOVE HEADER WORDS FROM BEGINNING OF FILE
				;REMEMBER, THERE WAS AN ILDB AT TAPIN2+1
				;SO THAT TO ACCOUNT FOR 42 OCTAL WORDS IN THE
				;DIRECTORY BLOCK REMAINING FROM THE ORIGINAL 43,
				;ONLY 42 NEED BE ACCOUNTED FOR
	ADDM	A,TAPHED+1


	HRROI	A,-XLOOKN-2	;NOW
	ADDM	A,TAPHED+2	;DECREMENT WORD COUNT

	MOVE	A,CURSTR	;INIT STR IT CAME FROM
	MOVEM	A,XFSTR
	FIXDEV			;FIX UP DEVICE NAME
MODDER:	INIT	FIL,BUFBIN
XFSTR:	0			;SIXBIT /STRNAM/
	XWD	FILHED,0
	JRST	XXFER		;HAVE TO PUT IT ELSEWHERE
	TRO	F,FILO
	PUSHJ	P,GETFBF	;GET BUFFERS FOR FILE
	OUTBUF	FIL,(CH)	;NUMBER OF BUF'S RETURNED IN CH
	FIX	FILDIR
	IFE	LEVELC,
	<
	LDB	A,[POINT 4,FILDIR+.RBPRV,12]
	

	SETSTS	FIL,(A)		;AND SET THAT MODE
	>
	ENTER	FIL,FILDIR
	PUSHJ	P,MAYBE3	;NOT AVAIL. - UNLESS THIS IS A FRAGMENTA-
				;TION ERROR RETURN.
				;IF NOT FRAGMENTATION, PUT FILE ELSEWHERE.


				;RESTORE STATUS & THEN
	JRST	XFER0		;BEGIN RESTORE
MAYBE3:	GETBAD	(A)		;SEE IF FRAGMENTATION OR NOT
XXFER:	PUSHJ	P,RSTHDR	;RESTORE FILE HEADER INFO FOR ENTER
	FIXDEV
MODDR:	INIT	FIL,BUFBIN	;TRY TO PUT IT ANYWHERE
	SIXBIT	/DSK/
	XWD	FILHED,0
	JRST	DNTAVL			;NO DISK
	MOVSI	A,(SIXBIT /DSK/)	;OK, DSK IS ACCEPTABLE
	MOVEM	A,CURSTR		;REMEMBER IT!!

	TRO	F,FILO		;FILE OUT FLAG ON
	PUSHJ	P,GETFBF	;GET BUFFERS
	OUTBUF	FIL,(CH)	;OUTPUT BUFFER SET UP
	FIX	FILDIR


	IFE	LEVELC,<
	LDB	A,[POINT 4,FILDIR+.RBPRV,12]
	SETSTS	FIL,(A)
	>
	ENTER	FIL,FILDIR
	PUSHJ	P,MAYBE4		;FAILURE - CONTINUE ON NEXT FILE
				;UNLESS THIS IS A FRAGMENTATION RETURN
;THE FOLLOWING SECTION OF CODE TRANSFERS A SINGLE DISK-ORIENTED FILE
;FROM TAPE TO THE DISK.

					;COMMUNICATE TO
					;USER THAT SOMETHING IS
					;HAPPENING
XFER0:
	IFE	LEVELC,<
	SETSTS	FIL,BUFBIN		;BUFFER BINARY MODE
	>


	TRNE	F,RESTSW	;IF /R IS ON
				;SKIP INFORMING USER
	JRST	QUIET		;OOPS, KEEP INFORMATION TO YOURSELF


	SKIPN	TALKER		;IF TALK SWITCH IS SET, ALLOW
				;< TO BE PRINTED
	JRST	QUIET		;OTHERWISE, FORGET INFORMING USER


	MOVEI	CH,74			;ASCII <
	PUSHJ	P,TYPEA		;AND DUMP INTO OUTPUT BUFFER
	SKIPN	LSTING		;TEST FOR TTY OUTPUT OF <>
	OUTPUT	TTO,		;  YES, FORCE 1ST BRACKET NOW
QUIET:	TRZ	F,FILO
	MOVE	A,CURSTR
	MOVEM	A,MORE72	;INSURE THE PROPER DEVICE IS SHADOWED


	SKIPN	ONEFIL		;SHADOW CHANNEL OPENED YET ?
	PUSHJ	P,KINCOR	;NOPE! OPEN IT!



	SKIPN	PAKFRE,TAPHED+2		;GET INPUT FILE'S WORD COUNT
	JRST	ACFIL6			;OOOOPS, NO WORDS LEFT
	SKIPN	PAKNAM,FILHED+2		;LIKEWISE FOR OUTPUT FILE
	JRST	ACTAP6			;OOOPS, NO MORE ROOM LEFT IN OUTPUT
					;BUFFER

;______________________*****************_________________________
SETUP2:	HRLZ	S,TAPHED+1		;FROM TAPE TO DISK
	HRR	S,FILHED+1		;FROM,,TO
FASTER:	CAILE	PAKNAM,(PAKFRE)		;
	SKIPA	WASTE,PAKFRE		;TAPE RUNS OUT AND LIMITS BLT
	MOVEI	WASTE,(PAKNAM)		;OUTPUT FILE BUFFER RUNS OUT FIRST
					;DISK LIMITING WORD COUNT
	HRRM	S,TSAF			;DESTINATION ADDRESS
				;SEE EXPLANATION AT "FAST:"
	AOBJP	S,TSAF			;
TSAF:	BLT	S,0(WASTE)




	SUBI	PAKNAM,(PAKFRE)		;FIND OUT WHICH [INPUT OR OUTPUT]
					;OR BOTH THAT YOU NEED TO DO

	JUMPGE	PAKNAM,ACFIL3		;OK, WE SUBTRACTED RIGHT (I.E.,
					;SMALLER SUBTRACTED FROM LASRGER)



	ADDM	WASTE,TAPHED+1		;REPOINT TAPE BUFFER TO REFLECT BLT


					;DISK BUFFER IS FULL
	MOVNM	PAKNAM,TAPHED+2		;UPDATE WORD COUNT
					;TO DISK
					;AND PUT IN BUFFER HEADER
					;SETTING DISK BUFFER TO 0(FULL)

ACTAP6:	PUSHJ	P,FILOUT		;DISK BUFFER FULL

	SKIPN	PAKFRE,TAPHED+2		;SEE IF TAPE BUFFER STILL HAS INFO IN IT
	JRST	ACFIL6			;TAPE RAN OUT CONCURRENTLY WITH
					;DISK'S FILLING UP
	HRRZ	PAKNAM,FILHED+2		;RESTORE THE REFRESHED COUNT TO AC
	JRST	SETUP2
					;TAPE BUFFER IS EMPTY....
ACFIL3:	HRRZM	PAKNAM,FILHED+2		;REMEMBER HOW MUCH ROOM LEFT FOR DISK
	ADDM	WASTE,FILHED+1		;REPOINT TAPE BUFFER TO REFLECT
					;THE BLT

ACFIL6:	PUSHJ	P,TAPIN			;TAPE BUFFER IS EMPTY, PLEASE REFILL
	JRST	TESTQ1			;FILE WE HAD BEEN TRANSFERRING
					;HAS BEEN CLOSED
	JRST	TESTQ2			;DIRECTORY RECORD FOUND
					;LIKEWISE, FILE PREVIOUSLY
					;BEING WRITTEN ON DISK HAS
					;BEEN CLOSED
	SKIPN	PAKNAM,FILHED+2		;MORE DATA TO TRANSFER, DATA RECORD FOUND
	JRST	ACTAP6			;PULL FILE IN FROM TAPE
					;AND CONTINUE PUTTING IT ON DISK
	HRRZ	PAKFRE,TAPHED+2		;REFRESH COUNTER
	JRST	SETUP2

TESTQ1:	TRNE	F,RESTSW
	POPJ	P,		;SKIP IMING USER FOR
	SKIPN	TALKER
	POPJ	P,		;IF DOING /R OR /T IS NOT ON
				;NOTE THAT /T DOES NOT OVERRIDE /R
				;THE SAME REASONS AT XFER0:

FILING:	MOVEI	CH,76		;RIGHT-ANGLE-BRKT
	PUSHJ	P,TYPEA			;OUTPUT
	JRST	CRLF			;RIGHT-ANGLE-BRKT FOLLOWED BY CR-LF

TESTQ2:	TRNE	F,RESTSW
	JRST	CPOPJ1
	SKIPN	TALKER
	JRST	CPOPJ1		;LIKEWISE, SKIP ONFORMING IF /R
				;OR IF /T IS NOT ON IN OTHER CASES

	AOS	(P)			;SET UP FOR SKIP RETURN
	JRST	FILING			;AND OUTPUT A RIGHT-ANGLE-BRKT

CGETDR:	SKIPLE	FILHED		;TRY TO CLOSE DISK OUTPUT FILE
				;BUT FORGET IT, IF FILE NOT OPEN
	CLOSE	FIL,DNC		;CLOSE UP ABORTED DISK FILE
	JRST	FTAPIN		;GET A DELILITER

ITAPIN:	PUSHJ	P,TAPIN		;DIRECTORY OR EOF MUST BE NEXT
	POPJ	P,			;EOF
	JRST	CPOPJ1			;DIRECTORY
	PUSHJ	P,ILLFMT		;IF DATA RECORD, BAD FORMAT
	JRST	ITAPIN

FTPIN1:	CLOSE	CHK,DNC		;CLOSE UP TIME CHECK CHANNEL
	IFN	MINREL,<
	RELEAS	CHK,		;AND GIVE UP DDB
		>
FTAPIN:	PUSHJ	P,TAPIN			;IGNORE DATA RECORDS
	POPJ	P,			;EOF
	JRST	CPOPJ1			;DIRECTORY
	JRST	FTAPIN			;IGNORE DATA RECORDS
SKPTAP:	PUSHJ	P,TAPIN		;GET SOME TAPE
	JRST	ISITHD			;IGNORE EOF'S
					;BUT EOF RETURN IS THE
					;TRAILER RETURN TOO
					;SO SEE WHICH IT IS
	JRST	SKPTAP			;DIRECTORY RECORD
	JRST	SKPTAP			;YOU FOUND DATA, FLUSH IT
ISITHD:	SKIPG	A,TAPHED		;REAL EOF
	JRST	SKPTAP			;YES!
	HRRZ	B,2(A)
	CAIE	B,FSPP-FIRBLK		;IS THE WORD COUNT RIGHT ?
	JRST	SKPTAP			;NOPE
	MOVE	B,3(A)			;IS DATA RIGHT ?
	CAME	B,STARFS		;*FAILS   ??????
	JRST	SKPTAP			;NOPE
	POPJ	P,			;YEP

GETEOF:	SKIPLE	TAPHED			;WE SAW SOMETHING WE DIDN'T LIKE
					;SKIP TO SOMETHING WE DO LIKE
					;DID WE JUST HAPPEN TO LAND ON
					;AN EOF ?
GETEF:	PUSHJ	P,TAPIN			;GET SOME INPUT
	POPJ	P,			;GOT WHAT WAS SOUGHT, EOF
	JRST	GETEF			;FLUSH DIRECTORIES
	JRST	GETEF			;FLUSH DATA

GETDIR:	PUSHJ	P,TAPIN
	JRST	CHKEND			;EOF OR TRAILER FOUND
					;TRAILER RECORDS (RETURN AT EOF)
	POPJ	P,			;GOT A DIRECTORY RECORD
	JRST	GETDIR

CHKEND:	TLNN	F,TENDF			;TRAILER SIGHTED ?
					;TRY RECIRCULATING TAPE
	POPJ	P,
	CLOSE	TAP,
	LOADPT
	POPJ	P,
;GET FIRST RECORD OF A FILE

ITAP:	PUSHJ	P,ITAPIN	;1ST REC. SHOULD BE DIRECTORY
				;BUT IT TAPE ERROR, MAY NOT BE, SKIP
				;UNTIL YOU FIND SOMETHING
				;YOU UNDERSTAND
	JRST	[	TLNN	F,TENDF
			JRST	ITAP		;REAL EOF
			POPJ	P,		;GOT THE TRAILER
		]
	POPJ	P,		;GOT A DIRECTORY

;CLR KEY ARGS IN EXTENDED LOOKUP/ENTER SPECS

FILSPK:	SETZM	FRBPOS
	SETZM	FRBNXT
	SETZM	FRBPRD
	SETZM	FRBUFD
	SETZM	FRBELB
	SETZM	FRBEUN
	POPJ	P,

;RESTORE LOOKUP/ENTER FILE SPECS

RSTHDR:	MOVSI	A,4(B)		;RESTORE LOOKUP HEADER
	HRRI	A,FILDIR
	BLT	A,FILDIR+XLOOKN
	JRST	FILSPK		;CLEAR OUT ENTRIES NOT USED
				;AND RETURN

;SETUP BUFFERS FOR FILE ENTER

GETFBF:	MOVEI	A,FILBUF	;SETUP BUFFERS FOR USER FILE
	MOVEM	A,.JBFF
	MOVE	A,USRPPN	;IF THIS IS 1,2 GIVE HIM ALL WE GOT
	MOVEI	CH,FILN		;PRESET TO LARGER NUMBER OF BUFFERS

	IFG	LOCK,<
	TLNE	F,LOCKER	;LOCKED ?
	POPJ	P,		;YES
		>
				;NOT LOCKED, WELL ARE WE
	CAME	A,FSPP		;1,2 ?
	MOVEI	CH,ALTFLN	;SMALLER NUMBER OF BUFFERS FOR NON 1,2'S
				;WHO AREN'T LOCKED IN CORE
	POPJ	P,

NOCORE:	PRLIN1	<?NOT ENOUGH CORE@>
	JRST	REINFO
;	TAPIN USUALLY RETURNS TO CALL +3
;	IT HAS TWO EXCEPTIONAL RETURNS WHICH SKIP ZERO OR ONE
;	AND THEN RETURN: END OF FILE
;			 DIRECTORY RECORD
;			 DATA RECORD
				;NOTE WELL*
				;TAPHED + 2
				;WILL CONTAIN # OF WORDS READ-1
				;UPON SUCCESSFUL RETURN
				;FROM TAPIN, I.E.,
				;NUMBER OF WORDS IN BUFFER & NUMBER
				;IN RIGHT HAND HALF OF 1ST WORD
				;OF BUFFER AGREE!

TAPIN:	TLZE	F,TENDF		;HAVE WE ALREADY REACHED TRAILER?
	JRST	CPOPJ1		;YES, SIMULATE DIRECTORY RECORD READ(CALL+2)
	TRO	F,TAPI
INN:	IN	TAP,		;READ ANOTHER BUFFER
	JRST	TAPIN2		;READ OK
				;READ NOT SO GOOD, WHAT'S THE MATTER
	STATZ	TAP,740000	;I/O ERROR BITS ON?
	JRST	RTAPIN		;SOMETHING IS WRONG, NOT JUST DIFFERENT
	STATZ	TAP,IOEND	;END OF FILE?
	JRST	TAPIN4		;YES, END USER FILE

RTAPIN:	TRNE	F,DOINGJ	;SOMETHING WAS NOT 100% AOK WITH THE READ
				;BUT THEN WE WERE DOING A /J
				;JUST JUMPING OVER THE SAVE SETS... SO
				;FORGET IT
	JRST	TAPIN3		;SAY IT WAS A GOOD READ
	TRO	F,TAPI		;SET FOR RETURN FROM FORMAT ERROR BELOW
	HRRZ	A,LASTWC#	;SEE IF LAST WORD COUNT = FULL BUFFER
				;IF NOT FULL BUFFER, IT TERMINATED A
				;FILE
	CAIE	A,TAPLEN-4	;FULL BUFFER, THEN IT WAS PROBABLY
				;A DATA RECORD
	JRST	CHKMOR		;WELL, WE FINISHED DEALING WITH
				;THE LAST FILE, SO WE REALLY DON'T KNOW
				;THE NAME OF THIS "NEW" FILE YET
WHONAM:	SKIPN	FNDBEG		;DON'T SAY THE NAME IF WE HAVEN'T SEEN
				;A HEADER RECORD
KNONAM:	PUSHJ	P,TFRERR	;NO, PRINT ERROR MESSAGE & FILE NAME
TAPRES:	PUSHJ	P,CLOFIL		;CLOSE BUT DO NOT TRANSFER FILE
					;CURRENTLY IN HAND
	GETSTS	TAP,B		;GET ERROR BITS
				;AND TRY TO RESCUE
	TRZ	B,760000	;CLEAR ERROR BITS
	SETSTS	TAP,(B)		;SET NEW STATUS
				;? DO WE WANT TO CLOSE TAP, HERE ?
	JRST	ILLTAP		;LOOK FOR SOME LANDMARK
CHKMOR:	MOVE	A,TAPHED	;SEE IF THIS MIGHT NOT
	HLRE	B,2(A)		;BE A DIRECTORY RECORD ITSELF
	AOJE	B,GETNAM	;IF THIS WAS A DIRECTORY RECORD
				;LEFT HALF = -1, WHICH PROPOGATES
				;TO ALL 7'S.
				;IF ADD 1 BRINGS TO = 0, THEN IT WAS A
				;DIRECTORY RECORD
				;THEN I KNOW THE FILE'S NAME
				;ALL I HAVE TO DO IS TO GET IT
	SOJE	B,WHONAM	;HAVE DATA RECORD, BUT DO WE HAVE FILE NAME
				;LAST RECORD WAS NOT FULL, I.E., IT
				;LOOKS AS IF WE HAD JUST READ A TERMINATION RECORD
				;AND THIS GUY SHOWS UP NEXT, BUT HE IS
				;NOT A DIRECTORY RECORD... HMM, SOMETHING IS
				;ROTTEN IN THE STATE OF DENMARK, I
				;WONDER WHAT ELSE WE MIGHT HAVE HERE:

				;WELL, THERE IS THE POSSIBILITY OF A TRAILER
				;OR HEADER RECORD BEING BAD
	MOVE	B,3(A)		;GET FIRST WORD OF RECORD
	CAME	B,STARFS	;SEE IF THIS IS *FAILS
	JRST	NOKNON		;NOPE! DON'T KNOW WHAT THE DEVIL THIS RECORD IS
	HLRZ	B,4(A)			;GET AFE/TAPE #
	CAIE	B,(SIXBIT /AFE/)	;IS IT "AFE" ?
	JRST	NOKNON		;WELL, THEN WE DON'T KNOW WHO IT IS

	HRRE	B,4(A)		;______________HEADER OR TRAILER/
				;FIND OUT WHICH
	JUMPL	B,BADTRA	;POSITIVE # = HEADER
				;NEG = TRAILER

BADHAD:	PRLIN1	<TAPE ERROR READING HEADER; RECORD ACCEPTED@>
	SETOM	FNDBEG		;SET SWITCH SAYING YOU'VE FOUND HEADER
	JRST	TAPIN6

BADTRA:	PRLIN1	<TAPE ERROR READING TRAILER; RECORD ACCEPTED@>
	JRST	TAPIN6		;BAD READ.. WELL, YES, BUT DON'T SHHOT
				;THE OPERATION DOWN, IT MAY NOT
				;BE ABSOLUTELY 100% GOOD DATA, BUT
				;IT IS GOOD ENOUGH TO CONTINUE ON


NOKNON:	SKIPN	FNDBEG			;HAVE WE FOUND THE FIRST RECORD YET ?
	JRST	TAPRES			;NO, DON'T OUTPUT DOUBLE ERROR MESSAGES

	PRLIN1	<TAPE ERROR READING IRRELEVANT RECORD; RECORD IGNORED@>
	STATO	TAP,IOTEND		;OOPS, IS EOT UP ?
	JRST	TAPRES
	JRST	CLOFIL		;CLOSE DISK FILE JUST IN CASE SOME
				;TRANSFER WAS GOING TO DISK


GETNAM:	PUSHJ	P,SETNAM	;SET UP NAME AND POISTIONING
	JRST	KNONAM		;GIVE THE USER NAME OF FILE SINCE
				;IT LOOKED AS IF THE READ ERROR WAS NOT
				;SO DEGRADING AS TO RETURN COMPLETE GARBAGE

TAPIN4:	TRZ	F,TAPI
	CLOSE	TAP,		;CLEAR END BIT
TAPIN5:	SETZM	LASTWC		;SET WORD COUNT TO NOT-FULL
				;WE HAVE PUT FLAG UP
				;SAYING "NAME OF INPUT FILE NOT KNOWN"
				;WHEN (IF) A TAPE ERROR OCCURS
				;ON NEXT IN UUO

	SETZM	ONEFIL		;SET UP FOR SHADOW CHANNEL INITIALIZATION
	TRNE	F,LISTSW!PRNTSW	;LISTING OR PRINTING ?
	POPJ	P,		;RETURN CALL+1 (EOF)
				;IF NOT LISTING OR PRINTING, THEN CLOSE UP
				;FILES YOU WERE WRITING ON THEPDISK


	IFE	COMFIL,<CLOSE	FIL,DNC!DONDAL>
	IFN	COMFIL,<CLOSE	FIL,DNC>
	CLOSE	DGA,DNC
	POPJ	P,

TAPIN3:	STATZ	TAP,IOEND		;DOING /J... AND AN ERROR
					;WELLL, WAS EOF ON ?
	JRST	TAPIN4			;YES
TAPIN2:	TRZ	F,TAPI		;RESET INPUT FLAG

	ILDB	B,TAPHED+1	;PICKUP WORD COUNT
				;SEE.

				;HOW MANY WORDS CAME IN ON THIS BUFFER
	SOS	CH,TAPHED+2	;PAY UP FOR WORD
	CAIE	CH,(B)		;DO MONITOR AND FAILSAFE AGREE ON RECORD LENGTHS ?
	PUSHJ	P,DISCRP		;ARG! NO!!


	HRRZM	B,LASTWC	;IN EITHER EVENT, REMEMBER WHAT WORD
				;COUNT MOST PROBABLY IS
	HLRE	A,B		;GET LEFT HALF
	JUMPE	A,CPOPJ2	;JUMP IF DATA RECORD
	JUMPG	A,TAPIN6	;HEADER/TRAILER
	TRNE	F,DOINGJ		;ARE WE LIABLE TO BE SEEING
					;FUNNY FILES<BOOTSTRAPING/>
					;IF SO,  DON'T WORRY ABOUT
					;NEGATIVE COUNTS<JRST	CPOPJ1>
	JRST	CPOPJ1
					;BE WORRIED.
	CAMN	A,[-6]		;OLD FORMAT?
	JRST	FAILSC		;OLD STYLE TAPE!
	AOJN	A,CHKNEG		;CHECK TO SEE IF NEGATIVE LEFT HALD
					;IS = -1 (IF SO, = FAILSA
					;DIRECTORY RECORD)
					;OR
					;IF JUST NEGATIVE
					;OTHER THAN -6 = PROBABLY
					;A MAGRIM OR SAVE FORMAT

	TRNN	F,LISTSW!PRNTSW		;IF PRINTING OR LISTING
				;DON'T CLOSE WHAT YOU HAVE^7T OPENED
	IFE	COMFIL,<CLOSE	FIL,DNC!DONDAL>
	IFN	COMFIL,<CLOSE	FIL,DNC>

			;DIRECTORY RECORD FOUND!
			;_______________________
	PUSHJ	P,SETNAM		;GET NAME
				;TO WHICHEVER DIRECTORY OUGHT TO GET IT
	TRNE	F,PRNTSW!LISTSW	;DON'T FLIP RPOJ-PROG #'S AROUNG;D
				;IF LISTING OR PRINTING
	JRST	CPOPJ1
				;CHANGES FOR /G AND /O
				;/O********/G
				;/G________/O
				;CHANGES
	MOVE	B,TAPHED
	MOVE	A,5(B)		;GET PROJECT-PROG # WHO OWNS THIS FILE
	CAMN	A,SYSPP		;IS IT 1,1
	MOVEI	B,1(B)		;IT IS 1,1   .. BUMP POINTER TO LOOK AT
				;FILE NAME, NOT OWNER
				;NOT OWNER OF FILE FOT THIS FILE
				;POINTER SET UP
SWAPI:	MOVE	U,5(B)		;DO WE, OR DON'T WE, SWAP
	MOVE	A,SLOPPN	;IS THIS THE FELLOW
				;WE ARE GOING TO CREATE OUT OF THE /G FELLOW ?
	CAME	A,SLGPPN	;FIRST, THOUGH .. ARE /G AND /O THE SAME
				;IF SO, CANNOT CREATE TWO UFDS.. TWO
				;FILE AREAS (ONLY LAST NE WOULD "WIN").
	CAME	U,A		;HMMM, NOT THE SAME...
				;WELL, IS THE GUY IN HAND
				;THE GUY WE WILL CREATE?

	JRST	CPOPJ1		;EITHER THE /O PPN = /G PPN
				;OR THEY ARE NOT EQUAL, BUT THIS IS NOT THE
				;/O FELLOW
				;DUMP THIS GUY,
				;HE IS THE /O FELLOW, AND IF WE DON' DUCK HIM
				;THERE WILL SURELY BE TWO
				;/O UFDS AND TWO AREAS WE TRY TO CREATE
				;LOOK FOR NEXT DIRECTORY !
	JRST	INN		;RETURN
				;WHEN THIS FELLOW IS BY-PASSED




DISCRP:	TRNE	F,DOINGJ		;IF SKIPPING
					;DON'T SWEAT THE INCONSISTENCY
	POPJ	P,
	SKIPN	FNDBEG			;HAVE WE VERIFIED THIS AS A FAILSA TAPE ?
	POPJ	P,			;NOPE, TAKE MONITOR'S WORD THAT
					;RECORD LENGTH IS OK

	PRLIN1	<RECORD LENGTH INCONSISTENCY IN#>
	HLRZ	A,B		;IS THIS WHAT LOOKS LIKE A DIRECTORY RECORD ?
	CAIN	A,-1			;DIRECTORY RECORD ?
	PUSHJ	P,SETNAM		;SET UP NEWLY FOUND NAME
	PUSHJ	P,PRUFL			;WITH NAME SET UP, WRITE IT OUT
					;OFFENDER
					;THEN,
	POP	P,T			;RESTORE LEVEL
	JRST	SEARCH			;SKIP TAPE TIL YOU RECOGNIZE SOMETHING

CHKNEG:	SKIPE	FNDBEG		;FOUND FIRST FILE YET ?
	JRST	FROG		;YES

	PRLIN1	<SKIPPING WHAT APPEARS TO BE A SAVE OR MAGRIM FORMAT FILE.@>
FROG:	CLOSE	TAP,0		;CLOSE UP TAPE
	MTAPE	TAP,7			;BACK UP OVER POSSIBLE EOF
	MTAPE	TAP,16			;FOWARD TO EOF
	JRST	INN			;READ ANOTHER TIME
SETNAM:	MOVE	B,TAPHED		;FIND WHERE YOU ARE
	MOVSI	A,4(B)		;AND WHERE YOU WANT TO
				;START BLT FROM
	HRRI	A,FILDIR	;TO FILDIR AND POSSIBLY SOME ONE ELSE
	BLT	A,FILDIR+1+3		;AND XFER
				;NOW....

	MOVE	A,TAPHED
	MOVE	B,5(A)		;GET PPN AGAIN
	CAME	B,SYSPP		;OUR FRIEND 1,1 AGAIN ?
	POPJ	P,		;NOT 1,1.. THEN NOT A UFD
	MOVSI	A,4(A)		;FROM,,TO
	HRRI	A,UFDDIR	; _ TO
	BLT	A,UFDDIR+1+3	;SET FILE DIRECTORY TOO

GOT11:	POPJ	P,		;RETURN
				;NOTE THAT THE  BLT-ED "DIRECTORY" REFLECTS
				;THE REAL USER
				;BUT WE ARE TRANSFERRING FOR THE SWAPPED
				;PROJECT-PROG #
CPOPJ2:	AOS	0(P)		;RETURN TWO SKIPS
CPOPJ1:	AOSA	0(P)		;RETURN +1
APOPJ:	POP	P,A		;RETURN ONE LEVEL UP
CPOPJ:	POPJ	P,		;RETURN

FILOUT:	TRO	F,FILO
	OUT	FIL,		;OUTPUT THE FILE
	JRST	FILOU3		;WRITTEN OK
RFILOU:	PRLIN1	<ERROR WHILE WRITING USER FILE@>
	PUSHJ	P,PRUFL		;PRINT USER'S FILE NAME
	PUSHJ	P,CLOFIL
				;CLOSE FILE CHANNELS
				;
	POP	P,A		;RETURN TO +1 LEVEL

FILOU3:	TRZ	F,FILO
	POPJ	P,
CLOFIL:	CLOSE	FIL,DONXFR!DNC
	CLOSE	DGA,	DNC
	POPJ	P,
				;FOUND A TRAILER OR A HEADER

TAPIN6:	MOVE	B,TAPHED	;GET TAPE INFORMATION
	MOVE	A,3(B)		;THIS WORD SHOULD SAY
	CAME	A,STARFS	;"*FAILS"
	JRST	INN		;NO???, IRRELEVANT RECORD
				;TRY TO FIND SOMETHING YOU UNDERSTAND
	HLRZ	A,2(B)		;GET VERSION NUMBER
	HRRZM	A,VERNO		;SAVE IT
	HRRE	A,4(B)		;SEE WHETHER HEADER OR TRAILER
	JUMPG	A,HDRREC	;FOUND A HEADER ...TREAT LIKE DIRECTORY
TRLR:	TLO	F,TENDF		;LOGICAL EOT FOUND, OR REAL EOT
				;TREAT LIKE EOT
				;THIS IS A TRAILER RECORD (PREMATURE LOGICAL EOT)
				;CLOSE UP FIL
				;BUT! EOT FOR US ANYWAY
	JRST	TAPIN5		;TRAILER READ, NOW SIMULATE EOF READ



HDRREC:	SETOM	FNDBEG		;YOU'VE FOUND THE  HEADER RECORD!!
	SKIPG	FILHED		;DID WE RUN INTO A HEADER RECORD
				;WHILE READING TAPE ?
				;IF SO, THEN WE HAVE A NEW STARTING POINT
				;CLOSE WHAT WE HAVE AND START AGAIN

	JRST	CPOPJ1


STRSTP:	PRLIN1	<UNEXPECTED HEADER RECORD ENCOUNTERED@>
	PUSHJ	P,SFEODR
	TRNN	F,LISTSW!PRNTSW
	PUSHJ	P,CLOFIL		;CLOSE UPON ERROR
	JRST	FTAPIN		;TRY TO FIND SOMETHINF YOU UNDERSTAND




SFEODR:	PR1	<SEARCHING FOR EOF OR DIRECTORY RECORD@>
	POPJ	P,

;SELECTIVE RESTORE COMMAND

;ACCEPT LETTER OR DIGIT, AND BUILD IDENTIFIER

NLETTR:	AOJG	R,FS2		;IGNORE CHARACTERS AFTER SIXTH
	MOVEI	CH,-40(CH)	;CONVERT TO SIXBIT
	IDPB	CH,S		;STASH INTO IDENT
	TLO	F,CSSW!ETWASW	;INDICATE CHAR SEEN
	JRST	FS2		;GET ANOTHER CHARACTER

;FILE DELIMITER

EXTDLM:	TLOE	F,PERSW		;PERIOD SEEN?
	JRST	FILDL1		;YES, THAT MAKES TWO
	TLZN	F,CSSW		;ANYTHING SEEN?
	TDZA	A,A		;BLANK FILENAME
	MOVE	A,IDENT		;YES, STORE IDENT AS FILNAME
	MOVEM	A,NAME
EXDLM1:	TLZ	F,CSSW		;START WITH A CLEAN SLATE
	HRROI	R,-3		;BUT ONLY GET 3 LETTERS NEXT TIME
	JRST	FS1.7		;GET EXTENSION (OR DELIMITER)

;ALL FILES CHARACTER

ALLFIL:	TLZE	F,CSSW		;PART OF A NAME?
	JRST	ALLFI1		;YES, * IN NAME ILLEGAL
	TLNE	F,PERSW		;PERIOD SEEN?
	TLOA	F,EXTSW!ALLFSW!ETWASW	;INDICATE EXT WILD
	TLO	F,NAMESW!ALLFSW!ETWASW	;INDICATE NAME WILD
	JRST	EXDLM1

;OUTPUT SPEC DELIMITER

COMMA:	PUSHJ	P,DO		;PROCESS FILE
	JRST	FS1.5		;GET NEXT IDENT

;LINE TERMINATOR

LINTER:	PUSHJ	P,DO		;PROCESS LAST FILE
	JRST	FS1A		;GET NEXT COMMAND
;SELECTIVE RESTORE ROUTINE
;PROCESSES ONE FILE SPECIFICATION

DO:	TRO	F,SLRESW	;SELECTIVE RESTORE IN PROGRESS
	TLZN	F,ETWASW	;ANYTHING ON THIS LINE SO FAR?
	POPJ	P,		;NO
	SETZM	STARPT#			;STARTING POINT NOT YET FLAGGED
	SETZB	A,ANYFIL#		;LIKEWISE,
					;RESET SWITCH THAT SAYS THERE HAVE
					;BEEN SOME FILES FOUND FOR THE PERSON
					;NAMED BY /G

	TLNE	F,PPFSW			;GOT SOMEWHERE ? LIKE TO JOB'S
					;PLACE ON TAPE ?
					;AND SKIP
	SETOI	A,			;-1 _ A
	MOVEM	A,ANYPPN#		;RESULT INTO CORE

					;WHENEVER STARPT = 0
					;WE SHALL GET THE DEVICE
					;PPN
					;FILENAME
					;AND EXTENSION OF OUT STARTING
					;POINT ON THE TAPE
					;IF WE DON'T FIND PROJ-PPN
					;SOUGHT BEFORE WE FIND OUR
					;STARTING POINT, WE HAVE
					;COMPLETELY CIRCLED THE TAPE
					;SO
					;THE GUY SOUGHT 'TAINT THERE.
					;
	MOVE	A,IDENT#	;STASH IDENTIFIER AWAY
	TLNN	F,PERSW		;HAS A PERIOD BEEN TYPED?
	MOVEM	A,NAME		;NO, IDENT WAS NAME
	MOVEM	A,EXT		;(YES) STORE AS EXTENSION
	TLZN	F,PERSW		;DO WE HAVE AN EXTENSION?
	SETZM	EXT		;NO, MAKE NULL EXTENSION
	TLNE	F,ALLFSW	;ANY * TYPED?
	JRST	DOALL1		;YES, PROCESS THEM
	TLNE	F,PPFSW		;ARE WE POSITIONED?
IFN	REWIND,<
	JRST	[
		SKIPG	B,TAPHED
		PUSHJ	P,SETIN
		MTAPE	TAP,1
		JRST	DO2A]		;DON'T INIT A TAPE THAT'S ALREADY INIT-ED
					;IF REWINDING, YOU MUST RE-FIND PPN

	>
	IFE	REWIND,<
	JRST	[SKIPG	B,TAPHED
			JRST[
			PUSHJ	P,SETIN
			JRST	DO2A]
		HLRE	A,2(B)
		AOJE	A,DO1
		PUSHJ	P,GETDIR
		PUSHJ	P,GSTRPT		;GET A STARTING POINT
		MOVE	B,TAPHED
		MOVE	A,5(B)		;SAME PPN
		CAME	A,SLGPPN
		JRST	NOTME2		;NOPE
		JRST	DO1		;YEP
		]
	>
	SKIPG	TAPHED
	PUSHJ	P,SETIN
DO2A:	SKIPE	FNDBEG			;WAIT... HAVE WE FOUND THE FIRST
					;RECORD (HEADER RECORD)
					;THUS IDENTIFIYING THIS AS A FAILSA
					;TAPE ?  IF SO, 
					;FORGET GOING THROUGH THE IDENTIFICATION
					;SEQUENCE
	JRST	DO2B
	PUSHJ	P,UNSAV2		;INSURE BUFFERS,
	PUSHJ	P,GETEOF		;SKIP TO EOF
					;VERIFY AS 5-SERIES TAPE
					;PUBLISH INFO
					;AND COME BACK
DO2B:	PUSHJ	P,XPLUSR		;EXPLANE TO THE USER WHAT IS HAPPENING
				;WHOM WE ARE LOOKING FOR
DO2:	PUSHJ	P,FINDPP	;MOVE TO NEXT AREA FOR THIS USER
NDPP:	JRST	HITEOT		;HIT EOT, EOF
				;OR RETURNED TO STARTING PLACE ON THE TAPE
DO1:	PUSHJ	P,THSFIL	;SHOULD WE COPY THIS FILE?
	JRST	NOTME3		;NOT ME
				;BUT CHECK TO SEE IF THIS MIGHT BE THE
				;STARTING PLACE ON THE TAPE
	PUSHJ	P,USRUFD	;GET A UFD IF HE NEEDS IT
	TDO	F,[XWD	PPFSW,TAPI]		;SET POSITION SWITCH FOR
						;A STOP HERE & FOR REEENTER
	PUSHJ	P,XFER		;COPY IT
	TLZ	F,PPFSW		;ON HITTING EOF OR EOT, WE NO LONGER
				;KNOW WE ARE WITHIN THE BOUNDS OF A
				;USER AREA
				;TAPE
	TRZ	F,TAPI		;CLEAR AFTER XFER
	TLNN	F,TENDF		;DO WE HAVE EOT ?
	POPJ	P,		;RETURN

HITEOT:	SKIPG	Q,TAPHED
	JRST	NOTME2		;WE HIT EOF, SINCE TAPE HAS BEEN CLOSE'D
	TLZN	F,TENDF		;IS IT EOT
	JRST	NOTME1		;NO! WE ARE WHERE WE STARTED
				;TAPE AT TRAILER RECORD = LOGICAL EOT
				;CLOSE UP AND GET  TO  BEGINNING OF SAVE SET
WINDER:	CLOSE	TAP,0
	LOADPT
	JRST	NOTME2		;SET UP TO FIND OUR PPN AGAIN

NOTME1:	SKIPN	ANYPPN
	JRST	NOPROJ		;NO PROJECT NN,MMM SEEN
	SKIPE	ANYFIL
	POPJ	P,
NOPPNF:	PRLIN1	<CANNOT FIND#>
	MOVE	B,NAME

	PUSHJ	P,PRNAME
	MOVE	B,EXT
	PUSHJ	P,PREXT
ONTHTP:	PR1	< ON THIS TAPE.@>
	POPJ	P,		;ASK WHAT NEXT

NOTME2:	TLZ	F,PPFSW		;EOF FOUND,LEAVING A KNOWN AREA
NOTME3:	PUSH	P,[NDPP]
	JRST	FINDP1

IFE	REWIND,<
;	REWIND TAPE & THEN /J BACK TO SAVE SET WE WERE ON
REWJMP:	SKIPE	RECIRC		;IF WE CAN, RECIRCULATE (REWIND AND ADVANCE THROUGH)
				;THE TAPE
	JRST	BKBKSP		;REPOSITION THE TAPE TO THE BEGINNING OF THE CURRENT USER
	MTAPE	TAP,1		;REWIND
	SETZB	A,FNDBEG	;REFRESH J COUNTER & RESET FLAG
				;SAYING I'VE FOUND BEGINNING RECORD

	EXCH	A,JFLAG		;
	MOVEM	A,JCTR#		;TEMP STORE
REW1:	SOSGE	JCTR		;LOOP TO DO AUTO /J'S
	POPJ	P,		;RETURN
	PUSHJ	P,JMPSAV	;MORE TO NEXT SAVE SET
	JRST	REW1		;ALWAYS SKIPS
	JRST	REW1		;ANY MORE?

>
	;SELECTIVE RESTORE
;PROCESSES FILE SPECIFICATIONS WITH *'S

DOALL1:	TLNE	F,PPFSW		;DO WE HAVE THE PPN DESIRED ?
	IFE	REWIND,<
	JRST	[	SKIPG	B,TAPHED
			JRST	[	PUSHJ	P,SETIN
			JRST	DOALL0
			]
			HLRE	A,2(B)
			AOJE	A,DOALL5
			PUSHJ	P,GETDIR
			MOVE	B,TAPHED
			MOVE	A,5(B)
			CAME	A,SLGPPN
			JRST	DOALL7
			JRST	DOALL5
			]

		>
	IFN	REWIND,<
	JRST		[SKIPG	B,TAPHED
			PUSHJ	P,SETIN
			MTAPE TAP,1
			JRST	DOALL0
			]
	>
	SKIPG	TAPHED
	PUSHJ	P,SETIN
DOALL0:	SKIPE	FNDBEG
	JRST	DOALL9

				;IF TAPE NOT  ALREADY IDENTIFIED
	PUSHJ	P,UNSAV3	;VERIFY AS 5-SERIES TAPE
				;SAME AS @ UNSAV2, EXCEPT DON'T
				;INIT THE TAPE
	PUSHJ	P,GETEOF	;CLOSE UP TAPE
DOALL9:	PUSHJ	P,XPLUSR	;EXPLAIN TO USER WANT
				;WE ARE LOOKING FOR IN THE [PP,NO]
				;LINE
DOALL4:	PUSHJ	P,FINDPP	;MOVE TO NEXT AREA FOR THIS USER
NDPP1:	JRST	EOTHIT		;HIT TRAILER RECORD (LOGICAL EOT)
					;EOF, OR STARTING PLACE ON THE TAPE
DOALL5:	PUSHJ	P,THSFIL	;LOOK FOR OTHER HALF OF SPEC
	JRST	DOALL8		;DON'T TRANSFER THIS GUY
				;BUT THIS FILE
				;MIGHT BE STARTING PLACE ON THE TAPE
	PUSHJ	P,USRUFD	;GET A UFD IF NEED BE
	PUSHJ	P,XFER		;FOUND, COPY IF DATE OK
	JRST	DOALL7		;EOF, TRY NEXT AREA
	JRST	DOALL5		;TRANSFERRED THE GUY WANTED
				;SEE IF THERE ARE MORE





DOALL7:	TLZ	F,PPFSW		;LEAVING A KNOWN AREA
DOALL8:	TLNE	F,TENDF		;DO WE HAVE TRAILER RECORD
	JRST	EOTHIT		;GOT IT!
	PUSH	P,[NDPP1]
	JRST	FINDP1



EOTHIT:	SKIPG	Q,TAPHED
	JRST	DOALL7		;WE HAVE A REAL EOF
	TLZN	F,TENDF		;AT LOGICAL EOT (TRAILER RECORD SEEN ?)
	JRST	NOPROJ
	CLOSE	TAP,0		;TRAILER RECORD FOUND

	LOADPT
	JRST	DOALL7		;GET TO START OF SAVE SET
				;AND LOOK FOR A MATCH ON PPN
;MISCELLANEOUS MOVEMENTS

BKBKSP:	PUSHJ	P,BKSP		;RETURN TO FRONT OF THIS SAVE SET
BKSP:	TRZ	F,TAPI		;CLEAR AFTER XFER
	SKIPL	TAPHED		;SHUT DOWN FILE
	CLOSE	TAP,0		;IFF IT NEEDS IT
	MTAPE	TAP,7		;BACK ONE RECORD
	MTAPE	TAP,17		;ONE OTHERWISE
	POPJ	P,		;RETURN


;POSITION TAPE FOR USER
;CALL:	PUSHJ P,FINDPP
;	EOT RETURN
;	FOUND AREA RETURN

FINDPP:	PUSHJ	P,BKSP		;BACKSPACE FILE
	MTAPE	TAP,6		;ADVANCE FILE
				;BY ADVANCING A RECORD OVER FILE MARK
FINDP1:	PUSHJ	P,FTAPIN	;IGNORE DATA
	 POPJ	P,		;HAVE REACHED LOGICAL EOT
	MOVE	B,TAPHED	;WHERE THE DATA IS
	HLRE	A,2(B)		; HEADER?
	JUMPG	A,ADAFHD	;SEE WHICHEVER
	SKIPN	STARPT		;GOT STARTING POINT ?
	JRST	[
		PUSHJ	P,GSTRPT
		JRST	NOTSAM
		]
	MOVE	B,TAPHED
	MOVE	A,6(B)
CHKLEE:	CAMN	A,FIRFIL		;SEE IF WE HAVE COME FULL CIRCLE
	JRST	SEEM1					;MAYBE


NOTSAM:	MOVE	A,5(B)		;GET DIRECTORY'S PPN
	CAMN	A,SLGPPN		;SAME AS USER'S
	JRST	ESTBL1			;THEN SAY SO
	JRST	FINDP1

ADAFHD:	PUSHJ	P,GETEOF	;ADVANCE TO BEGINNING OF NEXT USER
	TLNE	F,TENDF		;CHECK TO SEE IF TRAILER SPOTTED
	POPJ	P,		;GOT ONE!
SEEM1:	HLLZ	A,7(B)
	CAME	A,FIREXT
	JRST	NOTSAM
	MOVE	A,FIRPPN
	CAME	A,5(B)
	JRST	NOTSAM
	MOVE	A,FIRSTR
	CAME	A,3(B)
	JRST	NOTSAM
	POPJ	P,		;MATCH FOUND , GIVE POJ RETURN

NOPROJ:	SKIPE	ANYPPN			;FIND OUR GUY ?
	JRST	FILES			;YEP, NOW DID WE GET
					;ANY OF THE FILES SELECTED
	PRLIN1	(CANNOT FIND#)		;OOOPS, NO FILES

	MOVE	TMP,SLGPPN
	PUSHJ	P,PRPPN1
				;SIGNAL THAT YOU WANT A NEW STARTING POINT
	JRST	ONTHTP		;CANNOT FIND [PROJ-PROG] ON THIS TAPE
				;AND POPJ BACK
FILES:	SKIPE	ANYFIL		;IF  NO FILES, TELL HIM ABOUT IT
	POPJ	P,

TEOFS:	PRLIN1	<TAPE EMPTY OF FILES SPECIFIED@>
	POPJ	P,

GSTRPT:	MOVE	A,3(B)		;GET STARTING STRUCTURE
	MOVEM	A,FIRSTR#

	MOVE	A,6(B)
	MOVEM	A,FIRFIL#		;STARTING FILE
	HLLZ	A,7(B)			;AND EXT
	MOVEM	A,FIREXT#

	MOVE	A,5(B)
	MOVEM	A,FIRPPN#
	SETOM	STARPT		;SET FLAG SAYING YOU KNOW WHERE YOU STARTED
	POPJ	P,
;COMPARE SPECIFIED NAME WITH NAME ON TAPE

;CALL:	PUSHJ P,THSFIL
;	UNSUCCESSFUL RETURN
;	SUCCESSFUL RETURN

THSFIL:	MOVE	B,TAPHED	;FIND BEG OF BUFFER
	TLNE	F,NAMESW	;LOOK AT NAME?
	JRST	THSFI2		;IGNORE
	MOVE	A,NAME		;CHECK EQUALITY
	CAME	A,6(B)
	POPJ	P,		;UNSUCCESSFUL RETURN
THSFI2:	TLNE	F,EXTSW		;LOOK AT EXTENSION?
	JRST	ESTBL2		;NO - SUCCESSFUL ..EVERY FILE WINS
	HLLZ	A,7(B)		;GET EXTENSION
	CAMN	A,EXT
	JRST	ESTBL2		;RETURN TO CALL + 2
				;HAVE FOUND HIM FIRST
	POPJ	P,		;UNSUCCESSFUL

;ESTABLISH YOU HAVE FOUND A USER.. DON'T LET HIM STAY AT TTY FOREVER
;WITHOUT SOME IDEA OF WHAT IS HAPPENING
ESTBL1:	SETOM	ANYPPN			;YOU HAVE ESTABLISHED CONTACT WITH A
	TLON	F,PPFSW			;AT LEAST 1 AREA (ANYPPN SET)
					;AND ARE NOW INSIDE AN AREA
					;PPFSW SET
	TRNE	F,LISTSW!PRNTSW!RESTSW	;SEE IF YOU ARE PRINTING
					;OR LISTING
					;OR /R - ING
					;IF SO, SKIP ESTABLISHING CONTACT
	JRST	CPOPJ1
ESTPR1:	PRLIN1	<FOUND ON TAPE#>
	MOVE	A,TAPHED		;GO AFTER STRUCTURE
	MOVE	B,3(A)			;THEN
	PUSHJ	P,FIXSPA		;RIGHT JUSTIFY THE DEVICE NAME
	PUSHJ	P,PRNAME
	PUSHJ	P,SPACE			;OUTPUT A SPACE
	MOVE	A,TAPHED
	MOVE	TMP,5(A)		;NOW PROJ-PROG NUMBER
	PUSHJ	P,PRPPN1		;FOUND DSKXXX<TAB>[PROJ-PROG]
					;NOW TYPED OUT
	PUSHJ	P,CRLF
	JRST	CPOPJ1			;RETURN TO CALL + 2
ESTBL2:	SETOM	ANYFIL		;ESTABLISH CONTACT WITH AT LEAST 1 FILE
	SETOM	ANYPPN		;FILE FOUND IMPLIES PPN FOUND
					;AND
	TLO	F,PPFSW		;ALSO IMPLIES WE ARE WITHIN PPN AREA
	TRNE	F,LISTSW!PRNTSW!RESTSW	;DONT PUBLISH
				;IF /RESTORING /PRINTING OR /LISTING
	JRST	CPOPJ1
	SKIPN	TALKER		;HMM, IS TALKER SWITCH ON ?
	JRST	CPOPJ1		;NOPE!

ESTPR2:	PRLIN1	<LOCATED ON TAPE#>

ESTPR3:	MOVE	A,TAPHED		;[47] GET CURRENT STRUCTURE
	MOVE	B,3(A)	;
	PUSHJ	P,FIXSPA		;RIGHT JUSTIFY THE DEVICE NAME
	PUSHJ	P,PRNAME
	MOVEI	CH,72			;AN ASCII :
	PUSHJ	P,TYPEA
	PUSHJ	P,SPACE			;OUTPUT A SPACE
	MOVE	A,TAPHED
	MOVE	B,6(A)
	PUSHJ	P,PRNAME		;SIX SIXBIT
					;OF FILE NAME
	MOVE	A,TAPHED
	HLLZ	B,7(A)
	PUSHJ	P,PREXT
	PUSHJ	P,CRLF		;A CR AND LF
	JRST	CPOPJ1		;FINIS

	;RIGHT JUSTIFY THE SIXBIT THING IN "B"
FIXSPA:	TRNE	B,77		;RIGHT MOST CHARACTER A SPACE?
	POPJ	P,		;NO SO EXIT
	LSH	B,-6		;ROTATE TO RIGHT 6
	JRST	FIXSPA		;LOOP TIL DONE

FNR:	LDB	A,[POINT 3,7(B),20]	;[47] GET TOGETHER
	LDB	U,[POINT 12,10(B),35]	;[47] A CREATION
	LSH	A,14			;[47] DATE
	IOR	A,U			;[47]
FNR1:	CAIE	A,10000			;[47] IF DATE = 1/5/75 OR
	CAIGE	A,2134			;[47] LESS-THAN 1/1/67
	CAIA				;[47] TELL USER FILE NOT RESTORED
	POPJ	P,			;[47] ELSE GET NEXT FILE
	LDB	A,[POINT 15,7(B),35]	;[47] GET ACCESS DATE
	PUSH	P,A			;[47] SAVE IT
	LDB	A,[POINT 3,7(B),20]	;[47] GET CREATION DATE
	LDB	U,[POINT 12,10(B),35]	;[47]
	LSH	A,14			;[47]
	IOR	A,U			;[47]
	PUSH	P,A			;[47] SAVE IT
	PRLIN1	<FILE NOT RESTORED#>
	PUSHJ	P,ESTPR3		;[47] PRINT FILE DESCRIPTOR
	 JFCL				;[47]
	PR1	<CREATE DATE:#>
	POP	P,Q			;[47] RESTORE CREATE DATE
	PUSHJ	P,YRSMOS		;[47] PRINT IT
	PR1	<ACCESS DATE:#>
	POP	P,Q			;[47] GET ACCESS DATE
	JRST	YRSMOS			;[47] PRINT AND RETURN
;CREATE AN INFINITE UFD FOR THE USER IF HE NEEDS IT

USRUFD:	MOVE	D,TAPHED	;WHERE DATA IS
	MOVE	A,3(D)		;GET THE STRUCTURE
	MOVEM	A,USRPP		;THREE PLACES TO LOOK FOR STRUCTURES
	MOVEM	A,CURSTR
	MOVEM	A,FIXU2		;SET UP STRUCTURES FROM THAT SIGNALED BY TPE
	PUSHJ	P,DOUFD		;SET UP UFD FROM INFORMATION ON TAPE
				;SWITCHING /G & /O AS REQUIRED
	FIXDEV
	INIT	UFD,BUFBIN	;LOOKUP ONLY
USRPP:	0
	XWD	0,UFDHED
	JRST	GETUSR		;TRY ELSEWHERE
	PUSHJ	P,MKUFBF

	FIX	UFDDIR
	LOOKUP	UFD,UFDDIR
	JRST	FIXUSR		;NO UFD -  HAVE TO MAKE ONE
UFCL:	CLOSE	UFD,DNC
	IFN	MINREL,<
	RELEAS	UFD,
		>
	POPJ	P,

FIXUSR:	CLOSE	UFD,DNC
	IFN	MINREL,<
	RELEASE	UFD,
		>
	FIXDEV
	INIT	MFD,BUFBIN	;CREATE UFD ON DESIRED STR
FIXU2:	0
	XWD	MFDHED,0
	JRST	GETUSR
	PUSHJ	P,DOUFD		;SET UP SPEC AND CLEAN UPS
	OUTBUF	MFD,MFDN
	FIX	UFDDIR
	ENTER	MFD,UFDDIR
	PUSHJ	P,MAYBE5	;IF NOT ERROR 17, TRY ELSEWHERE.
				;SEE IF ERROR 17 ON EXTENDED ENTER
	JRST	MAKU2		;CLOSE MFD & RET

MAYBE5:	GETBAD	(A)	;SEE IF 17 ERROR CODE
				;POPJ BACK IF SO, POP OFF AND FALL INTO
				;GETUSR IF NOT
GETUSR:	INIT	UFD,BUFBIN	;UFD ANYWHERE?
	SIXBIT	/DSK/
	XWD	0,UFDHED
	JRST	DNTAVL		;BAD NEWS
	MOVSI	A,(SIXBIT /DSK/)
	MOVEM	A,CURSTR
	PUSHJ	P,DOUFD		;SET SPECS
	PUSHJ	P,MKUFBF
	LOOKUP	UFD,UFDDIR
	CAIA
				;SPR # 10-5298
				;THANKS! JOHN EDGECOMBE!!
	JRST	UFCL		;FOUND
	PUSHJ	P,GETPAK	;NO UFD - MAKE ONE ANYWHERE
	PUSHJ	P,DOUFD
	JRST	MAKU1		;ENTER & RET

DOUFD:	MOVE	A,[XWD UFDDIR+4,UFDDIR+5]
	SETZM	UFDDIR+4
	BLT	A,UFDDIR+XLOOKN
	MOVE	A,SYSPP		;1,1 HAS THE UFD'S
	MOVEM	A,UFDDIR+1
	MOVEI	A,XLOOKN	;40 WORDS OF LOOKUP INFO
	MOVEM	A,UFDDIR


	MOVE	A,5(D)		;GET PPN
	CAMN	A,SLGPPN		;IS THIS THE /G FELLOW
	MOVE	A,SLOPPN		;YES
	MOVEM	A,UFDDIR+2		;UPDATE OR KEEP THE SAME


	MOVSI	A,(SIXBIT /UFD/)
	MOVEM	A,UFDDIR+3
	HRLOI	A,377777	;LARGEST POSITIVE #
	MOVEM	A,URBQTI
	MOVEM	A,URBQTO
	MOVEI	A,.RPDIR		;DIRECTORY BIT
	MOVEM	A,URBSTS
	POPJ	P,
;DATE CHECK
;CALL:	PUSHJ	P,CHKCRE
;RETURNS:	R .GT. U
;		R .EQ. U
;		R .LT. U

CHKCRE:	TRNN	F,RESTSW!SLRESW	;[41];IF SAVING DONT CHECK VERNO
	JRST	CHKCR1		;[41];SKIP THE VERSION CHECK
	MOVE	A,VERNO		;WHICH FAILSA WROTE THIS TAPE?
	CAIGE	A,100		;VERSION 100 HAS 15 BIT DATE FIELD
	JRST	CHKCR2		;[41];JUMP -- MUST BE 12 BIT FIELD
CHKCR1:	CAILE	S,(W)		;[41];COMPARE THE 3 HI-ORDER CREATION BITS
	POPJ	P,		;S IS GREATER
	CAIE	S,(W)		;CRDATE = FILE DATE?	[44]
	JRST	CPOPJ2		;NO .LT.		[44]
CHKCR2:	LDB	S,[POINT 12,R,35] ;[41];CHECK DATES
	LDB	W,[POINT 12,U,35]
	CAILE	S,(W)		;COMPARE
	POPJ	P,		;S IS GREATER
	CAIE	S,(W)		;AGAIN
	JRST	CPOPJ2		;W IS GREATER THAN S
	LDB	R,[POINT 12,R,20]	;RIGHT JUSTIFY THE	[44]
	LDB	U,[POINT 12,U,23]	;  TIME FIELDS		[44]
	CAMLE	R,U		;R .LE. U?
	POPJ	P,		;NO
	CAML	R,U		;=?
	JRST	CPOPJ1		;YES, SKIP
	JRST	CPOPJ2		;.LT. SO SKIP 2

;INITIALIZE MAGNETIC TAPE
SETSYN:	MOVEI	A,SYNCH		;SETUP SYNCHRONOUS INPUT
	MOVEM	A,SYNCIN	;AND FALL INTO INIT
	PUSHJ	P,SETINA	;SKIP UNCONDITIONAL ASYNCHRONOUS MODE
	JRST	GMTABF		;SET MTA BUF'S UP

SETIN:	PUSHJ	P,SETI		;SET FOR IN PUT
	PUSHJ	P,GETCOR	;GET CORE
	JRST	GMTABF		;SET BUF'S UP

SETI:	SETZM	SYNCIN		;INSURE THAT ASYNCHROUNOUS INPUT IS DONE
SETINA:	SETZB	A,LASTWC		;SET LAST WORD COUNT READ = 0
					;TO AID IN FINDING IRRELAVENT
					;RECORDS
	TROA	A,TAPHED		;BUFFER HEADER ADDRESS
SETO:	MOVSI	A,TAPHED		;DITTO FOR OUTPUT

	MOVEM	A,INOUT		;SET HEADER
	SETZM	RECCNT#		;RESET # OF RECORDS WRITTEN SINCE LAST EOF
				;OR DIRECTORY RECORD
IFE	REWIND,<	MOVE	A,INIT1	;GET INIT FUNCTION
	TRZ	A,SYNCH		;CLR SYNC INPUT BIT
	XOR	A,SYNCIN#	;GET CURRENT SYNCH IN
	MOVEM	A,INIT1		;RESET
	>
	MOVE	A,FS6BIT	;DOES LOGICAL DEVICE FAILSA EXIST
	CALLI	A,DEVCHR
	TLNE	A,20		;IS DEVICE A MAGTAPE?
	TLNN	A,40		;IS IT AVAILABLE?
	JRST	NOTAP		;NO TO EITHER: COMPLAIN
INIT1:	INIT	TAP,BUFBIN!NOCNT	;ALLOW PRIVATELY-BUFFERED MTAPES
FS6BIT:	SIXBIT	/FAILSA/
INOUT:	XWD	TAPHED,TAPHED	;BUFR HDR FOR INPUT OR OUTPUT (SET BY ABOVE)
	JRST	NOTAP		;UNLIKELY
	MOVE	A,[XWD 400000,TAPBUF+1]	;INIT 1ST WORD OF HEADER
	MOVEM	A,TAPHED
	POPJ	P,

GETCOR:	MOVEI	A,MFDBUF		;NOW LAST USED CORE LOC
	MOVEM	A,.JBFF
	IFN	LOCK,<
	TLNE	F,LOCKER
	POPJ	P,
	>
	IFE	DEBUG,<
	CALLI	A,CORE			;NOW!
	>
	IFN	DEBUG,
	<
	CAIA
	>
	JRST	NOCORE
	POPJ	P,		;RETURN

GMTABF:	SETBUF	TAP
	POPJ	P,
				;SET UP MAGTAPE BUFFERS

				;MUST HAVE CORE ALLOCATED BEFORE YOU COME HERE
SETOU:	PUSHJ	P,SETO		;THEN SET FOR OUTPUT
	PUSHJ	P,GMTABF	;SET UP THE MAGTAPE BUFFERS
	JRST	NNLTAP		;DO A DUMMY OUTPUT

;INIT THE DISK STRUCTURE WITH THE MOST ROOM LEFT ON IT
;IN ORDER TO CREATE A UFD FOR THIS PROJ-PROG #

GETPAK:	IFN	LEVELC,
	<
	TRNE	F,LEVELC			;ARE WE IN LEVEL-D MODE
	POPJ	P,				;NO!
	>
	MOVSI	PAKNAM,(SIXBIT /DSK/)
	MOVEM	PAKNAM,DEVICE

	SETOI	W,			;1ST, THEN SUBSEQUENT FILES
					;FOR GOBSTR AND JOBSTR... 0
	SETZB	R,CH			;WILL BE REQUIRED IF SYSSTR
	MOVE	B,TAPHED		;GET # BLOCKS IN FILE TO USE AS CRITERIA
	MOVE	B,11(B)		;FOR MINIMUM SPACE REQUIREMENT
	LSH	B,-^D7



GETP1:	MOVE	U,TAPHED
	MOVE	U,5(U)			;GET PROJECT PROGRAMMER #
	CAMN	U,SLGPPN		;IS THE ONE WE HAVE THE SAME
					;AS THE ONE WE ARE
					;SWAPPING ?
	MOVE	U,SLOPPN		;YES, SWAP

	CAMN	U,USRPPN		;IS THE GUY FINALLY SELECTED FOR
					;THE OUTPUT PPN THE SAME AS THE
					;USER PPN RUNNING THIS JOB ?
					;IF SO, USE JOBSTR, OTHERWISE, USE
					;GOBSTR
	JRST	CHKJOB			;OK, USE JOBSTR


	MOVE	U,USRPPN		;SEE PPN #
	CAME	U,FSPP			;/O NOT = PPN RUNNING THIS SHOW
					;ARE WE 1,,2 ?
	JRST	CHKSYS			;NOPE, MUST USE SYSSTR UUO TO GET UNITS






	MOVE	U,[1,,4]
	MOVEI	D,0

	MOVE	CH,[3,,D]		;POINT TO AC WHICH ARE THE ARGUMENT
					;LIST
					;GO!

	CALLI	CH,GOBSTR	;GET NEXT STRUCTURE
	  JRST	GETP2		;ERROR OR THROUGH
JUMPIN:	SKIPN	PAKNAM,W	;END OF LIST ?
	JRST	GETP2		;YEP

	MOVE	A,[XWD 3,PAKNAM]	;WANT 1ST THREE ARGS RETURNED
	CALLI	A,DSKCHR
	JRST	GETP2
	CAMLE	PAKFRE,B	;MORE ROOM HERE THAN ON LAST?
	TLNE	A,.UPOFL!.UPHWP!.UPSWP!.UPSAF!.UPNNA!.UNIAWL

				;YES, THIS DRIVE USABLE?
	JRST	GETP1		;NO, LOOK AT NEXT PACK
	MOVEM	PAKNAM,DEVICE	;YES, SAVE BEST SO FAR
	MOVE	B,PAKFRE		;SAVE FREE COUNT ASSOCIATED WITH STR NAME
					;HELD IN DEVICE:
	JRST	GETP1		;CONSIDER NEXT PACK
GETP2:	INIT	MFD,BUFBIN	;INIT SELECTED DEVICE MFD
DEVICE:	SIXBIT	/DSK/		;SIXBIT /STRNAM/
	XWD	MFDHED,0
	JRST	DNTAVL		;NOT AVAILABLE
	MOVE	A,DEVICE	;OK, WHO DONE IT
	MOVEM	A,CURSTR	;HE DID IT!
	POPJ	P,


CHKJOB:	MOVEI	R,-SYSSTR+JOBSTR
	MOVE	CH,[1,,W]
CHKSYS:	CALLI	CH,SYSSTR(R)		;SYSSTR OR JOBSTR
	JRST	GETP2			;THROUGH SEARCHING
	JUMPN	R,JUMPIN			;GOT A PACK,  IN W, CONTINUE
	MOVE	W,CH			;GOT A PCK, IN CH... NOW IN W
	JRST	JUMPIN
SUBTTL 
;PRINT A DIRECTORY OF AN ENTIRE FAILSAFE TAPE ON LOGICAL DEVICE LST
					;FLAGS SET**********
					;/X HAS SET
					;XSWITC!PRNTSW!LISTSW
					;/P HAS SET
					;PRNTSW!LISTSW
					;/L HAS SET
					;LISTSW
;"/X" SWITCH
GOTANX:	TRO	F,XSWITC		;FOUND AN X

;"/P" SWITCH
PRINT:	AOS	JFLAG		;WE ARE ADVANCING OVER A SAVE SET
				;BY PRINTING IT

	TRO	F,PRNTSW!LISTSW
	SKIPG	TAPHED			;ANY NEED TO INIT THE DEVICE ?
	PUSHJ	P,SETIN			;YEP!
	IFN	REWIND,<
	MTAPE	TAP,1		;INIT + START REWIND
	>
	INIT	TTO,AL		;INIT A LISTING DEVICE
	SIXBIT	/LST/		;LOGICAL NAME LST
	XWD	TTYO,0
	JRST	NOLIST
	MOVEI	A,MFDBUF	;USE DSK BUFFERS
	MOVEM	A,.JBFF
	MOVSI	A,(SIXBIT	/LST/)
	CALLI	A,DEVCHR
	MOVEI	B,MFDBUF
	IORI	B,1777
				;SET TO NEXT HIGHER K
	SUBI	B,MFDBUF	;SUBTRACT OFF BASE ADDRESS


	MOVEI	CH,DSKSIZ		;START BY ASSUMING DSK
	TLNE	A,LPT			;BUT IS IT AN LPT?
	MOVEI	CH,LPTSIZ
	TLNE	A,ITSTTY
	MOVEI	CH,TTYSIZ
				;# BUFFRS
	IDIVI	B,(CH)		;DIVIDE HOW MUCH CORE YOU HAVE BY
				;AMOUNT OF CORE PER BUFFER TO GIVE YOU
	OUTBUF	TTO,(B)
				;NUMBER OF BUFFERS
				;IF NOT AN LPT OR TTY, TAKE DSK AS DEFAULT
	MOVE	A,FS6BIT	;ENTER A FILE NAME FOR LIST
	MOVEM	A,LSTDIR
	MOVSI	A,(SIXBIT /DIR/)
	MOVEM	A,LSTDIR+1
;[40] PRINT+32 30JUL74
	SETZM	LSTDIR+2	;[40];ZERO THE PROTECTION FIELD
	SETZM	LSTDIR+3
	ENTER	TTO,LSTDIR
;PAGE 5-30 OF VERSION 77   [EDIT#34]
	JRST	[PUSHJ	P,TTYINI
	PRLIN1	<? CANNOT ENTER OUTPUT FILE FOR /P@>
		JRST	REINFO
			]

	OUTPUT	TTO,

	PUSHJ	P,UNSAV3	;VERIFY & PRINT HEADER

	PUSHJ	P,GETEOF	;CLOSE UP TAPE


ALRIDN:	MOVSI	A,(SIXBIT "LST")
	CALLI	A,DEVCHR	;GET CHARACTERISTICS OF
				;THIS DEVICE (I.E., "LST")
	TLNN	A,ITSTTY	;IF IT'S A TTY, PUSH OUTPUT
				;OUT EVERY END OF LINE, LET
				;THE LADS SEE THE STATUS OF THE TAPE
				;EVERY TIME IT CHANGES (I.E., NEW
				;USER AREA READ)
				;
	SETOM	LSTING#		;SET FLAG
				;WHICH SAYS THAT THIS IS NOT A TTY AS FAR
				;AS WE ARE CONCERNED
				;OUTPUTS AT END OF LINE
				;ARE TO BE SUPPRESSED, AND
				;WE SHALL DO AN OUTPUT ONLY AS
				;THE BUFFER COUNT GOES
				;TO 0.
				;
				;THIS IS TO HELP KEEP THE SPACE REQUIRED
				;FOR A DIRECTORY ON DISK DOWN
				;SINCE IF WE DO AN OUTPUT EVERY
				;TIME WE SEE AN EOL (12) WE SHALL
				;BE DONING AN OUTPUT ABOUT EVERY 60
				;CHARACTERS OR EVERY 12
				;WORDS (DECIMAL) INSTEAD OF EVERY
				;128 WORDS
	TRNE	F,XSWITC	;ARE WE JUST RECREATING THE TTY OUTPUT?

	JRST	YESXSW		;YEP!

	PRLIN1	<NAME   EXT@>
	PR1 <ALLOCATED_THIS_ALL_   ACCESS__ CREATION@>


YESXSW:
PRINT2:	PUSHJ	P,FTAPIN
	JRST	CHKFMT		;EOF. LOGICAL EOT
				;MAYBE, BUT ALSO COULD BE
				;A TRAILER RECORD CHECK IT OUT

	PUSHJ	P,LIST3		;PRINT USER DIRECTORY
	JRST	PRINT2		;GO DO NEXT USER
PRINT3:	PRLIN1	<$END OF#>
	HRRE	A,4(Q)		;GET SEQUENCE #
				;REMEMBER, REEL NUMBER IS NEGATIVE FOR TRAILER BLOCKS
	MOVNM	A,TAPNUM	;LEAVE IT WHERE IT IS EXPECTED
	MOVE	A,5(Q)		;GET WRAPUP TIME AND DATE
	MOVEM	A,TIMOUT
	PUSHJ	P,ENDMES	;OUTPUT WRAPUP INFO
				;REMEMBER, THIS
				;MESSAGE WILL BE THE ONLY
				;PROOF ON DEVICE "LST" THAT THE
				;TAPE RAN SUCCESSFULLY TO THE TRAILER
				;BLOCK.!!!!!!
				;ALSO
				;WRAP UP TIME GIVES A DEFINATIVE
				;TERMINATION POINT FOR THE SAVING
				;OF FILES. THAT IS, THERE IS NO FILE ON
				;THIS TAPE JUST PRINTED WHICH HAS A
				;CREATION TIME/DATE AFTER THE TERMINAL DATE AND
				;TIME JUST GIVEN.

	PUSHJ	P,GETEOF		;ADSORB THE EOF FOLLOWING THE
					;TRAILER RECORD
	PUSHJ	P,TTYINI		;GO FIX TTY
IFN	REWIND,<	MTAPE	TAP,1		;REWIND
	>
	JRST	FS1AA		;GO RESTART
;"/L" SWITCH - LIST FILES ON TAPE UNDER USER PROJ-PROG # ON TTY

LIST:	IFN	REWIND,<
	PUSHJ	P,SETIN		;INIT
	MTAPE	TAP,1
	>
	TRO	F,LISTSW		;WE ARE LISTING
	XLIST
	IFE	REWIND,<
	LIST
	SKIPE	FNDBEG				;GOT HEADER RECORD ?
	JRST	[SKIPG	B,TAPHED
		JRST	[	PUSHJ	P,SETIN
				JRST	LIST4
			]
		TLNN	F,PPFSW		;OK
					;WE HAVE FOUND 1ST
					;RECORD
					;WE HAVE AN OPEN BUFFER
					;NOW* DO WE HAVE
					;THE  PPN AREA ?
		JRST	LIST4		;NOPE!
		PUSHJ	P,GETDIR		;GET A DIRECTORY
		MOVE	B,TAPHED
		MOVE	A,5(B)
		CAME	A,SLGPPN
		JRST	.-4
		PUSHJ	P,GSTRPT
		JRST	LIST3
		]
	PUSHJ	P,UNSAV2			;WE NEED MTA & BUFFERS
						;AND TO BE SURE
	>
	LIST
	XLIST
	IFN	REWIND,<
	LIST
	PUSHJ	P,UNSAV3
	>
	LIST

						;THIS IS A 5-SERIES TAPE
						;AND TO NOTIFY AS TO
						;SAME & GIVE TAPE #

	PUSHJ	P,GETEOF		;SHUT OFF EOF WHEN YOU FIND IT
LIST4:	PUSHJ	P,XPLUSR		;EXPLAIN TO USER WHOM YOU SEEK
LIST4B:	SETZM	STARPT		;INSURE THAT ON THE FIRST PASS WITH A
				;/L THAT YOU HAVE NO STARTING POINT
	SETZM	ANYFIL		;SET SWITCH SAYING THAT FOR THIS /L
				;PASS YOU HAVE NOT FOUND ANY FILES
				;FOR THE USER SPECIFIED BY /G
	SETZM	ANYPPN		;ALSO RESET PPN FOUND SWITCH
LIST4A:	PUSHJ	P,FINDP1		;GET PPN
	JRST	GOTEOT		;WELL, WE HAVE EOT, EOF OR MAYBE THE
				;STARTING PLACE ON THE 
				;TAPE


LIST3:	TRNE	F,XSWITC	;ARE WE JUST RECREATING THE TTY OUTPUT ?
	JRST	NLIST3		;YEP!
	PUSHJ	P,CRLF		;SPACE DOWN SOME

	PRLIN1	<DIRECTORY FOR#>
	SETOM	ANYFIL		;BUT YOU HAVE FOUND A DIRECTORY ENTRY
				;AND HENCE FILES FOR THE PERSON
				;NAMED BY /G
NLIST3:	MOVE	Q,TAPHED	;WHERE THE DIRECTORY IS
	MOVE	B,3(Q)		;GET STRUCTURE NAME
	MOVEM	B,CURSTR
	MOVE	B,5(Q)		;PROJ-PROG NUMBER
	MOVEM	B,UFDDIR+2
	PUSHJ	P,PRPP		;GIVE NUMBER OF USER
	SETZM	TOTAL#		;ZONK RUNNING TOTAL
	TRNN	F,XSWITC		;KEEP /X OUTPUT COMPACTED
	PUSHJ	P,LFCRLF	;SPACE DOWN A BIT MORE


LIST1:	TRNN	F,XSWITC	;JUST DOING THE TTY OUTPUT ?
	PUSHJ	P,PRFIL		;PRINT NAME OF FILE, WE ARE DOING THE WHOLE THING
LIST1A:	PUSHJ	P,FTAPIN	;IGNORE DATA
LIST1B:	JRST	GOTEOT		;END OF FILE
LIST1C:	MOVE	B,TAPHED
	MOVE	A,6(B)
	CAME	A,FIRFIL
	JRST	LIST1
	HLLZ	A,7(B)
	CAME	A,FIREXT
	JRST	LIST1
	MOVE	A,FIRPPN
	CAME	A,5(B)
	JRST	LIST1
	MOVE	A,FIRSTR
	CAME	A,3(B)
	JRST	LIST1
PROJQ:	SKIPE	ANYPPN			;FIND OUR GUY ?

	POPJ	P,
	JRST	NOPROJ		;NO PROJECT-PROGRAMMER AREA FOUND

LIST2:	TRNE	F,PRNTSW	;PRINTING?
	POPJ	P,		;YES
	TLZE	F,TENDF		;ARE WE AT EOT (TRAILER RECORD SIGHTED ?)
	JRST	ENDOFM		;EOT UP, REWIND
	TLZ	F,PPFSW		;RESET FOUND PP SWITCH
				;WE HAVE FOUND A BONA FIDE EOF
	JRST	LIST4A		;YOU HAVE JUST FOUND THE NEXT USER OR AREA
				;SO  ADVANCING AND BACKSPACING IS
				;UNCALLED FOR






					;
GOTEOT:	SKIPG	Q,TAPHED
	JRST	LIST2		;GOT REAL EOF


	TRNE	F,PRNTSW		;ARE WE /P PRINTING
	JRST	PRINT3		;YEP
	CLOSE	TAP,		;SPR 10-9515 AVOID ADR CHECK AT REINFO
	TLZN	F,TENDF		;CHECK TRAILER FLAG
	JRST	NOPROJ		;TAPE IS OPEN _ MEANS AT BEGINNING POINT
ENDOFM:	CLOSE	TAP,
	LOADPT

	TLZ	F,PPFSW			;HAVEN'T GOT THIS PPN FOR SURE
					;ANY MORE
	JRST	LIST2			;AND CONTINUE



XPLUSR:	PRLIN1	<SEARCHING FOR#>;		;TELL WHO IS SOUGHT
	MOVE	TMP,SLGPPN
	JRST	PRPPN			;AND PRINT IT OUT
;PRINT FILE.EXT   ALLOCATED THIS ALLOCATED ALL ACCESS DATE   CREATION DATE & TIME

PRFIL:	MOVE	Q,TAPHED	;SET PTR TO DATA EVERY TIME
	MOVE	B,5(Q)		;GET PPN
	CAMN	B,SYSPP		;IS IT 1,1 ?
	JRST	PRUFD		;YES
	MOVE	B,6(Q)		;GET FILE NAME
	PUSHJ	P,PRNAME	;NO
PRFIL2:	HLLZ	B,7(Q)		;GET EXTENSION
	PUSHJ	P,PREXT


	TRNN	F,PRNTSW	;ARE WE PRINTING?
	JRST	CRLF		;ALL DONE ?  FINISH UP


	PUSHJ	P,TAB
	MOVE	A,14(Q)		;GET NUMBER OF BLOCKS ALLOCATED

	ADDM	A,TOTAL		;GET TOTAL
	PUSHJ	P,PRNUM		;PRINT IT

	PUSHJ	P,TAB		;AND A TAB

	MOVE	A,TOTAL
	PUSHJ	P,PRNUM		;RUNNING TOTAL
	TLO	F,POPGOT	;WITHOUT CR & LF

	HRRZ	Q,7(Q)		;GET ACCESS DATE
	PUSHJ	P,YRSMOS	;TAB FOLLOWED BY MOS AND YEARS


				;


	PUSHJ	P,SPACE
	PUSHJ	P,TAB

	MOVE	Q,TAPHED	;RESTORE POINTER
	MOVE	A,10(Q)		;CREATE DATE
	LDB	R,[POINT 3,7(Q),20] ;GET HI-ORDER CREATE BITS
	JRST	DATIME		;DATE AND TIME OF CREATION AND RETURN
CHKFMT:	TLZN	F,TENDF		;GOT TRAILER /
	JRST	PRINT2		;NOT YET !
	MOVE	Q,TAPHED	;SET UP
	JRST	PRINT3		;FOR ENDING MESSAGE
					;VERIFIED
PRUFD:	MOVE	TMP,6(Q)		;SETUP TMP
	PUSHJ	P,PRPPN1		;PRINT UFD
	JRST	PRFIL2		;NOW THE EXTENSION

;PRINT INFORMATION ON A GIVEN FILE IN CASE OF UUO FAILURE

PRNMEX:	PUSH	P,A		;PRINTS NAME & EXTENSION OF FILE
	UNFIX	FILDIR
	MOVE	B,FILDIR+1		;GET OWNER 'S PPN
	CAMN	B,SYSPP		;IS IT 1,1 ?
	JRST	NAMPP		;YES, NAME IS A BINARY PROJ-PROG NR.
	MOVE	B,FILDIR+2		;NO, NAME IS IN SIXBIT
	PUSHJ	P,PRNAME	;PRINT IT
EXTPP:	HLLZ	B,FILDIR+3		;GET EXTENSION
EXTPP1:	PUSHJ	P,PREXT		;PRINT EXT.
	JRST	APOPJ		;POP P,A + POPJ P,
NAMPP:	UNFIX	UFDDIR		;FIX UFDDIR
	MOVE	TMP,UFDDIR+2
	PUSHJ	P,PRPPN1	;PRINT THE FILE'S NAME
	HLLZ	B,UFDDIR+3		;AND THE EXTENSION
	JRST	EXTPP1			;AND THEN IT'S EXTENSION
					;WHICH MAY NOT BE ".UFD"

;PRINT PROJ#,PROG# BY WHICH FILE WAS REFERENCED

PRFLPP:	PUSH	P,A
	MOVE	TMP,FILDIR+1	;GET PP#
	PUSHJ	P,PRPPN		;PRINT
	JRST	APOPJ		;GET BACK A, THEN RETURN

;PRINT PROJ#,PROG# IN UFDDIR

PRPP:	HRROI	A,-6		;LIKE PRNAME, BUT WILL NOT PRINT SPACES
	MOVE	B,CURSTR	;PRINT CURRENT FILE STRUCTURE
PRPP1:	MOVEI	CH,0			;CLEAR
	ROTC	B,6			;SLIP AROUND
	CAIE	CH,0		;ELIMINATE BLANKS
	PUSHJ	P,TYPE
	AOJL	A,PRPP1

	PUSHJ	P,TAB		;OUTPUT A TAB
	MOVE	TMP,UFDDIR+2	;GET PP#

;CALL IS THUS	...MOVE		TMP,PPN
;		...PUSHJ	P,PRPPN

PRPPN:	PUSHJ	P,PRPPN1		;PUT OUT THE PPN
	JRST	CRLF			;THEN A CARR RET & LINE FEED

PRPPN1:	HLRZ	A,TMP		;PROJECT #
	PUSHJ	P,PRNUM8
	PRCHAR	<,>
	HRRZ	A,TMP		;PROGRAMMER #
	TRNN	F,LISTSW!PRNTSW		;ARE WE PRINTING ?
	CAME	TMP,SLGPPN				;OR AT A SWAP PPN
	JRST	PRNUM8
	CAMN	TMP,SLOPPN		;/G NOT = /O
	JRST	PRNUM8
	PUSHJ	P,PRNUM8
	PR1	< OUTPUT AS#>
	MOVE	TMP,SLOPPN		;GET THE NUMBER OUTPUT
	JRST	PRPPN1

PRTIME:	MOVE	A,5(D)		;GET CREATE-DATE/TIME INFO
	LDB	R,[POINT 3,4(D),20]	;HI-ORDER CREATE BITS
	HLRZ	B,2(D)			;VERSION #
	CAIGE	B,SECVER			;MIN & SEC OR JUST MIN ?
	JRST	DATIME
;PRINT THE DATE AND TIME FROM AC A
;DATE = ((Y-1964)*12+M-1)*31+D-1 IN BITS 21-35
;TIME IN SECONDS SINCE MIDNITE IN BITS 4-20
;ALTERNATE ENTRY POINT AT DATIME USES TIME IN MINUTES IN BITS 10-20, DATE THE SAME

;CALL:	PUSHJ	P,DATIME

DAYTIM:	TLZ	A,400000	;CLEAR ALL NON TIME AND DATE BITS
	SKIPE	Q,VERNO			;IF NEW VERSION (101)
	CAIL	Q,101			; WROTE THIS TAPE
	JRST	[LDB Q,[POINT 15,A,35]	; SETUP FOR NEW DATE75 FORMAT
		LSH A,-^D15		;DATE IS 15 BITS WIDE
		JRST DAYTI0	]
	LDB	Q,[POINT 12,A,35] ;PICKUP DATE
	LSH	A,-^D12		;OUTPUT TIME FIRST
DAYTI0:	IDIVI	A,^D60*^D60	;DIVIDE INTO HOURS AND SECONDS
	MOVE	R,A+1		;SAVE SECONDS
	PUSHJ	P,PRNUM		;PUBLISH HOURS
	PRCHAR	<:>
	MOVE	A,R		;PUBLISH MINUTES

PICKUP:	IDIVI	A,^D60
	MOVE	R,A+1		;SAVE SECONDS	[OR MINUTES IF JRST-ING HERE]
	PUSHJ	P,PRNUM
	PRCHAR	<:>
	MOVE	A,R		;GET SECONDS
	PUSHJ	P,PRNUM		;PUBLISH SECONDS
YRSMOS:	PUSHJ	P,TAB		;TAB OUT
;YRSMOS+1 INSERTED 1 INSTRUCTION [36]
	ANDI	Q,77777		;MASK TO 15 BITS [36]
	IDIVI	Q,^D31*^D12	;GET YEARS
	IDIVI	R,^D31		;GET MONTH AND DAY
	AOS	A,S		;PUBLISH DAY OF MONTH
	PUSHJ	P,PRNUM
	CAIGE	R,6		;LEFT OR RIGHT SIDE OF TABLE
	SKIPA	A,MONTAB(R)	;RIGHT
	HLRZ	A,MONTAB-6(R)	;LEFT
	DPB	A,[POINT 18,MONDPB,23]	;STASH INTO TEXT
	JSP	A,PR		;PUBLISH MONTH

	IFN	PAGING,	<	JFCL	MONDPB	>

	IFE	PAGING,	<
MONDPB:	SIXBIT	/ PDP#/	>

	MOVEI	A,^D64(Q)	;PUBLISH YEAR
	PUSHJ	P,PRNUM
	TLZE	F,POPGOT		;NEED A SPECIAL POPJ ?
	POPJ	P,			;YOU'VE GOT IT
SWPRET:	JRST	CRLF			;RETURN VIA CR - LF

	IFN	PAGING,	<
MONDPB:	SIXBIT	/ HOH#/	>
DATIME:	TLZ	A,777740	;ZERO ALL NON TIME/DATE BITS
	LDB	Q,[POINT 12,A,35] ;PICKUP DATE
	LSH	A,-^D12		;OUTPUT TIME FIRST
	MOVE	B,VERNO		;IF VERSION 101 WROTE THIS TAPE
	CAIL	B,101		;  R HAS THE HI-ORDER CREATE DATE BITS
	DPB	R,[POINT 3,Q,23] ; SO PUT THEM ALL TOGETHER
	JRST	PICKUP		;PICK UP REST OF PROCEDURE


MONTAB:	SIXBIT	/JULJAN/	;TABLE OF MONTH NAMES
	SIXBIT	/AUGFEB/
	SIXBIT	/SEPMAR/
	SIXBIT	/OCTAPR/
	SIXBIT	/NOVMAY/
	SIXBIT	/DECJUN/
;THE PRINT ROUTINES ARE CALLED BY
;	JSP	A,PRLIN		;BEGINS WITH CRLF
;	SIXBIT	/MESSAGE OF ANY LENGTH/
;OR
;	JSP	A,PR		;BEGINS IMMEDIATELY
;	SIXBIT	/MESSAGE OF ANY LENGTH/
;	OR!!!
;	JSP	A,PR <OR PRLIN>
;	JFCL	ADDRESS OF LITERAL SIXBIT MESSAGE

;WITH ANY CALL, CONTROL RETURNS TO THE LOCATION IMMEDIATELY
;FOLLOWING THE END OF THE MESSAGE ENTRY
;
;EACH MESSAGE MUST END WITH ONE OF THE FOLLOWING CHARACTERS:
;	@ AT THE END OF THE MESSAGE GIVES A CRLF
;	# AT THE END OF THE MESSAGE GIVES A SPACE

PRLIN:	PUSHJ	P,CRLF
	XLIST
	IFN PAGING,
	<
	LIST
PR:	MOVEI	B,@(A)		;GET POINTER
	>
	LIST
	XLIST
	IFE PAGING,
	<
	LIST
PR:	MOVEI	B,(A)
	>
	LIST
	TLOA	B,440600		;P AND S FOR BYTE POINTER
					;POINT 6,ADDRESS OF LITERAL
PRLUP:	PUSHJ	P,TYPEA		;TYPE IT OUT
	ILDB	CH,B		;PICKUP NEXT CHAR
	CAIN	CH,77		;IS IT A PSEUDO TAB ?
				; SIXBIT _
	TRCA	CH,000066	;MAKE HIM A REAL TAB
	MOVEI	CH,40(CH)	;TAB SKIPS THIS INSTRUCTION, BUT
				;ALL OTHER ARE ASCII-IZED
	CAIN	CH,100		;SIXBIT @
				;WHICH HAS BEEN ASCII-IZED
	JRST	PR6		;FINISH LINE
	CAIE	CH,43		;SIXBIT #
				;WHICH HAS BEEN ASCII-IZED
	JRST	PRLUP		;GET NEXT CHAR TO TYPE
	PUSHJ	P,SPACE		;OUTPUT FINAL SPACE
	IFE PAGING,
	<
	JRST	1(B)		;RETURN
	>
	IFN	PAGING,<
	JRST	1(A)
	>
PR6:	PUSHJ	P,CRLF		;OUTPUT CRLF
PRRET:
	IFN	PAGING,<
	JRST	1(A)
	>
	IFE	PAGING,
	<
	JRST	1(B)		;(A) + 1 GIVE VECTOR
	>
				;BACK TO AFTER THE JFCL
				;AOJA	B,@B
				;DOES NOT WORK BECAUSE EFFECTIVE ADDRESS
				;IS CALCULATED BEFORE THE ADDITION IS DONE

;PRINT AN ASTERISK IMMEDIATELY
ASTRSK:	XLIST
	IFN	BELL,
	<
	LIST
	MOVEI	CH,007			;^G = BELL
					;
	PUSHJ	P,TYPEA
	>
	LIST

JSTAST:	MOVEI	CH,52			;*
	PUSHJ	P,TYPEA
	OUTPUT	TTO,			;FORCE IT OUT NOW
	POPJ	P,

;PRINT A SPACE
;OR A TAB
TAB:	SKIPA	CH,[OCT	11]	;TAB
SPACE:	MOVEI	CH,40		;ASCII SPACE
	JRST	TYPEA		;TYPE IT OUT

;PRINT ONE OR TWO CRLF'S
LFCRLF:	MOVEI	CH,1012		;LINE FEED PLUS BIT TO PROHIBIT OUTPUT
	PUSHJ	P,TYPEA
CRLF:	MOVEI	CH,15		;ASCII CR
	PUSHJ	P,TYPEA		;TYPE IT OUT
	MOVEI	CH,12-40	;ASCII LF IN PSEUDO-SIXBIT

;PRINT ONE SIXBIT CHARACTER
TYPE:	MOVEI	CH,40(CH)	;CONVERT SIXBIT TO ASCII

;PRINT ONE ASCII CHARACTER
TYPEA:	SOSG	TTYO+2		;OUTPUT THE CHARACTER IN CH
	OUTPUT	TTO,
	IDPB	CH,TTYO+1
	SKIPE	LSTING		;IS THE DON'T FORCE OUTPUT EVERY E.O.L
				;CHARACTER FLAG UP ?
	POPJ	P,		;RETURN, FORGET WHAT CHARACTER IS, YOU
				;AREN'T SUPPOSED TO FORCE OUTPUTS AT EOL

	CAIN	CH,12		;END OF LINE?
	OUTPUT	TTO,0		;YEP, FORCE WHATEVER IT IS OUT
	POPJ	P,		;RETURN

;PRINT A CHARACTER - WITH UPARROW IF A CONTROL CHARACTER

PRCH:	MOVEM	CH,PRCH1#	;STASH CHAR AWAY SAFELY
	PUSHJ	P,CRLF		;START A LINE OF TEXT
	MOVE	CH,PRCH1	;UNSTASH THE CHAR
PRCHNL:	CAIL	CH,40		;NORMALLY PRINTING?
	JRST	TYPEA		;YES, PRINT AND POPJ
	PRCHAR	<^>
	MOVE	CH,PRCH1	;REGET CHAR
	MOVEI	CH,100(CH)	;CONVERT TO CONTROL MUMBLE
	JRST	TYPEA		;PRINT AND POPJ

;PUBLISH THE OCTAL NUMBER IN AC A
; CALL:	PUSHJ	P,PRNUM8
PRNUM8:	SKIPA	A+1,[10]		;RADIX 8.

;PUBLISH THE DECIMAL NUMBER IN AC A
;	ALWAYS PUBLISH AT LEAST TWO DIGITS
; CALL:	PUSHJ	P,PRNUM
PRNUM:	MOVEI	A+1,12		;RADIX 10.
PRNUMA:	MOVEI	CH,"0"		;INSURE AT LEAST TWO DIGITS
	CAIGE	A,(A+1)		;IS NUMBER BIGGER THAN RADIX
	PUSHJ	P,TYPEA		;NO, PABLISH A LEADING ZERO
	HRRM	A+1,PRN		;THIS MAY LOOK LIKE A CROCK, BUT IF YOU
					;LOOK CAREFULLY, ANY ATTEMPT TO
					;DO IDIVI A,0(A+1) DIES ON
					;THE SECOND DIGIT
PRN:	IDIVI	A,0		;REMAINDER IS LOW ORDER DIGIT
	HRLM	A+1,(P)		;STASH IN LEFT OF CURRENT PDL WORD
	JUMPE	A,MORDIG	;ANY MORE DIGITS?
	PUSHJ	P,PRN		;YES, PUT NEXT DIGIT IN NEXT PDL WORD
MORDIG:	HLRZ	CH,(P)		;UNSTASH DIGIT
	MOVEI	CH,60(CH)	;CONVERT TO ASCII
	JRST	TYPEA		;OUTPUT IT & POPJ TO .-2 FOR NXT DIGIT, OR RETURN

;PRINT A PERIOD FOLLOWED BY THE LEFTMOST THREE SIXBIT
;	CHARACTERS IN AC B
PREXT:	TLNN	B,-1		;ANY EXTENSION (LEFT HALF ONLY)
	JRST	NOPERD			;NO EXT
	PRCHAR	<.>
PR3CHR:	SKIPA	A,[-3]		;SET CHARACTER COUNT

;PRINT THE SIX SIXBIT CHARACTERS IN AC B
PRNAME:	HRROI	A,-6		;SET CHARACTER COUNT

;PRINT THE N SIXBIT CHARS IN AC B
;	ENTER WITH -N IN AC A
PRNAM1:	MOVEI	CH,0		;CLEAR CH(=B+1)
	ROTC	B,6		;ROTATE HIGH ORDER CHAR INTO CH
	PUSHJ	P,TYPE		;PUBLISH
	AOJL	A,PRNAM1	;GET NEXT CHAR
	POPJ	P,		;RETURN

NOPERD:	TRNN	F,PRNTSW	;PRINTING?
	POPJ	P,		;NOPE, JUST LISTING
				;IF LISTING, DON'T PAD OUT BLANK EXTENSIONS
	HRROI	A,-4		;FOUR (4) SPACES FOR NULL EXT
	JRST	PRNAM1		;PRINT IT (OR THEM)

;MISC TTY SUBRS

TTYINI:	INIT	TTI,AL		;INITIALIZE TTY INPUT
	SIXBIT	/TTY/
	XWD	0,TTYI
	CALLI	EXIT		;NO TTY IS FATAL
	MOVEI	A,TTYBFI	;SETUP TTY BUFFERS FOR INPUT
	MOVEM	A,.JBFF
	INBUF	TTI,TTYINN
	INIT	TTO,ASCII		;INITIALIZE TTY OUTPUT
	SIXBIT	/TTY/
	XWD	TTYO,0
	CALLI	EXIT

	IFN	LOCK,<
	TLNE	F,LOCKER
	JRST	GTTOBF		;IF LOCK IS ON, DON'T DO A CORE UUO
	>
	MOVEI	A,TAPBUF
	MOVEM	A,.JBFF

	IFE DEBUG,<
	CALLI	A,CORE
	>
	IFN	DEBUG,<
	CAIA
	>
	JRST	NOCORE
GTTOBF:	SETBUF	TTO;		;SET UP TELETYPE BUFFERS
				;NOTE THAT THE ; AFTER SETBUF TTO^
				;IS NECESSARY
				; I SHOULD HAVE REMEMBERED THIS FROM WORK ON
				;THE COBOL COMPILER!!!!!!!!!!!!




	MOVE	A,[400000,,TTOBUF+1]
	MOVEM	A,TTYO		;SET UP STATUS WORD
	SETZM	LSTING		;WE MAY BE LISTING, BUT THE DEVICE
				;WE ARE SPEAKING TO WANTS TO
				;HAVE AN OUTPUT FORCED WHENEVER
				;IT SEES AN EOL (12)

	OUTPUT	TTO,		;DUMMY OUTPUT
	POPJ	P,			;YES, RETURN

;TELETYPE INPUT
TYI:	SOSLE	TTYI+2
	JRST	TYIOK		;CHARS AVAILABLE
	INPUT	TTI,		;GET A BUFFER
	STATO	TTI,760000	;EOF OR ERR?
	JRST	TYIOK		;NO, OK.
	PUSHJ	P,TTYINI	;ASSUME EOF, GET TTY AGAIN
	TDZA	CH,CH
TYIOK:	ILDB	CH,TTYI+1	;GET A CHAR
	JUMPE	CH,TYI		;JUNK NULLS
	POPJ	P,
;MISCELLANEOUS ERROR MESSAGES

;COMPLAIN ABOUT AN ILLEGAL DIGIT
NILSW:	MOVEI	CH,60-133(CH)	;RESTORE ASCII CODE FOR NUMBER
ILSW:
;COMPLAIN ABOUT AN ILLEGAL CHAR
ILCH:	CAIN	CH,032		;IS IT CONTROL-Z	[EDIT#35]
	JRST	ZOUT		;YES			[EDIT#35]
	PUSH	P,CH		;SAVE CH
	TYPES	($)
	POP	P,CH		;RESTORE CH
	PUSHJ	P,PRCHNL		;PRINT OFFENDING CHAR
	PR1	< IS ILLEGAL@>
	JRST	FS1.1		;ASK WHAT NEXT


ZOUT:	CLOSE 	TTO,		;CONTROL-Z EXIT		[EDIT#35]
	CLOSE	TAP,		;			[EDIT#35]
	CLOSE	MFD,DNC		;			[EDIT#35]
	CLOSE	UFD,DNC		;			[EDIT#35]
	CLOSE	FIL,DNC		;			[EDIT#35]
	CLOSE	CHK,DNC		;			[EDIT#35]
	CLOSE	DGA,DNC		;			[EDIT#35]
	CALLI	EXIT		;			[EDIT#35]

;FILE NAME ERROR
FILDL1:	PRLIN1	<$TWO PERIODS#>
	JRST	ALLFI2
ALLFI1:	PRLIN1	<$ASTERISK#>
ALLFI2:	PR1	<IN NAME@>
	JRST	FS1.2

;COMMAND ERROR - RESTART
COMERR:	PRLIN1	<$COMMAND ERROR@>
	JRST 	START		;BACK TO BEGINNING

;COMMAND NOT YET IMPLEMENTED
NOTYET:	CAIN	CH,032		;CONTROL-Z?		[EDIT#35]
	JRST	ZOUT		;YES			[EDIT#35]
	PUSH	P,CH		;SAVE IT
	TYPES	($)
	POP	P,CH
	PUSHJ	P,PRCH		;PRINT FRUSTRATING CHAR
	PR1	< ISNT YET IMPLEMENTED@>
	JRST	FS1.1

;NUMBER OUT OF RANGE - RESTART
NUMOUT:	PRLIN1	<$NUMBER OUT OF RANGE@>
	JRST	START		;BACK TO BEGINNING

NOLIST:	PUSHJ	P,TTYINI	;GO FIX UP TTY
	PRLIN1	<?NO DEVICE "LST"?@>
	JRST	REINFO

ILLFMT:	PRLIN1	<ILL FORMAT ON TAPE@>
	SETOM	FNDBEG		;SIGNAL WE HAVE FOUND ENOUGH TO FAKE A BEGINNING
SEARCH:	PUSHJ	P,SFEODR
	JRST	CGETDR		;DON'T JUST GIVE UP... KEEP TRYING

NOTAP:	PUSHJ	P,TTYINI		;ERROR MESSAGE OUT TO TTY
	PRLIN1	<?NO MTA NAMED "FAILSA"?@>
REINFO:	CALLI	EXIT
BADMFD:	PRLIN1	<LOOKUP ERROR ON MFD FOR#>
	JRST	UGHMFD
NOMFD:	PRLIN1	<CANNOT INIT MFD FOR#>
UGHMFD:	MOVE	B,CURSTR	;PRINT STRUCTURE NAME
	PUSHJ	P,PRNAME
	PUSHJ	P,CRLF

	JRST	ENDMFD			;CONTINUE UNTIL MFD'S ARE EXHAUSTED




NOTFS:	PUSHJ	P,TTYINI	;INSURE OUTPUT TO TTY
	PRLIN1	<?NOT LOGGED IN UNDER 1,2!@>
	JRST	REINFO

MAYBE2:	GETBAD	(A)		;IF NOT FRAGMENTATION
				;ERROR, FALL INTO MESSAGE, OTHERWISE,
				;RETURN BY POPJ
NOUFD:	PRLIN1	<CANNOT RESTORE UFD#>
	JRST	PRPP

NODSK:	PUSHJ	P,TTYINI		;FIX UP TTY
	PRLIN1	<$CAN'T INIT DISK FOR DATE CHECK; TRY AGAIN@>
	JRST	START

TFRERR:	PRLIN1	<TAPE#>
	JRST	UFLER2
UFLERR:	PUSHJ	P,NULTAP		;RESET TAPE BUFFER TO TRY
					;TO STOP BAD FILE FROM BEING WRITTEN OUT ON TAPE
	PRLIN1	<DISK#>
UFLER2:	PR1	<ERROR READING#>
PRUFL:	MOVE	A,[XWD	ZONKER,SAVNAM]	;BLT DIRECTORY NAME
				;OF FILE SOUGHT TO SAFE PLACE WHILE YOU
	BLT	A,SAVNAM+4

	MOVE	A,[XWD FILDIR,ZONKER]	;BLT OFFENDING(ERROR) FILE
				;NAME INTO POSITION FOR PRINTING

	BLT	A,PROT
	PUSHJ	P,PRNMEX	;PRINT NAME & EXT OF FILE
	MOVS	A,[XWD ZONKER,SAVNAM]	;BLT SAVED NAME BACK INTO POSITION
	BLT	A,FILPP+4

	JRST	CRLF		;DO OUTPUT UUO

DNTAVL:	PUSHJ	P,TTYINI		;OUTPUT TO TTY
	PRLIN1	<$DISK NOT AVAILABLE@>
	CALLI	A,GETPPN	;IS THIS FAILSAFE PPN?
	  JFCL			;BE DEFENSIVE
	CAME	A,FSPP
	JRST	NOTFS		;NO, COMPLAIN
	JRST	FS1A

TFLWF:	PUSHJ	P,PRNMEX	;PRINT NAME & EXTENSION OF FILE
	PUSHJ	P,TAB		;AND A TAB

	JRST	PRFLPP		;PRINT PROJ-PROG NR. SPECIFIED IN FILE

WRLOK:	PRLIN1	<$MTA WRITE-LOCKED; INSERT RING & TYPE "/C"@>
	GETSTS	TAP,A		;GET CURRENT STATUS OF TAPE
	TRZ	A,400000	;TURN OFF WRITE-LOCK FLAG
				;AND THEN
	SETSTS	TAP,(A)		;RESTORE ALL OTHER FLAGS
SLASHW:	PUSHJ	P,ASTRSK	;PUT OUT 'READY FOR INPUT'
GETINP:	PUSHJ	P,TYI		;GET A CHARACTER FROM TTY
	CAIE	CH,12		;SKIP LN FEEDS AND
	CAIN	CH,15		;CARR RETS
	JRST	GETINP		;SKIP LF AND CR, GO BACK FOR GOOD STUFF
	CAIE	CH,"/"		;SLASH?
	JRST	GETINP		;WAIT TILL SLASH
	PUSHJ	P,TYI		;GET SOME MORE INPUT FROM TTY
	CAIE	CH,"C"		;WAIT FOR C TO FOLLOW
	JRST	SLASHW		;LOOP UNTIL /C OR ^C START
	JRST	TAPOU1		;HOORAY! THE IDIOT PUT A RING IN REEL


DEVERR:	PRLIN1	<$MTA OK? TYPE "/C" TO CONTINUE@>
	GETSTS	TAP,A		;GET ALL FLAGS
	TRZ	A,200000	;RESET PHYSICAL DEVICE ERROR
	SETSTS	TAP,(A)		;RESTORE ALL OTHER FLAGS
	JRST	SLASHW		;WAIT FOR / AND THEN C


TOOMNY:	PRLIN1	<$TOO MANY ARGS@>
	JRST	FS1.1

FAILSC:	PUSHJ	P,TTYINI			;INIT TTY SO OUTPUT FORCED TO TTY
	PRLIN1	<?OLD FORMAT TAPE. SUGGEST ".R FAILCD"@>
	JRST	REINFO


WRONGV:	PUSHJ	P,TTYINI			;INIT TTY SO OUTPUT FORCED TO TTY
	PRLIN1	<?TAPE APPEARS TO BE A 4-SERIES FAILSAFE TAPE.@>
	JRST	REINFO


ILLNAM:	PRLIN1	<ILLEGAL FILENAME:#>
	PUSHJ	P,TFLWF
	PR1	<ENCOUNTERED@>
	JRST	SEARCH


ILLTAP:	PRLIN1	<TAPE READ ERROR#>
	JRST	SEARCH			;LOOK FOR SOMETHING YOU CAN READ
FIXFRG:	HRRZ	A,(P)	;GO AFTER EFFECTIVE ADDRESS OF ENTER AGAIN
	MOVEI	A,@-2(A)
	IFN	LEVELC,
	<
	MOVE	B,(A)		;GET 1ST WORD
	TLNE	B,-1		;ARE WE 4-SERIES OR 5-SERIES
	POPJ	P,		;EXIT IF 4-SERIES
	>
	MOVEI	TMP,077777		;MASK FOR ERROR CODE
	ANDCAM	TMP,3(A)		;ZERO ALL BUT CREA-DATE BITS
	POPJ	P,

MAYBE4:	HRRZ	A,(P)		;GET ADDRESS OF PUSHJ
	LDB	A,[POINT 9,-2(A),8]		;GET LEFT HALF
						;STRIP OFF CHANNEL & INDEX
				;AND INDIRECT BITS <JUST LEAVE OP CODE>
	CAIE	A,(<ENTER>B44)	;DID YOU HAVE AN ENTER?
	JRST	LOOKER		;NOT AN ENTER...?? CAN'T BE ERROR 17
				;ERROR.. GO TO IT.
	HRRZ	B,(P)		;GET ADDRESS OF ENTER+1+1
	MOVEI	B,@-2(B)	;NOW GET EFFECTIVE ADDRESS OF ENTER
	IFN	LEVELC,
	<
	MOVE	A,(B)		;GET  1ST WORD
	TLNE	A,-1
	JRST	LOOKER		;SKIP OUTTA HERE IF 4-SERIES
	>
	HRRZ	A,3(B)		;GET RIGHT HALF OF UUO ADD +3 = ERROR RETURN
	CAIN	A,FRAGER	;FREGMENTATION ?
	JRST	FIXFRG		;GREAT! ONLY FRAGMENTATION ON ENTER
				;WE CAN CONTINUE (FIXFRG CLEARS ERROR CODE)

	CAIN	A,NOROOM	;NO MORE ROOM ?
	JRST	[PRLIN1	<NO MORE ROOM FOR#>
		PUSHJ	P,TFLWF
		POP	P,A		;POP OFF
		JRST	GETEOF		;TRY ANOTHER USER
		]
	JUMPE	A,ILLNAM		;ILLEGAL FILE NAME ON AN ENTER
;UUO ERROR CHECK ROUTINE(ENTER,LOOKUP, RENAME)
;CALL:	UUO	DSK,E
;	PUSHJ	P,UUOERR
;RETURN DEPENDS UPON UUO
;E OF THE UUO IS USED TO FIND FILENAME

RENERR:
LOOKER:
ENTERR:	MOVEI	A,RENTER	;RETURN IF ENTER OR RENAME ERROR
	EXCH	A,(P)		;GET CALL ADDRESS+1
	TRO	F,UUOERR	;SET UUO ERROR FLAG
	IFN LEVELC,
	<
	MOVEI	B,@-2(A)
	MOVE	U,1(B)		;GET ERROR # IF THIS IS A 4-WORD BLOCK

	MOVE	B,(B)		;GET FIRST WORD OF UUO SPEC
	TLNE	B,-1		;4 OR 5 SERIES FORMAT ?
	JRST	MISCER		;4 SERIES!!
	>

	MOVEI	B,@-2(A)	;GET ADDRESS
	HRRZ	U,3(B)		;SAVE ERROR CODE NUMBER
	MOVEI	TMP,077777		;MASK FOR ERROR CODE
	ANDCAM	TMP,3(B)		;RESET ERROR FLAGS IN DIRECTORY
	CAIGE	U,ERRTMX	;IS IT A KNOWN TYPE OF ERROR?
	JRST	@ERRTAB(U)	;DISPATCH TO ERROR PRINT ROUTINE

	JRST	MISCER		;UNKNOWN ERROR
ERRTAB:	EXP	FNF		;FILE NOT FOUND
	EXP	NSUCH		;NO SUCH UFD
	EXP	PROTF		;PROTECTION FAILURE
	EXP	FBMOD		;FILE BEING MODIFIED
	EXP	EXNAM		;TRIED RENAME TO EXISTING NAME
ERRTMX==.-ERRTAB
;INDIVIDUAL ERROR PRINT-OUT ROUTINES

FNF:	POP	P,A		;RESTORE PD-LEVEL
	TRNE	F,UFDI		;LOOKUP ON UFD ?
	JRST	MORE1		;YES, DO NEXT UFD, THIS ONE IS LOST
	JRST	MORE2		;GO AFTER MORE FILES

NSUCH:	PUSHJ	P,TFLWF
	PR1	<REFERENCES NON-EXISTENT USER AREA@>
	POPJ	P,

PROTF:	PR1	<PROTECTION FAILURE ON#>
MISCE1:	JRST	TFLWF

FBMOD:	PUSHJ	P,TFLWF
	PR1	<IS BEING MODIFIED@>
	POPJ	P,

EXNAM:	LDB	CH,[POINT 9,-2(A),8]		;GET UUO WHICH SET US HERE
						;GET RID OF XR, I AND AC BITS
	CAIE	CH,(<RENAME>B44)	;WAS IT A RENAME ?
				;(RENAME ERROR ON LOOKUP ???)
	JRST	REMOVE		;RENAME ERROR ON LOOKUP SOUNDS LIKE
				;THE STRUCTURE HAS BEEN DISMOUNTED

	PR1	<ATTEMPTED TO RENAME#>
	PUSHJ	P,TFLWF
	PR1	<TO AN EXISTING NAME@>
	POPJ	P,


REMOVE:	TRZE	F,FILI		;DOING FILE INPUT ?
	JRST	ENDFIL		;YES,,,, BUT THE FILE WENT AWAY
	TRZE	F,UFDI		;UFD INPUT ??
	JRST	ENDUFD		;IT WENT AWAY


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;IT WOULD APPEAR HERE THAT THE SRUCTURE HAS DISAPPEARED
	MOVEI	CH,042		;CH _ "
	PUSHJ	P,TYPEA
	MOVE	B,CURSTR		;"%STRUCTURE FOO
	PUSHJ	P,PRNAME
	PR1	< WAS REMOVED BEFORE SAVE WAS COMPLETED. THE TAPE IS@>
	PR1	<"INCOMPLETE FOR STRUCTURE#>
	MOVE	B,CURSTR
	PUSHJ	P,PRNAME
	PR1	<._CONTINUING WITH NEXT STRUCTURE.@>
	JRST	ENDMFD			;TRY NEXT STR



MISCER:	PR1 <LOOKUP/ENTER FAILURE#>
	MOVEI	CH,"("		;PRINT (ERR CODE)
	PUSHJ	P,TYPEA
	MOVEI	A,(U)			;GET ERROR NUMBER
	TRZ	A,777700	;SELECT LOW 6 BITS
	MOVEI	A+1,10		;OCTAL RADIX
	PUSHJ	P,PRNUMA
	MOVEI	CH,")"		;FINISH THE LINE
	PUSHJ	P,TYPEA
	PUSHJ	P,SPACE
	PUSHJ	P,PRNMEX
	JRST	CRLF		;IDENTIFY THE ERROR #, FILE NAME
				;ONE LF
				;EXIT BACK TO WHERE YOU ARE POPJ'ED TO
				;IN THE ERROR RECOVERY AND DETECTION SECTION,
				;CODE WILL TRANSFER CONTROL TO TFLWF:
				;OR LIKE PLACE WHERE OFFENDING FILE WILL
				;BE IDENTIFIED.  POPJ-ING RELIEVES
				;PROBLEM OF MULTIPLE ERROR MESSAGES FOR
				;A SINGLE FILE

;REENTER CODE
;START AT RENTER WHEN USER HAS TYPED "REENTER" TO MONITOR

RENTER:	TRNN	F,-1		;ANY OPERATIONS IN PROGRESS?
	JRST	START		;NO

	TRZE	F,UUOERR	;UUO ERROR?
	JRST	RENINT		;YES, SKIP I/O ERROR CHECKS
	TRNE	F,TAPI		;TAPE INPUT ERROR?
	JRST	RTAPIN		;YES, TELL USER
	TRNE	F,FILO		;FILE OUTPUT IN PROGRESS?
	JRST	RFILOU		;LET USER KNOW

RENINT:	MOVEI	B,17		;INTERNAL REENTER POINT
	ANDI	B,(F)		;GET ONLY MAJOR OPERATION BITS
	JUMPE	B,FS1A		;NO /S, /R, /L, OR SELECT. REST. IN PROGRESS
	LSH	B,-1		;REDUCE BITS TO QUANTITIES FOR INDEXING
	TRZ	B,4		;WAS /S IN PROGRESS?
				;IF SO, INSURE SWITCH IS OFF
	MOVEI	T,6		;NO
RENDSP:	HLRZ	A,RENTAB(T)	;PICK UP BITS
	TRZ	A,37		;MASK OUT IND AND XR FIELD
	TRZE	F,(A)		;MATCH?
	JRST	@RENTAB(T)	;YES, DISPATCH
	SOJGE	T,RENDSP	;NO, TRY AGAIN
NOREEN:	PRLIN1	<$NOT AN I/O FAILURE - CANNOT DETERMINE REENTRY POINT@>
	JRST	FS1.2

;REENTRY PROCESS DISPATCH

RENTAB:	XWD	TAPO,RTAPOU
	XWD	FILI,ENDFIL		;RFILIN JRST'S TO ENDFIL
	XWD	UFDI,ENDUFD		;RUFDIN JRSTS TO ENDUFD AFTER EXTRA
					;ERROR MESSAGES

	XWD	MFDI,RMFDIN
	XWD	FILO+B,RFILO
	XWD	TAPI+B,RTAPI
	XWD	UFDO+B,RUFDOU

RUFDOU:	JRST	UFDFA1		;SELECTIVE RESTORE IN PROGRESS
	JRST	UFDFA2		;/R IN PROGRESS
	JRST	FS1A		;/L IN PROGRESS

RFILO:	JRST	CGETDR		;SEL. REST. FILE OUTPUT TO DSK
				;CLOSE DISK OUTPUT AND SKIP TO NEXT EOF OR
				;FILE FOR THIS USER
	JRST	TAPIN4		;/R OUTPUT FILE TO DSK
	JRST	NOREEN		;/L OUTPT TO DSK SHOULDN'T HAPPEN

RTAPI:	POPJ	P,		;PROBABLY A PROTECTION FAILURE
				;QUIT NOW WHILE AHAEAD
	JRST	SELRES		;/R TAPE INPUT
	TRO	F,TAPI		;READ ERROR ON LISTING
				;SET FLAG IN CASE OF ANOTHER ERROR

SELRES:	SKIPN	FNDBEG		;FOUND BEGINNG RECORD ?
	PUSHJ	P,TRACKS	;TAPE ERROR AND YOU HAVEN'T FOUND 1ST RECORD
				;SOUND LIKE YOU MAY HAVE THE WRONG CHANNEL
				;TAPE ON THE RIGHT CHANNEL DRIVE....
	POP	P,A		;CORRECT TO PD-LEVEL
	JRST	-1(A)		;AND GO BACK TO FTAPIN OR WHOMSOEVER
				;CALLED YOU AND TRY AGAIN





UFDFA1:	PRLIN1	<$CANNOT WRITE UFD#>
	PUSHJ	P,PRPP
	JRST	FS1AA		;REINITIALIZE


TRACKS:	PRLIN1	<"TAPE ERROR ON 1ST RECORD; ARE TAPE & DRIVE COMPATIBLE WITH RESPECT TO:@>
	PR1	<"CHANNELS, DENSITY, PARITY, & PHASE ?@>
	POPJ	P,


;BUFFER HEADERS

TTYI:	BLOCK	3		;TTY INPUT BUFFER HEADER**2
TTYO:	BLOCK	3		;TTY OUTPUT BUFFER HEADER**2
TAPHED:	BLOCK	3		;MAGTAP INPUT OR OUTPUT BUFFER HEADER**2
MFDHED:	BLOCK	3		;DISK MFD BUFFER HEADER**2
UFDHED:	BLOCK	3		;DISK UFD BUFFER HEADER**2
DGAHED:	BLOCK	3		;PHANTOM CHANNEL
CHKHED:	BLOCK	3		;DATE CHECK FILE HEADER
FILHED:	BLOCK	3		;DISK USER FILE BUFFER HEADER**2

;MTA HEADER BLOCK
FIRBLK:	XWD	AARDVARK,FSPP-FIRBLK	;WD0=XWD HEADER FLAG,BLK WDCT
STARFS:	SIXBIT	/*FAILS/	;WD1
	SIXBIT	/AFE   /	;WD2=XWD SIXBIT "AFE",TAPE SEQ#
				;NEGATIVE TAPE SEQ# MEANS TRAILER
	EXP	0		;WD3=TAPCTD BIT (B0), USRCTD BIT (B1)
				;    CRTIME (B13-23), CRDATE (B24-35)
FSPP:	XWD	1,2		;WD4=FAILSAFE PROJ,PROG #


SYSPP: 1,,1
;LOOKUP & ENTER SPECS
				;EXT LOOKUP	-    OLD LOOKUP



				;NOTE THAT 4-WORD ENTERS/LOOKUPS ARE
				;THE ONLY KIND UTILIZED ON THE MFD AT
				;THIS TIME
HELPS:	400000,,0
	SIXBIT	/SYS   /
	EXP	HELPIT
HELPIT:
LSTDIR:
MFDDIR:	0			;0,XLOOKN	-     FILNAM
	0			;PPN		-     EXT.,ACC.DAT.
	0			;FILNAM		-     PROT,MODE,CREAT
	0			;EXT.,ACC.DAT.	 -    PPN
;	0			;PROT,MODE,CREAT
;	BLOCK	5		;--NEVER TOUCH--
;MRBPOS:	0			;--CLR BEFORE RESTORE--
;MRBNXT:	0			;   "    "	 "
;MRBPRD:	0			;   "    "	 "
;	BLOCK	1		;--NEVER TOUCH--
;MRBUFD:	0			;--CLR BEFORE RESTORE--
;MRBSTS:	0			;FILE STATUS WORD
;MRBELB:	0			;--CLR BEFORE RESTORE--
;MRBEUN:	0			;   "    "	 "
;	BLOCK	XLOOKN-21	;---NEVER TOUCH ON SAVE OR RESTORE--

UFDDIR:	0			;0,XLOOKN	-     FILNAM
	0			;PPN		-     EXT.,ACC.DAT.
	0			;FILNAM		-     PROT,MODE,CREAT
	0			;EXT.,ACC.DAT.	 -    PPN
	0			;PROT,MODE,CREAT
	BLOCK	5		;--NEVER TOUCH--
URBPOS:	0			;--CLR BEFORE RESTORE--
URBNXT:	0			;   "    "	 "
URBPRD:	0			;   "    "	 "
	BLOCK	1		;--NEVER TOUCH--
URBUFD:	0			;--CLR BEFORE RESTORE--
URBSTS:	0			;FILE STATUS WORD
URBELB:	0			;--CLR BEFORE RESTORE--
URBEUN:	0			;   "    "	 "
	BLOCK	XLOOKN-21	;---NEVER TOUCH ON SAVE OR RESTORE--
URBQTO=URBEUN+2			;LOGGED OUT QUOTA
URBQTI=URBQTO-1

FILMRK:	XWD	-1,XLOOKN+2	;FILE HEADER (MUST PRECEDE CURSTR)
CURSTR:	0			;CURRENT FILE STRUCTURE (MUST PRECEDE FILDIR)
FILDIR:	0			;0,XLOOKN	-     FILNAM
	0			;PPN		-     EXT.,ACC.DAT.
	0			;FILNAM		-     PROT,MODE,CREAT
	0			;EXT.,ACC.DAT.	 -    PPN
	0			;PROT,MODE,CREAT
	BLOCK	5		;--NEVER TOUCH--
FRBPOS:	0			;--CLR BEFORE RESTORE--
FRBNXT:	0			;   "    "	 "
FRBPRD:	0			;   "    "	 "
	BLOCK	1		;--NEVER TOUCH--
FRBUFD:	0			;--CLR BEFORE RESTORE--
FRBSTS:	0			;FILE STATUS WORD
FRBELB:	0			;--CLR BEFORE RESTORE--
FRBEUN:	0			;   "    "	 "
	BLOCK	XLOOKN-21	;---NEVER TOUCH ON SAVE OR RESTORE--
;MISCELLANEOUS DATA

ZONKER:		0
FILPP:	0			;E+3		LEAVE HERE, USED IN BLT
NAME:	0			;E FOR UUO ERRORS
EXT:	0			;E+1
PROT:	0			;E+2
DSKNAM:	BLOCK	NUMSTR		;FILE STRUCTURE LIST FOR /S,/U
DSKNME:	0			;END OF LIST MARKER - ALWAYS 0
MFDSPK:	BUFBIN
ACTSTR:	0			;SIXBIT /STRNAM/
	0			;OBUF,IBUF FOR MFD
DGADIR:	0
	0
	0
	0


	VAR			;MISC. VARIABLES
	LIT			;LITERAL TABLE
SAVNAM:	BLOCK	5		;SAVE NAME OF SOUGHT FILE HERE
WATBUF:	BLOCK	XLOOKN+2

PDL:	BLOCK	PDSIZ



;I/O BUFFERS

TTYBFI:	BLOCK	TTYINN*TTYSIZ	;BUFFERS FOR TTY INPUT
TTOBUF:	BLOCK	TTON*TTOLEN	;BUFFERS FOR TTY OUTPUT
TAPBUF=.				;BUFFER STARTING LOC FOR TAPE
MFDBUF=TAPBUF+TAPN*TAPLEN		;STARTING LOC FOR MFD
UFDBUF=MFDBUF+MFDN*DSKSIZ		;STARTING LOC FOR UFD
FILBUF==UFDBUF+UFDN*DSKSIZ		;CHECK FOR ACCESS AND CREATION
ENDIF1=FILBUF+ALTFLN*DSKSIZ		;END OF MODULE IF ALTN FILE
					;BUFFERS USED

ENDIF2=FILBUF+FILN*DSKSIZ		;END IF FILN # USED
	VSTBUF=3

	IFE	DEBUG,<
	BLOCK	VSTBUF		;LEAVE ROOM FOR INIT'ING MTA BUF HEADER
				;WHEN DOING  SPACING FUNCTIONS
	>
	IFN	DEBUG,
	<
	RELOC	ENDIF2
	>
TECOSTOP: END	START