Google
 

Trailing-Edge - PDP-10 Archives - SRI_NIC_PERM_SRC_3_19910112 - utilities/dart.mac
There are no other files named dart.mac in the archive.
	TITLE	DART	DUMP AND RESTORE TECHNIQUE
	SUBTTL	DEFINITIONS
STANSW==0

;R.E. GORIN STANFORD A.I. PROJECT AUGUST 26, 1972

IFDEF FOR,<MACRO__0;>MACRO==1		;SELECT ASSEMBLER

IFE MACRO,<				;FAIL MACROS
	DEFINE	DEF(A,B)<A_B>
	DEFINE	SDEF(A,B)<A__B>
	DEFINE	DDEF(A,B)<A_B>
	DEFINE	DSDEF(A,B)<A__B>
>

IFN MACRO,<				;MACRO MACROS
	DEFINE	DEF(A,B)<A=B>
	DEFINE	SDEF(A,B)<A==B>
	DEFINE	DDEF(A,B)<A=B>
	DEFINE	DSDEF(A,B)<A==B>
>

SDEF	VERSION,5			;MUST HAVE A NON-ZERO VERSION
SDEF	IOVER,2				;TAPE FORMAT NUMBER.

SDEF	IRCPPN,0			;IRCAM PPN FORMAT

IFN IRCPPN,<SEARCH DPYUUO>

;	ACCUMULATOR DEFINITIONS

DEF	FL,0				;FLAG AC

DEF	A,1				;VERY TEMPORARY AC
DEF	B,2
DEF	C,3
DEF	D,4

DEF	W,5
DEF	X,6
DEF	Y,7
DEF	Z,10

DEF	K,11
DEF	L,12

DEF	Q,13				;LESS TEMPORARY AC'S
DEF	R,14
DEF	S,15
DEF	TX,16

DDEF	P,17				;MAJOR PUSH-DOWN POINTER


;	IO CHANNEL DEFINITIONS

SDEF	FILE,1				;CHANNEL FOR READING DISK FILES
SDEF	UFD,2				;CHANNEL FOR READING A UFD
SDEF	MEM,3				;CHANNEL TO REMEMBER FILE NAMES
SDEF	MTA,4				;CHANNEL FOR TAPE OPERATIONS
SDEF	INDIR,5				;CHANNEL FOR INDIRECT COMMAND FILES.
SDEF	LST,6				;CHANNEL FOR LISTING
SDEF	DSKMSC,7			;MISC. DSK CHANNEL (DART.REC,DART.TAP, ETC.)
SDEF	DSKMEM,10			;DSK CHAN FOR REMEMBERING STATE (DART.MEM)
SDEF	UDPCHN,17			;CHANNEL FOR HELLIWELL'S UDP SERVICE
					;(ONLY AT STANFORD FOR UDPSW NOT 0)

;	OPDEFS

OPDEF	RESET	[CALLI	0]
OPDEF	DEVCHR	[CALLI	4]
OPDEF	CORE	[CALLI	11]
OPDEF	EXIT	[CALLI	12]
OPDEF	DATE	[CALLI	14]
OPDEF	TIMER	[CALLI	22]
OPDEF	GETPPN	[CALLI	24]
OPDEF	SLEEP	[CALLI	31]
OPDEF	TTCALL	[051B8]
OPDEF	PJOB	[CALLI	30]


SDEF	PDLEN,100			;PUSH DOWN LIST SIZE



SDEF	DBGSW,0				;NONZERO FOR DEBUGGING VERION OF DART
IFDEF SPCWAR,<IFNDEF STANSW,<STANSW==1>>	;FOR STANFORD FEATURES
IFNDEF	STANSW,<STANSW==0>			;ASSUME NOT STANFORD BY DEFAULT

IFN STANSW,<
SDEF(ALTMOD,175)
>
IFE STANSW,<
SDEF(ALTMOD,33)
>

IFN	STANSW,<
KMCSW==0				;ON FOR KMCDMP COMMAND.
UDPSW==0				;ON FOR OLD USER DISK PACK (UDP) SERVICE.
PPNDIV==100				;SIXBIT PPNS
PPNADD==" "				;SIXBIT PPNS
PPNCHR==3				;3 CHARACTERS IN EACH PPN PART
	RADIX	5+5
NTTAPE==59				;TOTAL NUMBER OF T-CLASS TAPES (MAX 2**12-1)
	RADIX	4+4
FTLUFD==1				;NONZERO TO USE SAIL LONG UFD'S TO AVOID
					;READING ALL THE RETRIEVAL IN THE WORLD
OPDEF	DSKPPN	[CALLI	400071]
OPDEF	SEND	[710B8]
OPDEF	NAMEIN	[CALLI	400043]
OPDEF	JBTSTS	[CALLI	400013]
OPDEF	WAKEME	[CALLI	400061]
OPDEF	DSKTIM	[CALLI	400072]
OPDEF	PTYUUO	[711B8]
OPDEF	PPIOT	[702B8]
OPDEF	UPGIOT	[703B8]
OPDEF	CHNSTS	[716B8]			;GET CHANNEL STATUS.
IFNDEF	UDPSW,<SDEF(UDPSW,0)>		;DEFAULT TO NOT UDP
IFN UDPSW,<
DSDEF	T,1				;DEFINE AC'S FOR UDP SERVICE
DSDEF	T1,1
DSDEF	T2,2
DSDEF	T3,3
DSDEF	T4,4
DSDEF	T5,5
DSDEF	T6,6
DSDEF	T7,7
DSDEF	T8,10
OPDEF	DEFPPN	[CALLI	400071]		;DEFAULT PPN FROM DSKPPN UUO.
OPDEF	UOUT	[1B8]			;OUTPUT
OPDEF	UIN	[2B8]			;INPUT
OPDEF	ULOOK	[3B8]			;LOOKUP
OPDEF	UENTER	[4B8]			;ENTER
OPDEF	URENAM	[5B8]			;RENAME
OPDEF	UOPEN	[6B8]			;OPEN
OPDEF	UCLOSE	[7B8]			;CLOSE
OPDEF	UDPMES	[10B8]			;ERROR MESSAGES
OPDEF	INIUDP	[11B8]			;INITIALIZE UDP
OPDEF	PASCHK	[12B8]			;ASK USER FOR PASSWORD & CHECK
>;IFN UDPSW
>;IFN STANSW

IFE	STANSW,<
SDEF	KMCSW,0
SDEF	PPNDIV,10			;OCTAL PPNS.  SET THIS TO 12 FOR DECIMAL.
SDEF	PPNADD,"0"			;OCTAL OR DECIMAL PPNS
SDEF	PPNCHR,6			;MAX OF 6 CHARACTERS IN EACH PPN PART
SDEF	UDPSW,0				;NO UDP'S EXCEPT AT STANFORD.
	RADIX	5+5
NTTAPE==31				;TOTAL NUMBER OF T-CLASS TAPES (MAX 2**12-1)
	RADIX	4+4
OPDEF	TAPOP.	[CALLI 154]
>

SDEF UDPCSW,0*UDPSW			;UDP COPY SWITCH REQUIRES UDPSW ON TOO.

EXTERN	.JBDDT,.JBFF,.JBREL,.JBVER,.JBREN
SDEF ZZ,.
	LOC	40
UUO:	0				;LOCATION FOR UUO INSTRUCTION
	JSR	UUOCON			;GODDDAM RPH
	LOC 136
	JRST DDTKLU			;KLUDGE UP DDT ENTRY
IFN STANSW,<				;NOT CLEAR HOW OUTSIDE WORLD WILL DO THIS
PRINTX Start me at 136 before saving as SYS:DART !!
>;IFN STANSW
	.ORG ZZ
;	VERSION HISTORY
;
;1	NOVEMBER 1972
;
;2	JANUARY 1973
;
;3	MARCH 1973	-  UDP ADDED
;
;4	JUNE 1973 -RECORD OFFSET.  NEW TAPE FORMAT.
;	(IN VERSION 4 THE 20TH WORD OF FILE RETRIEVAL IS SET TO
;	THE RECORD OFFSET ON DUMPING. (1 IS NORMAL).
;	ON RESTORE FROM A VERSION 4 TAPE, THE RECORD OFFSET IS
;	WRITTEN INTO THE FILE RETRIEVAL.)
;
;	OCTOBER 1973 ARCHIVE COMMAND
;
;	AUGUST 1974 - UDP FLUSHED
;
;5	NOVEMBER 1974 - DATE75 CONVERSION
;	Tape Format
COMMENT $

	Tapes are usually recorded at 800 BPI,  odd  parity.   Record
length  does not exceed 1280 words. There are three types of records,
header-trailer records, File start records, and Continuation records.


Header-Trailer records:

Word 0:		version,,length
				version is the positive version
				number of the DART that created
				this tape. Length is the length
				of the data following.

Word 1:		'DART  '	sixbit DART

Word 2:		'*HEAD*' or '*TAIL*'
				data in sixbit

Word 3:		time,date	in file system format
				Version 5: Bits 0-2 are high date.

Word 4:		ppn		the name of the person running
				Dart.

Word 5:		class,,tapno	Tape number of this tape
				Dump class of this dump


Tape numbers are kept only for system  class  dumps.  User  class  is
class  0.   Classes  1  and  2  are  system  classes  (Temporary  and
Permanent).


File-Start Records
Word 0:		-n,,length	-n denotes file-start records.
				length is the number of data words
				that follow. N is the tape format
				number.

Word 1:		devnam		name of the source device

Word 2-21			file retrieval of this file as it
				appeared on the disk.

word 22-length			data from the file.

word length+1			exclusive or of words 1-length.

word length+2			if this is 0, skip to next record.
				if this is <0, threat as word 0 above.


File continuation Record
word 0		0,,length	length is the number of data words

words 1-length			data from the file

word length+1			xor of words 1-length above

word length+2			same as in File-start record.


If  a  file start is seen, then at least all of the retrieval data is
present in the current magtape record.

Tape formats (IOVER):
1.	As above
2.	As above, except word xx of the retrieval is the record offset.

$
	SUBTTL	FLAG BIT DEFINITIONS
;RIGHT SIDE

SDEF	ALLFLG,1			;* HAS BEEN SEEN IN A SIXBIT TERM
SDEF	ALLFIL,2			;* SEEN FOR FILE NAME
SDEF	ALLEXT,4			;* SEEN FOR FILE EXTENSION
SDEF	ALLPRJ,10			;* SEEN FOR PROJECT NAME
SDEF	ALLPRG,20			;* SEEN FOR PROGRAMMER NAME
SDEF	SCANON,40			;WE HAVE DONE A RESCAN
SDEF	MRUNCM,100			;WE HAVE SEEN A MONITOR LEVEL RUN COMMAND
SDEF	ABFILE,200			;ADVANCE/BACKSPACE FILE - NOT RECORD
SDEF	ADVCOM,400			;ADVANCE - NOT BACKSPACE COMMMAND
SDEF	PURCOM,400			;PURGE COMMAND - NOT PDUMP OR FDUMP
SDEF	INDON,1000			;SET WHILE WE ARE READING AN INDIRECT COMMAND
SDEF	INDEOF,2000			;SET WHEN EOF SEEN ON INDIRECT FILE.
SDEF	LSTON,4000			;SET WHILE WE ARE DOING A LIST OPERATION
SDEF	LSTTTY,10000			;SET IF LISTING DEVICE IS A TTY.
SDEF	MTAEOT,20000			;SET IF WE READ LOGICAL END OF TAPE
SDEF	SAFETY,40000			;SET WHILE WE DO A SAFETY LOOKUP
SDEF	LOOKDN,100000			;A LOOKUP HAS BEEN DONE (OTHERWISE MTAPE)
SDEF	FULL,  200000			;FULL DUMP REQUIRED
SDEF	PCLASS,400000			;PERMANENT CLASS DUMP

SDEF	ALLMSK,ALLFIL!ALLEXT!ALLPRG!ALLPRJ	;MASK FOR ALL WILD SPECS.

;LEFT SIDE
SDEF	IGNEOT,     1			;IGNORE EOT WHILE READING/WRITING
SDEF	MCLOSE,     2			;AN OUTPUT CLOSE ON THE MTA HAS JUST BEEN DONE.
SDEF	UFDEOF,     4			;EOF SEEN ON CURRENT UFD.
SDEF	DEOF,      10			;EOF ON DART.DAT IN MERGE (ARCHIVE/LOCATE)
SDEF	DNEED,     20			;NEED A NEW RECORD FROM DART.DAT WHEN CLEAR!
SDEF	TEOF,      40			;EOF SEEN ON TAPE-FILE IN MERGE
SDEF	AEOF,      40			;EOF SEEN ON ARC FILE (ARCHIVE/LOCATE)
SDEF	TNEED,    100			;NEED DATA FROM TAPE FILE WHEN BIT CLEAR!
SDEF	ANEED,    100			;NEED DATA FROM ARC-FILE WHEN BIT CLEAR!
SDEF	RDHACK,   200			;HACK TO SUPPRESS TAPE HEADER TYPE OUT
SDEF	MOUNT,    400			;SET WHEN WE REQUIRE MT MOUNT OPERATION.
SDEF	UDPGO,   1000			;CURRENT TRANSFER IS USING THE UDP
SDEF	DMEMRA,  2000			;STATE MEMORY FILE (DART.MEM) IS OPEN RA
SDEF	L.NOD,   4000			;NODUMP COMMAND (NOT DUMP)
SDEF	L.WLDS, 10000			;WILD STRUCTURE IN LOCATE
SDEF	L.TURK,	20000			;TURKEY COMMAND, P OR T OK FOR GETANS
					;ALSO FLAGS OLD .EUQ FILE PICKUP IN PRESTORE
SDEF	L.PUMP, 40000			;PUMPKIN COMMAND, /SWITCH OK IN SCAN
					;ALSO FLAGS PLIST (VS. PRESTORE)
SDEF	L.SWIT,100000			;NOW PARSING /SWITCH IN SCAN
SDEF	L.BOTH,200000			;FOUND SAME FN IN DAT AND ARC

;FREE STORAGE PARAMETERS
SDEF	FSDEV,0				;DEVICE NAME
SDEF	FSNAM,1				;FILE NAME
SDEF	FSEXT,2				;FILE EXTENSION,,FLAGS
SDEF	FSPPN,3				;FILE PPN
SDEF	FSLEN,4				;SIZE OF AN FS. BLOCK.

;DEVCHR BITS	LEFT SIDE
SDEF	TTYBIT,10			;DEVICE IS A TTY
SDEF	DIRBIT,4			;DEVICE HAS A DIRECTORY.
SDEF	DEVDSK,200000
IFN UDPSW,<
SDEF	DEVUDP,100000			;DEVICE IS A UDP
>
	SUBTTL	COMMAND SYNTAX

COMMENT $

EVERY COMMAND IS A SINGLE LINE. THE FIRST THING ON THE LINE IS 
A COMMAND NAME. ALL COMMANDS MUST TERMINATE WITH A CRLF.
COMMAND NAMES MAY BE ABBREVIATED DOWN TO THE MINIMUM UNIQUE NAME.
PARAMETERS WITHIN A COMMAND CANNOT BE ABBREVIATED (E.G. 'RECORD' IN
AN ADVANCE OR BACKSPACE COMMAND, OR A DEVICE NAME ANYWHERE).

COMMANDS ARE:

DUMP  		;DUMP FILES FOR A USER
RESTORE		;RESTORE FILES FOR A USER
TURKEY		;TELL WHO LAST USED A DART TAPE
PUMPKIN		;ASK GREAT PUMPKIN TO RESTORE FILE

MRESTO		;MAJOR RESTORE  - PRIVILEGED
FDUMP 		;FULL DUMP    -   PRIVILEGED
PDUMP 		;PERMANENT DUMP - PRIVILEGED
TDUMP 		;TEMPORARY DUMP - PRIVILEGED

PICKUP		;PICKUP LAST COMMAND AFTER A CRASH
REWIND		;REWIND
ADVANCE		;ADVANCE FILE OR RECORD
BACKSPACE	;BACKSPACE FILE OR RECORD
LIST  		;LIST THE TAPE
LOCATE		;LOCATE WHERE THE NAMED FILES WERE DUMPED
EOT   		;ADVANCE TO END OF TAPE

IF THE DEVICE NAME IS OMITTED, MTA0 IS ASSUMED.

REWIND    {<DEV>{:~~
EOT	  {<DEV>{:~~

ADVANCE   {FILE|RECORD~{<DEV>{:~~{<COUNT>~
BACKSPACE {FILE|RECORD~{<DEV>{:~~{<COUNT>~

LIST      {<DEST>_~{<DEV>:~

DUMP      {<DEST>_~<SOURCE>
RESTORE   {<DEST>_~<SOURCE>
PUMPKIN   {/<SWITCH>~{<DEST>_~<SOURCE>

FDUMP	  {<DEV>:~
TDUMP	  {<DEV>:~
PDUMP	  {<DEV>:~

MRESTO
PICKUP

LOCATE	<SOURCE>

TURKEY	P<NUMBER> | T<NUMBER>

<SOURCE>   {{<DEV>:~{[<PRJ>,<PRG>]~@~
		{<DEV>:~{<FILENAME>{.<EXT>~~{[<PRJ>,<PRG>]~{,<SOURCE>~

<DEST>  {<DEV>:~{<FILENAME>{.<EXT>~~{[<PRJ>,<PRG>]~

<COUNT>	 <NUMBER>

<SWITCH>  P<NUMBER> | T<NUMBER> | <DATE>
<DATE>  <DAY>-<MONTH>{-<YEAR>~ | <NMONTH>/<DAY>{/<YEAR>~
<DAY>  <NUMBER>
<NMONTH>  <NUMBER>
<MONTH>  <NMONTH> | JAN | FEB | ... | DEC
<YEAR>  <NUMBER>

<NUMBER>  "STRING OF DECIMAL DIGITS"

THE FOLLOWING TERMS ARE DEFINED BY COMMON USAGE:
<FILENAME>
<EXT>
<PRJ>
<PRG>
<DEV>

$
	SUBTTL	MAGTAPE PARAMETERS
;EVERYTHING YOU WANTED TO KNOW ABOUT MAGTAPES BUT WERE AFRAID TO ASK
;MTAPES:
OPDEF	MTNOOP	[MTAPE	0]		;NO OPERATION. WAIT FOR CONTROLLER TO FINISH
OPDEF	REWIND	[MTAPE	1]		;REWIND THE TAPE TO LOAD POINT
OPDEF	BACKR	[MTAPE	7]		;BACKSPACE RECORD
OPDEF	BACKF	[MTAPE	17]		;BACKSPACE FILE.
					;PUTS TAPE AT LOAD POINT OR IN FRONT 
					;OF EOF OF PREVIOUS FILE
OPDEF	SKIPR	[MTAPE	6]		;ADVANCE RECORD
OPDEF	SKIPF	[MTAPE	16]		;ADVANCE FILE
OPDEF	WREOF	[MTAPE	3]		;WRITE END OF FILE
OPDEF	WBLANK	[MTAPE	13]		;WRITE 3 INCHES OF BLANK TAPE.
OPDEF	SKIPT	[MTAPE	10]		;SKIP TO END OF TAPE
					;STOPS AFTER 2 EOFS OR AN EOF AFTER EOT MARK

;IO STATUS BITS

SDEF	IOIMPM,400000			;WRITE LOCKED OR CONTROLLER ILLEGAL OPERATION
SDEF	IODERR,200000			;DATA MISSED, TAPE IS BAD OR CONTROLLER HUNG
SDEF	IODTER,100000			;PARITY ERROR
SDEF	IOBKTL,40000			;RECORD READ EXCEEDS BUFFER SIZE
SDEF	IOEOF,20000			;EOF MARK SEEN
SDEF	IOACT,10000			;DEVICE IS ACTIVE
SDEF	IOBOT,4000			;LOAD POINT
SDEF	IOTEND,2000			;TAPE END
SDEF	IOPAR,1000			;PARITY. 0=ODD, 1=EVEN
SDEF	DEN800,600			;DENSITY = 800
SDEF	DEN556,400			;DENSITY = 556
SDEF	DEN200,200			;DENSITY = 200
SDEF	IONRCK,100			;SUPRESS ERROR RETRIES
SDEF	IOWC,20				;INHIBIT SYSTEM COPUTATION OF OUTPUT WC
SDEF	IMODE,10			;IMAGE MODE
	SUBTTL	DISK PARAMETERS  (STANFORD)
;	EVERYTHING YOU WANTED TO KNOW ABOUT THE DISK BUT WERE AFRAID TO ASK

SDEF	DDNAM,0		;.RBNAM		;FILE NAME
SDEF	DDEXT,1		;.RBEXT		;EXT,,CREATION DATE (AND HIGH DATE)
SDEF	DDPRO,2		;.RBPRV		;PROTECTION, MODE, TIME & DATE
SDEF	DDPPN,3		;.RBPPN		;PPN OF FILE OWNER
SDEF	DDLOC,4		;--		;LOCATION OF FIRST BLOCK OF THIS GROUP
SDEF	DDLNG,5		;.RBSIZ		;+LENGTH OF THIS FILE IN WORDS.
SDEF	DREFTM,6	;.RBEXT (!)	;DATE OF LAST REFERENCE
SDEF	DDMPTM,7	;.RBNCA		;DUMP STATUS WORD
SDEF	DGRP1R,10	;--		;POINTER TO RECORD 1 OF GROUP 1
SDEF	DNXTGP,11	;--		;BLOCK NUMBER OF NEXT GROUP
SDEF	DSATID,12	;.RBDEV		;SATID OF THIS FILE
SDEF	DQINFO,13	;--		;START OF 5 WORDS FOR LOGIN,ETC
IFE STANSW,<
SDEF	DQAUT,15	;.RBAUT
SDEF	DQVER,16	;.RBVER
>
SDEF	DDOFFS,17			;THE OFFSET WORD (VERSION 4 TAPES)

;;NOTE: THE NON-STANFORD VERSION STORES RETRIEVAL INFORMATION ON THE TAPE
;;	IN SAIL FORMAT, RATHER THAN USING DEC'S RIB ORGANIZATION, SO THAT
;;	MAYBE SOMEDAY DART WILL BE USABLE AS A SAIL-IRCAM FILE TRANSPORTER
;;	GIVEN THEY GET 9-TRACK DRIVES OR WE GET 7-TRACK DRIVES!!  TO THIS
;;	END, THE DDOFFS WORD IS ALWAYS STORED =1 IN THE NON-SAIL VERSION.

IFN STANSW,<
;UFD ENTRY FORMAT
UNAM==0
UEXT==1
UPRO==2
ULOC==3
IFN FTLUFD,<
ULEN==4				;FILE LENGTH IN UFD
UTIME==5			;EXTENDED TIME LAST WRITTEN
UREFT==6			;REFTIME
UDMPT==7			;DMPTIME
;UNUSED==10			;(DGRP1R)
;UNUSED==11			;(DNXTGP)
;USATID==12			;DSATID
UQINFO==13; 14, 15, 16		;DQINFO
UOFFST==17			;DOFFST
>;IFN FTLUFD
>;IFN STANSW

SDEF	UFDN,20				;NUMBER OF WORDS IN A DIRECTORY ENTRY

;	BITS FOR DEVICE MODE 
SDEF	GARBIT,200			;ALLOWS ERROR RETURN FROM BAD RETRIEVAL
SDEF	DMPBIT,400			;USE 6 WORD LOOKUP/RENAME BLOCKS.


IFE STANSW,<				;ASSUME PARALLEL FEATURES DON'T EXIST ELSEWHERE
SDEF	GARBIT,0
SDEF	DMPBIT,0
>

;	BITS FOR CLOSE UUO
SDEF	NUPACC,0			;STANFORD: "DON'T UPDATE ACC" NOT AVAIL.

IFE STANSW,<
SDEF	NUPACC,110			;ELSEWHERE, "DON'T UPDATE ACCESS TIME" BITS
>

COMMENT $
	DEFINITION OF THE DDMPTM WORD

BIT	FUNCTION
0	SET BY T CLASS DUMP. CLEARED BY P CLASS.
1-3	PERMANENT DUMP COUNT.  INCREMENTED BY P CLASS DUMPS
	  (PCOUNT is a byte poiner to this field in FILINF+DDMPTM.)
4	DUMP DATE INVALID.
	  (PINVAL is a byte poiner to this field in FILINF+DDMPTM.)
5	DELETE AFTER DUMPING.  IF SET, FILE WILL BE DELETED AFTER
	  IT HAS BEEN PDUMPED TWICE.
6	DUMP NEVER.  (NON-STANFORD ONLY. UNUSED AT SAIL.)
7-8	RESERVED FOR FUTURE EXPANSION
9-20	TAPE NUMBER OF THE MOST RECENT DUMP TAPE.
	  (PTAPEN is a byte poiner to this field in FILINF+DDMPTM.)
21-35	DUMP DATE - 15 BIT SYSTEM FORMAT DATE OF THIS DUMP.
	  (PDDATE is a byte poiner to this field in FILINF+DDMPTM.)

IFE STANSW, BIT 6 MEANS DUMP NEVER.  IFN STANSW, 400 BIT IN PROTECTION
CODE MEANS DUMP NEVER, BUT WE CAN'T USE THAT BECAUSE IT REALLY MEANS
SOMETHING IN THE DEC MONITOR.  THIS IS WHY I USE THE NONPRIVILEGED
CUSTOMER RIB WORD INSTEAD OF THE PRIVILEGED ONE, SO PEOPLE CAN SET THE
DUMP NEVER BIT.
$
; DO NOT X NDFAIL this page, otherwise FAIL will blow up!!  (DATA)

	SUBTTL	DATA STORAGE

CRESTA:	RESTAR			;UNEXPECTED EOT GOES JRST @CRESTA
				;PRESTORE CHANGES IT TO PRUEOT
CREST1:	RESTAR			;ILLEGAL TAPE FORMAT GOES JRST @CREST1
				;PRESTORE CHANGES IT TO PRPOSN

SDEF	INFOSIZ,20		;SIZE OF IMPORTANT PART OF RETRIEVAL
SDEF	RECSIZ,2400		;MAX SIZE OF RECORDS ON TAPE

IFE STANSW,<
DEFINE LKDEF(XX)<
SDEF(XX,.-LKBLK)
0>

LKBLK:	LKLEN-1
LKDEF(.RBPPN)
LKDEF(.RBNAM)
LKDEF(.RBEXT)
LKDEF(.RBPRV)
LKDEF(.RBSIZ)
LKDEF(.RBVER)
LKDEF(.RBSPL)
LKDEF(.RBEST)
LKDEF(.RBALC)
LKDEF(.RBPOS)
LKDEF(.RBFT1)
LKDEF(.RBNCA)
LKDEF(.RBMTA)
LKDEF(.RBDEV)
LKDEF(.RBSTS)
LKDEF(.RBELB)
LKDEF(.RBEUN)
LKDEF(.RBQTF)
LKDEF(.RBQTO)
LKDEF(.RBQTR)
LKDEF(.RBUSD)
LKDEF(.RBAUT)
SDEF(LKLEN,.-LKBLK)

GOBBLK:	0		;GOBSTR ARG BLOCK
	-1
	0

STRUCT:	0		;STRUCTURE NOW BEING DUMPED
SYSPPN:	0		;PPN FOR SYS DEVICE
ERSPPN:	0		;PPN EQUIVALENT FOR ERSATZ DEVICE IN LOCATE

UFDEBK:	LKLEN-1		;ENTER BLOCK FOR MAKING A UFD
	1,,1		;.RBPPN
REPEAT .RBSTS-.RBNAM,<
0>
	400000		;.RBSTS
	0
	0
	377777,,777777	;.RBQTF
	377777,,777777	;.RBQTO
	0
	0
	0
>;IFE STANSW

IFN STANSW,<
PROPRV==<100000,,0>
REAPRV==< 40000,,0>
WRTPRV==< 20000,,0>
AAOPRV==< 10000,,0>
INFPRV==<    20,,0>

DUMPRV:	PROPRV!REAPRV!WRTPRV!INFPRV	;PRIVS REQUIRED BY THE SYSTEM DUMPER
DUMPER:	'DMPSYS'		;AT STANFORD THE DUMPER'S NAME
GOD:	'  1  1'		;AT STANFORD THE GUY WITH ALL THE UFDS
RDOFFS:	'GODMOD'		;STANFORD READ FILE OFFSET
	20			;OPCODE
	0			;OFFSET NUMBER HERE (1=NORMAL)
	0			;ACTUAL FILE LENGTH IN WORDS
WROFFS:	'GODMOD'		;WRITE FILE OFFSET
	21			;OPCODE
	0			;SET TO DESIRED OFFSET (1=NORMAL)
>

IFE STANSW,<
DUMPER:	1,,2			;EVERYWHERE ELSE THE DUMPER IS 1,2
GOD:	1,,1			;HOW THEY SPELL ONE OF THE 9 BILLION NAMES OF GOD
>
UUOCON:	0
	JRST	.UUCON		;CALL UUO ROUTINE.

CRLF:	BYTE(7)15,12
PDLIST:	BLOCK	PDLEN

ONEPPN:	0			;THE ONE PPN THAT IS BEING SCANNED FOR WILD FILE
MFDPTR:	0			;IOWD TO INCORE COPY OF MFD

INVERS:	0			;INPUT TAPE VERSION NUMBER.
TAPCLS:	0			;

FSPTR:	0			;POINTER TO LAST TERM
DEST:	0			;POINTER TO DESTINTATION TERM
TBASE:	0			;POINTER TO BASE OF SOURCE TERMS.

DEFDEV:	0			;DEFAULT DEVICE SET BY DEV:@FILE
DEFPPN:	0			;DEFAULT PPN SET BY [P,PN]@FILE

IDEV:	0			;INDIRECT DEVICE
INAM:	0			;INDIRECT NAME
IEXT:	0			;INDIRECT EXTENSION
IPPN:	0			;INDIRECT PPN

FDEV:	0			;DEVICE
FNAM:	0			;NAME
FEXT:	0			;EXTENSION
FPPN:	0			;PPN

STKPPN:	0			;SAVE THE STICKY PPN HERE.
STKDEV:	0			;SAVE THE STICKY DEVICE HERE.
STKBIT:	0			;SAVE [*,*] BITS HERE

	0			;EXTRA CELL FOR MTDEV BLOCK. - USED IN DUMPGO
MTDEV:	0			;NAME OF MAG TAPE FOR DUMP.
MTNAM:	0			;FILE NAME ON MAGTAPE
MTEXT:	0			;FILE EXTENSION ON MAGTAPE
MTPPN:	0			;FILE PPN ON MAGTAPE

	0			;EXTRA CELL FOR RSTDEV BLOCK - USED IN RESTGO
RSTDEV:	0			;DEVICE TO RESTORE ONTO
RSTNAM:	0			;FILE NAME TO RESTORE ONTO
RSTEXT:	0			;FILE EXTENSION TO RESTORE ONTO
RSTPPN:	0			;FILE PPN TO RESTORE ONTO

	0			;EXTRA CELL FOR LSTDEV BLOCK - USED IN LISTGO
LSTDEV:	0			;LISTING DEVICE
LSTNAM:	0			;LISTING FILE NAME
LSTEXT:	0			;LISTING FILE EXTENSION
LSTPPN:	0			;LISTING FILE PPN.

FILBLK:	BLOCK	UFDN		;A PLACE FOR LOOKUPS/ENTERS.
LASSAV:	BLOCK	4		;NAME OF FILE THAT WAS LAST SAVED.

DSKMM0:	0
DSKMM1:	0
DSKMM2:	0
DSKMM3:	0			;FLAG FOR ASCII/BINARY
XDMPUT:	0			;INSTR. XCTED AT DMPUT.  USUALLY SOSGE DSKMM2


REPCNT:	0			;REPEAT COUNT FOR ADVANCE/BACKSPACE
LOGPPN:	0			;LOGGED IN NAME OF THIS USER.
USRPPN:	0			;NAME OF THIS USER
IFN DBGSW,<
DBGNTP:	1			;WHEN DEBUGGING, NONZERO TO BYPASS TAPE OUTPUT
DBGMFC:	0			;WHEN DEBUGGING, COUNTER TO LIMIT MFD READING
DBGPPN:	'DMPEJG'		;WHEN DEBUGGING, PPN DEBUG PERSON WILL USE
DEF	TAPREG,DBGPPN		;WHEN DEBUGGING, KEEP RECORDS IN DBGPPN
>;IFN DBGSW
IFE DBGSW,<
IFN STANSW,<
TAPREG:	' SSSYS'
>
IFE STANSW,<
TAPREG:	1,,2
>
>;IFE DBGSW
AMBIG:	0			;FOR DETECTING AMBIGUOUS COMMANDS AND MATCH UNDER MASK
SAVDEL:	0			;SAVE TERM DELIMITER HERE.
WC:	0			;WORD COUNT OF REMAINING SPACE IN RECORD
FWC:	0			;FILE WORD COUNT
FSIZE:	0			;FILE SIZE IN WORDS
SRCDEV:	0			;NAME OF STRUCTURE FROM WHICH MT FILE CAME.
FILINF:	BLOCK	INFOSIZ		;PARTIAL RETRIEVAL DATA OF CURRENT FILE.
QMODE:	0			;SET WHILE QUOTING SPECIAL SIXBIT CHARACTERS
CHKSUM:	0			;CHECKSUM (XOR) OF DATA WORDS
STRNAM:	0			;SAVE CURRENT STRUCTURE NAME HERE FOR READING
UNQSTR:	0			;[IRCAM] SYSTEM DUMP ON A SINGLE STR, NAME HERE
THSDAT:	0			;THE DATE TODAY IN SYSTEM FORMAT
THSDAX:	0			;THE DATE TODAY IN DAYCNT FORMAT
MTTREC:	0			;TOTAL OF ALL RECORDS WRITTEN ON MTA
MTFILN:	0			;TOTAL OF ALL RECORDS WRITTEN ON THIS MT FILE.
FIXCNT:	0

CLASS:	0			;CLASS OF DUMP. 0 = USER
TAPNO:	0			;TAPE NUMBER OF THIS TAPE.
TAPNAM:	0			;TAPE TITLE IN SIXBIT (P00001 OR T00001)
PICKON:	0			;SET TO -1 WHEN DOING A PICKUP.
MRTPNO:	0			;IN MRESTORE, OPR TELLS PGM WHICH TAPE TO USE
STAPNO:	0			;IN MRESTORE, SAVE CURRENT TAPNO IN FUNNY FORMAT

DATDAT:	0			;EXT,,DATE OF ALLDIR.DAT, SET BY DMPSTR FOR MERGE
SPPN:	0			;IN SPLIT, PPN FROM ALLDIR.MEM
SNAME:	0			;IN SPLIT, FILE NAME FROM ALLDIR.MEM
SEXT:	0			;IN SPLIT, EXT FROM ALLDIR.MEM
DTAPPN:	0			;IN SPLIT, NONZERO WHEN SPPN=NEW PPN FOR DTAPES.DAT
TRANGE:	0			;IN MERGE, DISP. INTO TTBUF OF CURRENT TAPE RANGE
TNAME:	0			;IN MERGE. UFD NAME FROM TAPE FILE.
ANAME:	0			;IN LOCATE UFD NAME FROM ARC
AEXT:	0
DNAME:	0			;IN MERGE, UFD NAME FROM DART.DAT
DEXT:	0			;IN LOCATE EXT FROM DAT
DNAMEO:	0			;IN ARCHIVE, UFD NAME FROM/TO DAT FILE.
MEMWC:	0			;IN MERGE, -WC REMAINING IN  TAPE FILE.
MEMWC1:	0			;IN MERGE, BYTE POINTER TO IN CORE BUFFER.
MEMWC2:	0			;IN MERGE, -WC REMAINING IN TAPE FILE BUFFER.
TPTR:	0			;IN MERGE, -WC,,MA OF TAPE FILE DATA IN CORE.
MTAPNO:	0			;IN MERGE, TAPE NUMBER + IF TEMPORARY THEN 400000
TNX:	0			;IN MERGE, SPECIAL VERSION OF TNAME
DNX:	0			;IN MERGE, SPECIAL VERSION OF DNAME
MMNAM:	0			;IN MERGE, NAME OF FILE FROM DART.DAT
MMEXT:	0			;IN MERGE, EXT OF FILE FROM DART.DAT
MMDAT:	0			;
MJBFF:	0			;IN MERGE, LOC OF DATA FROM DART.DAT
TNWRM1:	0			; TNWRIT POINTER
TNWRM2:	0			; TNWRIT COUNTER
ALLSIZ:	0			; SIZE (IN WORDS) OF CURRENT ALLDIR.MEM
TTNAM:	0
TTEXT:	0			;IN ARCHIVE..
LQUIET:	0			;FLAGS WHETHER OR NOT TO PRINT IN LOCATE
RELMCT:	0			;COUNT ACCESS FAILURES IN ALLMEM.
PPURGE:	0			;IF SET TO -1, THIS IS A PHONY PURGE
TAPWFL:	0			;Flag for TAPHED/TAPTAI to check for write lock

DEVNAM:	0			;DISK STRUCTURE NAME FOR INPUT OR OUTPUT
IFN STANSW,<
SDEF(STRUCT,DEVNAM)		;ONLY ONE STRUCTURE
>

	[ASCIZ/ UNKNOWN /]
CLNAM:	[ASCIZ/ USER /]
	[ASCIZ/ TEMPORARY /]
	[ASCIZ/ SYSTEM PERMANENT /]
SDEF	CLMAX,.-CLNAM


TOBUF:	400000,,MBUF1+1		;HERE IS WHAT WE INITIALIZE THE BUFFERS TO.
	POINT	36,0,35		;THIS IS THE BYTE SIZE
	0			;THIS IS WHERE THE WORD COUNT GOES

TIBUF:	400000,,MBUF1+1		;HERE IS WHAT WE INITIALIZE THE BUFFERS TO.
	POINT	36,0,35		;THIS IS THE BYTE SIZE
	0			;THIS IS WHERE THE WORD COUNT GOES

FIBUF:	BLOCK	3
FOBUF:	BLOCK	3
INDRBF:	BLOCK	3
LSTBUF:	BLOCK	3
UFDBUF:	BLOCK	3

;BYTE POINTERS
PDATE:	POINT	12,FILINF+DDPRO ,35	;CREATION DATE FROM PROTECTION WORD
PDATEH:	POINT	 3,FILINF+DDEXT ,20	;HIGH BITS OF CREATION DATE
PCOUNT:	POINT	 3,FILINF+DDMPTM, 3	;DUMP COUNT FROM DUMP WORD
PTAPEN:	POINT	12,FILINF+DDMPTM,20	;TAPE NUMBER FROM DUMP WORD
PDDATE:	POINT	15,FILINF+DDMPTM,35	;DUMP DATE IN DUMP WORD
PINVAL:	POINT	 1,FILINF+DDMPTM, 4	;DATE DUMPED INVALID BIT (20000 LEFT)

MONTAB:	ASCII	/Jan-/
	ASCII	/Feb-/
	ASCII	/Mar-/
	ASCII	/Apr-/
	ASCII	/May-/
	ASCII	/Jun-/
	ASCII	/Jul-/
	ASCII	/Aug-/
	ASCII	/Sep-/
	ASCII	/Oct-/
	ASCII	/Nov-/
	ASCII	/Dec-/

IFN STANSW,<			;BLOCK FOR ABSOLUTE MODE DISK READ.
RRD:	'GODMOD'		;FOR ABSOLUTE DISK READ
	1			;CODE FOR READ
	IOWD	20,FILINF	;THIS IS WHERE TO PUT THE DATA
RRD1:	0			;THIS IS THE TRACK NUMBER.
>

;MAGTAPE BUFFERS FOR INPUT AND OUTPUT

MBUF1:	0			;BUFFER 1 FIRST WORD UNUSED
	RECSIZ+1,,MBUF2+1
ALTBUF:	BLOCK	RECSIZ+1	;SPACE USED FOR INDIRECT BUFFERS

MBUF2:	0
	RECSIZ+1,,MBUF3+1
	BLOCK	RECSIZ+1

MBUF3:	0
	RECSIZ+1,,MBUF1+1
	BLOCK	RECSIZ+1

ALLPTR:	0			;POINTER INTO ALLBUF
REELPT:	0			;POINTER IN REELBF

TAPBLK:	BLOCK	2		;BUFFER FOR I/O TO DART.TAP
MEMBLK:	BLOCK	200		;BUFFER FOR DUMP MODE IO
ALLBUF:	BLOCK	400		;BUFFER FOR ALLDIR.DAT
				;CAUTION: ALLBUF HAS TO BE CLEARED BEFORE CALLING REELMM
				;FORMAT IS: WORD 0/ PPN
					    ;WORD 1,3,.. /FILE NAME
					    ;WORD 2,4,.. /EXT,,TAPE NUMBER
REELBF:	BLOCK	200		;REEL FILE LIST BUFFER.
				;FORMAT IS: WORD 0/ PPN
					    ;WORD 1,3,../FILE NAME
					    ;WORD 2,4,../EXT,,DATE LAST WRITTEN
DEFINE MDEF(XX)<
SDEF(XX,.-MEMSAV)
0>
MEMSAV:				;DATA TO BE SAVED FOR PICKUPS.
MDEF	(DCLASS)		;FLAGS,,CLASS
MDEF	(CHKNUM)		;CHECKPOINT NUMBER.
MDEF	(MSTRNA)		;NAME OF CURRENT STRUCTURE.
MDEF	(MMTDEV)		;DEVICE NAME OF MAGTAPE.
MDEF	(TAPNUM)		;TAPE NUMBER
MDEF	(FUSER)			;USER IN PROGRESS.
MDEF	(FFILE)			;FILE NAME FIRST DUMPED ON MTFILE
MDEF	(FFEXT)			;AS ABOVE, EXTENSION
MDEF	(LUSER)			;LAST USER NAME IN ALLDIR.
MDEF	(LFILE)			;LAST FILE SAVED IN ALLDIR
MDEF	(LEXT)			;AS ABOVE, EXTENSION.
MDEF	(PTRSAV)		;SAVE REELPTR HERE.
MDEF	(MERGFL)		;SET TO -1 AFTER A MERGE.
MDEF	(TTCNT)			;COUNTS NUMBER OF TERMS IN TTBUF
MDEF	(MTAPOS)		;MTA POSITION, FOR DISPLAYING
MDEF	(MTAPQU)		;SET TO -1 IF MTA POSITION IS QUESTIONABLE
SDEF(TTBUF,.-MEMSAV)
	BLOCK	20		;SPACE FOR TAPE TERM BUFFER
	BLOCK	3		;EMPTY SPACE TO ACCOUNT FOR DISK LOSS
SDEF(MEMLEN,.-MEMSAV)		;LENGTH OF MEMSAV

;MTA POSITION DISPLAY DATA
	RADIX	5+5
SDEF(MXINCH,556*800)		;NUMBER OF UNITS IN ONE INCH
SDEF(MXFOOT,12*MXINCH)		;NUMBER OF UNITS IN ONE FOOT
MTFOOT:	MXFOOT
MTIRGL:	3*MXINCH/4		;INTERRECORD GAP = 3/4 INCH
MTEOFL:	3*MXINCH		;EOF MARK = 3 INCHES
MT2400:	2400*MXFOOT		;WHOLE TAPE = 2400 FEET
MTALTB:	6*MXINCH/556*21/20	;556 BPI : ONE WORD = 6 FRAMES * FUDGE
	6*MXINCH/200*21/20	;200 BPI : ONE WORD = 6 FRAMES * FUDGE
	6*MXINCH/556*21/20	;556 BPI : ONE WORD = 6 FRAMES * FUDGE
	6*MXINCH/800*21/20	;800 BPI : ONE WORD = 6 FRAMES * FUDGE
	RADIX	4+4
;; THANK YOU, MR. GILBERT, FOR THE __ DEFINITIONS.


NAMSPL:	'[LIST]'		;SPOOLER'S JOB NAME AND WAKEME BLOCK.
PPNSPL:	'SPLSYS'
	0			;FOR WAKEME
SPLFOR:	'NP ',,1		;BLOCK FOR SPOOL COMMANDS. SPOOLER ID.
SPLREQ:	0			;STUFF OUR PPN HERE.
SPLJOB:	0			;STUFF LINE,,JOB NUMBER HERE.
SPLDEV:	0			;DEVICE NAME TO LOCATE FILE.
	0			;READ IN MODE 0
SPLSIZ:	0			;FILE SIZE IN RECORDS.
SPLTIM:	0			;SET DATE,,TIME
SPLNAM:	0			;SET FILE NAME
	'LST',,0		;FILE EXTENSION
	0
SPLPPN:	0			;FILE PPN.
	BLOCK 3			;3 ZEROES FOR ALIAS.
SPLBIT:	100			;NARROW TITLE.
	BLOCK 3			;NO PAGE SPECS.
SDEF(SPLLNG,.-SPLFOR)
SPLIOW:	IOWD	SPLLNG,SPLFOR	;IOWD FOR THE SPOOLER COMMAND FILE.
	0

UUOTMP:	0			;CELL FOR UUO DISPATCH


;TYPE 0=VISIBLE, 1=ENDPOINT, 2=INVISIBLE,
;MODE 1=ABSOLUTE, 0=RELATIVE.
	DEFINE	LVW(X,Y,BRIGHT,SIZE,MODE,TYPE)
<	BYTE(11)X,Y(3)BRIGHT,SIZE(1)0,MODE(2)TYPE(4)6	>
	DEFINE	CW(C1,D1,C2,D2,C3,D3)
<	BYTE(8)D1,D2,D3(3)C1,C2,C3,4>

;THE WORD AT BUFBUF IS IGNORED FOR A III PROGRAM

DDCMD:	CW(1,46,2,0,2,0)	;FUNCTION CODE - TEXT MODE, SELECT OWN CHANNEL
DDBUF:	CW(3,47,4,1,5,10)	;COLUMN 39., LINE 24.
IIIBUF:	LVW(0,700,0,0,1,2)	;ABSOLUTE INVISIBLE
DMBUF:	BYTE(7)177,14,106,142	;Column 39., line 3.

BUFBUF:	0			;Position select word(s) go here, device dependent.
	0
DDDAT:	1			;ROOM FOR 40 CHARACTERS
	1
	1
	1
	1
	1
	1
DDDEND:	1
	<BYTE(7)15,12>+1
DPYEND:	0

DPYHDR:	642000,,BUFBUF		;Overlapped, DD double-field, DM truncate, DM USERGO
	DPYEND-BUFBUF+1		;TOTAL LENGTH OF DPY PROGRAM
	0			;FLAG TO SEE IF STILL IN PROGRESS
	BUFBUF+1		;ADRESS OF LOW ORDER LINE SELECT FOR DD

LINSAV:	0			;LINE CHARACTERISTICS WORD.
DPYSXS:	0			;CHARACTER COUNT FOR DPYSIX

TPGNUM:	0			;PAGE NUMBER IN LISTING FILE
SDEF(TPBUFL,64*3*2)		;LINE/PAGE * WORDS/ENTRY * ENTRY/LINE = WORDS/PAGE
TPGPDP:	0			;AOBJN (PDL) POINTER TO PAGE BUFFER
TPGFLG:	0			;0=NORMAL, -1 = MRESTORE
TPBUF:	BLOCK	TPBUFL

IFE STANSW,<
MAXLEN:	2000*200		;DEFAULT MAXIMUM LENGTH FOR SYSTEM DUMPS (IRCAM)
>;IFE STANSW
IFN STANSW,<
MAXLEN:	42410*200		;DEFAULT MAXIMUM LENGTH FOR SYSTEM DUMPS (STANFORD)
				;42410 (17672 DECIMAL) RECORDS = 2209 KWORDS
				;...ABOUT 2/3 OF AN 800 BPI 7-TRK 2400 FOOT TAPE
>;IFN STANSW

;PARAMETERS FOR WRITING THE INDEX INTO DART.DAT (MERGE/ARCHIVE OUTPUT FILE)
DATWC:	0
IDXPDP:	0
IDXPDL:	BLOCK	200

;PARAMETERS FOR WRITING THE INDEX INTO DART.ARC (ARCHIVE OUTPUT FILE)
ARCWC:	0
ADXPDP:	0
ADXPDL:	BLOCK	200

;PARAMETERS FOR SKIPPING THE INDEX PORTION ON INPUT OF DART.DAT
LSTRPP:	0			;LAST PPN READ FROM FILE
LSTIPP:	0			;LAST PPN READ FOUND IN INDEX.

;PARAMETERS FOR SKIPPING THE INDEX PORTION ON INPUT OF DART.ARC
ALTRPP:	0			;LAST PPN READ FROM FILE
ALTIPP:	0			;LAST PPN READ FOUND IN INDEX.

;IN LOCATE, AOBJN POINTERS TO INDEX DATA THAT'S IN CORE
DATIDX:	0
ARCIDX:	0

;MRESTORE COMMAND
MRBASE:	0
MRSTDV:	0
MRSTNM:	0
MRSTET:	0
MRSTPN:	0

;NODUMP, REAP COMMANDS (SET/CLEAR BIT PER FILE)
NODDSP:	0			;ADDR OF COMMAND-SPECIFIC ROUTINE

;PUMPKIN COMMAND
SWITCH:	0
DAY:	0
MONTH:	0
YEAR:	0
PBASE:	0
DEF(PFILES,200)			;MAX NUMBER OF FILES WE CAN RESTORE
DEF(PDEV,0)				;FORMAT OF P BLOCK
DEF(PNAME,1)
DEF(PEXT,2)
DEF(PPPN,3)
DEF(PTPDT,4)			;TAPE,,DATE
DEF(PSIZE,5)			;WORDS PER FILE BLOCK
PIOWD:	0			;WILL GET IOWD FOR OUTPUT
	0
LOCLUK:	BLOCK 4
TAPES:	0			;POINTER TO HEAD OF PRESTORE TAPES LIST
RTAPES:	0			;POINTER TO ORIGINAL LIST HEAD
TRMCNT:	0			;HOW MANY TERMS TO RESTORE IN THIS TAPE
LASTW:	0			;BACK POINTER FOR TERM LIST
OWNER:	0			;-1 IF HAVE OWNER ACCESS TO FILE
PRIVS:	0			;OUR PRIVILEGES
UPPN:	0			;OUR PPN
UPRG:	0			;OUR PRG
ALIAS:	0			;OUR DSKPPN
PRUIOW:	0			;IOWD FOR MAILING TO LUSER
	0			;END OF IO CMD LIST
PRUFNM:	0			;UNIQUE FN FOR MAIL GOES HERE
DDTADR:	0			;DDT START ADDR
DDTSVA:	0			;AC SAVE WORDS FOR DDT ENTRY
DDTSVB:	0
PRSAVP:	0			;SAVED PDL FOR EMERGENCY UNWIND DURING PRESTORE
PREQTP:	0			;REQUIRED TAPE NUMBER, FOR HEADER CHECK
UNP2QF:	0			;-1 WHILE READING EUQ FOR UNPUMPKIN
PUMWIZ:	0			;-1 ON BAD FORMAT TAPE DURING PRESTORE
PREALW:	0			;SAVED W (TERM BLOCK) MATCHING FILE IN PRESTORE
PRLSTW:	0			;SAVED LASTW DITTO
PMULTF:	0			;-1 IF THIS FILE MATCHES 2 TERM BLOCKS

RMDWAK:	'<RMND>'
RMDSYS:	'RMDSYS'
	0

PRVMTA:	SIXBIT /GODMOD/
	14
	IOWD 17,PRVBUF
PRVBUF:	BLOCK 13
PASWD:	0			;PASSWORD RETURNED HERE IF INF
PRIVWD:	0			;PRIVILEGES RETURNED HERE
	0			;LAST LOGIN TIME RETURNED HERE
GRPWD:	0			;GROUP ACCESS BITS RETURNED HERE

;GROUP ACCESS/PRIVILEGE BITS
;None of these symbols are actually used in the code except GROUPS and MASPRV.
;GROUPS is a fullword value but MASPRV must be right half.

DEF(REAPRV,40000)
DEF(WRTPRV,20000)
DEF(MASPRV,1)
DEF(SYSPRV,2)
DEF(SCYPRV,4)
DEF(DECPRV,10)
DEF(ACTPRV,20)
DEF(CSPPRV,40)

DEF(GROUPS,47)		;ALL OF THE ABOVE.

DEF(FSPNAM,FSLEN)	;EXTENSION TO TERM BLOCKS
DEF(FSPEXT,FSLEN+1)
DEF(FSPPPN,FSLEN+2)
DEF(FSPREQ,FSLEN+3)	;EXTRA WORD FOR REQUESTOR'S PPN
DEF(FSPDAT,FSLEN+4)	;DATE OF REQUEST
DEF(FSPLEN,FSLEN+5)	;EXTENDED LENGTH

REGRST:	RSTNAM		;OUTPUT NAME LOCATION
	RSTEXT		;OUTPUT EXT LOCATION
	RSTPPN		;OUTPUT PPN LOCATION
	ADDI W,FSLEN	;POINT W TO NEXT BLOCK
	CAMGE W,FSPTR	;END TEST FOR INPUT TERMS
	JFCL		;NO-OP FOR NORMAL BLT TO ELIMINATE TERM
	CAIA		;ANY TERM BLOCK OK FOR NORMAL RESTORE
	CAMGE W,FSPTR	;TEST FOR EMPTY TERM LIST SAME AS END TEST
	PUSHJ P,LCHECK	;WHAT TO DO IF FILE ALREADY EXISTS
	CAIA		;SKIP IFF REGULAR RESTORE

PUMRST:	FSPNAM(W)	;OUTPUT NAME LOCATION
	FSPEXT(W)	;OUTPUT EXT LOCATION
	FSPPPN(W)	;OUTPUT PPN LOCATION
	HRRZ W,(W)	;POINT W TO NEXT BLOCK
	SKIPE W		;END TEST FOR INPUT TERMS
	JRST PREKIL	;LEAVE MAIN RESTORE CODE TO LINK OUT TERM
	SKIPGE FSPREQ(W);SKIP IF THIS TERM BLOCK STILL UNRESTORED
	SKIPLE TRMCNT	;TEST FOR NO TERMS LEFT IN PRESTORE TAPE LIST
	PUSHJ P,PFILEX	;WHAT TO DO IF FILE ALREADY EXISTS
	JFCL		;SKIP IFF REGULAR RESTORE

DEF(R.NAM,0)		;POINTERS INTO ABOVE
DEF(R.EXT,1)
DEF(R.PPN,2)
DEF(R.NXT,3)
DEF(R.END,4)
DEF(R.BLT,5)
DEF(R.NULP,6)
DEF(R.EMPT,7)
DEF(R.SAFE,10)
DEF(R.REGP,11)

PLBUF:	BLOCK 20	;TEXT BUFFER FOR ONE LINE OF PLIST OUTPUT

DEF(PUMNUM,200)		;HOW MANY REQUESTS CAN WE UNDELETE
UNPUTR:	BLOCK PUMNUM	;TABLE OF POINTERS TO USER'S REQUESTS FOR UNPUMPKIN
UNPBUF:	BLOCK 200	;BUFFER FOR ONE DISK RECORD OF .QUE FILE

PATCH:	BLOCK	20
PATCH1:	BLOCK	20
PATCH2:	BLOCK	20
PATCH3:	BLOCK	20
;NOCORE NODEV NODEV0 NODEV1 NOLOOK NOMTA ILLPPN ALLIND ALLDEV SYNTAX ILLFMT ALLLST NOENT LSTERR INDERR UFDRER NOPRV PURERR NOTDSK

	SUBTTL	ERROR MESSAGES
NOCORE:	OUTSTR	[ASCIZ/Can't get enough core.
/]
	JRST	RESTAR

NODEV:	OUTSTR	[ASCIZ/OPEN failed on device /]
	PUSH	P,A
	PUSH	P,B
	PUSH	P,C
	JUMPE	B,NODEV1
	MOVE	A,B
	PUSHJ	P,SIXOUT
NODEV0:	OUTSTR	[ASCIZ/:  Called from: /]
	HRRZ	A,-3(P)
	PUSHJ	P,DISLOC
	OUTSTR	[ASCIZ/
/]
	JRST	RESTAR

NODEV1:	OUTSTR	[ASCIZ/
Device name is blank.  See if you can locate a wizard.
/]
	HALT	NODEV0

NOLOOK:	OUTSTR	[ASCIZ/LOOKUP failure on /]
	PUSHJ	P,TYFIL
	OUTSTR	CRLF
	JRST	RESTAR

NOMTA:	OUTSTR	[ASCIZ/Can't INIT magtape
/]
	JRST	RESTAR

ILLPPN:	OUTSTR	[ASCIZ/Illegal PPN
/]
	JRST	RESTAR

ALLIND:	OUTSTR	[ASCIZ/"*" specification in the name of an indirect file is illegal
/]
	JRST	RESTAR

ALLDEV:	OUTSTR	[ASCIZ/Device "*" illegal
/]
	JRST	RESTAR

SYNTAX:	OUTSTR	[ASCIZ/Improper syntax in command
/]
	JRST	RESTAR

ILLFMT:	OUTSTR	[ASCIZ/Illegal tape format.  This doesn't look like a DART tape.
Try a BACKSPACE command to position the tape, or an ADVANCE command
to skip the bad part.
/]
	JRST	@CREST1

ALLLST:	OUTSTR	[ASCIZ/"*" in the name of a listing file is illegal.
/]
	JRST	RESTAR

NOENT:	OUTSTR	[ASCIZ/ENTER failed
/]
	JRST	RESTAR

LSTERR:	OUTSTR	[ASCIZ/IO error on listing file.
/]
	JRST	RESTAR

INDERR:	OUTSTR	[ASCIZ/Output error on archive file.
/]
	JRST	RESTAR

UFDRER:	OUTSTR	[ASCIZ/UFD read error.
/]
	JRST	RESTAR

NOPRV:	OUTSTR	[ASCIZ/You are not privileged to do
FDUMP, PDUMP, TDUMP, PURGE, PRESTORE, or MRESTORE commands.
/]
	JRST	RESTAR

PURERR:	OUTSTR	[ASCIZ/PURGE command requires an argument list
/]
	JRST	RESTAR

NOTDSK:	OUTSTR	[ASCIZ/Illegal source device /]
	MOVE	A,B
	PUSHJ	P,SIXOUT
IFE UDPSW,<	OUTSTR	[ASCIZ/:  only DSK is legal.
/]>
IFN UDPSW,<	OUTSTR	[ASCIZ/:  ONLY DSK AND UDP ARE LEGAL.
/]>
	JRST	RESTAR
;DPYSER DPYFIL DPYFL1 DPYPPN DPYPPR DPYSIX DPYSX1 DPYDEC DPYPPO DPYOCT DPYSER

	SUBTTL	DISPLAY SERVICE
;CALL WITH:
;	PUSHJ	P,DPYSER
;	DATA,,ROUTINE
;ROUTINE WILL BE CALLED WITH A PUSHJ P, WITH C CONTAINING DATA ADRESS AND D BYTE PTR

IFN STANSW!IRCPPN,<
DPYSER:	SKIPE	LINSAV			;SKIP IF NO DPY.
	SKIPE	DPYHDR+2		;DPY. SKIP IF DD/DM DONE.
	JRST	CPOPJ1			;DO NOTHING IF NOT DPY OR DD/DM BUSY
	MOVEI	A,1
	MOVEM	A,DDDAT			;CLOBBER TEXT AREA TO NULLS
	MOVE	A,[DDDAT,,DDDAT+1]
	BLT	A,DDDEND		;...
	MOVE	D,[POINT 7,DDDAT]	;SET UP BYTE POINTER
	MOVE	B,TAPNAM
	MOVEI	A,6
	PUSHJ	P,DPYSIX
	MOVEI	A," "
	IDPB	A,D
	MOVEI	A,"  "
	SKIPE	MEMSAV+MTAPQU		;SKIP IF MTA POSITION IS NOT QUESTIONABLE
	MOVEI	A,"+?"			;IF QUESTIONABLE, PREFIX OUTPUT WITH "?+"
	IDPB	A,D
	LSH	A,-7
	IDPB	A,D
	MOVE	A,MEMSAV+MTAPOS		;PICK UP MTA POSITION
	ADD	A,[6*MXINCH]		;ADD 6 INCHES FOR ROUNDING
	IDIV	A,MTFOOT		;GET FEET (REMAINDER IN B)
	JUMPGE	A,.+2
	MOVEI	A,0
	RADIX	5+5
	CAIL	A,9999			;MORE THAN 9999 FEET???
	MOVEI	A,9999
	RADIX	4+4
	PUSHJ	P,DPYDEC		;PUT OUT POSITION IN DECIMAL
	MOVEI	A," "
	IDPB	A,D
	MOVEI	A,"f"
	IDPB	A,D
	MOVEI	A,"t"
	IDPB	A,D
	MOVEI	A,"."
	IDPB	A,D
	MOVEI	A," "
	IDPB	A,D
	HLRZ	C,@(P)			;GET DATA ADDRESS
	HRRZ	A,@(P)			;GET ROUTINE ADDRESS
	PUSHJ	P,(A)
	UPGIOT	DPYHDR			;DISPLAY STUFF
	JRST	CPOPJ1			;RETURN

DPYFIL:	MOVE	B,(C)			;GET FILE NAME
	MOVEI	A,6			;NUMBER OF CHARACTERS
	PUSHJ	P,DPYSIX
	HLLZ	B,1(C)
	MOVEI	A,4
	JUMPE	B,DPYFL1
	MOVEI	A,"."
	IDPB	A,D
	MOVEI	A,3
DPYFL1:	PUSHJ	P,DPYSIX
	ADDI	C,3
DPYPPN:	MOVEI	A,"["
	IDPB	A,D
IFN IRCPPN,<
	MOVE B,(C)
	TLNE B,777740
	TRNN B,777740
	JRST DPYPPO			;OCTAL PPN
>;IRCPPN
	HLLZ	B,(C)
	MOVEI	A,3
IFN IRCPPN,<
	TLNE B,770000
	TLO B,400000
>;IRCPPN
	PUSHJ	P,DPYSIX
	MOVEI	A,","
	IDPB	A,D
	HRLZ	B,(C)
	MOVEI	A,3
IFN IRCPPN,<
	TLNE B,770000
	TLO B,400000
>;IRCPPN
	PUSHJ	P,DPYSIX
DPYPPR:	MOVEI	A,"]"
	IDPB	A,D
	POPJ	P,

DPYSIX:	MOVEM	A,DPYSXS		;SAVE CHARACTER COUNT.
DPYSX1:	MOVEI	A,0
	LSHC	A,6
	ADDI	A," "
	IDPB	A,D
	SOSLE	DPYSXS
	JRST	DPYSX1
	POPJ	P,

DPYDEC:	IDIVI	A,12
	HRLM	B,(P)
	JUMPE	A,.+2
	PUSHJ	P,DPYDEC
	HLRZ	A,(P)
	ADDI	A,"0"
	IDPB	A,D
	POPJ	P,

IFN IRCPPN,<
DPYPPO:	HLRZ A,(C)
	PUSHJ P,DPYOCT
	MOVEI A,","
	IDPB A,D
	HRRZ A,(C)
	PUSHJ P,DPYOCT
	JRST DPYPPR

DPYOCT:	IDIVI	A,10
	HRLM	B,(P)
	JUMPE	A,.+2
	PUSHJ	P,DPYOCT
	HLRZ	A,(P)
	ADDI	A,"0"
	IDPB	A,D
	POPJ	P,

>;IRCPPN

>;IFN STANSW!IRCPPN
IFE STANSW!IRCPPN,<
DPYSER:	JRST	CPOPJ1
SDEF(DPYFIL,0)
SDEF(DPYPPN,0)
;;THANK YOU, MR. GORIN, FOR THESE UNDEFINED SYMBOLS
>;IFE STANSW!IRCPPN
;FILINF WC FSIZE DUMP DUMP0 DUMP1 DUMP3 DUMP4 DXTAB DUMPX0 DUMPX1 DUMPX2 DUMPX3 DUMPXX TAPHED TAPTAI TAPHD1 NXTOBF

	SUBTTL	DUMP A DATA FILE TO TAPE

COMMENT	$
FILINF:	BLOCK	20	;SET UP WITH 20 WORDS OF RETRIEVAL INFORMATION
WC:	BLOCK	1	;SET WITH WORD COUNT AVAILABLE IN THIS RECORD
FSIZE:	0		;WILL BE SET TO WORD COUNT OF FILE.

ROUTINE WILL SKIP RETURN UNLESS END OF TAPE IS FOUND.
$

DUMP:	MOVM	B,FILINF+DDLNG		;GET THE FILE WORD COUNT.
	MOVEM	B,FSIZE			;SAVE FILE SIZE IN WORDS
	MOVE	A,WC			;GET THE WORD COUNT LEFT IN RECORD
	CAILE	A,200+INFOSI+3		;ENOUGH LEFT TO MAKE IT WORTH IT?
	JRST	DUMP0			;YES. CONTINUE ON THIS TAPE RECORD
	SETZM	TOBUF+2			;ZERO THE BUFFER COUNT
	MOVEI	A,RECSIZ		;THE WORD COUNT OF SPACE LEFT HERE.
	MOVEM	A,WC			;SET UP WC
DUMP0:	SUBI	A,INFOSI+3		;WC-OVERHEAD = DATA SPACE COUNT.
	MOVE	B,FSIZE			;GET FILE SIZE
	CAILE	B,(A)			;IS THE FILE SMALL ENOUGH TO FIT?
	MOVEI	B,(A)			;FILE IS TOO BIG. WRITE ONLY THIS MUCH
	MOVNM	B,FWC			;SAVE -WC OF FILE IN THIS RECORD
	MOVSI	A,-IOVER		;NEGATIVE IOVERSION NUMBER,
	HRRI	A,INFOSI+1(B)		;GET -IOVER,,WC.  WC=DATA+RETRIEVAL+1
;* NEXT CALL MAY FAIL
	PUSHJ	P,TWRITE		;WRITE WORD COUNT.
	POPJ	P,			;RETURN WITH ERROR
	MOVNI	B,INFOSI+3(B)		;WE WRITE WC+DEVNAM+INFO+FILE+CHECKSUM
	ADDM	B,WC			;THIS WILL BE WC WHEN WE'RE THROUGH
	MOVE	A,STRUCT		;GET THE DEVICE NAME
	MOVE	C,A			;INITIALIZE CHECKSUM
	MOVNI	B,INFOSIZE+1		;THIS IS THE OVERHEAD COUNT
	ADDM	B,TOBUF+2		;DECREMENT THE OUTPUT COUNT.
	IDPB	A,TOBUF+1		;WRITE ON TAPE.
IFN IRCPPN,<
	MOVE B,FILINF+DDPPN		;TURN IRCAM PPN INTO SAIL PPN
	TLNE B,770000			;FOR TRANSPORTABILITY
	TLO B,400000
	TRNE B,770000
	TRO B,400000
	MOVEM B,FILINF+DDPPN
>
	MOVSI	B,-INFOSI		;MAKE AOBJN POINTER FOR FILINF
DUMP1:	MOVE	A,FILINF(B)		;GET A RETRIEVAL WORD
	XOR	C,A			;COMPUTE THE CHECKSUM
	IDPB	A,TOBUF+1
	AOBJN	B,DUMP1			;LOOP
IFN IRCPPN,<
	MOVE B,[400000,,400000]		;PUT BACK IRCAM PPN
	ANDCAM B,FILINF+DDPPN		;IN CASE ANYONE CARES
>
	MOVE	B,FWC			;GET THE WORD COUNT OF DATA WORDS
	ADDM	B,FSIZE			;DECREASE FILE SIZE
	JRST	DUMP4			;GO TO CALL THE INNER LOOP

DUMP3:	MOVE	B,FSIZE			;GET THE SIZE OF THE FILE REMAINDER
	CAILE	B,RECSIZ-2		;WILL IT FIT IN A RECORD?
	MOVEI	B,RECSIZ-2		;NO. THIS IS HOW MANY TO TAKE
	MOVNI	A,(B)			;GET - THE SIZE
	ADDM	A,FSIZE			;DECREASE FILE SIZE.
	MOVEM	A,FWC			;SAVE AS THE COUNT FOR THIS RECORD.
	ADDI	A,RECSIZ-2		;ADD THE RECORD SIZE
	MOVEM	A,WC			;SAVE AS RECORD REMAINING WC.
	SETZ	C,			;ZERO THE CHECKSUM
	MOVEI	A,(B)			;GET +THE COUNT
;* THIS ONE CAN FAIL.
	PUSHJ	P,TWRITE		;WRITE ON THE FILE.
	POPJ	P,			;RETURN AN ERROR
	MOVE	B,FWC			;GET THE DATA COUNT

DUMP4:	ADDM	B,TOBUF+2		;DECREMENT THE BUFFER COUNT.
	MOVEI	X,3			;
	AND	X,B			;PICKUP 2 BITS FROM B
	ASH	B,-2			;AND SHIFT B APPROPRIATELY
	MOVE	D,TOBUF+1		;PICKUP BYTE POINTER
	TLZE	D,770000		;ZERO THE BYTE POSITION
	SUBI	D,1			;OOPS WAS A 444400,
	SUBI	D,(X)
	JUMPE	B,DUMPXX		;IF B IS ZERO, WRITE CHECKSUM ONLY
	JRST	@DXTAB(X)		;AND JUMP WILDLY INTO THE OPEN CODE

DXTAB:	DUMPX0
	DUMPX1
	DUMPX2
	DUMPX3
	
DUMPX0:	SOSG	FIBUF+2			;IS THERE DATA IN BUFFER?
	PUSHJ	P,DFREDX		;READ FROM DISK FILE
	ILDB	A,FIBUF+1		;LOAD A WORD FROM THE FILE.
	XOR	C,A			;SAVE CHECKSUM
	MOVEM	A,1(D)			;SAVE WORD.
DUMPX1:	SOSG	FIBUF+2			;IS THERE DATA IN BUFFER?
	PUSHJ	P,DFREDX		;READ FROM DISK FILE
	ILDB	A,FIBUF+1		;LOAD A BYTE FROM THE FILE.
	XOR	C,A			;SAVE CHECKSUM
	MOVEM	A,2(D)			;SAVE BYTE.
DUMPX2:	SOSG	FIBUF+2			;IS THERE DATA IN BUFFER?
	PUSHJ	P,DFREDX		;READ FROM DISK FILE
	ILDB	A,FIBUF+1		;LOAD A BYTE FROM THE FILE.
	XOR	C,A			;SAVE CHECKSUM
	MOVEM	A,3(D)			;SAVE BYTE.
DUMPX3:	SOSG	FIBUF+2			;IS THERE DATA IN BUFFER?
	PUSHJ	P,DFREDX		;READ FROM DISK FILE
	ILDB	A,FIBUF+1		;LOAD A BYTE FROM THE FILE.
	XOR	C,A			;SAVE CHECKSUM
	MOVEM	A,4(D)			;SAVE BYTE.
	ADDI	D,4
	AOJL	B,DUMPX0		;LOOP READING/WRITING
DUMPXX:	IDPB	C,D			;WRITE THE CHECKSUM INTO THE BUFFER
	SOS	TOBUF+2			;DECREMENT THE COUNT BY ONE MORE
	MOVEM	D,TOBUF+1		;POINTS TO LAST BYTE DEPOSITED.
	SKIPLE	FSIZE
	JRST	DUMP3
	JRST	CPOPJ1

;WRITE A TAPE HEADER OR TRAILER.

TAPHED:	SETZM	TAPWFL
	PUSHJ	P,MTANOP		;NO-OP so status will be available
	GETSTS	MTA,A
	TRNE	A,IOBOT			;Front of tape?
	 SETOM	TAPWFL			;Yes, set flag to check for write lock
	MOVE	B,['*HEAD*']
	JRST	TAPHD0

TAPTAI:	SETZM	TAPWFL
	MOVE	B,['*TAIL*']
TAPHD0:	HRLZ	A,.JBVER		;GET THE VERSION NUMBER
	HRRI	A,5			;WORD COUNT FOR HEADER.
	PUSHJ	P,TWRITE		;WRITE
	JFCL
	MOVNI	A,5
	ADDM	A,TOBUF+2
	MOVE	A,['DART  ']
	IDPB	A,TOBUF+1
	IDPB	B,TOBUF+1
	DATE	A,			;AVOID LOSSAGE AT MIDNITE
	MSTIME	B,
	DATE	C,
	MSTIME	D,
	CAMN	A,C
	JRST	TAPHD1
	MOVE	A,C
	MOVE	B,D
TAPHD1:	IDIVI	B,74*1750		;LEAVE MINUTES IN B
	LSH	B,14			;SHIFT IT 12 BITS LEFT
	LDB	C,[POINT 3,A,23]	;GET HIGH DATE   DATE75
	ANDI	A,7777			;LEAVE LOW DATE ONLY IN A
	IOR	A,B			;TIME & DATE IN FILE SYSTEM FORMAT
	DPB	C,[POINT 3,A,2]		;STORE HIGH ORDER DATE. DATE75
	IDPB	A,TOBUF+1
	MOVE	A,USRPPN
	IDPB	A,TOBUF+1
	HRLZ	A,CLASS
	HRR	A,TAPNO
	IDPB	A,TOBUF+1
IFN DBGSW,<
	SKIPE	DBGNTP
	JRST	NXTOBF			;FAKE CLOSE IF NOT OUTPUTTING
>;IFN DBGSW
	PUSHJ	P,MTACLZ		;FORCE HEADER FILE OUT
	SKIPN	TAPWFL
	 POPJ	P,			;Tape was not rewound or was TAPTAI
; Check tape for write lock if was rewound: ask operator to
;  put in a write ring, and then rewind and retry operation.
	GETSTS	MTA,A
	TRNE	A,IOTEND		;Not IOTEND
	 POPJ	P,
	TRNN	A,IOIMPM		;and IOIMPM implies write locked
	 POPJ	P,
	TTCALL	11,
	OUTSTR	[ASCIZ/This tape is write-locked!  If you are SURE you want to continue
and write on the tape, put the write ring in and type carriage return: /]
	TTCALL	4,A
	TTCALL	11,
	GETSTS	MTA,A
	TRZ	A,700000
	SETSTS	MTA,(A)
	PUSHJ	P,MTAREW		;Make sure it is rewound
	PUSHJ	P,MTANOP		;Wait for rewind, make status avail.
	PUSHJ	P,MTINIT
	MOVE	B,['*HEAD*']
	JRST	TAPHD0

IFN DBGSW,<
NXTOBF:				;FAKE CLOSE OR OUTPUT BY MOVING TO NEXT BUFFER
	PUSH	P,A
	PUSH	P,B
	HRRZ	A,@TOBUF	;POINT AT NEXT BUFFER
	HRRZM	A,TOBUF		;UPDATE BUFFER HEADER BUFFER POINTER
	ADDI	A,2		;POINT AT DATA PART OF BUFFER
	HLL	A,TOBUF+1	;PICK UP HIGH PART OF BYTE POINTER
	TLZ	A,770000	;ZAP POSITION PART
	MOVE	B,A
	TLO	A,440000	;AND SET IT TO =36
	MOVEM	A,TOBUF+1	;STORE NEW BYTE POINTER IN BUFFER HEADER
	LSH	B,-30		;GET BYTE SIZE
	MOVEI	A,44		;NUMBER OF BITS PER WORD
	SKIPE	B
	IDIV	A,B		;GET NUMBER OF BYTES PER WORD IN A
	MOVE	B,@TOBUF	;GET DATA SIZE+1,,NEXT BUFFER POINTER
	TLZ	B,400000	;TURN OFF FLAG BIT
	MOVEM	B,@TOBUF	;PUT IT BACK
	HLRZ	B,B		;GET DATA SIZE+1
	SOS	B		;GET DATA SIZE
	IMUL	A,B		;GET BYTE COUNT
	MOVEM	A,TOBUF+2	;STORE IT IN BUFFER HEADER
	POP	P,B
	POP	P,A
	POPJ	P,
>;IFN DBGSW
;RDFIL RDHED RDHED0 WRECK1 WRK1 WRECK2 RDHED1 RDHEDZ RDHEDP RDHED2 RDFILX RDFLX1 RDFLX2 HEDHAK

	SUBTTL	RESTORE A DATA FILE FROM TAPE.
RDFIL:	TRZ	FL,MTAEOT		;ASSUME NOT AT THE END
	PUSHJ	P,TREADX		;READ WC WORD FROM TAPE
	TRNE	FL,MTAEOT		;EOTAPE NOW?
	POPJ	P,			;END OF TAPE TO REPORT.
	HRRZM	A,WC			;SAVE THE WORD COUNT
	JUMPL	A,RFIL1			;JUMP IF THIS IS A FILE HEADER
	JUMPE	A,RDHED2		;JUMP IF WC=0, NO DATA LEFT IN THIS FILE
RDHED:	TLNE	FL,RDHACK		;SPECIAL TREATMENT FOR TAPE HEADERS?
	JRST	HEDHAK			;YES.
	HLRZ	A,A			;GET VERSION NUMBER ONLY
	PUSH	P,A			;SAVE VERSION NUMBER
	PUSHJ	P,TREAD			;READ ON
	CAME	A,['DART  ']		;IS THIS REASONABLE?
	JRST	ILLFMT			;ASSUME ILLEGAL FORMAT
	MOVEI	B,[ASCIZ/DART version /]
	PUSHJ	P,STROUT
	POP	P,A
	PUSHJ	P,TYPOCT		;TYPE VERSION NUMBER.
	PUSHJ	P,TREAD
	MOVEI	B,[ASCIZ/  tape header
Recorded  /]
	CAMN	A,['*HEAD*']
	JRST	RDHED0
	CAME	A,['*TAIL*']
	JRST	ILLFMT
	MOVEI	B,[ASCIZ/  tape trailer
Recorded  /]
RDHED0:	PUSHJ	P,STROUT
	PUSHJ	P,TREAD			;READ DATE/TIME
	PUSH	P,A			;SAVE DATE/TIME
	TLZ	A,700000		;CLEAR HIGH DATE	DATE75
	LSH	A,-14			;TIME ONLY
	PUSHJ	P,TYTIME		;TYPE TIME
	MOVEI	B,[ASCIZ/ /]
	PUSHJ	P,STROUT
	POP	P,A			;GET DATE AND TIME BACK
	LDB	B,[POINT 3,A,2]		;GET HIGH DATE		DATE75
	ANDI	A,7777			;LOW DATE ONLY
	DPB	B,[POINT 3,A,23]	;STORE HIGH DATE	DATE75
	PUSHJ	P,TYDATE
	MOVEI	B,[ASCIZ/,  by /]
	PUSHJ	P,STROUT
	PUSHJ	P,TREAD	
	PUSHJ	P,PPNOUT
	PUSHJ	P,TREAD	
	PUSH	P,A
	HLRZ	A,A
	CAIL	A,CLMAX
	MOVNI	A,1
	MOVEM	A,TAPCLS		;TAPE CLASS
	MOVE	B,CLNAM(A)
	PUSHJ	P,STROUT
	MOVEI	B,[ASCIZ/class/]
	PUSHJ	P,STROUT
	POP	P,A
	HRRZ	A,A
	PUSH P,TAPCLS			;FOR PRESTORE CHECK LATER
	PUSH	P,A
	JUMPE	A,RDHED1

;REMEMBER WHAT BASTARD IS USED THIS TAPE IN CASE HE DOESN'T PUT IT AWAY
;OR IF HE MUNGS IT.
;FROM HERE TO WRECK2

	EXCH	A,TAPCLS		;SAVE TAPE NUMBER OVER CLASS
	CAIE	A,2
	MOVNS	TAPCLS			;NEGATIVE MEANS SYSTEM PERMANENT.
	MOVEI	A,17
	MOVSI	B,'DSK'
	MOVEI	C,0
	OPEN	DSKMSC,A
	PUSHJ	P,NODEV
IFN STANSW,<
	MOVE	A,['DART  ']
	MOVSI	B,'REC'
	MOVEI	C,0
	MOVE	D,TAPREG	;' SSSYS' OR DBGPPN
	LOOKUP	DSKMSC,A
	JRST	[SETZB W,X		;ZERO THE WC
		ANDI B,-1		;LOOKUP ERROR CODE ONLY.
		JUMPE B,WRECK1		;JUMP IF FILE NOT FOUND.
		JRST WRECK2]		;JUMP IF OTHER ERROR.
	MOVS	D,D
	MOVN	W,D
>
IFE STANSW,<
	MOVEI A,.RBSIZ		;ARG COUNT = 5
	MOVE B,TAPREG
	MOVE C,['DART  ']
	MOVSI D,'REC'
	MOVEI W,0
	LOOKUP DSKMSC,A
	JRST	[SETZB W,X
		 ANDI D,-1
		 JUMPE D,WRECK1
		 JRST WRECK2]
	MOVE W,X
>
WRECK1:	MOVE	A,['DART  ']
	MOVSI	B,'REC'
	MOVEI	C,0
	MOVE	D,TAPREG	;' SSSYS' OR DBGPPN
	ENTER	DSKMSC,A
	JRST	WRECK2
	JUMPE	W,WRK1			;JUMP IF NO INPUT NEEDED
	IDIVI	W,200			;CALCULATE RECORD NUMBER, WORDS IN LAST REC.
	JUMPE	X,WRK1			;IF NO WORDS LEFT OVER, WE AVOID READING
	USETI	DSKMSC,1(W)		;SET FOR INPUT
	INPUT	DSKMSC,[IOWD 200,MEMBLK
			0]
WRK1:	USETO	DSKMSC,1(W)
	HRRZ	A,TAPCLS
	DATE	B,			;DATE75-OK
	HRL	A,B
	MOVEM	A,MEMBLK(X)		;STORE DATE,,TAPE NUMBER
	MOVE	A,LOGPPN
	MOVEM	A,MEMBLK+1(X)		;STORE USER NAME
	MOVNI	A,2(X)			;INCREASE THE WORD COUNT.
	HRLZ	A,A
	HRRI	A,MEMBLK-1		;FORM IOWD
	MOVEI	B,0
	OUTPUT	DSKMSC,A
	CLOSE	DSKMSC,
WRECK2:	RELEAS	DSKMSC,

	MOVEI	B,[ASCIZ/
Tape number /]
	PUSHJ	P,STROUT
	MOVE A,(P)
	PUSHJ	P,DECOUT
RDHED1:	MOVEI	B,CRLF
	PUSHJ	P,STROUT
	TRC	FL,LSTON+LSTTTY
	TRCN	FL,LSTON+LSTTTY
	CLOSE	LST,			;FORCE TTY OUTPUT
	POP P,A				;GET TAPE NUMBER
	POP P,B				;GET TAPE CLASS
	SKIPN PREQTP			;ARE WE READING A TAPE FOR PRESTORE?
	JRST RDHEDP			;NO
	JUMPLE B,RDHEDZ			;LOSE IF NOT SYSTEM CLASS
	CAIE B,2			;SKIP IF PERMANENT
	TRO A,400000			;TEMP FLAG
	CAMN A,PREQTP			;IS THIS THE ONE WE WANT?
	JRST RDHEDP			;YES, OK
RDHEDZ:
IFN STANSW!IRCPPN,<
	MOVNI A,1			;NO, FOO
	BEEP A,
>;IFN STANSW!IRCPPN
	OUTSTR [ASCIZ /
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!!! THAT'S NOT THE TAPE I ASKED FOR !!!
!!!      GO GET THE RIGHT TAPE      !!!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
/]
IFN STANSW!IRCPPN,<
	BEEP A,
>;IFN STANSW!IRCPPN
	PUSHJ P,MTAREW
	OUTSTR [ASCIZ /
When you get it ready type Y: /]
	PUSHJ P,PYORN0
	 JRST .-2
	PUSHJ P,MTAREW
	JRST RDFIL			;LET'S TRY AGAIN FOLKS

RDHEDP:	MOVNI	A,4
	ADDB	A,WC
RDHED2:
IFN STANSW,<
	PUSHJ	P,MTACLZ
>
;; I don't understand why, but at IRCAM this seems to skip over the EOF
;; so that REOFIL doesn't figure out it's the end of the tape after the
;; trailer.  Flushing this makes it work.  Duh.
	GETSTS	MTA,A
	TRZ	A,20000			;CLEAR IODEND (END OF FILE)
	SETSTS	MTA,(A)
	JRST	RDFIL

RDFILX:	MOVE	A,WC			;PICKUP THE WORD COUNT REMAINING
	ADDM	A,TIBUF+1		;INCREMENT THE BYTE POINTER
	MOVN	A,A
	ADDM	A,TIBUF+2		;DECREMENT THE BUFFER COUNT
	PUSHJ	P,TREAD			;READ AHEAD. THIS IS THE CHECKSUM
	PUSHJ	P,TREADX		;READ MORE. THIS IS NEXT WC.
	TRNE	FL,MTAEOT		;END OF TAPE?
	POPJ	P,			;YES. RETURN.
	JUMPL	A,RDFLX1		;JUMP IF WE HAVE THE BEGINNING OF A FILE.
	JUMPE	A,RDFLX2		;JUMP IF NO DATA LEFT IN THIS RECORD
	TLNE	A,-1			;SKIP IF LEFT SIDE OF A IS ZERO
	JRST	RDFLX1			;OOPS.  THIS MIGHT BE A TAPE TRAILER
	HRRZM	A,WC			;SAVE THE WC
	JRST	RDFILX			;AND GO FLUSH MORE.

RDFLX1:	SOS	TIBUF+1			;DECREMENT BYTE POINTER
	AOS	TIBUF+2			;INCREMENT WORD COUNT
	POPJ	P,			;RETURN

RDFLX2:	SETZM	TIBUF+2			;ZERO REMAINING COUNT
	POPJ	P,			;SO NEXT READ WILL GET NEW RECORD

HEDHAK:	TLZ	FL,RDHACK		;TELL THEM ABOUT IT UPSTAIRS.
	POPJ	P,
;RFIL1 RFIL2 RFDATA RFDT0 RFDT1 RFDT2 RFDT3 RFDT5 RFDT6 DDFWRT DDFWR1 DDFWR3

	SUBTTL	READ A FILE NAME FROM THE TAPE. READ TAPE DATA.  RFIL1, RFDATA
RFIL1:	HLROM	A,INVERS		;STORE -(IOVERSION NUMBER)
	MOVNS	INVERS			;STORE +(IOVERSION NUMBER)
	PUSHJ	P,TREAD			;GET DATA FROM TAPE.
	MOVEM	A,SRCDEV		;SAVE SOURCE DEVICE NAME
	MOVEM	A,CHKSUM		;SAVE CHECKSUM
	SOS	WC
	MOVSI	B,-INFOSI		;LOAD UP RETRIEVAL DATA
RFIL2:	PUSHJ	P,TREAD
	MOVEM	A,FILINF(B)
	XORM	A,CHKSUM
	SOS	WC			;DECREMENT WC.
	AOBJN	B,RFIL2			;LOOP READING RETRIEVAL
IFN IRCPPN,<
	MOVE A,[400000,,400000]		;TURN SAIL PPN INTO IRCAM PPN
	ANDCAM A,FILINF+DDPPN
>
	MOVE	A,FILINF+DDLNG
	MOVEM	A,FSIZE			;SAVE FILE SIZE IN WORDS.
	POPJ	P,			;RETURN AND LET HIM DECIDE

RFDATA:
RFDT0:	SOSGE	WC			;READ ONE FILE DATA WORD FROM TAPE
	JRST	RFDT1			;WC EXHAUSTED
	PUSHJ	P,TREAD			;READ DATA
	XORM	A,CHKSUM
	PUSHJ	P,DDFWRT		;WRITE ON THE DISK.
	SOS	FSIZE			;DECREMENT THE FILE SIZE FROM TAPE
	JRST	RFDT0			;....

RFDT1:	PUSHJ	P,TREAD
	XORB	A,CHKSUM
	JUMPE	A,RFDT2			;CHECKSUM IS OK.
	OUTSTR	[ASCIZ/Tape checksum failure. Checksum bits = /]
	PUSHJ	P,OCTOUT
	OUTSTR	CRLF

RFDT2:	SKIPG	FSIZE			;ARE WE DONE?
	JRST	RFDT3			;YES.
	PUSHJ	P,TREAD			;READ THE WC FROM NEXT RECORD
	JUMPLE	A,ILLFMT		;LOOKS LIKE ILLEGAL FORMAT
	HRRZM	A,WC
	SETZM	CHKSUM
	JRST	RFDT0

RFDT3:
IFN UDPSW,<
	TLNE	FL,UDPGO		;IS THIS THE UDP?
	JRST	RFDT5			;YES. CLOSE IT.
>
	CLOSE	FILE,NUPACC
	STATZ	FILE,740000
	PUSHJ	P,RFDT6			;ERROR.
	POPJ	P,

IFN UDPSW,<
RFDT5:	UCLOSE	FILE,
	POPJ	P,
>

RFDT6:	OUTSTR	[ASCIZ/Disk write error.   Status = /]
	PUSH	P,A
	GETSTS	FILE,A
	PUSHJ	P,DISLOC
	OUTSTR	CRLF
	POP	P,A
	POPJ	P,
	
DDFWRT:	SOSG	FOBUF+2
	PUSHJ	P,DDFWR1
	IDPB	A,FOBUF+1
	POPJ	P,

DDFWR1:
IFN UDPSW,<
	TLNE	FL,UDPGO		;ON THE UDP?
	JRST	DDFWR3			;YES.
>
	OUTPUT	FILE,
	STATZ	FILE,740000
	PUSHJ	P,RFDT6
	POPJ	P,
	
IFN UDPSW,<
DDFWR3:	UOUT	FILE,			;FOR THE UDP
	POPJ	P,
>
;TWRITE TWRIT0 TWRIT1 TWRIT2 YMTA1 NOMTA1 TWRIT3 TWREOT TWRIT4 WRLOCK

	SUBTTL	WRITE TAPE
TWRITE:	SOSG	TOBUF+2
	JRST	TWRIT1
TWRIT0:	IDPB	A,TOBUF+1
	AOS	(P)
	POPJ	P,

TWRIT1:	AOS	MTFILN		;COUNT THE TOTAL SIZE OF THIS FILE
	AOS	MTTREC		;COUNT THE TOTAL OF ALL RECORDS
TWRIT2:
IFN DBGSW,<
	SKIPN	DBGNTP
	JRST	YMTA1
	PUSHJ	P,NXTOBF	;IF NOT OUTPUTTING, FAKE OUTPUT
	SKIPA
	JRST	TWREOT	;TO FAKE AN EOT (FOR TESTING W/O TAPE)
	JRST	NOMTA1
YMTA1:
>;IFN DBGSW
	PUSHJ	P,MTAOUP
	STATZ	MTA,742000	;LOOK FOR ALL ERROR BITS
	JRST	TWRIT3		;SOME ERROR
NOMTA1:	IDPB	A,TOBUF+1	;DO THE NORMAL THINGS
	AOS	(P)		;AND SKIP RETURN
	POPJ	P,

TWRIT3:	STATO	MTA,IOTEND	;END OF TAPE?
	JRST	TWRIT4		;SOME OTHER ERROR
TWREOT:	TLNE	FL,IGNEOT	;HAVE WE TOLD HIM EOT ALREADY?
	JRST	TWRIT0		;YES. HE DOESN'T WANT TO BE BOTHERED AGAIN
IFN DBGSW,<
	SKIPE	DBGNTP
	JRST	NXTOBF		;FAKE CLOSE IF NOT OUTPUTTING
>;IFN DBGSW
	PUSHJ	P,MTACLZ	;DO THE OUTPUT CLOSE.
	POPJ	P,		;EOT: LET THE GUY UPSTAIRS WORRY ABOUT IT

TWRIT4:	PUSH	P,A		;SAVE SOME STUFF
	GETSTS	MTA,A		;GET MT STATUS
	TRNE	A,IOIMPM	;IS THIS ILLEGAL WRITE ON WRITE LOCKED TAPE?
	JRST	WRLOCK		;YES.

;I DON'T WISH TO ATTEMPT TO CORRECT THIS.
	OUTSTR	[ASCIZ/Mag tape write error.  MT Status = /]
	PUSHJ	P,DISLOC	;TYPE DISASTER.
	OUTSTR	CRLF
	JRST	RESTAR

WRLOCK:	TTCALL	11,0
	OUTSTR	[ASCIZ/ Write operation on a write-locked tape!
Put the write ring in, reposition the tape, and retry your command.
/]
	JRST RESTAR

;	OUTSTR	[ASCIZ/Write operation on a write-locked tape!
;Put the write ring in and type carriage return.
;/]
;	TTCALL	4,A
;	TTCALL	11,
;	GETSTS	MTA,A
;	TRZ	A,700000
;	SETSTS	MTA,(A)
;	POP	P,A
;	JRST	TWRIT2
;TREAD TREADZ UEOT TREADX TREAD1 TREAD2 REOTAP REOFIL MTINIT NOMTA0 BUFSET MINIT1 MTERR

	SUBTTL	READ TAPE	MTINIT
TREAD:	SOSG	TIBUF+2
	PUSHJ	P,TREAD1
	JRST	TREADZ
	JRST	UEOT
TREADZ:	ILDB	A,TIBUF+1
	POPJ	P,

UEOT:	OUTSTR	[ASCIZ/Unexpected end of tape.
/]
	JRST @CRESTA		;NORMALLY RESTAR BUT PRESTORE DOESN'T LIKE THAT

TREADX:	SOSG	TIBUF+2		;DECREMENT BUFFER COUNT
	PUSHJ	P,TREAD1	;HAVE TO ASK SYSTEM
	JRST	TREADZ		;SUCCESS
	PUSHJ	P,MTABKF	;BACKSPACE OVER THE 2ND EOF MARK
	TRO	FL,MTAEOT	;SET ENDING FLAG
	POPJ	P,		;RETURN

TREAD1:	PUSHJ	P,MTAINP
TREAD2:	STATO	MTA,762000	;LOOK FOR VARIOUS ILLEGALITIES, EOF AND EOT
	POPJ	P,		;RETURN IF WE WIN.
	GETSTS	MTA,A		;GET THE STATUS
	TRZE	A,20000		;END OF FILE?
	JRST	REOFIL		;YES.
	TRNE	A,2000
	JRST	REOTAP
	OUTSTR	[ASCIZ/MT read error. MT status = /]
	PUSH	P,FL		;SAVE FLAGS
	TRZ	FL,LSTON	;TYPE ON TTY
	PUSHJ	P,DISLOC
	OUTSTR	CRLF
	POP	P,FL
	PUSHJ	P,MTASKR	;SKIP PAST BAD SPOT.
	JRST	TREAD1

REOTAP:	TLON	FL,IGNEOT	;TELL HIM ONLY ONCE THAT EOT IS HAPPENING.
	OUTSTR	[ASCIZ/Physical end of tape.
/]
	POPJ	P,

REOFIL:	PUSHJ	P,MTACLZ	;CLOSE THE MTA
	SETSTS	MTA,(A)		;RESET END OF TAPE BIT
	PUSHJ	P,MTAINP	;READ ANOTHER BUFFER FULL
	STATO	MTA,20000	;IS THIS END OF FILE?
	JRST	TREAD2		;NO. LET TREAD TAKE CARE OF IT.
	OUTSTR	[ASCIZ/Logical end of tape.
/]
	JRST	CPOPJ1		;RETURN

MTINIT:	MOVEI	A,IMODE+DEN800
	SKIPN	B,MTDEV
	MOVE	B,['MTA0  ']
	MOVEM	B,MTDEV
	DEVCHR	B,
	TLNN	B,20
	JRST	MTERR
	MOVE	B,MTDEV
	MOVE	C,[TOBUF,,TIBUF]
IFN DBGSW,<
	SKIPE	DBGNTP			;SKIP IF REAL TAPE OUTPUT TO BE DONE
	JRST	NOMTA0			;IF NO REAL OUTPUT, DON'T OPEN THE MTA
				;FOR NOW, NO OPEN EVEN IF WE JUST WANTED TO READ
				;LATER, MIGHT ALLOW READING ONLY HERE
>;IFN DBGSW
	PUSHJ	P,MTAOPE
	JRST	NOMTA
NOMTA0:	MOVEI	A,RECSIZ		;INITIALIZE THE WC
	MOVEM	A,WC
	SETZM	MTFILN			;NO RECORDS ON THIS FILE YET

;SET UP BOTH INPUT AND OUTPUT BUFFER HEADERS FOR THE MAGTAPES.
;WE KNOW WE WILL ONLY USE ONE AT A TIME. (I HOPE)

BUFSET:	MOVE	A,[400000,,MBUF1+1]
	MOVEM	A,TOBUF
	MOVEM	A,TIBUF
	MOVSI	A,(<POINT 36,0,35>)
	MOVEM	A,TOBUF+1
	MOVEM	A,TIBUF+1
	SETZM	TOBUF+2
	SETZM	TIBUF+2
	MOVE	A,[RECSIZ+1,,MBUF2+1]
	MOVEM	A,MBUF1+1
	HRRI	A,MBUF3+1
	MOVEM	A,MBUF2+1
	HRRI	A,MBUF1+1
	MOVEM	A,MBUF3+1
	POPJ	P,


MINIT1:	PUSHJ	P,MTINIT		;INITIALIZE MAGTAPE WITH ONE BUFFER
	MOVEI	A,MBUF1+1		;POINTER TO FIRST BUFFER
	HRRM	A,MBUF1+1		;SAVED IN THE FIRST BUFFER
	POPJ	P,			;RETURN

MTERR:	OUTSTR	[ASCIZ/Device /]
	MOVE	A,MTDEV
	PUSHJ	P,SIXOUT
	OUTSTR	[ASCIZ/ is not a magtape.
/]
	JRST	RESTAR
;MTAOPE MTACLZ MTACLI MTAINP MTAIN2 MTAIN3 MTAOUP MTANOP MTAREL MTAREW MTASKR MTASKF MTABKR MTABKF MTASKT MOUTUP MGOTWC MEOFUP MWRDUP SEVTRK

	SUBTTL	LOW LEVEL MTA I/O ROUTINES : MTAOPE/MTACLZ/MTAINP/MTAOUP/ETC.

MTAOPE:	OPEN	MTA,A
	JRST	CPOPJ
	JRST	CPOPJ1

MTACLZ:	SKIPGE	TOBUF			;SKIP IF OUTPUT BUFFER HAS BEEN USED
	JRST	MTACLI			;OUTPUT BUFFER NOT USED, ASSUME INPUT CLZ
	PUSHJ	P,MOUTUP		;UPDATE POSITION COUNT FOR ANY OUTPUT IN BUF
	PUSHJ	P,MEOFUP		;UPDATE POSITION FOR EOF MARK
MTACLI:	CLOSE	MTA,
	POPJ	P,

MTAINP:	INPUT	MTA,
	STATZ	MTA,742000		;ANY ERRORS?
	POPJ	P,			;YES, GET OUT HERE
	PUSH	P,A
	PUSH	P,B
	STATO	MTA,020000		;END OF FILE?
	JRST	MTAIN2			;NO, JUMP
	PUSHJ	P,MEOFUP		;YES, UPDATE POSITION FOR EOF MARK
	SKIPN	TIBUF+2			;WAS ANY DATA READ THIS TIME?
	JRST	MTAIN3			;NO, DON'T COUNT AS EMPTY RECORD TOO
MTAIN2:	MOVEI	A,44			;PICK UP WORD SIZE (=36 BITS)
	LDB	B,[POINT 6,TIBUF+1,11]	;PICK UP BYTE SIZE
	IDIVM	A,B			;GET BYTES PER WORD IN B
	MOVE	A,TIBUF+2		;PICK UP BYTE COUNT
	IDIV	A,B			;GET NUMBER OF WORDS IN A
	JUMPE	B,.+2			;TEST REMAINDER
	AOJ	A,			;NUMBER OF WORDS = CEILING(BYTES/BPW)
	PUSHJ	P,MWRDUP		;UPDATE POSITION FOR NUMBER OF WORDS
	MOVE	A,MTIRGL		;PICK UP INTERRECORD GAP LENGTH
	ADDM	A,MEMSAV+MTAPOS		;ADD IT IN TO POSITION
MTAIN3:	POP	P,B
	POP	P,A
	POPJ	P,

MTAOUP:	PUSHJ	P,MOUTUP		;UPDATE POSITION COUNT FOR ANY OUTPUT IN BUF
	OUTPUT	MTA,
	POPJ	P,

MTANOP:	MTNOOP	MTA,
	STATO	MTA,IOBOT		;AT BEGINNING OF TAPE ?
	POPJ	P,			;NO, RETURN
	SETZM	MEMSAV+MTAPOS		;YES, SET POSITION TO ZERO FEET INTO TAPE
	SETZM	MEMSAV+MTAPQU		;     SET POSITION NOT QUESTIONABLE
	POPJ	P,

MTAREL:	RELEAS	MTA,
	POPJ	P,

MTAREW:	REWIND	MTA,
	SETZM	MEMSAV+MTAPOS		;SET POSITION TO ZERO FEET INTO TAPE
	SETZM	MEMSAV+MTAPQU		;SET POSITION NOT QUESTIONABLE
	POPJ	P,

MTASKR:	SKIPR	MTA,
	SETOM	MEMSAV+MTAPQU		;SET POSITION QUESTIONABLE
	POPJ	P,

MTASKF:	SKIPF	MTA,
	SETOM	MEMSAV+MTAPQU		;SET POSITION QUESTIONABLE
	POPJ	P,

MTABKR:	BACKR	MTA,
	SETOM	MEMSAV+MTAPQU		;SET POSITION QUESTIONABLE
	POPJ	P,

MTABKF:	BACKF	MTA,
	SETOM	MEMSAV+MTAPQU		;SET POSITION QUESTIONABLE
	POPJ	P,

MTASKT:	SKIPT	MTA,
	PUSH	P,MT2400
	POP	P,MEMSAV+MTAPOS		;SET POSITION TO 2400 FEET
	SETOM	MEMSAV+MTAPQU		;BOY IS THAT EVER QUESTIONABLE
	POPJ	P,


; LOCAL SUBROUTINES ...

MOUTUP:	SKIPGE	TOBUF			;SKIP IF OUTPUT BUFFER HAS BEEN USED
	POPJ	P,
	PUSH	P,A
	PUSH	P,B
	MOVE	A,TOBUF
	HRRZ	A,1(A)			;PICK UP WORD COUNT
	STATZ	MTA,IOWC		;SKIP IF NOT USING WORD CNT
	JRST	MGOTWC
	HRRZ	A,TOBUF+1		;BYTE POINTER WORD ADDR
	HLRZ	B,TOBUF+1		;BYTE POINTER POSITION AND SIZE
	TRZ	B,007777		;ZERO ALL BUT POSITION
	CAIN	B,440000		;IS NEXT BYTE (TO IDBP) FIRST IN WORD?
	SOJ	A,			;YES, BACK UP WORD ADDR
	SUB	A,TOBUF			;MINUS BUFFER POINTER (BUFFER-2)
	SOJ	A,			;MINUS ONE = WORD COUNT (IN RIGHT HALF)
	HRRZ	A,A
MGOTWC:	PUSHJ	P,MWRDUP		;UPDATE POSITION FOR NUMBER OF WORDS
	MOVE	A,MTIRGL		;PICK UP INTERRECORD GAP LENGTH
	ADDM	A,MEMSAV+MTAPOS		;ADD IT IN TO POSITION
	POP	P,B
	POP	P,A
	POPJ	P,

MEOFUP:	PUSH	P,A
	MOVE	A,MTEOFL		;PICK UP EOF MARK LENGTH
	ADD	A,MTIRGL		;PLUS ONE IRG LENGTH
	ADDM	A,MEMSAV+MTAPOS		;ADD IT INTO POSITION
	POP	P,A
	POPJ	P,

MWRDUP:	GETSTS	MTA,B
	LDB	B,[POINT 2,B,28]	;PICK UP DENSITY
	IMUL	A,MTALTB(B)		;COMPUTE RECORD LENGTH
IFN IRCPPN,<
	MOVE B,[2,,[	1010
			MTA]]
	TAPOP. B,
	 MOVEI B,0			;DEFAULT TO 9-TRACK IF NO TAPOP
	JUMPN B,SEVTRK			;NONZERO FOR 7-TRACK
	IMULI A,3
	IDIVI A,4
SEVTRK:
>;IRCPPN
	ADDM	A,MEMSAV+MTAPOS		;ADD IT IN TO POSITION
	POPJ	P,
;DFREAD DFRED1 DFRED2 DFREDQ DFREDX DFRED3 DFRED4 DFWRTX DFWRIT DFWRT1

	SUBTTL	DISK I/O FOR DATA FILES

DFREAD:	SOSG	FIBUF+2			;READ DATA FILE
	PUSHJ	P,DFRED1
	ILDB	A,FIBUF+1
	POPJ	P,

DFRED1:	IN	FILE,
	POPJ	P,
	STATZ	FILE,20000
IFN STANSW,<
	POPJ P,
>;STANSW
IFE STANSW,<
	JRST DFREDQ			;[IRCAM] SEE COMMENT BELOW
>;NOT STANSW
DFRED2:	OUTSTR	[ASCIZ/Disk input error.
/]
	GETSTS	FILE,A
	SETSTS	FILE,20000(A)
	POPJ	P,

;; [IRCAM] The Stanford version of this code seems to return whatever happens
;; to be in the buffer even if it gets an end of file indication.  I assume
;; this must have something to do with the setting of IODEND on the reading
;; of a partial record at SAIL, whereas DEC doesn't set it until the first
;; non-record is read.  In any case, for the DEC case it means you get crud
;; returned instead of the 0 Ralph seems to expect; maybe SAIL zeros the
;; buffer and DEC doesn't?  Someone who understands this better than I can
;; look into it.  Meanwhile, I hereby invent a kludge to make sure we return
;; a zero uplevel on EOF:

DFREDQ:	POP P,(P)		;FLUSH RETURN ADDR OF CALL TO DFRED1
	MOVEI A,0		;RETURN A 0
	POPJ P,			; TO CALLER OF DFREAD

;; By the way, this caused halts at LOCPP4+5 with an empty DART.ARC sometimes.

DFREDX:
IFN UDPSW,<
	TLNE	FL,UDPGO
	JRST	DFRED4
>
	IN	FILE,			;CALLED ONLY FROM DUMP!!!
	POPJ	P,
	STATO	FILE,20000
	PUSHJ	P,DFRED2		;CALL ERROR ROUTINE AND RETURN.
DFRED3:	MOVEI	A,200
	MOVEM	A,FIBUF+2
	MOVE	A,FIBUF
	ADD	A,[POINT 36,1,35]	;
	MOVEM	A,FIBUF+1		;SAVE STUFF.
	POPJ	P,

IFN UDPSW,<
DFRED4:	UIN	FILE,
	POPJ	P,			;WIN
	JRST	DFRED3			;END OF FILE.
>

DFWRTX:	AOS	DATWC			;(CALLED FROM MERGE. COUNT WORDS)
DFWRIT:	SOSG	FOBUF+2			;WRITE DATA FILE
	PUSHJ	P,DFWRT1
	IDPB	A,FOBUF+1
	POPJ	P,

DFWRT1:	OUT	FILE,
	POPJ	P,
	PUSH	P,A
	GETSTS	FILE,A
	OUTSTR	[ASCIZ/Disk write error. DSK status = /]
	PUSHJ	P,DISLOC
	OUTSTR	CRLF
	POP	P,A
	JRST	RESTAR
;RINDIR RIND1 RIND2 RIND3 RIND4 LSTSTR LSTST1 LSTOUT LSTOT1 UFDRD UFDRD1 UUFDRD UUFDR1 UUFDR2 INDOUT INDOU1

	SUBTTL	DISK I/O  - INDIRECT READ - DIRECTORY READ - LISTING WRITE
RINDIR:	SOSLE	INDRBF+2
	JRST	RIND1
	TRNE	FL,INDEOF		;BUFFER EXHAUSTED. HAS EOF BEEN SEEN?
	JRST	RIND4			;EOF SEEN BEFORE
	IN	INDIR,			;READ
	JRST	RIND1			;WIN
	STATZ	INDIR,20000		;WAS THIS EOF?
	JRST	RIND3			;YES. SET FLAG AND RETURN A DELIMITER
	GETSTS	INDIR,A
	OUTSTR	[ASCIZ/Device error while reading indirect command file. Status = /]
	PUSHJ	P,DISLOC
	OUTSTR	CRLF
	JRST	RESTAR	

RIND1:	ILDB	A,INDRBF+1
	MOVE	A,@INDRBF+1
	TRNE	A,1			;IS THERE AN SOS LINE NUMBER?
	JRST	RIND2			;YES. FLUSH IT.
	LDB	A,INDRBF+1		;LOAD DATA AGAIN.
	POPJ	P,

RIND2:	AOS	INDRBF+1		;ADVANCE THE BYTE POINTER
	MOVNI	A,5
	ADDM	A,INDRBF+2
	JRST	RINDIR

RIND3:	TRO	FL,INDEOF
RIND4:	MOVEI	A,12
	POPJ	P,


LSTSTR:	HRLI	B,440700		;PICKUP A BYTE POINTER
LSTST1:	ILDB	A,B
	JUMPE	A,CPOPJ
	PUSH	P,[LSTST1]		;FORCE RETURN TO LSTST1
LSTOUT:	SOSG	LSTBUF+2		;OUTPUT A CHARACTER TO LISTING DEVICE
	OUT	LST,
	JRST	LSTOT1
	CLOSE	LST,			;ATTEMPT TO CLOSE LISTING DEVICE
	JRST	LSTERR
LSTOT1:	IDPB	A,LSTBUF+1
	POPJ	P,

UFDRD:	SOSG	UFDBUF+2		;READ FROM UFD.
	IN	UFD,
	JRST	UFDRD1
	STATO	UFD,20000		;EOF?
	JRST	UFDRER			;NO. READ ERROR.
	POPJ	P,
UFDRD1:	ILDB	A,UFDBUF+1
	JRST	CPOPJ1

IFN UDPSW,<
UUFDRD:	SOSG	UFDBUF+2		;HERE TO READ DIRECTORY OF UDP.
	JRST	UUFDR2			;HAVE TO ASK OUR UDP SERVICE
UUFDR1:	ILDB	A,UFDBUF+1
	JRST	CPOPJ1
UUFDR2:	UIN	UFD,
	JRST	UUFDR1
	POPJ	P,			;END OF FILE.
>

;OUTPUT ON INDIR CHANNEL (REALLY USED IN ARCHIVE ROUTINE)
INDOUT:	SOSG	INDRBF+2
	OUT	INDIR,
	JRST	INDOU1
	JRST	INDERR
INDOU1:	IDPB	A,INDRBF+1
	POPJ	P,
;LCHECK YORN LCTYPE LCTAB LCBUSY LCNAME LCNOLK LCNOOP LCBRET LCUNA LCILPR LCNFL0 LCNFL1 LCEXIS LCNOFL LCILUS LCILU1 LCILU2 LCILU3

	SUBTTL	LCHECK	CHECK AFTER A LOOKUP - PARMS IN FILBLK
LCHECK:
	HRRZ	B,B			;LOOKUP CODE.
	CAIE	B,-1			;IS CODE SPECIAL?
	CAIGE	B,LCTBM			;IS CODE IN BOUNDS?
	JRST	@LCTAB(B)		;YES.
	OUTSTR	[ASCIZ/Unrecognizable LOOKUP status code = /]
	MOVE	A,B
	PUSHJ	P,TYPOCT
	OUTSTR	[ASCIZ/
Safety LOOKUP of /]
	JRST	LCTYPE

YORN:	TTCALL	11,
	TTCALL	4,A
	TTCALL	11,
	CAIE	A,"Y"
	CAIN	A,"Y"+40
	AOS	(P)
	POPJ	P,

LCTYPE:	MOVE	D,[FILBLK,,A]
	BLT	D,D
	PUSHJ	P,TYFIL
	OUTSTR	CRLF
	POPJ	P,

	LCEXIS				;FILE ALREADY EXISTS
LCTAB:	LCNOFL				;FILE NOT FOUND IN UFD
	LCILUS				;ILLEGAL USER NAME - NO UFD
	LCILPR				;PROTECTION VIOLATION
	LCBUSY				;FILE IS BUSY NOW.
	LCNAME				;RENAME TO THE SAME NAME.
	LCNOLK				;NO LOOKUP BEFORE RENAME
IFN STANSW,<			;SAIL AND DEC ERROR CODES A BIT DIFFERENT
	LCNOOP				;NO OPEN HAS BEEN DONE YET
	LCNOOP				;ERROR CODE 7 DOESN'T HAPPEN
	LCBRET				;BAD RETRIEVAL - UFD GARBAGED.
>
	LCUNA				;UNACESSABLE - BAD RETRIEVAL.
SDEF LCTBM,.-LCTAB

LCBUSY:	OUTSTR	[ASCIZ/File is being referenced. LOOKUP of /]
	JRST	LCTYPE

LCNAME:
LCNOLK:
LCNOOP:
	OUTSTR	[ASCIZ/Illegal file status. LOOKUP of /]
	JRST	LCTYPE

LCBRET:
LCUNA:
	OUTSTR	[ASCIZ/Bad retrieval. LOOKUP of /]
	JRST	LCTYPE

LCILPR:	TRNE	FL,SAFETY
	OUTSTR	[ASCIZ/Safety /]
	OUTSTR	[ASCIZ/LOOKUP protection violation.  /]
	TRNN	FL,SAFETY
	JRST	LCTYPE			;REAL LOOKUP. TYPE NAME AND RETURN
LCNFL0:	PUSHJ	P,LCTYPE		;TELL NAME
LCNFL1:	OUTSTR	[ASCIZ/Type Y to ignore: /]
	JRST	YORN

LCEXIS:	TRNN	FL,SAFETY
	JRST	CPOPJ1			;RETURN IF THE FILE EXISTS
	OUTSTR	[ASCIZ/File already exists: /]
	PUSHJ	P,LCTYPE
	OUTSTR	[ASCIZ/Type Y to replace. /]
	JRST	YORN

LCNOFL:	TRNE	FL,SAFETY
	JRST	CPOPJ1			;FILE IS NOT THERE. SWELL.
	OUTSTR	[ASCIZ/File not found: /]
	JRST	LCTYPE			;TYPE NAME AND RETURN

LCILUS:	OUTSTR	[ASCIZ/UFD not found for user /]
	MOVE	A,FILBLK+3
	PUSHJ	P,PPNOUT
	OUTSTR	CRLF
	TRNN	FL,SAFETY
	POPJ	P,			;CAN'T WIN THIS WAY.
	OUTSTR	[ASCIZ/Type Y (and return) to create a UFD, or
type return after you've created the UFD via LOGIN.  /]
	PUSHJ	P,YORN
	JRST	LCILU2			;LOOKUP THE UFD.
	MOVE	A,FILBLK+3
	MOVSI	B,'UFD'
IFN STANSW,<
	MOVSI	C,005000		;READ ONLY ACCESS FROM THE NETWORK
	MOVE	D,GOD
	ENTER	FILE,A
>
IFE STANSW,<
	MOVEM A,UFDEBK+.RBNAM
	MOVEM B,UFDEBK+.RBEXT
	MOVE C,[13,,16]
	GETTAB C,			;SYSTEM DEFAULT UFD PROTECTION
	 MOVSI C,777000			;THIS IS THE IRCAM DEFAULT
	MOVEM C,UFDEBK+.RBPRV
	MOVE D,LOGPPN
	MOVEM D,UFDEBK+.RBAUT
	ENTER FILE,UFDEBK
>
	JRST	LCILU1
IFE STANSW,<
	USETO FILE,2			;LOGIN DOES THIS SO IT MUST BE RIGHT
>
	CLOSE	FILE,
	JRST	CPOPJ1

LCILU1:	CLOSE	FILE,
	OUTSTR	[ASCIZ/ENTER to create a new UFD lost.
Type Y to skip this file, else, type return after you've made a new UFD: /]
	PUSHJ	P,YORN
	JRST	.+2
	POPJ	P,
LCILU2:	MOVE	A,FILBLK+3
	MOVSI	B,'UFD'
	MOVEI	C,0
	MOVE	D,GOD
	LOOKUP	FILE,A
	JRST	LCILU3
	CLOSE	FILE,
	JRST	CPOPJ1

LCILU3:	OUTSTR	[ASCIZ/UFD still doesn't exist. This file will be skipped.
/]
	CLOSE	FILE,
	POPJ	P,
;DECOUT TYPOCT TYPOC1 OUT.CH STROUT DISLOC OCTCOM OCTOUT SIXOUT SIXOT1 SIXFIL SIXFL0 SIXFL1 TYFIL TYFIL1 PPN0 PPN6 PPN61 PPNOUT PPN8 PPN1 PPN2 PPN3 TYTIME TYDATE

	SUBTTL	SOME TYPE OUT ROUTINES
DECOUT:	IDIVI	A,12
	HRLM	B,(P)
	JUMPE	A,.+2
	PUSHJ	P,DECOUT
	JRST	TYPOC1

TYPOCT:	IDIVI	A,10
	HRLM	B,(P)
	JUMPE	A,.+2
	PUSHJ	P,TYPOCT
TYPOC1:	HLRZ	A,(P)
	ADDI	A,"0"
OUT.CH:	TRNE	FL,LSTON
	JRST	LSTOUT
	TTCALL	1,A
	POPJ	P,

STROUT:	TRNE	FL,LSTON
	JRST	LSTSTR
	OUTSTR	(B)
	POPJ	P,

DISLOC:	MOVEI	C,6		;CHARACTER COUNT
	HRLZ	B,A		;DATA IS ADJUSTED LEFT
OCTCOM:	SETZ	A,
	LSHC	A,3
	ADDI	A,"0"
	PUSHJ	P,OUT.CH
	SOJG	C,OCTCOM
	POPJ	P,

OCTOUT:	MOVE	B,A
	MOVEI	C,14
	JRST	OCTCOM

SIXOUT:	MOVE	B,A
SIXOT1:	SETZ	A,
	LSHC	A,6
	ADDI	A," "
	PUSHJ	P,OUT.CH
	JUMPN	B,SIXOT1
	POPJ	P,

SIXFIL:	MOVEI	C,6			;SET COUNT.  TYPES 6 CHARACTERS FROM A
SIXFL0:	MOVE	B,A			;GET THE DATA. CALL HERE WITH C SET
SIXFL1:	SETZ	A,
	LSHC	A,6
	ADDI	A," "
	PUSHJ	P,OUT.CH
	SOJG	C,SIXFL1
	POPJ	P,

TYFIL:	PUSH	P,B			;TYPE THE FILE FROM A,B,D
	PUSHJ	P,SIXFIL
	MOVEI	A," "
	PUSHJ	P,OUT.CH
	POP	P,A
	HLLZ	A,A
	PUSHJ	P,SIXFIL		;WILL TYPE AT LEAST 3 EXTRA SPACES
TYFIL1:	JUMPE	D,CPOPJ
IFE IRCPPN,<
	PUSH	P,D
	HLRZ	A,D
	MOVEI	C,PPNCHR
	PUSHJ	P,PPN1
	MOVEI	A,","
	PUSHJ	P,OUT.CH
	POP	P,A
	HRRZ	A,A
	MOVEI	C,PPNCHR
	JRST	PPN1
>
IFN IRCPPN,<
	MOVE A,D
PPN0:	PUSH P,A
	TLNE A,777740
	TRNN A,777740
	JRST PPN8
	TLNN A,77
	JRST PPN8
	HLLZ B,A
	PUSHJ P,PPN6
	MOVEI A,","
	PUSHJ P,OUT.CH
	POP P,B
	HRLZS B
PPN6:	TLNE B,770000
	TLO B,400000
	MOVEI C,3
PPN61:	MOVEI A,0
	LSHC A,6
	ADDI A,40
	PUSHJ P,OUT.CH
	SOJG C,PPN61
	POPJ P,
>

PPNOUT:	PUSH	P,A			;TYPE THE PPN THAT'S IN A.
	MOVEI	A,"["
	PUSHJ	P,OUT.CH
IFE IRCPPN,<
	HLRZ	A,(P)
	MOVEI	C,PPNCHR		;THIS IS THE CHARACTER COUNT FOR PPN
	PUSHJ	P,PPN1
	MOVEI	A,","
	PUSHJ	P,OUT.CH
	POP	P,A
	HRRZ	A,A
	MOVEI	C,PPNCHR
	PUSHJ	P,PPN1
>
IFN IRCPPN,<
	POP P,A
	PUSHJ P,PPN0
>
	MOVEI	A,"]"
	JRST	OUT.CH

IFN IRCPPN,<
PPN8:	HLRZS A
	MOVEI C,3
	PUSHJ P,PPN1
	MOVEI A,","
	PUSHJ P,OUT.CH
	POP P,A
	HRRZS A
	MOVEI C,0		;DROPS THROUGH TO PPN1
>
PPN1:	IDIVI	A,PPNDIV
	HRLM	B,(P)
	SUBI	C,1
	JUMPE	A,.+2
	PUSHJ	P,PPN1
PPN2:	SOJL	C,PPN3
	MOVEI	A," "
	PUSHJ	P,OUT.CH
	SOJGE	C,.-1
PPN3:	HLRZ	A,(P)
	ADDI	A,PPNADD
	JRST	OUT.CH


TYTIME:	IDIVI	A,74			;HOURS IN A, MINUTES IN B
	PUSH	P,B			;SAVE MINUTES
	PUSHJ	P,DECOUT
	MOVEI	A,":"
	PUSHJ	P,OUT.CH
	MOVE	B,(P)
	MOVEI	A,"0"
	CAIGE	B,12
	PUSHJ	P,OUT.CH
	POP	P,A
	JRST	DECOUT

TYDATE:	IDIVI	A,37			;DAYS IN B
	PUSH	P,A			;SAVE THE REST
	MOVEI	A," "			;BLANK
	CAIG	B,10
	PUSHJ	P,OUT.CH
	MOVEI	A,1(B)			;GET THE DAY OF MONTH
	PUSHJ	P,DECOUT
	MOVEI	A,"-"
	PUSHJ	P,OUT.CH
	MOVE	A,(P)
	IDIVI	A,14			;MONTHS IN B
	MOVEM	A,(P)
	MOVEI	B,MONTAB(B)
	PUSHJ	P,STROUT
	POP	P,A
	ADDI	A,100
	JRST	DECOUT
;RESTAR START STARTP STARTX CMD CMD1 CMGET NODPY CMGET1 CMGET2 CMGET3 NOTYET AMBIGC ILLCOM ILLCM1 COMTAB COMTB1

	SUBTTL	INITIALIZE - COMMAND DISPATCH
RESTAR:	TTCALL	11,0			;HERE AFTER SOME HORRIBLE ERROR
	RESET
	MOVE	P,[IOWD PDLEN,PDLIST]
	OUTSTR	CRLF
	SETZ	FL,
	SETZM	MEMSAV+MTAPOS		;SET POSITION TO ZERO FEET INTO TAPE
	SETOM	MEMSAV+MTAPQU		;SET POSITION QUESTIONABLE
	JRST	CMD

START:	RESET
	MOVEI	A,VERSION
	MOVEM	A,.JBVER
	MOVE	P,[IOWD PDLEN,PDLIST]
IFE STANSW,<
	MOVE A,[0,,16]
	GETTAB A,
	 MOVE A,[1,,1]
	MOVEM A,GOD
	MOVE A,[1,,16]
	GETTAB A,
	 MOVE A,[1,,4]
	MOVEM A,SYSPPN
	MOVE A,[2,,16]
	GETTAB A,
	 MOVE A,[1,,2]
	MOVEM A,DUMPER
>
IFN DBGSW,<
	MOVE	A,DBGPPN
	MOVEM	A,DUMPER		;MAKE DUMPER = DBGPPN, FOR DEBUGGING
>;IFN DBGSW
IFE IRCPPN,<
	MOVEI	A,0
	GETPPN	A,
IFE STANSW,<
	 JFCL
>
	MOVEM	A,LOGPPN		;SAVE LOGGED IN PPN
IFN STANSW,<
	CAME	A,DUMPER
	JRST	STARTX			;NOT THE DUMPER - DON'T SNARF PRIVS
STARTP:	SETZ	A,
	GETPRV	A,			;GET MY CURRENT PRIVS
	TDO	A,DUMPRV		;OR IN THE PRIVS I NEED
	SETPRV	A,			;GET THEM
	TDC	A,DUMPRV
	TDCN	A,DUMPRV
	JRST	STARTX			;GOT THEM ALL...A.O.K.
	OUTSTR	[ASCIZ /Can't enable privileges needed for system-class!!
/]
IFE DBGSW,<;Just type message and ignore it if debugging
	HALT	.+1
	JRST	STARTP
>;IFE DBGSW

STARTX:	MOVEI	A,0			;GET STANFORD-TYPE ALIAS.
	DSKPPN	A,			;GET DISK NAME OF THIS USER
>;IFN STANSW
>;IFE IRCPPN
IFN IRCPPN,<
	HRROI A,2			;USE KLUDGY IRCAM VERSION OF
	GETTAB A,			;ALIAS: GETTAB GETS REAL PPN
	 GETPPN A,
	  JFCL				;SIGH
	MOVEM A,LOGPPN
	GETPPN A,			;GETPPN GETS ALIAS
	 JFCL
>
	MOVEM	A,USRPPN		;SAVE PPN OF THIS USER
	DATE	A,
	MOVEM	A,THSDAT
	OUTSTR	CRLF
	SETZ	FL,			;ZERO ALL THE FLAGS
	SETZM	MEMSAV+MTAPOS		;SET POSITION TO ZERO FEET INTO TAPE
	SETOM	MEMSAV+MTAPQU		;SET POSITION QUESTIONABLE
	TTCALL	10,			;RESCAN THE TTY
	TRO	FL,SCANON		;DOING A RESCAN
	JRST	CMD1			;SKIP THE *

CMD:	SETZ A,
IFN STANSW,<
	JBTSTS A,		;SEE IF NOT LOGGED IN
	TLNN A,10000		;JLOG
	 EXIT
>;IFN STANSW
	OUTSTR	[ASCIZ/*/]
IFN STANSW,<
	MOVSI A,0		;ACTIVE
	GETPRV A,
	IOR A,[1,,200000]	;LUP AND LIV FREE IF IN PASSIVE
	MOVSI B,1		;PASSIVE
	GETPRV B,
	AND A,B			;KEEP ONLY PASSIVE-ENABLED ONES
	SETPRV A,
>;IFN STANSW
	SETZ	FL,			;CLEAR ALL FLAGS.
CMD1:	TRZ	FL,MRUNCM		;CLEAR MONITOR RUN COMMAND
	SETZM	MTDEV
	PUSHJ	P,CMGET			;READ A COMMAND FROM THE TTY
	TRNN	FL,MRUNCM		;WAS THIS A MONITOR COMMAND?
	TRNN	FL,SCANON		;WAS A REAL COMMAND. ARE WE RESCANNING?
	JRST	CMD			;NOT RESCANNING OR RUN COMMAND. GO DO IT AGAIN
	EXIT				;EXIT AFTER ONE RESCANNED COMMAND.

CMGET:	TLO FL,L.PUMP!L.SWIT		;ALLOWING SLASH, BUT NOT DOING IT NOW
	PUSHJ	P,GETSIX		;GET A COMMAND NAME
	TLZ FL,L.PUMP!L.SWIT
	CAIN	A,12			;SKIP UNLESS END OF LINE
	JUMPE	B,CPOPJ			;NULL COMMAND?
	JUMPE	B,ILLCOM		;ILLEGAL COMMAND
	MOVEM	A,SAVDEL		;SAVE THE DELIMITER

IFN STANSW!IRCPPN,<
IFN STANSW,<
	MOVNI	D,1
	TTCALL	6,D			;GET LINE CHARACTERISTICS
	CAME	D,[-1]
	TLNN	D,460000		;NOT DETACHED, SKIP IF DPY
	MOVEI	D,0			;DETACHED OR NOT DPY
>;STANSW
IFN IRCPPN,<
	MOVE D,[2,,[ .TOTTY  0 ]]
	TRMOP. D,
	 MOVEI D,0
	TLZE D,400000			;TURN IRCAM DISPLAY BIT
	TLO D,40000			; INTO SAIL DM BIT
>;IRCPPN
	MOVEM	D,LINSAV		;<0=III, >0=DD, 0=TTY OR DETACHED
	JUMPE	D,NODPY
	MOVE	A,DDCMD
	TLNN	D,20000			;Skip if DD
	SETZ	A,
	MOVEM	A,BUFBUF		;First word of display program
	MOVE	A,DDBUF			;Assume DD
	TLNE	D,400000
	MOVE	A,IIIBUF
	TLNE	D,40000
	MOVE	A,DMBUF
	MOVEM	A,BUFBUF+1
NODPY:
>

					;CREATE A MASK FOR THE SEARCH
	SETZB	D,AMBIG			;REMEMBER LOCATION OF COMMAND
	TDZ	C,[007700,,-1]		;BYTE SIZE SET TO 44. POINTS TO D
	TDO	C,[004400,,D]
	SETO	A,
	DPB	A,C			;SET UP D WITH A MASK
	MOVSI	C,-COMTL
	SKIPE PUMWIZ
	MOVSI C,-PCOMTL			;EXTRA COMMANDS FOR PUMPKIN WIZARD
CMGET1:	MOVE	A,COMTAB(C)
	CAMN	B,A
	JRST	CMGET3
	AND	A,D
	CAME	A,B
	JRST	CMGET2
	MOVE	A,C
	EXCH	A,AMBIG			;REMEMBER THIS COMMAND
	JUMPE	A,CMGET2
	MOVNI	C,2			;AMBIGUOUS COMMAND
	JRST	CMGET3			;
CMGET2:	AOBJN	C,CMGET1
	SKIPN	C,AMBIG
	MOVNI	C,1
CMGET3:	MOVE	C,COMTB1(C)
	SKIPE PUMWIZ			;PUMPKIN WIZARD POSITIONING TAPE?
	JUMPGE C,ILLCOM			;YES, ONLY SOME COMMANDS LEGAL
	JRST	(C)				;DISPATCH

NOTYET:	OUTSTR	[ASCIZ/Unimplemented command "/]
	JRST	ILLCM1
AMBIGC:	OUTSTR	[ASCIZ/Ambiguous command "/]
	JRST	ILLCM1
IFE UDPCSW,<UDPCOP:>
IFE KMCSW,<KMCDMP:>
ILLCOM:	OUTSTR	[ASCIZ/Illegal command "/]
ILLCM1:	MOVE	A,B
	PUSHJ	P,SIXOUT
	OUTSTR	[ASCIZ/"
/]
	TTCALL	11,
	POPJ	P,

COMTAB:	'R     '
	'RUN   '
	'START '
	'CONTIN'
	'S     '		;START
	'DDT   '
	'DUMP  '		;DUMP FILES FOR A USER
	'RESTOR'		;RESTORE 
	'MRESTO'		;MAJOR RESTORE  - PRIVILEGED
	'FDUMP '		;FULL DUMP    -   PRIVILEGED
	'TDUMP '		;TEMPORARY DUMP - PRIVILEGED
	'PDUMP '		;PERMANENT DUMP - PRIVILEGED
	'PICKUP'		;PICKUP LAST COMMAND AFTER A CRASH
	'REWIND'		;REWIND
	'ADVANC'		;ADVANCE FILE OR RECORD
	'BACKSP'		;BACKSPACE FILE OR RECORD
	'LIST  '		;LIST THE TAPE
	'TLIST '		;LIST FOR COMPATABILITY
	'EOT   '		;ADVANCE TO END OF TAPE
	'LOCATE'		;LOCATE FILES FROM DART.DAT
	'EXIT  '
	'POSITI'		;POSITION THE TAPE
	'ARCHIV'		;ARCHIVE COMMAND
	'PURGE '		;DO PCLASS DUMP, DELETING FILES
	'UDPCOP'		;COPY OLD UDP TO NEW
	'KMCDMP'
	'NODUMP'		;SET NO-DUMP BIT FOR FILES
	'MAXLEN'		;SET MAX LENGTH FOR SYSTEM DUMPS
	'TURKEY'		;SEE WHO LAST USED A TAPE
	'PUMPKI'		;ASK THE GREAT PUMPKIN TO RESTORE A FILE
	'PRESTO'		;I AM THE GREAT(EST) PUMPKIN!
	'PLIST '		;LIST THE PUMPKIN QUEUE
	'UNPUMP'		;UN-PUMPKIN
	'REAP  '		;CAUSE FILE TO BE DUMPED AND DELETED
	'UNREAP'		;UNDO REAP
SDEF	COMTL,.-COMTAB
;FOLLOWING SPECIAL COMMANDS ACCEPTED ONLY AFTER TAPE ERROR IN PRESTORE
	'RETRY '		;RETRY THIS TAPE
	'FLUSH '		;FLUSH THIS TAPE
SDEF	PCOMTL,.-COMTAB

	AMBIGC
	ILLCOM
COMTB1:	MONCOM			;R
	MONCOM			;RUN
	MONCOM			;START
	MONCOM			;CONTINUE
	MONCOM			;S(TART)
	400000,,DDTCOM		;DDT
	DUMPGO			;DUMP
	RESTGO			;RESTORE
	MRESTO
	FDUMP
	TDUMP
	PDUMP
	PICKUP
	400000,,REWGO		;REWIND
	400000,,ADVANC		;ADVANCE
	400000,,BACKSP		;BACKSPACE
	LISTGO			;LIST
	LISTGO			;TLIST
	400000,,EOTGO		;EOT
	DLOCAT			;LOCATE
	[EXIT]			;EXIT
	NOTYET			;POSITION (UNIMPLEMENTED)
	ARCHIV			;ARCHIVE
	0,,PURGE		;PURGE COMMAND
	UDPCOP			;UDP COPY.
	KMCDMP			;KMCDMP
	NODUMP			;SET NO-DUMP BIT FOR FILES
	MAXSET			;SET MAX LENGTH FOR SYSTEM DUMPS
	TURKEY			;FIND OUT WHO DIDN'T PUT THE TAPE AWAY
	PUMPKI			;ASK THE GREAT PUMPKIN TO RESTORE A FILE
	PRESTO			;I AM THE GREAT(EST) PUMPKIN!
	PLIST			;LIST THE PUMPKIN QUEUE
	UNPUMP			;REMOVE A PUMPKIN REQUEST
	REAP			;CAUSE FILE TO BE DUMPED AND DELETED
	UNREAP			;UNDO REAP
;FOLLOWING SPECIAL COMMANDS ACCEPTED ONLY AFTER TAPE ERROR IN PRESTORE
	400000,,RETRY		;RETRY THIS TAPE
	400000,,TFLUSH		;FLUSH THIS TAPE
;DDTCOM DDTGO NODDT MONCOM FLUSH FLUSH1 MAXSET

	SUBTTL	DDTCOM, MONCOM, FLUSH, MAXLEN
DDTCOM:	TTCALL	11,		;FLUSH TYPE AHEAD
	TRNN	FL,SCANON	;ARE WE RESCANNING?
	JRST	DDTGO		;NO. CALL DDT
	TRO	FL,MRUNCM
	POPJ	P,

DDTGO:	HRRZ	A,.JBDDT	;PICKUP .JBDDT
	JUMPE	A,NODDT
	OUTSTR	[ASCIZ/(DDT.  Return with CPOPJ$G)
/]
	JRST	(A)		;DO IT.

NODDT:	OUTSTR	[ASCIZ/No DDT
/]
	POPJ	P,

MONCOM:	MOVE	A,SAVDEL	;GET THE DELIMITER
	TRO	FL,MRUNCM	;ANNOUNCE ANOTHER RUN CONTROL COMMAND
	JRST	FLUSH1
FLUSH:	TTCALL	4,A
FLUSH1:	CAIE	A,12
	CAIN	A,ALTMOD
	POPJ	P,
	JRST	FLUSH		;FLUSH UNTIL LF OR ALTMODE

;CODE FOR DISPATCH TO UNIMPLEMENTED OPERATIONS

	OUTSTR	[ASCIZ/Unimplemented operation "/]
	MOVE	A,B
	PUSHJ	P,SIXOUT
	OUTSTR	[ASCIZ/"
/]
	POPJ	P,

MAXSET:	PUSHJ P,RDNUMB		;READ NUMBER AFTER MAXLEN
	LSH B,7			;RECORDS INTO WORDS
	MOVEM B,MAXLEN
	POPJ P,
;REWGO EOTGO ADVANC BACKSP ADVAN1 ADVAN2 ADVAN3 ADVAN4 ADVGO BACK1 BACK2 ADVCM NUMTST NUMTS1 NUMTSX

	SUBTTL	REWIND, EOT, ADVANCE, BACKSPACE
REWGO:	PUSHJ	P,DEVSCN		;SCAN FOR A DEVICE, ETC.
	PUSHJ	P,MTINIT
	TRZ	FL,MTAEOT
	PUSHJ	P,MTAREW
	PUSHJ	P,MTAREL		;RELEASE DEVICE.
	POPJ	P,

EOTGO:	PUSHJ	P,DEVSCN
	PUSHJ	P,MTINIT
	PUSHJ	P,MTASKT		;SKIP TO END OF TAPE
	PUSHJ	P,MTAREL
	POPJ	P,


ADVANC:	TROA	FL,ADVCOM		;SET ADVANCE COMMAND
BACKSP:	TRZ	FL,ADVCOM		;CLEAR ADVANCE.
	TRO	FL,ABFILE		;ADVANCE/BACKSPACE FILE
	MOVEI	A,1
	MOVEM	A,REPCNT		;ASSUME REPEAT FACTOR OF ONE
	MOVE	A,SAVDEL
	CAIE	A,12
	CAIN	A,ALTMOD
	JRST	ADVGO
	PUSHJ	P,GETSIX		;GET SOMETHING IN SIXBIT
	CAIN	A,":"			;COLON FORCES THE DEVICE NAME
	JRST	ADVAN3			;TREAT THIS AS A DEVICE NAME
	CAMN	B,['FILE  ']
	JRST	ADVAN1			;ADV/BAK FILE
	CAME	B,['RECORD']
	JRST	ADVAN2			;THIS MUST BE A DEVICE NAME
	TRZ	FL,ABFILE		;CLEAR ADV/BAC FILE FLAG
ADVAN1:	CAIE	A,12
	CAIN	A,ALTMOD
	JRST	ADVGO			;DONE WITH SCAN
	PUSHJ	P,GETSIX
	CAIN	A,":"
	JRST	ADVAN3			;FORCE DEVICE NAME NOW.
ADVAN2:	PUSHJ	P,NUMTST		;TEST SIXBIT IN B FOR BEING A NUMBER
	JRST	ADVAN3			;NOT A NUMBER MUST BE A DEVICE NAME
	JRST	ADVAN4			;PROCESS A NUMBER

ADVAN3:	MOVEM	B,MTDEV			;SAVE DEVICE NAME
	CAIE	A,12
	CAIN	A,ALTMOD
	JRST	ADVGO
	PUSHJ	P,GETSIX
	JUMPE	B,ADVGO			;IGNORE NULLS.
	PUSHJ	P,NUMTST
	JRST	SYNTAX			;IMPROPER SYNTAX
ADVAN4:	MOVEM	C,REPCNT		;SAVE REPEAT COUNT.
ADVGO:	PUSHJ	P,MTINIT		;INITIALIZE THE DEVICE
	MOVE	C,REPCNT
	TRNE	FL,ADVCOM		;ADVANCE OR BACKSPACE?
	JRST	ADVCM			;ADVANCE
BACK1:	TRNN	FL,ABFILE
	PUSHJ	P,MTABKR		;BACKSPACE RECORD
	TRNE	FL,ABFILE
	PUSHJ	P,MTABKF		;BACKSPACE FILE
	PUSHJ	P,MTANOP		;WAIT
	STATO	MTA,IOBOT		;BEGINNING OF TAPE?
	SOJG	C,BACK1			;STILL IN TAPE KEEP ON TRUCKING
	STATZ	MTA,IOBOT		;AT FRONT OF TAPE?
	JRST	BACK2
	TRNE	FL,ABFILE		;SKIP IF BY RECORDS
	PUSHJ	P,MTASKF		;NO. HAVE TO SKIP FORWARD OVER EOF MARK
	TRNN	FL,ABFILE		;SKIP IF BY FILES
	PUSHJ	P,MTASKR		;BY RECORDS, SKIP ONE RECORD.
BACK2:	PUSHJ	P,MTAREL
	POPJ	P,

ADVCM:	TRNN	FL,ABFILE
	PUSHJ	P,MTASKR		;ADVANCE RECORD
	TRNE	FL,ABFILE
	PUSHJ	P,MTASKF		;ADVANCE FILE
	STATO	MTA,IOTEND		;END OF TAPE?
	SOJG	C,ADVCM			;NO. KEEP ON TRUCKING
	PUSHJ	P,MTAREL
	POPJ	P,			;RETURN

NUMTST:	JUMPE	B,CPOPJ			;NULL IS NOT A NUMBER
	PUSH	P,B
	SETZ	D,
NUMTS1:	SETZ	C,
	ROTC	B,6
	SUBI	C,'0'
	JUMPL	C,NUMTSX
	CAILE	C,11
	JRST	NUMTSX
	IMULI	D,12
	ADDI	D,(C)
	JUMPN	B,NUMTS1
	MOVE	C,D
	AOS	-1(P)
NUMTSX:	POP	P,B
	POPJ	P,
;LSTINI LISTG1 LISTG2 LISTGO LSTLP LSTLP1 LSTLP2 LSTFIN

	SUBTTL	LISTGO	TLIST, LIST COMMANDS
LSTINI:	TRZ	FL,LSTON+LSTTTY		;ZERO SOME BITS
	SETZM	LSTDEV-1		;KLUGE
	SKIPN	R,DEST			;WAS THERE ANY DESTINATION GIVEN
	MOVEI	R,LSTDEV-1		;KLUGE TO ZERO RSTDEV BLOCK
	MOVSI	R,(R)			;SOURCE OF BLT
	HRRI	R,LSTDEV		;DESTINATION
	BLT	R,LSTPPN		;DO THE TRANSFER
	MOVSI	A,'TTY'			;ASSUME TTY IF NO EXPLICIT DEST.
	SKIPN	DEST			;WAS THERE EXPLICIT DEST TERM
	MOVEM	A,LSTDEV		;NO. SET *.* FLAGS
	SKIPN	A,LSTDEV		;IF THIS IS ZERO
	MOVSI	A,'DSK'			;THERE WAS EXPLICT DEST AND NO DEV.
	MOVEM	A,LSTDEV		;SAVE AS RESTORE DEVICE.
	HRRZ	B,LSTEXT		;GET ANY WILD BITS
	TRNE	B,ALLMSK		;ARE ANY SET?
	JRST	ALLLST			;YES. *'S ILLEGAL IN LIST TERM
	MOVEI	A,0			;LISTING IN MODE 0
	MOVE	B,LSTDEV		;PICKUP THE LISTING DEVICE
	MOVSI	C,LSTBUF		;BUFFER HEADER.
	OPEN	LST,A			;OPEN THE DEVICE
	PUSHJ	P,NODEV			;LOSE.
	OUTBUF	LST,2			;MAKE SOME BUFFERS.
	MOVE	A,LSTDEV		;GET THE NAME OF THE LISTING DEVICE
	DEVCHR	A,			;GET CHARACTERISTICS
	TRO	FL,LSTON		;ANNOUNCE WE ARE LISTING
	TLNE	A,TTYBIT		;IS THIS A TTY?
	TRO	FL,LSTTTY		;MARK AS BEING LISTING ON A TTY
	TLNN	A,DIRBIT		;IS THIS A DIRECTORY DEVICE?
	POPJ	P,			;NO.  ENTER IS UNNECESSARY
	SKIPE	A,LSTNAM		;GET A FILE NAME
	JRST	LISTG1
	MOVE	A,['DART  ']		;
	MOVSI	B,'LST'
	SETZB	C,D
	JRST	LISTG2

LISTG1:	HLLZ	B,LSTEXT		;GET THE EXTENSION.
	SETZ	C,
	SKIPN	D,LSTPPN
LISTG2:	MOVE	D,USRPPN
	ENTER	LST,A
	JRST	NOENT
	POPJ	P,


LISTGO:	PUSHJ	P,SCAN			;SCAN THE WORLD
	HRRZ	W,TBASE			;GET THE BASE OF ALL TERMS
	CAML	W,FSPTR			;ARE THERE ANY SOURCE TERMS AT ALL?
	PUSHJ	P,GETBLK		;NO. MAKE A TERM BLOCK
	MOVE	A,FSDEV(W)		;LOOK FOR A DEVICE
	MOVEM	A,MTDEV			;SAVE MT DEVICE.
	PUSHJ	P,MTINIT		;INITIALIZE THE MAGTAPE.
	PUSHJ	P,MTANOP		;DO A MTA NO-OP TO DETECT FRONT OF TAPE
	PUSHJ	P,LSTINI
LSTLP:	PUSHJ	P,RDFIL			;READ A FILE HEADER
	TRNE	FL,MTAEOT		;END OF TAPE?
	JRST	LSTLP2			;YES. WE'RE DONE
	MOVE	A,SRCDEV
	JUMPE	A,LSTLP1
	CAMN	A,['DSK   ']
	JRST	LSTLP1
	PUSHJ	P,SIXOUT
	MOVEI	A,":"
	PUSHJ	P,LSTOUT
	MOVEI	A,11
	PUSHJ	P,LSTOUT		;SOME SPACE.
LSTLP1:	MOVE	A,FILINF+DDNAM		;GET FILE NAME
	MOVE	B,FILINF+DDEXT
	MOVE	D,FILINF+DDPPN
	PUSHJ	P,TYFIL			;TYPE A FILE NAME FROM A,B,D
	MOVEI	B,CRLF
	PUSHJ	P,LSTSTR
	TRNE	FL,LSTTTY		;SKIP UNLESS LISTING ON A TTY
	CLOSE	LST,			;FORCE EACH LINE OUT TO THE TTY
	PUSHJ	P,DPYSER		;DISPLAY NAME, PPN, AND NO. OF FEET
	FILINF+DDNAM,,DPYFIL
	PUSHJ	P,RDFILX		;FLUSH THE REST OF THE FILE
	TRNN	FL,MTAEOT		;SKIP IF END OF TAPE THERE
	JRST	LSTLP			;LOOP
LSTLP2:	PUSHJ	P,MTAREL	;FINISHED WITH MTA
LSTFIN:	TRZ	FL,LSTON+LSTTTY
	CLOSE	LST,
	RELEAS	LST,
	POPJ	P,
;UNREAP REAP NODUMP SETCLR DUMPGO DMPG1 DMPG2 DMTERM DMTER1 DMTR1A DMTR1B DMTER3 DMTER2 DMTALL DMTAL1 DUMPG4 DUMPG3

	SUBTTL	DUMPGO	SCAN COMMANDS - DO THE DUMP

UNREAP:	MOVEI A,UNRPER			;CLEAR REAP BIT
	JRST SETCLR

REAP:	SKIPA A,[REAPER]		;SET REAP BIT
NODUMP:	MOVEI A,NODTHS			;ADDR OF ROUTINE TO SET/CLEAR BIT
SETCLR:	MOVEM A,NODDSP			;SAVE ADDR
	TLOA FL,L.NOD			;SET NODUMP COMMAND
DUMPGO:	TLZ FL,L.NOD			;SET DUMP COMMAND
	PUSHJ	P,SCAN			;SCAN EVERYTHING!
	SETZM	MTDEV-1			;WATCH THIS KLUGE
	SKIPN	R,DEST			;IS THERE A DESTINATION TERM?
	MOVEI	R,MTDEV-1		;NO DESTINATION. MAKE DEFAULTS
	MOVSI	A,(R)
	HRRI	A,MTDEV
	BLT	A,MTPPN
	HRRZ	R,TBASE			;GET THE BASE ADDRESS OF THE SOURCE
	CAME	R,FSPTR			;SAME AS CURRENT POINTER?
	JRST	DMPG1			;NO. AT LEAST 1 TERM.
	PUSHJ	P,GETBLK		;GET A TERM BLOCK.
	MOVEI	A,ALLFIL+ALLEXT		;GET THE FLAGS
	MOVEM	A,FSEXT(R)		;SAVE THEM. SET FOR DSK:*.*[CURRENT AREA]
	TLNN FL,L.NOD			;IS THIS THE REAL DUMP COMMAND?
	JRST DMPG1			;YES, NO EXPLICIT FILE LIST IS OK
	OUTSTR [ASCIZ /You must specify some files explicitly.  ("*.*" is ok.)
/]
	JRST RESTAR

DMPG1:	MOVE	A,FSPTR			;GET THE FREE POINTER
	MOVEM	A,.JBFF			;SET IT AS .JBFF
	MOVE	A,USRPPN		;THIS IS THE STICKY PPN
	MOVEM	A,STKPPN		;SAVE THE STICKY PPN
	MOVSI	A,'DSK'			;THIS IS THE STICKY DEVICE
	MOVEM	A,STKDEV		;SAVE IT.
	TLNE FL,L.NOD			;NO MAGTAPE FOR NODUMP
	JRST DMPG2
	PUSHJ	P,MTINIT		;INIT THE MAGTAPE
	SETZM	CLASS			;CLASS = 0 IS USER DUMP
	SETZM	TAPNO			;ASSUME WE DON'T KNOW WHAT TAPE NUMBER
	PUSHJ	P,TAPHED		;MAKE A TAPE HEADER RECORD.
	SETZM	LASSAV			;NO LAST FILE SAVED.

DMPG2:	HRRZ	R,TBASE			;GET THE (RISING) BASE OF TERM LIST
	CAML	R,FSPTR			;ARE WE BENEATH THE FREE POINTER?
	JRST	DUMPG3			;DONE.
	MOVSI	R,(R)			;GET THE BASE ADDRESS
	HRRI	R,FDEV			;GET THE DESTINATION
	BLT	R,FPPN			;STORE THRU THE PPN
	MOVEI	A,FSLEN			;UPDATE TBASE TO POINT TO NEXT TERM
	ADDM	A,TBASE			;...
	PUSH	P,.JBFF			;SAVE .JBFF

					;PROCESS A SINGLE TERMBLOCK IN DUMP COMMAND
DMTERM:	MOVEI	A,10!DMPBIT!GARBIT	;OPEN THE FILE DEVICE. DON'T CHANGE REFTIM
	SKIPN	B,FDEV			;GET THE FILE DEVICE
	MOVE	B,STKDEV		;USE THE STICKY DEVICE INSTEAD
	MOVEM	B,STKDEV		;SAVE LAST DEVICE USED AS STICKY
	MOVEM	B,DEVNAM		;SAVE HERE FOR DUMP
	MOVEI	C,FIBUF			;ADDRESS OF BUFFER HEADER.
	TLZ	FL,UDPGO		;ASSUME NOT UDP

	MOVE	D,B			;GET SOURCE DEVICE
	DEVCHR	D,
	TLNE	D,DEVDSK		;IS IT A DISK?
	JRST	DMTER1			;YES.
IFE UDPSW,<
	JRST	NOTDSK			;NOT DSK AND ONLY DSK IS LEGAL
>
IFN UDPSW,<
	TLNN	D,DEVUDP		;IS IT A UDP?
	JRST	NOTDSK			;NO. AND NOT DSK EITHER.
	TLO	FL,UDPGO		;SET FOR FUTURE UDP OPERATIONS
	INIUDP	B			;INITIALIZE UDP. DEVICE NAME IN B
	UOPEN	FILE,A			;OPEN THE UDP.
>
DMTER1:
IFN STANSW,<
	OPEN	FILE,A			;ATTEMPT TO OPEN THE DEVICE
	PUSHJ	P,NODEV			;DEVICE IS UNAVAILABLE
	TLNE	FL,UDPGO
	JRST	DMTR1B			;JUMP IF THIS IS THE UDP.
	CHNSTS	FILE,A			;GET THE CHANNEL STATUS FROM UUOCON
	TRNN	A,100			;SKIP IF THIS IS DEVICE SYS
	JRST	DMTR1A			;NOT DEVICE SYS.
	MOVSI	A,'DSK'			;THIS IS SYS:  CHANGE TO DSK:[1,3]
	MOVEM	A,DEVNAM		;DEVICE IS REALLY THE DISK
	MOVEM	A,STKDEV		;SET STICKY DEVICE.
	MOVE	A,['  1  3']		;USE SYS AREA PPN.
	MOVEM	A,FPPN			;SET EXPLICIT PPN.
DMTR1A:	TLNN FL,L.NOD			;NO BUFFERS FOR NODUMP
	INBUF	FILE,23			;SOME BUFFERS ARE NEEDED
>
DMTR1B:	MOVE	A,FEXT			;GET THE MAJIC BITS
	TRNN	A,ALLFIL+ALLEXT		;ANY WILD FILE NAME?
	MOVEI	A,ALLFIL+ALLEXT		;NO WILD NAME. PICKUP WILD BITS
	SKIPN	FNAM			;IS THERE AN EXPLICIT NAME?
	IORM	A,FEXT			;NO EXPLICIT NAME ADD WILD BITS
	HRRZ	A,FEXT			;GET THE MAJIC BITS
	TRNE	A,ALLMSK
	JRST	DMTALL			;GO OFF TO SELECT FILES.
IFE STANSW,<
	MOVEI A,10
	MOVE B,DEVNAM
	MOVEM B,STRUCT
	MOVEI C,FIBUF
	OPEN FILE,A
	PUSHJ P,NODEV
	TLNN FL,L.NOD			;NO BUFFERS FOR NODUMP
	INBUF FILE,23
>
	MOVE	A,FNAM			;DUMP ONE FILE AND POPJ
	HLLZ	B,FEXT
	SETZ	C,
	SKIPN	D,FPPN
	MOVE	D,STKPPN		;DEFAULT TO STICK PPN
	MOVEM	D,STKPPN		;SAVE STICKY PPN
	MOVEM	D,FPPN			;SAVE IT BACK HERE TOO.
	PUSHJ	P,DMTHIS

IFN UDPSW,<
DMTER3:	TLZN	FL,UDPGO
	JRST	DMTER2			;CLOSE NORMAL DISK.
	UCLOSE	FILE,			;CLOSE UDP
	SETZM	USYNC			;TO CATCH ERRORS.
	JRST	DUMPG4
>

DMTER2:	CLOSE	FILE,NUPACC		;DON'T UPDATE ACCESS DATE
	RELEAS	FILE,
	JRST	DUMPG4


DMTALL:
IFN UDPSW,<
	TLNN	FL,UDPGO		;IS THIS A UDP?
	JRST	DMTAL1			;NO
	PUSHJ	P,UDMALL		;YES. DO WILD SPEC FROM UDP.
	JRST	DMTER3			;NOW CLOSE THE UDP ENTIRELY.
>
DMTAL1:	PUSHJ	P,DMALL			;DUMP WILD TERM.

DUMPG4:	POP	P,.JBFF			;RETURN HERE FROM DMALL
	JRST	DMPG2

DUMPG3:	TLNN FL,L.NOD			;NO MTA FOR NODUMP
	PUSHJ	P,MTAREL
	POPJ	P,
;DMTHIS DMPLKP DMTHIX DMTHIY YMTA4 NOMTA4 YMTA5 NOMTA5 NODTHS STANOD NSTNOD NSTNO1 REAPER UNRPER DMRED0 YMTA6 DMREDO DMRED1 DMRED2 DMRED3 NOMTA7

	SUBTTL	DMTHIS	DUMP ONE FILE TO TAPE
DMTHIS:	MOVEM	A,FILINF+DDNAM		;HERE FROM DMALL TO DUMP ONE FILE.
	MOVEM	B,FILINF+DDEXT
	MOVEM	D,FILINF+DDPPN
	MOVE	X,[A,,FILBLK]
	BLT	X,FILBLK+3
	TRZ	FL,SAFETY
IFN UDPSW,<
	TLNE	FL,UDPGO
	ULOOK	FILE,A
>
IFE STANSW,<
	PUSHJ P,DMPLKP			;MAKE SUBR OF LOOKUP CODE SO
	 POPJ P,			;SYSTEM DUMPS CAN USE IT TOO
	JRST DMTHIX

DMPLKP:	MOVEM A,LKBLK+.RBNAM
	MOVEM B,LKBLK+.RBEXT
	MOVEM D,LKBLK+.RBPPN
	LOOKUP FILE,LKBLK
>
IFN STANSW,<
	LOOKUP	FILE,A			;ATTEMPT TO FIND FILE.
>
	JRST	[PUSHJ P,LCHECK		;CANNOT BE FOUND
		JFCL
		POPJ P,]		;FLUSH THIS TERMBLOCK
IFE STANSW,<
	MOVE B,LKBLK+.RBEXT
	MOVEM B,FILINF+DDEXT
	MOVE C,LKBLK+.RBPRV
	MOVEM C,FILINF+DDPRO
	MOVE D,LKBLK+.RBSIZ
	MOVEM D,FILINF+DDLNG
	ANDI B,77777
	MOVEM B,FILINF+DREFTM
	MOVEI B,1
	MOVEM B,FILINF+DDOFFS
	MOVE B,LKBLK+.RBNCA
	MOVEM B,FILINF+DDMPTM
	MOVE B,LKBLK+.RBDEV
	MOVEM B,FILINF+DSATID
	MOVE B,LKBLK+.RBAUT
	MOVEM B,FILINF+DQAUT
	MOVE B,LKBLK+.RBVER
	MOVEM B,FILINF+DQVER
	JRST CPOPJ1
>
IFN STANSW,<
	MOVEM	C,FILINF+DDPRO
	MOVS	D,D
	MOVMM	D,FILINF+DDLNG
	TLNE	FL,UDPGO		;CAN'T GET THIS FROM THE SYSTEM IF UDP.
	JRST	DMTHIX			;SO AVOID THIS SHIT.
	MTAPE	FILE,['GODMOD'
			   14
		      IOWD 20,FILINF]
	JFCL				;CAN'T LOSE. IT SAYS HERE
	MTAPE	FILE,RDOFFS		;READ OFFSET FROM THE OFFSET BLOCK.
	MOVE	A,RDOFFS+2		;GET THE OFFSET NUMBER.
	MOVEM	A,FILINF+DDOFFS		;SAVE IT IN THE RETRIEVAL.
>
DMTHIX:	MOVE	D,[FILINF+DDNAM,,A]	;PICK UP THE FILE NAME AGAIN
	BLT	D,D
	PUSHJ	P,TYFIL			;TYPE THE FILE NAME - NO CR
	TLNN FL,L.NOD
	JRST DMTHX0			;JUMP IF DUMP COMMAND
	OUTSTR CRLF			;IF NOT DUMP COMMAND, TYPE CRLF
	MOVE	D,[FILINF+DDNAM,,A]	;PICK UP THE FILE NAME AGAIN
	BLT	D,D
	JRST @NODDSP			;PROCESS NODUMP COMMAND

DMTHX0:	PUSHJ	P,DPYSER		;DISPLAY NAME, PPN, AND NO. OF FEET
	FILINF+DDNAM,,DPYFIL
	TLZ	FL,IGNEOT
IFN STANSW,<
	TLNE	FL,UDPGO		;UDP?
	JRST	DMTHIY			;YES. WE SKIP THE OFFSET STUFF.
	MOVEI	A,2
	SUB	A,FILINF+DDOFFS
	USETI	FILE,(A)		;USETI TO THE FIRST REAL RECORD.
>
DMTHIY:	PUSHJ	P,DUMP
	JRST	DMRED0			;HAVE TO DO IT OVER ON A NEW TAPE
IFN DBGSW,<
	SKIPN	DBGNTP
	JRST	YMTA4
	PUSHJ	P,NXTOBF		;FAKE CLOSE IF NOT OUTPUTTING
	JRST	NOMTA4			;NO TAPE OPERATIONS IF NOT USING IT
YMTA4:
>;IFN DBGSW
	PUSHJ	P,MTACLZ
NOMTA4:	MOVEI	A,RECSIZ
	MOVEM	A,WC
	SETZM	MTFILN
IFN DBGSW,<
	SKIPN	DBGNTP
	JRST	YMTA5
	SKIPA
	JRST	DMREDO	;TO FAKE AN EOT (FOR TESTING W/O TAPE)
	JRST	NOMTA5			;NO TAPE OPERATIONS IF NOT USING IT
YMTA5:
>;IFN DBGSW
	STATZ	MTA,742000		;SEE THAT THE MTA IS HAPPY.
	JRST	DMREDO
NOMTA5:	MOVE	A,[FILBLK,,LASSAV]
	BLT	A,LASSAV+3		;SAVE THE NAME OF THE FILE WE JUST FINISHED
	OUTSTR	CRLF			;AFTER THE FILE IS OUT, TYPE CR.
	POPJ	P,

NODTHS:
IFN STANSW,<
	TLO C,400000			;THIS IS THE SAIL NO-DUMP BIT
STANOD:	MOVE D,FILINF+DDPPN
	MOVE W,FILINF+DREFTM		;LONG RENAME! BH 7/7/79
	MOVE X,FILINF+DDMPTM		;DITTO
	RENAME FILE,A
	 JFCL
	POPJ P,
>
IFE STANSW,<
	MOVSI D,4000			;THIS IS OUR NO-DUMP BIT
NSTNOD:	IORM D,LKBLK+.RBNCA		;IN A DIFFERENT WORD TOO
NSTNO1:	RENAME FILE,LKBLK
	 JFCL
	POPJ P,
>

REAPER:	MOVSI D,10000			;DELETE-AFTER-DUMPING BIT
IFN STANSW,<
	IORM D,FILINF+DDMPTM		;SET IT IN DUMP WORD
	JRST STANOD			;JOIN SAIL NODUMP CODE
>;IFN STANSW
IFE STANSW,<
	JRST NSTNOD			;JOIN NON-SAIL CODE
>;IFE STANSW

UNRPER:	MOVSI D,10000
IFN STANSW,<
	ANDCAM D,FILINF+DDMPTM		;CLEAR NO-DUMP BIT
	JRST STANOD
>;IFN STANSW
IFE STANSW,<
	ANDCAM D,LKBLK+.RBNCA		;CLEAR BIT
	JRST NSTNO1
>;IFE STANSW

DMRED0:
IFN DBGSW,<
	SKIPN	DBGNTP
	JRST	YMTA6
	PUSHJ	P,NXTOBF	;IF NOT OUTPUTTING, FAKE OUTPUT
	JRST	DMREDO
YMTA6:
>;IFN DBGSW
	PUSHJ	P,MTACLZ		;ATTEMPT TO END FILE 
DMREDO:	OUTSTR	[ASCIZ/	Not saved. - Physical end of tape.
/]
IFN DBGSW,<
	SKIPE	DBGNTP
	JRST	NOMTA7			;NO TAPE OPERATIONS IF NOT USING IT
>;IFN DBGSW
	PUSHJ	P,MTAREL		;RELINQUISH THE MAG TAPE
	PUSHJ	P,MINIT1		;INIT THE MAGTAPE WITH ONLY ONE BUFFER
DMRED1:	PUSHJ	P,MTABKF
	PUSHJ	P,MTABKF
	PUSHJ	P,MTASKF
	SETZM	TIBUF+2			;ZERO THE DATA COUNT.
	PUSHJ	P,RDFIL			;READ THE FILE NAME OFF THE TAPE.
	MOVE	A,FILINF+DDNAM
	HLLZ	B,FILINF+DDEXT
	MOVE	C,FILINF+DDPPN
	SKIPN	LASSAV
	JRST	DMRED2
	CAMN	A,LASSAV
	CAME	B,LASSAV+1
	JRST	DMRED1
	MOVE	A,FILINF+DDPPN
	CAME	A,LASSAV+3
	JRST	DMRED1
	JRST	DMRED3

DMRED2:	CAMN	A,FILBLK
	CAME	B,FILBLK+1
	JRST	DMRED3			;LOSE.
	CAME	C,FILBLK+3
	JRST	DMRED3
	PUSHJ	P,MTABKF		;BACKUP TO FRONT
DMRED3:	PUSHJ	P,MTASKF		;SKIP PAST PRESENT MT FILE.
	PUSHJ	P,MTAREL		;
	PUSHJ	P,MTINIT		;INIT WITH THREE BUFFERS AGAIN
	TLO	FL,IGNEOT		;TURN ON THE IGNORE EOT INDICATOR
	PUSHJ	P,TAPTAI		;WRITE A TAPE TAIL
	TLZ	FL,IGNEOT		;
	PUSHJ	P,MTAREW		;REWIND THE TAPE
NOMTA7:	CLOSE	FILE,NUPACC		;WILL LOOK THIS UP AGAIN, LATER.
	OUTSTR	[ASCIZ/Mount the next tape and type CONTINUE
/]
	EXIT	1,			;CALL THE EXIT FROM WHICH WE CAN CONTINUE
	PUSHJ	P,TAPHED		;WRITE ANOTHER TAPE HEADER.
	MOVE	D,[FILBLK,,A]		;RESTORE FILE NAME TO A,B,D
	BLT	D,D
	JRST	DMTHIS			;AND START FROM THE TOP.
;DMALL DMALLD DMALL1 DMALL2 DMALL3 DMALL4 DMALL5 DMALL6 DMALL8 DMALL9 DMAL10 DMAL11

	SUBTTL	DMALL	PROCESS A DUMP TERM WITH WILD SPECIFICATION.

IFN STANSW,<
DMALL:
>

;;NON-SAIL VERSION THIS IS THE CODE FOR ONE STRUCTURE ONLY

DMALLD:
IFE STANSW,<
	MOVEM B,STRUCT
	MOVEI A,10
	MOVEI C,FIBUF
	OPEN FILE,A			;WE OPEN EACH STR SEPARATELY
	 PUSHJ P,NODEV
	TLNN FL,L.NOD
	INBUF FILE,23
	HRRZ A,FEXT			;RALPH EXPECTS THIS
>
	TRNN	A,ALLPRJ+ALLPRG		;WILD PPN?
	JRST	DMAL11			;NO. PREPARE TO DUMP ONE PPN WILD.
	MOVE	A,GOD			;READ THE MFD ON THE FILE CHANNEL.
	MOVSI	B,'UFD'
	SETZ	C,
	MOVE	D,GOD
	TRZ	FL,SAFETY
	MOVE	X,[A,,FILBLK]
	BLT	X,FILBLK+3
IFE STANSW,<
	MOVEM A,LKBLK+.RBNAM
	MOVEM B,LKBLK+.RBEXT
	SETZM LKBLK+.RBPRV
	MOVEM D,LKBLK+.RBPPN
	LOOKUP FILE,LKBLK
>
IFN STANSW,<
	LOOKUP	FILE,A
>
	JRST	[PUSHJ P,LCHECK		;LOOKUP FAILURE
		JFCL
		RELEAS	FILE,
		POPJ	P,]		;FLUSH THIS TERM
	MOVE	Q,.JBFF			;PICKUP .JBFF
IFN STANSW,<
	MOVS	D,D			;-WC IN D
	MOVEI	R,UFDN			;SIZE OF ONE MFD/UFD ENTRY
>
IFE STANSW,<
	MOVN D,LKBLK+.RBSIZ
	MOVEI R,2
>
	IDIVM	D,R			;DIVIDE TO MAKE COUNT OF UFD'S
DMALL1:	PUSHJ	P,DFREAD		;READ.
	JUMPE	A,DMALL3
	CAMG	Q,.JBREL
	JRST	DMALL2
	MOVE	B,.JBREL
	ADDI	B,2000
	CORE	B,
	JRST	NOCORE
DMALL2:	MOVEM	A,(Q)
	PUSHJ	P,DFREAD
	HLRZ	A,A
	CAIE	A,'UFD'
	SUBI	Q,1
	AOJA	Q,DMALL4

DMALL3:	PUSHJ	P,DFREAD
DMALL4:
IFN STANSW,<
	MOVE	D,[-UFDN+2,,2]
DMALL5:	PUSHJ	P,DFREAD		;FLUSH REST OF DIRECTORY ENTRY
	AOBJN	D,DMALL5
>
	AOJL	R,DMALL1
	CLOSE	FILE,			;RELEASE THE MFD
	MOVE	A,.JBFF			;GET OLD .JBFF INTO A
	EXCH	Q,.JBFF			;OLD .JBFF IN Q. .JBFF SET RIGHT
	SUB	A,.JBFF			;A HAS -WC.
	HRL	Q,A
	MOVEM	Q,MFDPTR		;-WC,,MA
	MOVE	Q,MFDPTR		;OK. HERE WE LOOK FOR MATCHING UFD
;; RE ABOVE: DUH....  -BH
DMALL6:	HRRZ	D,FEXT			;SET UP WITH THE BITS
	HLRZ	A,FPPN
	HRRZ	B,FPPN
	TRNE	D,ALLPRJ		;WILL ANY PROJECT DO?
	JRST	DMALL8			;YES.
	HLRZ	C,(Q)			;GET A PRJ
	CAIE	C,(A)
	JRST	DMAL10
DMALL8:	TRNE	D,ALLPRG
	JRST	DMALL9
	HRRZ	C,(Q)
	CAIE	C,(B)
	JRST	DMAL10
DMALL9:	MOVE	A,(Q)			;SET UP WITH UFD NAME
	PUSH	P,Q			;DON'T CLOBBER Q
	PUSH	P,.JBFF
	PUSHJ	P,DMONE			;DO ONE USER
	POP	P,.JBFF
	POP	P,Q			;RESTORE Q
DMAL10:	AOBJN	Q,DMALL6		;LOOP - REINTIALIZE A,B,D
	RELEAS	FILE,
	POPJ	P,

DMAL11:	PUSH	P,.JBFF
	PUSHJ	P,D1PPN
	POP	P,.JBFF
	RELEAS	FILE,
	POPJ	P,
;DMALL NXTSTR DMALLA DMALLX DMALS1 DMALLS

	SUBTTL	DMALL	FOR NON-SAIL VERSION, DOES MULTIPLE STRUCTURES

IFE STANSW,<
DMALL:	SETZM GOBBLK		;ASSUME SYS: OR ERSATZ U.F.N.
	MOVS B,DEVNAM		;WHAT A BUM
	TLNE B,-1		;** THIS IS NOT STRICTLY GENERAL
	JRST DMALLS		;** ASSUMES 4 OR MORE CHARS IS SINGLE STR
	CAIN B,'DSK'
	SETOM GOBBLK		;MAKE GOBSTR DO JOBSTR
	CAIN B,'ALL'
	JRST DMALLA		;USE SYSSTR WHICH IS DIFFERENT FORMAT OF COURSE
	SETOM GOBBLK+2		;ELSE ASK GOBSTR FOR SYS SEARCH LIST
	PUSHJ P,.+1		;OFFICIAL STANDARD PROGRAMMING TECHNIQUE 87
	MOVEI B,GOBBLK		;WE'LL JRST HERE EACH TIME THROUGH
	GOBSTR B,		;ASK SYS FOR NEXT STRUCTURE
	 JRST DMALS1		;NO UUO, ASSUME SINGLE STR
	SKIPN B,GOBBLK+2	;LOOK AT THE ANSWER
	JRST DMALLX		;STUPID FENCE IS END FOR US
NXTSTR:	AOJE B,DMALLX		;LIKEWISE END OF LIST
	SUBI B,1		;GET BACK STR NAME
	PUSHJ P,DMALLD		;DO WILD STUFF FOR THIS STR
	JRST @(P)		;GET NEXT STR

DMALLA:	SETZM GOBBLK+2		;INITIAL SYSSTR ARG IS ZERO
	PUSHJ P,.+1		;NOT -1 LIKE THE OTHERS, YAY, DEC
	MOVE B,GOBBLK+2		;COME HERE FOR EACH STR
	SYSSTR B,
	 JRST DMALS1
	MOVEM B,GOBBLK+2	;MIGHT AS WELL SAVE IT HERE AS ANYWHERE
	JUMPN B,NXTSTR
DMALLX:	POP P,(P)		;POP OFF LOOP ADDRESS
	POPJ P,

DMALS1:	POP P,(P)		;ABORT FANCY STRUCTURE SEARCH
DMALLS:	MOVE B,DEVNAM		;JUST PASS THE NAME THE USER TYPED
	JRST DMALLD		; ON TO RALPH
>;ENDS IFE STANSW, ENTIRE PAGE
;D1PPN DMONE DMONE1 DMONE4 DMONE2 DMONE3

	SUBTTL	DMONE	PROCESS WILD FILE NAMES INSIDE ONE UFD
D1PPN:	SKIPN	A,FPPN			;PICKUP THE EXPLICIT PPN.
	MOVE	A,STKPPN		;NONE EXPLICIT. USE THE STICKY ONE.
	MOVEM	A,STKPPN		;STORE NEW STICKY PPN.
DMONE:	MOVEM	A,ONEPPN		;SAVE THE NAME OF THIS USER.
	MOVEI	A,10			;MODE 10
	MOVE	B,STRUCT		;THE CURRENT DEVICE, WHATEVER
	MOVEI	C,UFDBUF		;AN INPUT BUFFER HEADER FOR THE UFD.
	OPEN	UFD,A			;OPEN THE CHANNEL
	PUSHJ	P,NODEV			;THIS PROBABLY DOESN'T EVER HAPPEN
	MOVE	A,ONEPPN
	MOVSI	B,'UFD'
	SETZ	C,
	MOVE	D,GOD
	TRZ	FL,SAFETY		;THIS IS A REAL LOOKUP
	MOVE	X,[A,,FILBLK]
	BLT	X,FILBLK+3
	LOOKUP	UFD,A			;ATTEMPT TO SEEK FILE.
	JRST	[PUSHJ P,LCHECK
		JFCL
		POPJ P,]
DMONE1:	PUSHJ	P,UFDRD			;READ FROM THE UFD.
	JRST	DMONE3			;ALL DONE WITH THIS UFD
	PUSH	P,A			;SAVE FILE NAME
	PUSHJ	P,UFDRD	
	JFCL
IFN STANSW,<
	HLLZ	A,A			;EXTENSION ONLY
	PUSH	P,A			;SAVE EXTENSION
	MOVE	D,[-UFDN+2,,2]
DMONE4:	PUSHJ	P,UFDRD			;FLUSH REST OF DIRECTORY ENTRY
	JFCL
	AOBJN	D,DMONE4
	POP	P,B			;EXTENSION INTO B
>
IFE STANSW,<
	HLLZ B,A
>
	POP	P,A			;FILE NAME INTO A
	JUMPE	A,DMONE1		;FILES WITH 0 NAMES AREN'T THERE.
IFN STANSW,<
;				;Don't flush RPG any more (09/04/78 EJG)
;	CAMN	B,['RPG   ']		;AT STANFORD DON'T DUMP RPG FILES
;	JRST	DMONE1
>
	HRRZ	X,FEXT			;GET THE SPECIAL BITS
	TRNN	X,ALLFIL		;WILL ANY NAME WORK?
	CAMN	A,FNAM			;NO. IS THIS THE RIGHT NAME?
	JRST	.+2			;WE'LL TAKE THIS NAME
	JRST	DMONE1			;FLUSH THIS NAME
	HLLZ	C,FEXT			;GET THE EXTENSION DESIRED.
	TRNN	X,ALLEXT		;ANY EXTENSION?
	CAMN	B,C			;NEED MATCH. DOES IT MATCH?
	JRST	.+2			;WE'LL TAKE THIS FILE
	JRST	DMONE1			;FLUSH THIS FILE.
DMONE2:	MOVE	D,ONEPPN		;HERE TO TAKE NAME FROM A,B,D
	PUSHJ	P,DMTHIS		;DUMP ONE FILE.
IFE STANSW,<
	CLOSE FILE,NUPACC		;DON'T UPDATE ACCESS DATE
>;IFE STANSW
	JRST	DMONE1			;LOOP

DMONE3:	CLOSE	UFD,
	RELEAS	UFD,
	POPJ	P,
;UDMALL UDMAL1 UDML1A UDML1B UDMAL2 UDMAL3 UDIRER

	SUBTTL	UDMALL	DUMP WILD SPECIFICATION FROM UDP.

IFN UDPSW,<

UDMALL:
	MOVEI	A,10				;HERE WE 'LOOKUP' THE DIRECTORY
	MOVE	B,DEVNAM
	MOVEI	C,UFDBUF
	UOPEN	UFD,A				;OPEN A UDP CHANNEL
	HALT	.+1				;IMPOSSIBLE RETURN
	PUSHJ	P,NODEV				;CAN'T HAPPEN
	ULOOK	UFD,400000+A			;'LOOKUP' THE DIRECTORY
	HALT	.+1				;IMPOSSIBLE RETURN
	JRST	UDIRER				;UDP DIRECTORY ERROR.
UDMAL1:	PUSHJ	P,UUFDRD			;READ FILE NAME
	JRST	UDMAL3				;DIRECTORY EMPTY.
	PUSH	P,A				;SAVE NAME
	PUSHJ	P,UUFDRD
	JFCL
	HLLZ	A,A				;EXTENSION ONLY.
	PUSH	P,A				;SAVE EXTENSION
	PUSHJ	P,UUFDRD			;DATE/TIME.
	JFCL
	PUSHJ	P,UUFDRD			;PPN
	JFCL
	PUSH	P,A				;SAVE PPN
	PUSHJ	P,UUFDRD			;READ WORD COUNT
	JFCL
	PUSHJ	P,UUFDRD			;READ UNUSED WORD
	JFCL
	POP	P,D				;RESTORE THE PPN
	POP	P,B				;RESTORE THE EXT
	POP	P,A				;AND THE FILE NAME
	JUMPE	A,UDMAL1			;FILES WITH 0 NAMES AREN'T
;				;Don't flush RPG any more (09/04/78 EJG)
;	CAMN	B,['RPG   ']			;RPG FILES NEVER
;	JRST	UDMAL1
	HRRZ	X,FEXT				;GET THE MAJIC BITS
	TRNN	X,ALLFIL			;WILL ANY NAME DO?
	CAMN	A,FNAM				;NOT ANY NAME. SKIP UNLESS RIGHT
	JRST	.+2				;THE NAME IS OK
	JRST	UDMAL1				;NAME REJECTED
	HLLZ	C,FEXT				;GET THE EXTENSION
	TRNN	X,ALLEXT			;WILL ANY EXTENSION DO?
	CAMN	B,C				;NOT ANY EXTENSION. MATCHES?
	JRST	.+2				;EXTENSION IS OK
	JRST	UDMAL1				;REJECT EXTENSION.
	TRC	X,ALLPRJ!ALLPRG	
	TRCE	X,ALLPRJ+ALLPRG			;ANY PPN WILL DO?
	CAMN	D,FPPN				;NO. RIGHT PPN?
	JRST	UDMAL2				;PPN IS OK.
	TRNN	X,ALLPRJ!ALLPRG			;ANY WILD PPN AT ALL?
	JRST	UDMAL1				;NO. REJECT FOR PPN.
	TRNN	X,ALLPRJ			;WILD PROJECT?
	JRST	UDML1A				;NO. JUST WILD PROGRAMMER
	HRRZ	C,D				;GET PROGRAMMER
	HRRZ	X,FPPN				;GET PROGRAMMER
	JRST	UDML1B
UDML1A:	HLLZ	C,D				;GET PROJECT PART
	HLLZ	X,FPPN
UDML1B:	CAME	C,X				;MATCHES?
	JRST	UDMAL1				;NO.
UDMAL2:	PUSHJ	P,DMTHIS
	JRST	UDMAL1				;LOOK FOR MORE

UDMAL3:	UCLOSE	UFD,
	POPJ	P,

UDIRER:	OUTSTR	[ASCIZ/ERROR FROM LOOKUP OF UDP DIRECTORY
/]
	HALT	CPOPJ
>
;UDPCOP CUDMAL CUDML1 CUDML3 CDMTHS ECONT RWLOOP RWEOF CMDTHT READ1 WRITE1 ECHECK EFAIL

	SUBTTL	UDPCOPY COPY OLD UDP TO NEW UDP

IFN UDPCSW,<
UDPCOP:	
	PUSH	P,.JBFF			;SAVE .JBFF
	MOVE	B,['UDP1  ']
	MOVSI	C,TOBUF
	MOVEI	A,10
	OPEN	MTA,A
	PUSHJ	P,NODEV
	OUTBUF	MTA,22

	MOVEI	A,10!DMPBIT!GARBIT	;OPEN THE FILE DEVICE. DON'T CHANGE REFTIM
	MOVE	B,['UDP2  ']		;GET THE FILE DEVICE
	MOVEM	B,STKDEV		;SAVE LAST DEVICE USED AS STICKY
	MOVEM	B,DEVNAM		;SAVE HERE FOR DUMP
	MOVEI	C,FIBUF			;ADDRESS OF BUFFER HEADER.
	TLO	FL,UDPGO		;ASSUME UDP
	INIUDP	B			;INITIALIZE UDP. DEVICE NAME IN B
	UOPEN	FILE,A			;OPEN THE UDP.
	JFCL
	PUSHJ	P,NODEV			;DEVICE IS UNAVAILABLE
	PUSHJ	P,CUDMAL		;DO *.*[*,*] FROM UDP INPUT
	UCLOSE	FILE,			;CLOSE UDP
	SETZM	USYNC			;TO CATCH ERRORS.
	POP	P,.JBFF			;RETURN HERE FROM DMALL
	RELEAS	MTA,
	POPJ	P,

CUDMAL:
	MOVEI	A,10				;HERE WE 'LOOKUP' THE DIRECTORY
	MOVE	B,DEVNAM
	MOVEI	C,UFDBUF
	UOPEN	UFD,A				;OPEN A UDP CHANNEL
	HALT	.+1				;IMPOSSIBLE RETURN
	PUSHJ	P,NODEV				;CAN'T HAPPEN
	ULOOK	UFD,400000+A			;'LOOKUP' THE DIRECTORY
	HALT	.+1				;IMPOSSIBLE RETURN
	JRST	UDIRER				;UDP DIRECTORY ERROR.
CUDML1:	PUSHJ	P,UUFDRD			;READ FILE NAME
	JRST	CUDML3				;DIRECTORY EMPTY.
	PUSH	P,A
	PUSHJ	P,UUFDRD
	JFCL
	HLLZ	A,A				;EXTENSION ONLY.
	PUSH	P,A				;SAVE EXTENSION
	PUSHJ	P,UUFDRD			;DATE/TIME.
	JFCL
	PUSHJ	P,UUFDRD			;PPN
	JFCL
	PUSH	P,A
	PUSHJ	P,UUFDRD			;READ WORD COUNT
	JFCL
	PUSHJ	P,UUFDRD			;READ UNUSED WORD
	JFCL
	POP	P,D				;RESTORE THE PPN
	POP	P,B				;RESTORE THE EXT
	POP	P,A				;AND THE FILE NAME
	JUMPE	A,CUDML1			;FILES WITH 0 NAMES AREN'T
	PUSHJ	P,CDMTHS		;DUMP ONE FILE TO NEW UDP
	JRST	CUDML1				;LOOK FOR MORE

CUDML3:	UCLOSE	UFD,
	POPJ	P,

CDMTHS:	MOVEM	A,FILINF+DDNAM			;HERE TO COPY ONE FILE.
	MOVEM	B,FILINF+DDEXT
	MOVEM	D,FILINF+DDPPN
	MOVE	X,[A,,FILBLK]
	BLT	X,FILBLK+3
	TRZ	FL,SAFETY
	ULOOK	FILE,A
	JFCL	
	JRST	[PUSHJ P,LCHECK		;CANNOT BE FOUND
		JFCL
		POPJ P,]		;FLUSH THIS TERMBLOCK
	MOVEM	C,FILINF+DDPRO
	MOVEM	C,FILBLK+3
	MOVE	D,[FILINF+DDNAM,,A]	;PICK UP THE FILE NAME AGAIN
	BLT	D,D
	PUSHJ	P,TYFIL			;TYPE THE FILE NAME - NO CR

;ENTER THE FILE ON THE 'MTA' AND WRITE IT!
ECONT:	MOVE	D,[FILINF+DDNAM,,A]	;TRY AGAIN AFTER MAKING MFD
	BLT	D,D
	ENTER	MTA,A			;
	JRST	ECHECK			;ERROR CHECK

RWLOOP:
	SOSG	FIBUF+2			;IS THERE DATA IN BUFFER?
	JSR	READ1			;READ FROM DISK FILE
	ILDB	A,FIBUF+1		;LOAD A WORD FROM THE FILE.
	SOSG	TOBUF+2
	JSR	WRITE1
	IDPB	A,TOBUF+1
	SOSG	FIBUF+2			;IS THERE DATA IN BUFFER?
	JSR	READ1			;READ FROM DISK FILE
	ILDB	A,FIBUF+1		;LOAD A WORD FROM THE FILE.
	SOSG	TOBUF+2
	JSR	WRITE1
	IDPB	A,TOBUF+1
	SOSG	FIBUF+2			;IS THERE DATA IN BUFFER?
	JSR	READ1			;READ FROM DISK FILE
	ILDB	A,FIBUF+1		;LOAD A WORD FROM THE FILE.
	SOSG	TOBUF+2
	JSR	WRITE1
	IDPB	A,TOBUF+1
	SOSG	FIBUF+2			;IS THERE DATA IN BUFFER?
	JSR	READ1			;READ FROM DISK FILE
	ILDB	A,FIBUF+1		;LOAD A WORD FROM THE FILE.
	SOSG	TOBUF+2
	JSR	WRITE1
	IDPB	A,TOBUF+1
	JRST	RWLOOP

RWEOF:	UCLOSE	FILE,
	JFCL
	CLOSE	MTA,
	MOVE	D,[FILINF+DDNAM,,A]
	BLT	D,D
	RENAME	MTA,A			;RENAME TO OLD CREATION DATE
	OUTSTR	[ASCIZ/ (RENAME TO UPDATE DATE OF CREATION FAILED) /]
CMDTHT:	OUTSTR	CRLF			;AFTER THE FILE IS OUT, TYPE CR.
	POPJ	P,

READ1:	0
	UIN	FILE,
	JRST	@READ1			;WIN
	JRST	RWEOF			;END OF FILE.

WRITE1:	0
	OUT	MTA,
	JRST	@WRITE1
	OUTSTR	[ASCIZ/OUTPUT ERROR!
/]
	HALT	@WRITE1

ECHECK:
	HRRZ	B,B			;LOOKUP CODE.
	CAIE	B,1			;IS CODE SPECIAL?
	JRST	EFAIL			;ENTER FAILURE
	OUTSTR	[ASCIZ/	MAKING UFD FOR /]
	MOVE	A,FILINF+DDPPN
	PUSHJ	P,PPNOUT
	MOVE	A,FILINF+DDPPN
	MOVSI	B,'UFD'
	MOVSI	C,555000
	MOVE	D,GOD
	ENTER	MTA,A
	JRST	LCILU1			;LOSE MESSAGE
	CLOSE	MTA,
	JRST	ECONT

EFAIL:	OUTSTR	[ASCIZ/ENTER FAILURE CODE = /]
	ADDI	B,"0"
	OUTCHR	B
	OUTSTR	[ASCIZ/TYPE CONTINUE TO TRY NEXT FILE
/]
	HALT	CMDTHT
>;IFN UDPCSW
;KMCDMP KMCDM1 KMCDM2 KMCDM4 KMCDM3 DMPKMC KMRED0 KMREDO KMRED1 KMRED2 KMRED3 KMCBUF KMCERR KMCER1

	SUBTTL	KMCDMP

IFN KMCSW,<
KMCDMP:	MOVE	B,['UDP1  ']
	DEVCHR	B,
	TLNE	B,200000		;IS THIS A NEW STYLE?
	JRST	KMCERR
	PUSHJ	P,MTINIT		;INIT THE MAGTAPE
	SETZM	CLASS			;CLASS = 0 IS USER DUMP
	SETZM	TAPNO			;ASSUME WE DON'T KNOW WHAT TAPE NUMBER
	PUSHJ	P,TAPHED		;MAKE A TAPE HEADER RECORD.
	SETZM	LASSAV			;NO LAST FILE SAVED.
	MOVEI	A,17
	MOVE	B,['UDP1  ']
	MOVEI	C,0
	OPEN	FILE,A
	PUSHJ	P,NODEV
;HERE WE READ THE DIRECTORY TRACK
	INPUT	FILE,[-4440,,KMCBUF-1
		1]

	MOVE	A,['KMCDIR']
	MOVEI	B,4440
	MOVEI	C,KMCBUF
	PUSHJ	P,DMPKMC
;NOW SETUP TO DUMP EACH FILE.
	SKIPLE	A,KMCBUF		;THE NUMBER OF FILES
	CAILE	A,2216			;MAX MUMBER
	JRST	KMCER1			;FOO.
	MOVN	A,A			;-NUMBER OF FILES
	MOVSI	A,(A)
	HRRI	A,KMCBUF+4		;ADDRESS OF THE FIRST FILE
KMCDM1:	SKIPN	(A)
	JRST	KMCDM3			;NO NAME THERE
	SKIPG	1(A)
	JRST	KMCDM4
	PUSH	P,A			;SAVE INDEX
	HLRZ	B,1(A)			;+WC INTO B
	MOVN	C,B			;-WC INTO C
	HRLZ	C,C			;-WC INTO LH. OF C
	MOVE	X,.JBFF			;ADDRESS WE CAN START AT
	ADD	X,B			;LAST ADDRESS NEEDED
	CAMGE	X,.JBREL
	JRST	KMCDM2
	CORE	X,
	JRST	NOCORE
KMCDM2:	HRR	C,.JBFF			;-WC,,FIRST ADDRESS
	SUBI	C,1			;ADJUST TO MAKE IOWD
	HRRZ	D,1(A)			;TRACK NUMBER IN D
	INPUT	FILE,C			;READ ENTIRE FILE INTO CORE
	MOVE	A,(A)			;FILE NAME INTO A
	MOVE	C,.JBFF			;FILE ADDRESS INTO C
	PUSHJ	P,DMPKMC
	POP	P,A
	JRST	KMCDM3

KMCDM4:	OUTSTR	[ASCIZ/Illegal file specifier: /]
	PUSH	P,A
	MOVE	A,(A)
	PUSHJ	P,SIXOUT
	MOVE	A,(P)
	MOVE	A,1(A)
	PUSHJ	P,OCTOUT
	POP	P,A

KMCDM3:	ADD	A,[1,,2]
	JUMPL	A,KMCDM1		;LOOP FOR ALL FILES
	RELEAS	FILE,
	PUSHJ	P,MTAREL
	POPJ	P,
	
;DUMP ONE FILE.
;CALL WITH A=FILE NAME, B= FILE LENGTH, C=FIRST ADDRESS
DMPKMC:	PUSH	P,A		;SAVE ARGUMENTS
	PUSH	P,B
	PUSH	P,C
	MOVE	D,[FILINF,,FILINF+1]
	SETZM	FILINF
	BLT	D,FILINF+17
	MOVEM	A,FILINF+DDNAM
	MOVEM	B,FILINF+DDLNG
	ADDI	B,1
	MOVEM	B,FIBUF+2
	HRLI	C,444400
	MOVEM	C,FIBUF+1
	MOVE	A,['KIDKMC']
	MOVEM	A,FILINF+DDPPN
	DATE	A,
	MOVEM	A,FILINF+DDEXT		;DATE
	DPB	A,[POINT 12,FILINF+DDPRO,35]
	LSH	A,-14
	DPB	A,[POINT 3,FILINF+DDEXT,20]
	MOVE	X,[FILINF,,FILBLK]
	BLT	X,FILBLK+3
	MOVE	D,[FILINF+DDNAM,,A]	;PICK UP THE FILE NAME AGAIN
	BLT	D,D
	PUSHJ	P,TYFIL			;TYPE THE FILE NAME - NO CR
	TLZ	FL,IGNEOT
	PUSHJ	P,DUMP
	JRST	KMRED0			;HAVE TO DO IT OVER ON A NEW TAPE
	PUSHJ	P,MTACLZ
	MOVEI	A,RECSIZ
	MOVEM	A,WC
	SETZM	MTFILN
	STATZ	MTA,742000		;SEE THAT THE MTA IS HAPPY.
	JRST	KMREDO
	MOVE	A,[FILBLK,,LASSAV]
	BLT	A,LASSAV+3		;SAVE THE NAME OF THE FILE WE JUST FINISHED
	OUTSTR	CRLF			;AFTER THE FILE IS OUT, TYPE CR.
	SUB	P,[3,,3]		;FLUSH ARGUMENTS FROM STACK
	POPJ	P,

KMRED0:	PUSHJ	P,MTACLZ		;ATTEMPT TO END FILE 
KMREDO:	OUTSTR	[ASCIZ/	NOT SAVED. - PHYSICAL END OF TAPE.
/]
	PUSHJ	P,MTAREL		;RELINQUISH THE MAG TAPE
	PUSHJ	P,MINIT1		;INIT THE MAGTAPE WITH ONLY ONE BUFFER
	HLLZS	LASSAV+1		;EXT ONLY
KMRED1:	PUSHJ	P,MTABKF
	PUSHJ	P,MTABKF
	PUSHJ	P,MTASKF
	SETZM	TIBUF+2			;ZERO THE DATA COUNT.
	PUSHJ	P,RDFIL			;READ THE FILE NAME OFF THE TAPE.
	MOVE	A,FILINF+DDNAM
	HLLZ	B,FILINF+DDEXT
	MOVE	C,FILINF+DDPPN
	SKIPN	LASSAV
	JRST	KMRED2
	CAMN	A,LASSAV
	CAME	B,LASSAV+1
	JRST	KMRED1
	MOVE	A,FILINF+DDPPN
	CAME	A,LASSAV+3
	JRST	KMRED1
	JRST	KMRED3			;FOUND IT.

KMRED2:	CAMN	A,FILBLK
	CAME	B,FILBLK+1
	JRST	KMRED3			;LOSE.
	CAME	C,FILBLK+3
	JRST	KMRED3
	PUSHJ	P,MTABKF		;BACKUP TO FRONT
KMRED3:	PUSHJ	P,MTASKF		;SKIP PAST PRESENT MT FILE.
	PUSHJ	P,MTAREL		;
	PUSHJ	P,MTINIT		;INIT WITH THREE BUFFERS AGAIN
	TLO	FL,IGNEOT		;TURN ON THE IGNORE EOT INDICATOR
	PUSHJ	P,TAPTAI		;WRITE A TAPE TAIL
	TLZ	FL,IGNEOT		;
	PUSHJ	P,MTAREW		;REWIND THE TAPE
	CLOSE	FILE,			;WILL LOOK THIS UP AGAIN, LATER.
	OUTSTR	[ASCIZ/MOUNT THE NEXT TAPE AND TYPE CONTINUE
/]
	EXIT	1,			;CALL THE EXIT FROM WHICH WE CAN CONTINUE
	PUSHJ	P,TAPHED		;WRITE ANOTHER TAPE HEADER.
	POP	P,C			;RESTORE ARGUMENTS FROM STACK
	POP	P,B
	POP	P,A
	JRST	DMPKMC			;AND START FROM THE TOP.


KMCBUF:	BLOCK	4440


KMCERR:	OUTSTR	[ASCIZ/Must ASSIGN OLD UDP1
/]
	POPJ	P,

KMCER1:	OUTSTR	[ASCIZ/Can't interpret the directory.
/]
	POPJ	P,

>;KMCSW
;RESTGO RSTG1 RSTG2 RSTG2A RSTG2B

	SUBTTL	RESTGO	RESTORE COMMAND

RESTGO:	PUSHJ	P,SCAN			;SCAN THE COMMAND LINE.
	MOVEI K,REGRST			;REGULAR RESTORE DATA AREA
	SETZM	RSTDEV-1		;KLUGE
	SKIPN	R,DEST			;WAS THERE ANY DESTINATION GIVEN
	MOVEI	R,RSTDEV-1		;KLUGE TO ZERO RSTDEV BLOCK
	MOVSI	R,(R)			;SOURCE OF BLT
	HRRI	R,RSTDEV		;DESTINATION
	BLT	R,RSTPPN		;DO THE TRANSFER
	MOVEI	A,ALLFIL+ALLEXT		;ASSUME DSK:*.*[CURRENT USER]
	SKIPN	DEST			;WAS THERE EXPLICIT DEST TERM
	MOVEM	A,RSTEXT		;NO. SET *.* FLAGS
	SKIPN	A,RSTDEV		;GET THE DEVICE NAME
	MOVSI	A,'DSK'			;NONE THERE. USE DISK
	MOVEM	A,RSTDEV		;SAVE AS RESTORE DEVICE.
	MOVE	B,RSTEXT		;GET SPECIAL BITS 
	SKIPN	A,RSTPPN		;SKIP IF THERE IS ANY PPN THERE.
	TRNE	B,ALLPRG+ALLPRJ		;NO PPN. SKIP IF NO WILD PPN FLGS
	JRST	.+2			;EXPLICIT PPN,  OR WILD PPN THERE 
	MOVE	A,USRPPN		;USE THE CURRENT PPN.
	MOVEM	A,RSTPPN		;STORE DESTINATION PPN.
	TRNN	B,ALLFIL+ALLEXT		;ANY WILD NAME? (BITS STILL IN B)
	SKIPE	RSTNAM			;NAME NOT WILD. SKIP IF NO NAME
	JRST	.+2			;SKIP IF EXPLICIT NAME OR WILD NAME
	MOVEI	B,ALLFIL+ALLEXT		;NO NAME AND NO WILD TERM MEANS *.*
	IORM	B,RSTEXT		;OR IN THE MAJIC BITS
	HRRZ	W,TBASE			;GET THE BASE OF ALL TERMS
	CAME	W,FSPTR			;ARE THERE ANY SOURCE TERMS AT ALL?
	JRST	RSTG1			;YES.
	PUSHJ	P,GETBLK		;GET A TERM BLOCK
	MOVEI	A,ALLFIL+ALLEXT		;RESTORE *.*[CURRENT AREA]
	MOVEM	A,FSEXT(R)		;STORE WILD FLAGS
RSTG1:	MOVE	A,USRPPN		;INITIAL STICKY PPN
	MOVEM	A,STKPPN		;SAVE IT
	SETZM	A,STKBIT		;SAVE STICKY BITS
	MOVE	A,FSDEV(W)		;LOOK FOR A DEVICE
	MOVEM	A,MTDEV			;DEV NAME GIVEN IN FIRST TERM. SAVE IT.
	MOVE	A,FSPTR
	MOVEM	A,.JBFF			;MAKE .JBFF FROM FREE POINTER.
RSTG2:	HRRZ	B,FSEXT(W)		;GET MAGIC BITS
	TRON	B,ALLFIL+ALLEXT		;IS THE NAME WILD?
	SKIPE	FSNAM(W)		;NOT WILD. IS THERE ANY NAME?
	JRST	.+2			;WILD NAME OR EXPLICIT NAME
	IORM	B,FSEXT(W)		;NO NAME AND NOT WILD. ASSUME *.*
	ANDI	B,ALLPRJ+ALLPRG		;SELECT ONLY THE PPN BITS.
	SKIPN	A,FSPPN(W)		;PICKUP ANY EXPLICIT PPN
	JUMPE	B,RSTG2A		;JUMP IF THERE IS NO EXPLICT BITS
	MOVEM	A,STKPPN		;SAVE NEW STICKY PPN
	MOVEM	B,STKBIT		;SAVE STICKY BITS
	JRST	RSTG2B

RSTG2A:	MOVE	A,STKPPN		;GET STICKY PPN
	MOVEM	A,FSPPN(W)
	HRRZ	B,STKBIT
	IORM	B,FSEXT(W)		;SAVE STICKY BITS HERE TOO

RSTG2B:	ADDI	W,FSLEN			;INCREMENT W
	CAML	W,FSPTR			;ARE WE DONE?
	JRST	RSTG3			;YES.
	SKIPE	A,FSDEV(W)		;PICKUP DEVICE NAME
	CAMN	A,MTDEV			;EXPLICIT DEVICE 
	JRST	RSTG2			;NO DEVICE, OR SAME DEVICE
	OUTSTR	[ASCIZ/Multiple source devices.
/]
	JRST	RESTAR
;UNPUMP PLIST PRESTO PREST1 PLIST0 EUQMSG EUQPLI NOPEUQ DOEUQ PREQLP PREBLK PRDTLP PREDEL PRDTDN PRDTNX NEWTAP PREOF PRNXTT EUQFIX WEDID DIDNT EUQNXT EUQTST EUQPRT EUQNIL PRNXT1 RETRY PRSTG3 TFLUSH PRUEOT PRPOSN PRUSER PMAIL PRUSE0 PRUSE1 PRUFLP PRUFNX PRUTA1 PRUTAP PRUMAI PRUMA1 PRUTRY PRUMER PRUNXT PRUEND PROPRN PRSKPL PRFNDT PRFND1 PRFND2 PRSKLP PRSKDN PRJUMP PRJUGG PRSKPT PRSKNO NOPQUE NOPREQ QUEERR PRUEOF DELEUQ PYORN PYORN0 PYORN1 PRUSTR PRUST1 PRUSIX PRUDEC PRUDE1 PRUDAT PRLFIL PRUFIL PRLFI1 PRUFI0 PRUF01 PRUF00 PRUFI1 PUX0 PUXSTR UNP2QS

COMMENT 
Format of PUMPKI.QUE file:
The file contains one or more request blocks; each block starts on a record
boundary.  Here is the format of a request block:
	0	word count, including this word
	1	date,,PRG of requestor
	2	dest name
	3	dest ext,,flags (flagging wildcards, as usual)
	4	dest ppn
	5-11	source term
	12-16	source term
	...	etc
The file can be parsed ignoring the record alignment, since the padding words will
be zero word counts and can be ignored.  The format of a source term is:
	0	source device (useless)
	1	source name
	2	source ext (sources are never wild)
	3	source PPN
	4	tape number,,date written (sign bit on for T tape)

This file is read into core into a data structure consisting of two
kinds of blocks, a tape block and a term block.  This is a tape block:
	0	tape number (in RH)
	1	term block list header,,next tape block or 0
	2	prev tape block or 0,,number of terms in the list for this tape
The cell TAPES points to the head of the tape list.  This is a term block:
	0	FSDEV	tape number,,next term block or 0
	1	FSNAM	source name
	2	FSEXT	source ext
	3	FSPPN	source PPN
	4	FSPNAM	dest name
	5	FSPEXT	dest ext
	6	FSPPPN	dest PPN
	7	FSPREQ	flag,,requestor's PRG
	10	FSPDAT	date of request

Here are the possible values for the flag (FSPREQ LH):
	0	request has not been dealt with, or tape was skipped
		invisibly (opr specified no messages to users)
	1	file not found on tape specified in request
	2	tape skipped by operator (tape not found)
	-3	request is in PUMPKI.EUQ (used for UNPUMPKIN only)
	-2	output file already exists
	-1	file restored successfully

Before doing the restore, PRESTORE renames PUMPKI.QUE to PUMPKI.EUQ; if the
file PUMPKI.EUQ already exists when the command is started, DART thinks that
a previously-started PRESTORE was interrupted, e.g., by a system crash.  In
this case the operator must confirm that s/he wants to continue the interrupted
restore, or else delete PUMPKI.EUQ and restart.  If the interrupted PRESTORE
is continued, some special processing is done for each tape in the list:
before the operator is asked to mount the tape, DART looks up every output
file requested for that tape.  Files which already exist are marked as
restored (at SAIL, they may be marked as already existed if the file was not
last written by [DMP,SYS]) and if no unrestored files are on the tape it is
skipped.  The danger is that a file which really already existed (at SAIL, it
must have been written by a previous PRESTORE) will be indicated to the user
as having been restored.


UNPUMP:	TLOA FL,L.TURK			;UNPUMPKIN FIRST DOES A SORT OF PLIST
PLIST:	TLZ FL,L.TURK
	TLO FL,L.PUMP			;PLIST COMMAND
	JRST PLIST0

PRESTO:	TLZ FL,L.PUMP			;PRESTORE COMMAND
	TLZ FL,L.TURK			;FLAG NOT REDOING .EUQ FILE
IFE IRCPPN,<
	GETPPN	A,			;GET THE REAL PPN (NOT DSKPPN)
	 JFCL				;DEC NEEDS THIS
>
IFN IRCPPN,<
	HRROI A,2			;REAL PPN COMES FROM GETTAB
	GETTAB A,
	 GETPPN A,
	  JFCL
>
	CAME	A,DUMPER		;IS THIS THE RIGHT NAME?
	JRST	NOPRV			;HE IS NOT THE RIGHT GUY.
	PUSH P,.JBFF		;WE'LL RECLAIM THE STORAGE
	PUSHJ P,SCAN		;MAYBE THE PUMPKIN WILL SPECIFY A TAPE
	MOVE A,TBASE
	CAML A,FSPTR		;ANY SOURCE?
	JRST PREST1		;NO, NO MTA
	MOVE A,FSDEV(A)		;YES, MAYBE A MTA
	MOVEM A,MTDEV
PREST1:	POP P,.JBFF		;THAT'S ALL WE LET HIM/HER SPECIFY
PLIST0:	SETZM DEST
	SETZM UNP2QF		;CLEAR UNPUMPKIN 2 QUEUES FLAG
	INIT UFD,10		;PREPARE TO READ THE REQUEST FILE
	 'DSK   '
	 UFDBUF			;INPUT BUFFER HEADER
	 PUSHJ P,NODEV		;IT CAN'T HAPPEN HERE?
REPEAT 0,<
	TLNE FL,L.TURK		;UNPUMPKIN?
	JRST NOPEUQ		;YES, USE .QUE REGARDLESS
>;REPEAT 0
	MOVE A,['PUMPKI']
	MOVSI B,'EUQ'
	MOVE D,DUMPER
	LOOKUP UFD,A		;FIRST LOOK FOR AN ABORTED RUN
	 JRST NOPEUQ
	TLNE FL,L.PUMP		;PLIST?
	JRST EUQPLI		;YES, USERS GET DIFFERENT OPTIONS
REPEAT 0,<
EUQMSG:	OUTSTR [ASCIZ /Partially processed PRESTORE file found.  Type Y to try to
continue this file, otherwise you'd better delete it and restart: /]
	PUSHJ P,PYORN		;MUST TYPE Y
	 JRST EUQMSG		;I SAID *MUST* TYPE Y
>;REPEAT 0
	OUTSTR [ASCIZ /(Using partially processed PRESTORE file!!)
/]
IFN STANSW!IRCPPN,<
	MOVNI A,1
	BEEP A,			;AFTER ALL, IT HAS TO BE DONE AGAIN FOR THE QUE FILE.
>;IFN STANSW!IRCPPN
	TLO FL,L.TURK		;OK, FLAG IT
	JRST DOEUQ

EUQPLI:
REPEAT 0,<
	OUTSTR [ASCIZ /There is a partially processed PUMPKIN request queue which
was interrupted by a crash.  Do you want to see that list?  If so, type Y.
Otherwise, we'll look for a new request queue: /]
	PUSHJ P,YORN		;ACCEPT ANYTHING FOR NO HERE
	 JRST NOPEUQ		;NO, WE TRY A .QUE
	JRST DOEUQ		;YES, WE USE THE .EUQ
>;REPEAT 0
	TLNE FL,L.TURK		;UNPUMPKIN?
	JRST UNP2QS		;YES, HAIRY MESS FOR BOTH QUEUES IN
	OUTSTR [ASCIZ /(Partially processed request queue:)
/]				;MUST TELL USER SOME OF THIS ALREADY DONE!
	PUSHJ P,DOEUQ		;FIRST DO THE EUQ LIST
	OUTSTR [ASCIZ /(End of partially processed queue.)
/]				;FALL INTO DOING QUE
NOPEUQ:	MOVE A,['PUMPKI']
	MOVSI B,'QUE'
	MOVE D,DUMPER
	LOOKUP UFD,A		;FIND THE QUEUE FILE
	 JRST NOPQUE
	TLNE FL,L.PUMP		;PLIST COMMAND?
	JRST DOEUQ		;YES, DON'T RENAME QUEUE FILE
	MOVSI B,'EUQ'
	MOVE D,DUMPER
	RENAME UFD,A		;CHANGE ITS NAME
	 JRST QUEERR		;SAY WHAT?
DOEUQ:	SETZM TAPES		;NO TAPE LIST TO START WITH
	INBUF UFD,2		;MAKE THE BUFFERS SO JOBFF WILL BE RIGHT
	MOVE W,.JBFF		;THIS IS OUR FREE STORAGE SYSTEM
PREQLP:	PUSHJ P,UFDRD		;READ THE WORD COUNT
	 JRST PREOF		;ALL READ IN
	JUMPE A,PREQLP		;SKIP PADDING WORDS
	MOVE Z,A		;SAVE WORD COUNT
	PUSHJ P,UFDRD		;DATE,,REQUESTOR'S PRG
	 JRST PRUEOF		; THERE BETTER BE ONE
	MOVEM A,RSTDEV		;SAVE IT HERE TEMPORARILY
	PUSHJ P,UFDRD		;DEST NAME
	 JRST PRUEOF
	MOVEM A,RSTNAM		;AS GOOD A PLACE AS ANY
	PUSHJ P,UFDRD
	 JRST PRUEOF
	MOVEM A,RSTEXT
	PUSHJ P,UFDRD
	 JRST PRUEOF
	MOVEM A,RSTPPN
	SUBI Z,FSLEN+1		;REMOVE THIS HEADER STUFF FROM WC
	IDIVI Z,PSIZE		;TURN WC INTO BLOCK COUNT
PREBLK:	PUSHJ P,PGTBLK		;GET A PRESTORE-SIZE TERM BLOCK
	PUSHJ P,UFDRD		;READ THE SOURCE POOP
	 JRST PRUEOF		;FIRST WE IGNORE THE DEV WORD
	PUSHJ P,UFDRD
	 JRST PRUEOF
	MOVEM A,FSNAM(R)
	PUSHJ P,UFDRD
	 JRST PRUEOF
	MOVEM A,FSEXT(R)
	PUSHJ P,UFDRD
	 JRST PRUEOF
	MOVEM A,FSPPN(R)
	PUSHJ P,UFDRD
	 JRST PRUEOF
	HLLZM A,FSDEV(R)	;TAPE NUMBER GOES HERE
	SKIPN FSNAM(R)		;SKIP UNLESS REQUEST HAS BEEN DELETED
	JRST PREDEL		;FORGET THIS
	MOVE B,RSTEXT		;GET DEST EXT AND FLAGS
	MOVE A,RSTNAM		;DEST NAME
	TRNE B,ALLFIL		;WILD?
	MOVE A,FSNAM(R)		;YES, USE SOURCE NAME
	MOVEM A,FSPNAM(R)	; AS DEST NAME
	TRNE B,ALLEXT		;WILD EXT?
	HLL B,FSEXT(R)		;YES, USE SOURCE
	HLLZM B,FSPEXT(R)
	MOVE A,RSTPPN
	TRNE B,ALLPRJ
	HLL A,FSPPN(R)
	TRNE B,ALLPRG
	HRR A,FSPPN(R)
	MOVEM A,FSPPPN(R)
	MOVE A,RSTDEV		;DATE,,REQUESTOR'S PRG
REPEAT 0,<
	HRRZM A,FSPREQ(R)	; INTO TERM BLOCK
>;REPEAT 0
	HLRZM A,FSPDAT(R)	;DATE INTO TERM BLOCK
	HLL A,UNP2QF		;0 EXCEPT FOR EUQ ENTRIES FOR UNPUMPKIN
	MOVEM A,FSPREQ(R)	;SO UNPUMPKIN KNOWS WHICH QUEUE TO DELETE FROM
	HLRZ A,FSDEV(R)		;GET TAPE NUMBER
	SKIPN X,TAPES		;LOOK FOR PREVIOUS TERM ON SAME TAPE
	JRST NEWTAP		;FIRST TERM IS ALWAYS NEW
PRDTLP:	CAME A,(X)		;SAME TAPE?
	JRST PRDTNX		;NO, TRY ANOTHER
	HLRZ A,1(X)		;YES, GET HEAD OF TERM LIST
	HRRM A,FSDEV(R)		;LINK BEHIND OUR NEW ONE
	HRLM R,1(X)		;NEW ONE IS NOW LIST HEAD
	AOSA 2(X)		;COUNT HOW MANY TERMS IN THIS TAPE
PREDEL:	SUBI W,FSPLEN		;HERE TO UNMAKE A DELETED REQUEST
PRDTDN:	SOJG Z,PREBLK		;FINISH THIS REQUEST
	JRST PREQLP		;OR GET NEXT REQUEST

PRDTNX:	HRRZ X,1(X)		;GET NEXT TAPE BLOCK
	JUMPN X,PRDTLP		; IF ANY
NEWTAP:	HRLZ X,R		;SAVE NEW TERM
	MOVE Y,A		;SAVE TAPE NUMBER
	PUSHJ P,TGTBLK		;GET A TAPE BLOCK
	MOVEM Y,(R)		;SAVE TAPE NUMBER
	HRR X,TAPES		;LINK OLD TAPE LIST BEHIND IT
	MOVEM X,1(R)
	MOVEI A,1
	MOVEM A,2(R)		;COUNT ONE TERM IN THIS TAPE SO FAR
	HRRZ A,TAPES		;OLD TOP TAPE
	HRLM R,2(A)		;NEW ONE IS NOW ITS BACK POINTER
	HRRZM R,TAPES		;NEW HEAD OF TAPE LIST
	JRST PRDTDN

; Here when the input queue file has been read into core.  If we decide
; to sort the tape numbers, here's where to do it.

PREOF:	SKIPN TAPES		;ANYTHING FOUND?
	OUTSTR [ASCIZ /  (Request queue is empty.)
/]				;QUEUE CONTAINS ONLY DELETED REQUESTS
	SKIPE UNP2QF		;DOING EUQ FOR UNPUMPKIN?
	POPJ P,			;YES, NOT REALLY DONE.  (BACK TO UNP2QS CODE)
	MOVEM W,.JBFF		;SAVE WHERE WE'RE UP TO IN CORE
	MOVSI A,'DSK'
	MOVEM A,RSTDEV		;CONSTANT OUTPUT DEVICE
	MOVE W,TAPES
	MOVEM W,RTAPES		;KEEP FULL TAPE LIST HEAD AROUND FOR REPORTING
	TLNE FL,L.PUMP		;IS THIS PLIST?
	JRST PLIST1		;YES, JUST LIST THE QUEUE
PRNXTT:	SKIPN W,TAPES		;GET TAPE BLOCK
	JRST DELEUQ		;NONE LEFT
	MOVE A,2(W)		;COUNT OF TERMS FOR THIS TAPE
	HRRZM A,TRMCNT		;KEEP FOR RESTORE'S DONE TEST
	TLNN FL,L.TURK		;ARE WE RECOVERING FROM ABORTED RUN?
	JRST PRNXT1		;NO, JUST ASK FOR THE TAPE
	INIT DSKMSC,17		;YES.  LOOK FOR ALREADY RESTORED FILES.
	 'DSK   '
	 0
	 PUSHJ P,NODEV
	TLZ FL,L.PUMP		;THIS WILL FLAG A RESTORED FILE
	HLRZ W,1(W)		;GET TERM LIST
EUQFIX:	JUMPE W,EUQTST		;JUMP IF NO TERMS LEFT
	MOVE A,FSPNAM(W)	;GET DESTINATION FILESPEC
	MOVE B,FSPEXT(W)
	MOVE D,FSPPPN(W)
	LOOKUP DSKMSC,A		;DOES THE FILE EXIST?
	 TRNE B,-1		;ERROR, CODE MUST BE 0 (NO SUCH FILE)
	JRST .+2		;FILE EXISTS
	JRST EUQNXT		;FILE DOESN'T EXIST
	MOVNI X,1		;CODE FOR ALREADY RESTORED
IFN STANSW,<
	MTAPE DSKMSC,PRVMTA	;SEE WHO WROTE THE FILE
	 JRST WEDID		;ERROR, NEVER MIND
	SETZM PASWD		;IN CASE OF INF
	MOVE A,GRPWD		;GET PPN WHICH WROTE FILE
	CAME A,DUMPER		;DID WE WRITE IT?
	JRST DIDNT		;NO, THIS IS A COINCIDENCE
>;IFN STANSW
WEDID:	TLOA FL,L.PUMP		;FLAG SOME TERM ALREADY RESTORED
DIDNT:	MOVNI X,2		;CHANGE CODE TO FILE ALREADY EXISTS
	HRLM X,FSPREQ(W)	;FLAG THIS TERM DONE
	SOS TRMCNT		;ONE FEWER TO DO
EUQNXT:	HRRZ W,FSDEV(W)
	JRST EUQFIX

EUQTST:	RELEAS DSKMSC,
	MOVE W,TAPES		;RESTORE TAPE POINTER
	TLNN FL,L.PUMP		;ANYTHING ALREADY RESTORED?
	SKIPG TRMCNT		; (MAYBE NOTHING TO DO BECAUSE ALREADY EXISTED)
	JRST .+2
	JRST EUQNIL		;NO, JUST DO THIS TAPE NOW
	MOVE A,(W)		;GET TAPE NUMBER
	MOVEM A,TAPNO		;SAVE IT FOR MRESTORE'S ROUTINES
	OUTSTR [ASCIZ /(Tape /]
	PUSHJ	P,REELMX
	MOVE	A,TAPNAM
	PUSHJ	P,SIXOUT
	SKIPE TRMCNT		;ANY LEFT?
	JRST EUQPRT		;YES, PARTIAL TAPE
	MOVEI B,[ASCIZ / completely restored, will be skipped.)
/]
	TLNN B,L.PUMP		;SKIP IF REALLY RESTORED SOMETHING
	MOVEI B,[ASCIZ /: all output files already exist; will be skipped.)
/]
	OUTSTR (B)
	MOVE W,TAPES
	HRRZ W,1(W)		;GET NEXT TAPE
	MOVEM W,TAPES
	JRST PRNXTT

EUQPRT:	OUTSTR [ASCIZ / partially restored; will continue it now.)
/]
EUQNIL:	MOVE W,TAPES		;RESTORE TAPE POINTER
PRNXT1:	MOVE A,(W)		;GET TAPE NUMBER
	MOVEM A,TAPNO		;SAVE IT FOR MRESTORE'S ROUTINES
	PUSHJ P,DOMT0		;ASK THE OPR FOR IT
	 JRST PROPRN		;S/HE SAYS NO, DEAL WITH THIS
	MOVE A,(W)
	MOVEM A,PREQTP		;SAVE TAPE NUMBER TO TELL RDFIL TO CHECK IT
	PUSHJ P,MTINIT
	PUSHJ P,MTAREW
	MOVE A,1(W)		;LINK OUT THIS TAPE NUMBER
	HRRZM A,TAPES		; FROM THE TAPE LIST
	HLRZ W,A		;GET POINTER TO TERM LIST FOR THIS TAPE
	MOVEM W,TBASE		;POINT TO BEGINNING OF LIST FOR THIS TAPE
RETRY:	SETZM PUMWIZ		;ENTRY AFTER REPOSITIONING TAPE ON ILL FMT
	MOVEI K,PUMRST		;POINT TO DATA AREA FOR PUMPKIN RESTORE
	PUSH P,CRESTA		;SAVE UNEXPECTED EOT TRANSFER ADDR (NORMALLY RESTAR)
	PUSH P,CREST1		;DITTO ILLFMT ADDR
	MOVEI A,PRUEOT
	MOVEM A,CRESTA
	MOVEI A,PRPOSN
	MOVEM A,CREST1
	MOVEM P,PRSAVP		;FOR UNWIND IN CASE OF UNEXPECTED EOT
	PUSHJ P,RSTG3		;DO THE ACTUAL WORK NOW
PRSTG3:	POP P,CREST1
	POP P,CRESTA
IFN STANSW!IRCPPN,<
	MOVNI A,1
	BEEP A,			;HELLO TEST, 1,2,3...
>;IFN STANSW!IRCPPN
TFLUSH:	SETZM PUMWIZ		;ENTRY TO GIVE UP ON THIS TAPE
	SETZM PREQTP		;NO LONGER REQUIRING A TAPE AT RDFIL
	SKIPG TRMCNT		;ON RETURN ALL TERMS SHOULD BE GONE
	JRST PRNXTT		; (SINCE WE CLEVERLY HAVE NO WILD TERMS)
IFN STANSW,<			;ONLY IF MAIL FEATURE
	OUTSTR [ASCIZ /Some unrestored files on this tape, will notify users.
/]
>;IFN STANSW
	MOVEI A,1		;CODE FOR FILE UNRESTORED BECAUSE NOT ON TAPE
	MOVE W,TBASE
	PUSHJ P,PRUSER		;NOTIFY USER OF UNRESTORED FILES
	JRST PRNXTT		;NEXT TAPE

PRUEOT:	MOVE P,PRSAVP		;HERE ON UNEXPECTED EOT
	PUSHJ P,MTINIT
	PUSHJ P,MTAREW
	JRST PRSTG3

PRPOSN:	MOVE P,PRSAVP		;HERE ON BAD FORMAT TAPE
	POP P,CREST1
	POP P,CRESTA
	OUTSTR [ASCIZ /Legal commands are ADVANCE, BACKSPACE, REWIND, EOT, and DDT.
When done, type RETRY to continue trying this tape, or FLUSH to skip it.
/]
	SETOM PUMWIZ		;RESTRICT COMMANDS TO THOSE SPECIFIED
	POPJ P,

PRUSER:	SKIPL FSPREQ(W)		;IS THIS TERM ALREADY RESTORED?
	HRLM A,FSPREQ(W)	;NO, SAVE REASON
	HRRZ W,FSDEV(W)		;POINTER TO NEXT TERM
	JUMPN W,PRUSER		;LOOP
	POPJ P,

PMAIL:
IFN STANSW,<			;FIND SOME OTHER WAY TO NOTIFY USERS ELSEWHERE
	INIT DSKMSC,17		;DUMP IT OUT
	 'DSK   '
	 0
	  PUSHJ P,NODEV
PRUSE0:	SKIPN W,RTAPES		;GET A TAPE
	JRST PRUEND		;NONE
	HRRZ X,1(W)		;NEXT TAPE AFTER THIS
	MOVEM X,RTAPES		; IS NEW LIST HEAD
	MOVEM X,TAPES		; AND REST-OF-TAPES HEAD
	HLRZ W,1(W)		;BEGINNING OF TERM LIST FOR THIS TAPE
PRUSE1:	HRRZ X,FSPREQ(W)	;GET PROGRAMMER NAME OF A LUSER
	HLRZ A,FSPREQ(W)	;GET NOTIFICATION CODE
	JUMPE A,PRUNXT		;JUMP IF NOT TO BE NOTIFIED
	MOVE Y,.JBFF		;HERE'S WHERE WE'LL PUT THE MESSAGE
	ADDI Y,1000		;KLUDGE, LEAVE ROOM FOR MESSAGE
	CAMLE Y,.JBREL
	CORE Y,
	 JFCL			;FCK IT
	MOVE A,.JBREL
	HRLZ Y,.JBFF
	HRR Y,.JBFF
	ADDI Y,1
	SETZM @.JBFF
	BLT Y,-1(A)		;ALL THIS TO AVOID SOS BITS
	MOVE Y,.JBFF
	HRLI Y,440700		;BPT
	MOVEI B,[ASCIZ \MAIL/SUBJEC/FROM="Great Pumpkin" \]
	PUSHJ P,PRUSTR		;OUTSTR THAT
	MOVEI B,(X)		;PRG OF LUSER
	PUSHJ P,PRUSIX
	MOVEI B,[ASCIZ /
/]
	PUSHJ P,PRUSTR
	MOVEI A,14		;CAN'T PUT A FORMFEED IN THIS HERE E-FORMAT PROGRAM
	IDPB A,Y
	MOVEI B,[ASCIZ /Restored Files
Here is a status report on your PUMPKIN requests:

Tape	File					Status

/]
	PUSHJ P,PRUSTR
	MOVEI Z,(W)		;GET FIRST BLOCK FOR THIS USER
	HRRZ K,FSPREQ(W)	;SAVE THE PRG HERE
PRUFLP:	PUSHJ P,PRUFIL		;POOT OUT FILE NAME
	HRRZS FSPREQ(Z)		;MAKE SURE WE DON'T TELL ABOUT THIS TWICE
PRUFNX:	HRRZ Z,FSDEV(Z)		;LOOK FOR MORE TERMS FOR SAME LUSER
PRUTA1:	JUMPE Z,PRUTAP		;NONE IN THIS TAPE, LOOK FOR ANOTHER
	HRRZ B,FSPREQ(Z)	;SAME PERSON?
	CAIN B,(K)
	JRST PRUFLP		;YES
	JRST PRUFNX		;NO

PRUTAP:	SKIPN Z,TAPES		;MORE TAPES TO CHECK?
	JRST PRUMAI		;NO
	HRRZ A,1(Z)		;YES, MARK NEW TAPE SEEN
	MOVEM A,TAPES
	HLRZ Z,1(Z)		;GET TERM LIST
	JRST PRUTA1

PRUMAI:	MOVEI A,0		;NULL IT OUT
PRUMA1:	IDPB A,Y
	TLNE Y,760000		;END OF WORD?
	JRST PRUMA1		;NO
	MOVEI Y,1(Y)		;END ADDR +1
	SUB Y,.JBFF		;LENGTH OF MESSAGE
	MOVNS Y			;NEGATIVE LENGTH
	HRL Y,.JBFF		;SWAPPED WCMA
	MOVSM Y,PRUIOW		;REAL WCMA
	SOS PRUIOW		;IOWD (WCMA-1)
	MSTIME A,		;ORIGINAL WAY TO MAKE UP UNIQUE FN
	HRLI A,(K)		; INCLUDING THE RECIPIENT
	MOVEM A,PRUFNM
	MOVEI L,100		;HOW MANY FNS TO TRY
PRUTRY:	MOVSI B,'FTP'		;PREPARE FOR LOOKUP
	MOVE D,RMDSYS
	LOOKUP DSKMSC,A		;EXISTS?
	 TRNE B,-1		;ERROR MUST BE FILE NOT FOUND TO WIN
	AOSA A,PRUFNM		;THIS NAME LOSES
	SKIPA A,PRUFNM		;THIS NAME WINS
	SOJG L,PRUTRY		;LOSES
	JUMPLE L,PRUMER		;MAIL ERROR
	CLOSE DSKMSC,		;NO HANGING LOOKUP
	MOVSI B,'FTP'		;PREPARE FOR ENTER
	MOVEI C,0
	MOVE D,RMDSYS
	ENTER DSKMSC,A		;DO IT
	 JRST PRUMER		;HUH?
	OUTPUT DSKMSC,PRUIOW	;WRITE IT
PRUMER:	CLOSE DSKMSC,		;SHIP IT
	MOVE A,RTAPES		;GET TAPE WE'RE DOING
	HRRZ A,1(A)		;GET ITS NEXT TAPE
	MOVEM A,TAPES		;SAVE AS LIST TO CHECK
PRUNXT:	HRRZ W,FSDEV(W)		;GET NEXT TERM BLOCK
	JUMPN W,PRUSE1		; IF ANY
	JRST PRUSE0		;ELSE NEXT TAPE

PRUEND:	RELEAS DSKMSC,
	MOVEI A,RMDWAK		;FIRE UP MAIL
	WAKEME A,
	 JFCL
>;END IFN STANSW
	POPJ P,

PROPRN:	SKIPN B,MRTPNO		;OPR DOESN'T LIKE OUR TAPE, DID S/HE GIVE ANOTHER?
	JRST PRSKPT		;NO, JUST SKIP A TAPE
	MOVE W,TAPES		;SKIP AHEAD TO HIS/HER TAPE
	MOVEI X,TAPES-1		;I THINK THIS IS AN UNNECESSARY PRECAUTION
PRSKPL:	MOVE A,(W)		;GET TAPE NUMBER
	CAIN A,(B)		;THERE YET?
	JRST PRFNDT		;FOUND IT
	MOVE X,W		;SAVE BACK POINTER
	HRRZ W,1(W)		;GET NEXT TAPE
	JUMPN W,PRSKPL		; IF ANY
	OUTSTR [ASCIZ /But, we don't need that one!  Try again:
/]
	JRST PRNXTT

PRFNDT:	OUTSTR [ASCIZ /Forget about intervening tapes?  (Otherwise we'll do them
after this one.) /]
PRFND1:	PUSHJ P,PYORN		;MUST BE Y OR N, NO DEFAULT
	 JRST PRJUGG		;NO, JUST JUGGLE THE LIST
IFN STANSW,<			;ONLY IF WE HAVE THE MAIL FEATURE
PRFND2:	OUTSTR [ASCIZ /Notify users that requests were not done? /]
	PUSHJ P,PYORN
	 JRST PRJUMP		;THIS IS APPROPRIATE IF DOING A PICKUP
	PUSH P,W		;SAVE TARGET TAPE
	HRRZ W,TAPES		;LOOP THROUGH NOTIFYING USERS
PRSKLP:	HRRZ A,1(W)
	HRRZM A,TAPES		;LINK THIS TAPE OUT
	CAMN W,(P)		;IS THIS THE TARGET?
	JRST PRSKDN		;YES, DONE
	HLRZ W,1(W)		;GET TERM LIST HEAD
	MOVEI A,2		;CODE FOR NOT RESTORED BECAUSE OPR SKIPPED TAPE
	PUSHJ P,PRUSER		;NOTIFY USERS
	SKIPE W,TAPES		;GET NEXT TAPE
	JRST PRSKLP
	SKIPN (P)		;MAYBE WE WEREN'T LOOKING FOR ANYTHING?
	JRST PRSKDN		;RIGHT! (FROM X OF LAST TAPE)
	OUTSTR [ASCIZ /Can't find tape block!/]
	HALT PRSKDN

PRSKDN:	POP P,W
>;IFN STANSW
IFE STANSW,<
PRFND2:
>;IFE STANSW
PRJUMP:	HRRZM W,TAPES		;SKIP AHEAD TO OPR'S TAPE, FLUSHING OTHERS
	JRST PRNXTT

PRJUGG:	HRRZ A,1(W)		;LINK OPR'S TAPE OUT OF LIST
	HRRM A,1(X)
	JUMPE A,.+2		;SKIP IF NEW HEAD WAS OLD TAIL
	HRLM X,2(A)		;BACK PTR TOO
	HRRZ A,TAPES		;NOW PUT OUR LIST AFTER IT
	HRRM A,1(W)
	HLRZ X,2(A)		;GET OLD HEAD'S BACK POINTER
	HRLM W,2(A)		;ITS NEW BACK PTR IS OUR NEW HEAD
	JUMPE X,.+2		;JUMP IF OLD HEAD WAS REAL HEAD, NO BACK PTR
	HRRM W,1(X)		;LINK NEW HEAD INTO FULL LIST
	HRLM X,2(W)		;BACK PTR FOR NEW HEAD
	HRRZM W,TAPES		;MAKE IT HEAD OF LIST
	JUMPN X,PRNXTT		;JUMP UNLESS NEW HEAD IS NEW REAL HEAD
	HRRZM W,RTAPES		;NEW HEAD OF FULL LIST
	JRST PRNXTT		;RECONFIRM USING THAT TAPE

PRSKPT:	SKIPE X,TAPES		;SKIP ONE TAPE
	HRRZ W,1(X)		;THIS IS TARGET TAPE
	JUMPE W,PRSKNO		;NO NEXT TAPE
	OUTSTR [ASCIZ /Forget about that tape?  (Otherwise we'll do it
after the next one.) /]
	JRST PRFND1

PRSKNO:	OUTSTR [ASCIZ /That's the last tape.  Do you want to forget about it? /]
	PUSHJ P,PYORN		;CONFIRM FLUSHING TAPE
	 JRST PRNXTT		;NO CONFIRM, ASK FOR SAME TAPE
	JRST PRFND2		;ASK ABOUT NOTIFYING USERS

NOPQUE:	TRNN B,-1		;WHAT LOOKUP ERROR?
	JRST NOPREQ		;FILE NOT FOUND, NO REQUESTS
	OUTSTR [ASCIZ /Can't read PUMPKI.QUE
/]
	POPJ P,

NOPREQ:	OUTSTR [ASCIZ /Nobody wants the Great Pumpkin today.
/]
	POPJ P,

QUEERR:	OUTSTR [ASCIZ /PUMPKI.EUQ already exists, please check it out.
/]
	JRST RESTAR

PRUEOF:	OUTSTR [ASCIZ /Bad format in PUMPKI.EUQ, get help.
/]
	JRST RESTAR

DELEUQ:
IFN STANSW,<
	OUTSTR [ASCIZ /PRESTORE done, notifying users...
/]
	PUSHJ P,PMAIL
>;IFN STANSW
	INIT DSKMSC,17
	 'DSK   '
	 0
	 PUSHJ P,NODEV
	MOVE A,['PUMPKI']
	MOVSI B,'EUQ'
	MOVE D,DUMPER
	LOOKUP DSKMSC,A
	 JFCL
	MOVE D,DUMPER
	MOVEI A,0
	RENAME DSKMSC,A
	 OUTSTR [ASCIZ /Couldn't delete PUMPKI.EUQ, get help.
/]
	RELEAS DSKMSC,
	OUTSTR [ASCIZ /Thank you, O Great Pumpkin.
/]
IFN STANSW!IRCPPN,<
	MOVNI A,1
	BEEP A,
>;IFN STANSW!IRCPPN
	POPJ P,

PYORN:	OUTSTR [ASCIZ /Type Y or N: /]
PYORN0:	INCHWL A
	SKIPA B,A
PYORN1:	INCHWL A
	CAIE A,12
	JRST PYORN1
	CAIE B,"Y"
	CAIN B,"y"
	JRST CPOPJ1
	CAIE B,"N"
	CAIN B,"n"
	POPJ P,
	JRST PYORN		;MUST TYPE Y OR N, NOT JUST CR

PRUSTR:	HRLI B,440700		;THIS TRIVIAL CODE DESERVES NO COMMENTS
PRUST1:	ILDB A,B
	JUMPE A,CPOPJ
	IDPB A,Y
	JRST PRUST1

PRUSIX:	JUMPE B,CPOPJ
	MOVEI A,0
	LSHC A,6
	JUMPE A,PRUSIX		;NO LEADING BLANKS IN PPN
	ADDI A,40
	IDPB A,Y
	SUBI D,1
	JRST PRUSIX

PRUDEC:	IDIVI B,5+5
	JUMPE B,PRUDE1
	HRLM C,(P)
	PUSHJ P,PRUDEC
	HLRZ C,(P)
PRUDE1:	ADDI C,"0"
	IDPB C,Y
	POPJ P,

PRUDAT:	MOVE A,B			;OUTPUT SYSTEM DATE
	IDIVI	A,37			;DAYS IN B
	PUSH	P,A			;SAVE THE REST
	MOVEI	A," "			;BLANK
	CAIG	B,10
	IDPB A,Y
	MOVEI	B,1(B)			;GET THE DAY OF MONTH
	PUSHJ	P,PRUDEC
	MOVEI	A,"-"
	IDPB A,Y
	MOVE	A,(P)
	IDIVI	A,14			;MONTHS IN B
	MOVEM	A,(P)
	MOVEI	B,MONTAB(B)
	PUSHJ	P,PRUSTR
	POP	P,A
	MOVEI B,100(A)
	JRST PRUDEC

PRLFIL:	HRLZ B,FSPREQ(Z)	;PLIST, TELL WHO REQUESTED IT
	PUSHJ P,PRUSIX
	MOVEI A,11
	IDPB A,Y
	HRRZ B,FSPDAT(Z)	;AND WHEN
	PUSHJ P,PRUDAT
	MOVEI A,11
	IDPB A,Y
	JRST PRLFI1

PRUFIL:	HLRE A,FSPREQ(Z)	;GET STATUS CODE
	JUMPE A,CPOPJ		;DON'T REPORT ON INVISIBLE FILE
PRLFI1:	HLRZ B,FSDEV(Z)		;ENTRY FOR PLIST, LISTS EVEN INVISIBLE TERMS
	MOVEI A,"P"
	TRZE B,400000		;WHICH KIND OF TAPE?
	MOVEI A,"T"
	IDPB A,Y
	PUSHJ P,PRUDEC		;POOT OUT THE TAPE NUMBER
	MOVEI A,11
	IDPB A,Y		;TAB
	MOVEI D,50		;COUNT CHARS IN FIELD FOR FILENAME(S)
	MOVE C,FSPPPN(Z)	;IS DEST SAME AS SOURCE?
	MOVE B,FSPNAM(Z)
	CAMN C,FSPPN(Z)
	CAME B,FSNAM(Z)
	JRST PRUFI0		;NO, MUST DO OUT_IN
	HLRZ B,FSEXT(Z)
	HLRZ C,FSPEXT(Z)
	CAIN B,(C)
	JRST PRUF00
PRUFI0:	MOVE B,FSPNAM(Z)	;HERE TO PRINT DEST NAME
	PUSHJ P,PRUSIX
	MOVEI A,"."
	HLLZ B,FSPEXT(Z)
	JUMPE B,PRUF01
	IDPB A,Y
	SUBI D,1
	PUSHJ P,PRUSIX
PRUF01:	MOVEI A,"["
	IDPB A,Y
	SUBI D,1
	HLLZ B,FSPPPN(Z)
	PUSHJ P,PRUSIX
	MOVEI A,","
	IDPB A,Y
	SUBI D,1
	HRLZ B,FSPPPN(Z)
	PUSHJ P,PRUSIX
	MOVEI A,"]"
	IDPB A,Y
	SUBI D,1
	MOVEI A,"_"
	IDPB A,Y
	SUBI D,1
PRUF00:	MOVE B,FSNAM(Z)
	PUSHJ P,PRUSIX
	MOVEI A,"."
	HLLZ B,FSEXT(Z)
	JUMPE B,PRUFI1
	IDPB A,Y
	SUBI D,1
	PUSHJ P,PRUSIX
PRUFI1:	MOVEI A,"["
	IDPB A,Y
	SUBI D,1
	HLLZ B,FSPPN(Z)
	PUSHJ P,PRUSIX
	MOVEI A,","
	IDPB A,Y
	SUBI D,1
	HRLZ B,FSPPN(Z)
	PUSHJ P,PRUSIX
	MOVEI A,"]"
	IDPB A,Y
	ADDI D,6		;SUB 1 FOR "]" ADD 7 FOR TAB STOP
	LSH D,-3		;SPACES TO TABS
	MOVEI A,11
	IDPB A,Y
	SOJG D,.-1
	HLRE A,FSPREQ(Z)	;GET STATUS CODE
	JUMPE A,PUX0		;HERE FOR PLIST ONLY, UNPROCESSED TERM
	JUMPGE A,.+2		;JUMP IF NOT RESTORED
	ADDI A,1		;-1 MEANS WAS RESTORED, -2 ALREADY EXISTS
	ADDI A,2		;RANGE -1 TO 2 CHANGED TO 1 TO 4
	CAILE A,4
	MOVEI A,4		;MAX ERROR CODE IS 4
PUX0:	MOVE B,PUXSTR(A)	;GET TEXT
	JRST PRUSTR

PUXSTR:	[ASCIZ /
/]
	[ASCIZ /Output file already exists
/]
	[ASCIZ /Restored
/]
	[ASCIZ /Not found on tape
/]
	[ASCIZ /Tape not found by operator
/]

UNP2QS:	MOVSI A,-3		;SPECIAL CODE, PRINTS NULL IN PUXSTR
	MOVEM A,UNP2QF		;FLAG THAT WE ARE DOING EUQ FILE
	PUSHJ P,DOEUQ		;DO IT
	SETZM UNP2QF		;NOW WE DO QUE IN ADDITION
	MOVE A,['PUMPKI']
	MOVSI B,'QUE'
	MOVE D,DUMPER
	LOOKUP UFD,A		;FIND THE QUEUE FILE
	 JRST PREOF		;NO QUE, WE'RE READY TO GO
	SETZM UFDBUF+2		;ENSURE THAT WE READ A RECORD RIGHT AWAY
	JRST PREQLP		;CONTINUE READING REQUESTS.
;PLIST1 PLIST3 PLIST2 UNPUM1 UNPUM3 UNPUM2 UNPUM5 UNPUM4 UNPUM6 UNPUM8 UNPUM7 UNPQLP UNPBLK UNPHIT UNPHI1 UNPURD UNPUR1 UNPUIN UNPEOF UNUEOF UNPLUZ PGETNO PGETN1 PGETN2 PGETN3 DDTKLU DDTENT

PLIST1:	CLOSE UFD,		;LET OTHER PEOPLE AT THE QUEUE
	TLNE FL,L.TURK		;PLIST OR UNPUMPKIN?
	JRST UNPUM1		;UNPUMPKIN
PLIST3:	SKIPN W,TAPES		;LIST QUEUE.  GET A TAPE
	POPJ P,			;NOPE
	HRRZ A,1(W)
	MOVEM A,TAPES		;REMOVE THIS TAPE FROM LIST
	HLRZ Z,1(W)		;GET HEAD OF TERM LIST
PLIST2:	JUMPE Z,PLIST3		;JUMP IF NO MORE TERMS IN THIS TAPE
	MOVE Y,[POINT 7,PLBUF]	;POINTER TO BUFFER FOR OUTPUT LINE
	PUSHJ P,PRLFIL		;LIST THIS TERM
	MOVEI A,0
	IDPB A,Y
	OUTSTR PLBUF
	HRRZ Z,FSDEV(Z)		;GET NEXT TERM
	JRST PLIST2

UNPUM1:	MOVEI X,0		;COUNT TERMS TYPED
IFE IRCPPN,<
	GETPPN	A,			;GET THE REAL PPN (NOT DSKPPN)
	 JFCL				;DEC NEEDS THIS
>
IFN IRCPPN,<
	HRROI A,2			;REAL PPN COMES FROM GETTAB
	GETTAB A,
	 GETPPN A,
	  JFCL
>
	HRRZ R,A		;GET USER'S PRG
UNPUM3:	SKIPN W,TAPES		;LIST QUEUE.  GET A TAPE
	JRST UNPUM6		;NOPE
	HRRZ A,1(W)
	MOVEM A,TAPES		;REMOVE THIS TAPE FROM LIST
	HLRZ Z,1(W)		;GET HEAD OF TERM LIST
UNPUM2:	JUMPE Z,UNPUM3		;JUMP IF NO MORE TERMS IN THIS TAPE
	HRRZ B,FSPREQ(Z)	;GET PRG OF REQUESTOR
	CAIE B,(R)		;IS THIS OUR REQUEST?
	JRST UNPUM4		;NO, FORGET IT
	CAIL X,PUMNUM		;SKIP IF NOT TOO MANY TERMS
	JRST UNPUM8		;OVERFLOW
	JUMPN X,UNPUM5		;JUMP IF WE'VE ALREADY GIVEN HEADER
	OUTSTR [ASCIZ /Here are your PUMPKIN requests:

index	tape	file (or output_input)

/]
UNPUM5:	MOVE Y,[POINT 7,PLBUF]	;POINTER TO BUFFER FOR OUTPUT LINE
	MOVEM Z,UNPUTR(X)	;SAVE POINTER TO TERM BLOCK
	AOS B,X			;NEXT INDEX, READY TO PRINT
	PUSHJ P,PRUDEC
	MOVEI A,11
	IDPB A,Y
	PUSHJ P,PRLFI1		;LIST THIS TERM
	MOVEI A,0
	IDPB A,Y
	OUTSTR PLBUF
UNPUM4:	HRRZ Z,FSDEV(Z)		;GET NEXT TERM
	JRST UNPUM2

UNPUM6:	JUMPN X,UNPUM7
	OUTSTR [ASCIZ /You have no pending PUMPKIN requests.
/]
	POPJ P,

UNPUM8:	OUTSTR [ASCIZ /That's all I can fit in my buffer!  Complain via GRIPE.
/]
UNPUM7:	OUTSTR [ASCIZ /
To delete a request, type its index number: /]
	PUSHJ P,PGETNO		;GET NUMBER
	 JRST UNPUM7		;BAD FORMAT
	JUMPE B,CPOPJ		;DONE IF NO NUMBER GIVEN
	CAIG B,(X)		;IN RANGE?
	JRST UNPUM9
	OUTSTR [ASCIZ /No such request index.
/]
	JRST UNPUM7

UNPUMA:	OUTSTR [ASCIZ /That request already deleted!
/]
	JRST UNPUM7

UNPUM9:	MOVE S,UNPUTR-1(B)	;GET PATTERN TO MATCH
	SETOM UNPUTR-1(B)	;FLAG IT DONE
	JUMPL S,UNPUMA		;JUMP IF ALREADY DELETED
	INIT UFD,17		;PREPARE TO READ THE REQUEST FILE
	 'DSK   '
	 0
	 PUSHJ P,NODEV		;IT CAN'T HAPPEN HERE?
	MOVE A,['PUMPKI']
	MOVSI B,'QUE'
	SKIPGE FSPREQ(S)	;CHECK WHICH QUEUE THIS IS FROM
	MOVSI B,'EUQ'		; AND OPEN THE RIGHT FILE
	MOVE D,DUMPER
	LOOKUP UFD,A		;FIND THE QUEUE FILE
	 JRST UNPLUZ
	MOVE D,DUMPER
	ENTER UFD,A		;READ/ALTER
	 JRST UNPLUZ
	PUSHJ P,UNPUIN		;READ A RECORD
	 JRST UNUEOF		;HUH? EMPTY FILE
UNPQLP:	PUSHJ P,UNPURD		;READ THE WORD COUNT
	 JRST UNPEOF		;ALL READ IN
	JUMPE A,UNPQLP		;SKIP PADDING WORDS
	MOVE Z,A		;SAVE WORD COUNT
	PUSHJ P,UNPURD		;REQUESTOR'S PPN
	 JRST UNUEOF		; THERE BETTER BE ONE
	MOVEM A,RSTDEV		;SAVE IT HERE TEMPORARILY
	PUSHJ P,UNPURD		;DEST NAME
	 JRST UNUEOF
	MOVEM A,RSTNAM		;AS GOOD A PLACE AS ANY
	PUSHJ P,UNPURD
	 JRST UNUEOF
	MOVEM A,RSTEXT
	PUSHJ P,UNPURD
	 JRST UNUEOF
	MOVEM A,RSTPPN
	SUBI Z,FSLEN+1		;REMOVE THIS HEADER STUFF FROM WC
	IDIVI Z,PSIZE		;TURN WC INTO BLOCK COUNT
UNPBLK:	MOVEI C,0		;WILL BECOME NONZERO FOR LOSING REQUEST
	PUSHJ P,UNPURD		;READ THE SOURCE POOP
	 JRST UNUEOF		;FIRST WE IGNORE THE DEV WORD
	PUSHJ P,UNPURD
	 JRST UNUEOF
	CAME A,FSNAM(S)		;IS IT THE RIGHT SOURCE NAME?
	MOVNI C,1		;NO
	PUSHJ P,UNPURD
	 JRST UNUEOF
	CAME A,FSEXT(S)
	MOVNI C,1
	PUSHJ P,UNPURD
	 JRST UNUEOF
	CAME A,FSPPN(S)
	MOVNI C,1
	PUSHJ P,UNPURD
	 JRST UNUEOF
	HLRZS A			;JUST TAPE NUMBER
	HLRZ B,FSDEV(S)		;DITTO FROM TARGET REQUEST
	CAIE A,(B)		;SAME?
	MOVNI C,1		;NOPE
	MOVE B,RSTEXT		;GET DEST EXT AND FLAGS
	MOVE A,RSTNAM		;DEST NAME
	TRNE B,ALLFIL		;WILD?
	MOVE A,FSNAM(S)		;YES, USE SOURCE NAME
	CAME A,FSPNAM(S)	; AS DEST NAME
	MOVNI C,1
	TRNE B,ALLEXT		;WILD EXT?
	HLL B,FSEXT(S)		;YES, USE SOURCE
	HLLZ A,B		;GET EXT W/O FLAGS
	CAME A,FSPEXT(S)
	MOVNI C,1		;NOT THE SAME
	MOVE A,RSTPPN
	TRNE B,ALLPRJ
	HLL A,FSPPN(S)
	TRNE B,ALLPRG
	HRR A,FSPPN(S)
	CAME A,FSPPPN(S)
	MOVNI C,1
	HRRZ A,RSTDEV		;REQUESTOR'S PPN
	HRRZ B,FSPREQ(S)	;DITTO FROM TARGET
	CAIE A,(B)
	MOVNI C,1
	JUMPE C,UNPHIT		;GOTCHA! IF NO MISSES
	SOJG Z,UNPBLK		;FINISH THIS REQUEST
	JRST UNPQLP		;OR GET NEXT REQUEST

UNPHIT:	MOVEI A,-4(Y)		;ADDRESS OF WORD TO CLOBBER TO ZERO
	CAIL A,UNPBUF		;IS IT IN PREVIOUS RECORD?
	JRST UNPHI1		;NO, EASIER
IFN STANSW,<
	MOVEI B,0		;MAKE SURE NO -1 OR GODMOD
	MTAPE UFD,B		;GET USET POINTER
>;IFN STANSW
IFE STANSW,<
	PRINTX FIGURE OUT HOW TO GET USET POINTER
>;IFE STANSW
	USETI UFD,-2(B)		;WANT RECORD BEFORE THE ONE WE LAST READ
	PUSHJ P,UNPUIN		;READ IT
	 JRST UNUEOF		;OOPS
	ADDI A,200		;MAKE WORD POINTER POINT INTO THE BUFFER
UNPHI1:	SETZM (A)		;FLAG THIS REQUEST DELETED
IFN STANSW,<
	MOVEI B,0		;MAKE SURE NO -1 OR GODMOD
	MTAPE UFD,B		;GET USET POINTER
>;IFN STANSW
IFE STANSW,<
	PRINTX FIGURE OUT HOW TO GET USET POINTER
>;IFE STANSW
	USETO UFD,-1(B)		;WANT THE LAST RECORD WE READ
	OUTPUT UFD,[IOWD 200,UNPBUF
		    0]
	RELEAS UFD,		;WE'VE DONE IT!
	OUTSTR [ASCIZ /OK./]
	JRST UNPUM7		;SEE IF S/HE WANTS ANOTHER ONE

UNPURD:	JUMPL Y,UNPUR1		;JUMP IF BUFFER NOT EMPTY
	PUSHJ P,UNPUIN		;EMPTY, GET ANOTHER
	 POPJ P,		;EOF
UNPUR1:	MOVE A,(Y)		;GET A WORD
	AOBJN Y,CPOPJ1
	JRST CPOPJ1		;SUCCESS RETURN

UNPUIN:	SETZM UNPBUF+1		;DEAL WITH POSSIBLE PARTIAL RECORD, SIGH
	MOVE Y,[UNPBUF+1,,UNPBUF+2]
	BLT Y,UNPBUF+177
	MOVE Y,[525252525252]	;UNLIKELY PATTERN
	MOVEM Y,UNPBUF
	IN UFD,[IOWD 200,UNPBUF
		0]
	 JRST UNPUI1		;SUCCESS
	MOVE Y,UNPBUF		;EOF, WAS THERE ANY DATA AT ALL?
	CAMN Y,[525252525252]	;SKIP IF YES
	POPJ P,			;ERROR OR EOF RETURN
UNPUI1:	MOVE Y,[-200,,UNPBUF]	;SET UP AOBJN FOR UNPURD
	JRST CPOPJ1		;OK RETURN

UNPEOF:				;REALLY ANY NON-HIT IS UNEXPECTED
UNUEOF:	RELEAS UFD,
	OUTSTR [ASCIZ /?? Gee, I can't find the request to delete it!
/]
	POPJ P,

UNPLUZ:	RELEAS UFD,
	OUTSTR [ASCIZ /Sorry, I can't access PUMPKI.QUE; probably busy.
Try again shortly.
/]
	POPJ P,

PGETNO:	MOVEI B,0
PGETN1:	INCHWL A
	CAIN A,15
	JRST PGETN1
	CAIL A,"0"
	CAILE A,"9"
	JRST PGETN2
	IMULI B,12
	ADDI B,-"0"(A)
	JRST PGETN1

PGETN2:	CAIN A,12
	JRST CPOPJ1
PGETN3:	CAIE A,12
	CAIN A,175
	POPJ P,
	INCHWL A
	JRST PGETN3

DDTKLU:	MOVEI A,DDTENT
	SKIPE B,.JBDDT
	SETDDT A,		;MRC SEZ: WHAT? YOU'VE NEVER USED SETDDT?
	MOVEI B,(B)		;I DON'T KNOW OR CARE WHAT'S IN THE LH
	CAIE B,DDTENT		;DON'T CLOBBER DDTADR TWICE
	HRRZM B,DDTADR
	OUTSTR [ASCIZ /Okay./]
	EXIT

DDTENT:	MOVEM A,DDTSVA
	MOVEM B,DDTSVB
IFN STANSW,<			;I DON'T KNOW HOW TO DEAL WITH THIS ELSEWHERE
	MOVSI A,0		;ACTIVE
	GETPRV A,
	IOR A,[1,,200000]	;LUP AND LIV FREE IF IN PASSIVE
	MOVSI B,1		;PASSIVE
	GETPRV B,
	AND A,B			;KEEP ONLY PASSIVE-ENABLED ONES
	SETPRV A,
>;IFN STANSW
	MOVE A,DDTSVA
	MOVE B,DDTSVB
	JRST @DDTADR
;RSTG3 RSTG3A RSTG4 RSTG5 RSTG5A RSTG5B RSTG5C RSTG6 RST5DD RST5DZ RST5DE RSTG7 RSTG77 RSTG99

	SUBTTL	MORE RESTORE CODE
RSTG3:	PUSHJ	P,MTINIT		;INIT THE MAGTAPE DEVICE
	PUSHJ	P,MTANOP		;DO A MTA NO-OP TO DETECT FRONT OF TAPE
	MOVEI	A,10			;DEVICE MODE
	SKIPN	B,RSTDEV		;GET THE DESTINATION DEVICE
	MOVSI	B,'DSK'
	MOVEM	B,RSTDEV		;SAVE
	MOVSI	C,FOBUF			;NO BUFFERS
	TLZ	FL,UDPGO		;ASSUME NOT UDP

	MOVE	D,B			;GET DEVICE NAME
	DEVCHR	D,
	TLNE	D,DEVDSK
	JRST	RSTG3A			;IS A DISK
IFE UDPSW,<
	JRST	NOTDSK
>
IFN UDPSW,<
	TLNN	D,DEVUDP		;IS THIS A UDP?
	JRST	NOTDSK			;NO.
	INIUDP	B			;INITIALIZE UDP
	TLO	FL,UDPGO
	UOPEN	FILE,A			;DO THE OPEN
>

RSTG3A:	OPEN	FILE,A			;ATTEMPT TO OPEN OUTPUT DEVICE
	PUSHJ	P,NODEV			;OOPS.
IFN UDPSW,<	TLNN	FL,UDPGO	;SKIP IF WE ARE THE UDP>
	OUTBUF	FILE,22			;TELL SYSTEM TO BUILD US SOME BUFFERS
RSTG4:	XCT R.REGP(K)			;SKIP IF NORMAL RESTORE
	 XCT R.EMPT(K)			;PRESTORE, SKIP IF NO TERMS LEFT
	  JRST .+2			;SKIP IF NORMAL RESTORE OR STILL TERMS LEFT
	   JRST RSTG7			;USED UP PRESTORE TAPE FINDING NOTHING!
	PUSHJ	P,RDFIL			;READ RETRIEVAL FROM MTAPE
	TRNE	FL,MTAEOT		;SKIP UNLESS END OF TAPE
	JRST	RSTG99

	PUSHJ	P,DPYSER		;DISPLAY FILE NAME FROM THE TAPE
	FILINF+DDNAM,,DPYFIL

	MOVEI W,TBASE
	MOVEM W,LASTW			;SETUP BACK LINK FOR PRESTORE
	SETZM PREALW			;CLEAR SAVED BLOCK FOR PRESTORE
	SETZM PRLSTW
	SETZM PMULTF			;CLEAR MULTIPLE-MATCH FLAG
	MOVE	W,TBASE			;GET THE BASE OF TERM BLOCK.
RSTG5:	XCT R.NULP(K)			;IF PRESTORE, TEST FOR USED UP BLOCK
	 JRST RSTG6			;YES.  (XCT DOES CAIA FOR NORMAL RESTORE)
	HRRZ	X,FSEXT(W)		;GET FLAGS
	TRNE	X,ALLFIL		;ANY FILE?
	JRST	RSTG5A			;YES. SKIP MATCH
	MOVE	Y,FSNAM(W)		;GET THE NAME
	CAME	Y,FILINF+DDNAM		;SAME AS MAGTAPE NAME?
	JRST	RSTG6			;NO. NO MATCH WITH THIS TERM.
RSTG5A:	TRNE	X,ALLEXT		;WILD EXTENSION?
	JRST	RSTG5B			;YES.
	HLLZ	Y,FSEXT(W)		;GET EXT FROM THIS TERM
	HLLZ	Z,FILINF+DDEXT		;GET EXT FROM MT
	CAME	Y,Z			;SAME AS MAG TAPE EXTENSION?
	JRST	RSTG6			;NO MATCH
RSTG5B:	TRNE	X,ALLPRJ		;ANY PROJECT?
	JRST	RSTG5C			;YES.
	HLLZ	Y,FSPPN(W)		;GET PROJECT NAME
	HLLZ	Z,FILINF+DDPPN		;GET MT PROJECT NAME
	CAME	Y,Z
	JRST	RSTG6			;LOSE
RSTG5C:	TRNE	X,ALLPRG		;ANY PROGRAMMER
	JRST	RST5DD			;YES. WIN.
	HRRZ	Y,FSPPN(W)
	HRRZ	Z,FILINF+DDPPN
	CAMN	Y,Z
	JRST	RST5DD			;WIN. DUMP FILE RETURN TO RSTG7 OR RSTG4
RSTG6:	MOVEM W,LASTW			;SAVE BACK POINTER FOR PRESTORE
	XCT R.NXT(K)			;POINT TO NEXT TERM
	XCT R.END(K)			;IS THIS OVERRUN YET?
	 JRST	RSTG5			;NO. CONTINUE LOOKING THRU TERM BLOCKS
	SKIPE PREALW			;NO MORE TERMS.  ANY FOUND FOR PRESTORE?
	JRST RST5DZ			;YES, DO THE PRESTORE NOW
	PUSHJ	P,RDFILX		;FLUSH THROUGH THE END OF THIS FILE
	TRNE	FL,MTAEOT		;SKIP UNLESS EOT
	JRST	RSTG99
	JRST	RSTG4			;LOOK FOR ANOTHER FILE ON THE TAPE

RST5DD:	XCT R.REGP(K)			;FOUND A MATCH, SKIP IF NORMAL RESTORE
	 SKIPA Y,LASTW			;PRESTORE, SAVE MATCH AND KEEP LOOKING
	  JRST RSTG5D			;NORMAL RESTORE, GO DO IT
	SKIPN PREALW			;HAVE WE ALREADY SAVED ONE?
	JRST RST5DE			;NO, SAVE THIS ONE
	SETOM PMULTF			;YES, FLAG THAT WE NEED THIS FILE AGAIN
RST5DZ:	MOVE Y,PRLSTW			;RESTORE THE FIRST ONE WE FOUND
	MOVEM Y,LASTW
	MOVE W,PREALW
	SETZM PREALW			;DON'T LOOP INFINITELY IF SAFETY LOOKUP
	SETZM PRLSTW			;  FAILS
	JRST RSTG5D			;GO DO THE RESTORE

RST5DE:	MOVEM Y,PRLSTW			;FIRST MATCH, SAVE IT
	MOVEM W,PREALW
	JRST RSTG6			;CONTINUE SCAN

RSTG7:	XCT R.REGP(K)			;SKIP IF NORMAL RESTORE
	PUSHJ P,MTAREW			;PRESTORE, REWIND THE TAPE
RSTG77:	RELEAS	FILE,			;RELEASE DESTINATION DEVICE
IFN UDPSW,<
	TLZE	FL,UDPGO
	SETZM	USYNC			;MAKE SURE WE CAN'T DIDDLE THE UDP
>
	PUSHJ	P,MTAREL		;RELEASE SOURCE DEVICE
	TRZ	FL,SAFETY
	POPJ	P,

RSTG99:	PUSHJ	P,MTAREW
	TRZ	FL,MTAEOT
	XCT R.REGP(K)			;SKIP IF NORMAL RESTORE
	 JRST RSTG77			;PRESTORE, RETURN WITH FILE NOT FOUND
	OUTSTR	[ASCIZ/Mount the next tape and type return to proceed.
Type altmode to return to command level.
/]
	TTCALL	11,
	TTCALL	4,A
	CAIN	A,ALTMOD
	JRST	RSTG7
	PUSHJ	P,MTACLZ
	JRST	RSTG4			;GO READ MORE.
;RSTG5D RSTG5E RSTPRE RSTG5H RSTG5G RSTG5G RSTG5W RSTG5X RSTG5F PREKIL PFILEX

	SUBTTL	RESTORE	ACTUALLY MOVE A FILE HERE.
RSTG5D:	TRNE	X,ALLMSK		;SKIP IF THERE IS NO WILDNESS.
	JRST	RSTG5E			;WILD TERM. DO NOT FLUSH TERM.
	XCT R.BLT(K)			;JUMPS OFF IF PRESTORE
	MOVNI	X,FSLEN			;LOAD - LENGTH OF BLOCK.
	ADDB	X,FSPTR			;SHRINK TERM BLOCK STORAGE
	MOVSI	Z,(X)			;SOURCE OF BLT
	HRRI	Z,(W)			;DESTINATION
	BLT	Z,FSLEN-1(W)		;BLT LAST TERM DOWN ONTO THIS ONE.
RSTG5E:	HRRZ	X,@R.EXT(K)		;GET THE WILD FLAGS INTO X FROM RESTORE SIDE
	MOVE	A,FILINF+DDNAM		;SET UP THE DEFAULTS
	MOVE	B,FILINF+DDEXT
	MOVE	C,FILINF+DDPRO
	MOVE	D,FILINF+DDPPN
	TRNN	X,ALLFIL		;IS RESTORE FILE NAME WILD?
	MOVE	A,@R.NAM(K)		;NOT WILD WE TAKE THIS NAME.
	TRNN	X,ALLEXT		;IS RESTORE EXTENSION WILD?
	HLL	B,@R.EXT(K)		;NOT WILD, TAKE THIS EXTENSION.  DATE75
	TRNN	X,ALLPRJ		;IS PROJECT WILD?
	HLL	D,@R.PPN(K)		;NO. SLURP THIS UP.
	TRNN	X,ALLPRG		;IS PROGRAMMER WILD?
	HRR	D,@R.PPN(K)		;NO. SLURP IT UP.
IFE STANSW,<
	PUSHJ P,RSTPRE			;MAKE SUBR SO MRESTORE CAN USE
	 JRST RSTG6
	JRST RSTG5G

RSTPRE:	MOVEM A,LKBLK+.RBNAM
	MOVEM B,LKBLK+.RBEXT
	MOVEM C,LKBLK+.RBPRV
	MOVEM D,LKBLK+.RBPPN
>
	MOVE	X,[A,,FILBLK]		;SAVE THE FILE NAME SOMEWHERE.
	BLT	X,FILBLK+3		;SAVE..
	TRO	FL,SAFETY

IFN UDPSW,<
	TLNE	FL,UDPGO		;ON THE UDP?
	ULOOK	FILE,A			;YES. ASK RPH
>

	LOOKUP	FILE,A			;LOOK UP THE FILE.
	JRST	.+2			;LOOKUP FAILURE IS A GOOD WAY TO START
	HRRI	B,-1			;THIS IS LOOKUP SUCCESS CODE.
	TLNN	FL,UDPGO
	CLOSE	FILE,NUPACC		;AVOID BEING IN READ/ALTER MODE
	XCT R.SAFE(K)			;CHECK THE OMENS.
IFN STANSW,<
	 JRST	RSTG6			;FOR SOME REASON, DON'T RESTORE.
>
IFE STANSW,<
	 POPJ P,
>
	TRZ	FL,SAFETY
	MOVE	D,[FILBLK,,A]
	BLT	D,D

IFN STANSW,<
IFN UDPSW,<
	TLNE	FL,UDPGO		;SKIP UNLESS THIS IS ENTER ON UDP
	JRST	RSTG5H			;ENTER ON UDP. DON'T CLEAR PROTECT
>

	SETZ	C,			;MAKE SURE WE DON'T PROTECT IT TOO MUCH
	JRST	RSTG5G			;GO DO DISK ENTER

IFN UDPSW,<
RSTG5H:	SKIPN	PASFLG			;HAS THERE BEEN A PASSWORD CHECK?
	PASCHK				;NO. DO IT. RETURN WHEN IT'S OK
	UENTER	FILE,A
>
RSTG5G:	ENTER	FILE,A			;
>;IFN STANSW
IFE STANSW,<
	MOVE A,FILINF+DQVER
	MOVEM A,LKBLK+.RBVER
	SETZM LKBLK+.RBSPL
	MOVE A,FILINF+DDLNG
	ADDI A,177
	LSH A,-7
	MOVEM A,LKBLK+.RBEST
	SETZM LKBLK+.RBALC
	SETZM LKBLK+.RBPOS
	SETZM LKBLK+.RBFT1
	MOVE A,FILINF+DDMPTM
	MOVEM A,LKBLK+.RBNCA
	SETZM LKBLK+.RBMTA
	SETZM LKBLK+.RBSTS
	MOVE A,FILINF+DQAUT
	MOVEM A,LKBLK+.RBAUT
	JRST CPOPJ1

RSTG5G:	ENTER FILE,LKBLK
>
	JRST	[OUTSTR [ASCIZ/ENTER failed: /]
		MOVE	D,[FILBLK,,A]
		BLT	D,D
		PUSHJ	P,TYFIL
		JRST	RSTG5F]
IFN STANSW,<
	MOVE	D,INVERS		;GET THE TAPE VERSION NUMBER
	MOVE	C,FILINF+DDOFFS		;GET THE NEEDED OFFSET.
	CAIL	D,2			;DART VERSION 4 (FORMAT 2) HAS THIS KLUGE
	CAIG	C,1			;OTHER THAN NORMAL?
	JRST	RSTG5X			;EARLY VERSION OR NORMAL FILE.
	TLNE	FL,UDPGO
	JRST	RSTG5W
	MOVEM	C,WROFFS+2		;SET FOR WRITE OFFSET UUO.
	MTAPE	FILE,WROFFS		;WRITE THE FILE OFFSET
	MOVEI	C,2
	SUB	C,FILINF+DDOFFS
	USETO	FILE,(C)
	JRST	RSTG5X

RSTG5W:	OUTSTR	[ASCIZ/UDP OUTPUT FILE WILL NOT HAVE RECORD OFFSET
/]
>;IFN STANSW
RSTG5X:	MOVE	D,[FILBLK,,A]
	BLT	D,D
	PUSHJ	P,TYFIL			;TYPE A FILE NAME
	PUSHJ	P,RFDATA		;GO DO THE RESTORE
IFN STANSW,<
	TLNE	FL,UDPGO
	JRST	RSTG5F			;AVOID RENAME IF UDP
	MOVE	D,[FILBLK,,A]
	BLT	D,D
	TLZ	C,400000		;AVOID RESTORING WITH PROT=400
	RENAME	FILE,A			;RENAME TO OLD CREATION DATE
	OUTSTR	[ASCIZ/ (RENAME TO UPDATE DATE OF CREATION FAILED) /]
>
RSTG5F:	OUTSTR	CRLF
	SKIPE PMULTF			;NEED THIS FILE AGAIN FOR PRESTORE?
	PUSHJ P,MTABKF			;YES, RE-READ IT
	SETZM PMULTF
	MOVE W,TBASE			;GET BEGINNING OF TERM LIST
	XCT R.EMPT(K)			;SKIP IF NO TERMS LEFT IN LIST
	JRST	RSTG4			;GO PROCESS MORE.
	JRST	RSTG7			;THERE ARE NO MORE TERMS

PREKIL:	HRROS FSPREQ(W)			;FLAG TERM AS ALREADY RESTORED
	SOS TRMCNT			;COUNT DOWN HOW MANY TO GO
	JRST RSTG5E

REPEAT 0,<			;code to really link out the term
	MOVE X,LASTW			;GET TERM WHICH LINKED TO THIS ONE
	HRRZ Z,(X)			;DOUBLE CHECK THAT IT POINTS HERE
	CAIE Z,(W)			; (NOTE THAT THIS CODE MUST NOT LOSE W)
	JRST RSTG5E			;NO, DO NOTHING
	HRRZ Z,(W)			;GET LINK OF THE DEAD TERM
	HRRM Z,(X)			;LINK DEAD ONE OUT
	JRST RSTG5E			;REJOIN REGULAR RESTORE
>;REPEAT 0

PFILEX:	MOVEI B,(B)			;GET JUST ERROR CODE
	JUMPE B,CPOPJ1			;SKIP RETURN IF FILE NOT FOUND
	MOVNI A,2			;ERROR CODE FOR ALREADY EXISTS
	HRLM A,FSPREQ(W)		;MUST BE NEGATIVE
	POPJ P,
;PUMPKI PUMP00 DLOCAT PUMP01 PUMP0 PUMP1 PUMP21 PUMP2 DLOC1 DLOC11 LOC1A PLOC1A DLOC20 DLOC2 DLOC22 DLOC2 LPPADV LOCPPS LOCPP1 LOCPP2 LOCPP3 LCPP3A LCPP3B LOCPP4 LCPP4A LCPP4B LOCPP5 LOCPP6 LOCPP7 LOCPP8 LOCPP9 LCPP10 LCPP11 LCPP12 LOCFPD LOCFPA

	SUBTTL	DLOCATE	PUMPKIN

PUMPKI:	SETZM SWITCH
IFE STANSW,<
	OUTSTR [ASCIZ/ Forget about getting PUMPKIN to work outside of SAIL.
/]
	EXIT
>;IFE STANSW
IFN STANSW,<
	MOVSI A,0
	GETPRV A,			;ACTIVE PRIVS
	TLNE A,60000			;REAPRV!WRTPRV
	JRST PUMP00			;PRIVS OK
>;IFN STANSW
	OUTSTR [ASCIZ /The PUMPKIN command can be given only at monitor level,
not after a * prompt from DART.
/]
PUMP0X:	INCHSL A			;ANY CHARS WAITING TO BE READ?
	 EXIT				;NO
	ANDI A,177
	CAIE A,12
	CAIN A,175
	EXIT				;CONTROL-CR, CR WILL WORK MAYBE
	JRST PUMP0X			;READ TO END OF LINE

PUMP00:	TLOA FL,L.PUMP			;THE GREAT PUMPKIN COMES BY NIGHT
DLOCAT:	TLZ FL,L.PUMP			;NOT PUMPKIN
	TLZ FL,L.BOTH
	PUSHJ	P,SCAN			;SCAN THE COMMAND LINE.
	MOVE	R,TBASE			;GET THE BASE OF THE WORLD
	CAML	R,FSPTR			;ARE THERE ANY TERMS?
	PUSHJ	P,GETBLK		;NO. MAKE ONE.
	MOVE	A,USRPPN		;GET USER PPN.
	MOVEM	A,STKPPN		;SAVE AS STICKY PPN
	SETZM	STKBIT			;ZERO STICKY BITS
	MOVSI	A,'DSK'
	MOVEM	A,STKDEV
	MOVE	A,FSPTR			;AVOID CLOBBERING DATA
	TLNN FL,L.PUMP			;PUMPKIN COMMAND?
	JRST PUMP1			;NO
	MOVEM A,PBASE			;PUMPKIN DATA BASE
	MOVEI X,FSLEN+1(A)		;SAVE IN AN AC TOO
	HRLI X,-<PFILES*PSIZE>		;MAKE AOBJN FORMAT
	ADDI A,PFILES*PSIZE+FSLEN+1	;LEAVE ROOM FOR SOME FILES
	SKIPN Z,DEST			;IS THERE AN EXPLICIT DEST?
	JRST PUMP0			;NO, SKIP THIS CHECK
	MOVS B,FSDEV(Z)			;YES, CHECK THE EXPLICIT DEVICE
	MOVE C,FSPPN(Z)
	CAIN B,'SYS'			;THIS IS THE FILE DISK TOO
	SKIPA C,['  1  3']
	CAIN B,'DSK'			;OUTPUT MUST BE TO THE FILE DISK
	JRST PUMP01
	JUMPE B,PUMP0			;SO IS NO DEVICE AT ALL
	OUTSTR [ASCIZ /Output device must be DSK
/]
	JRST RESTAR

PUMP01:	MOVEM C,FSPPN(Z)
PUMP0:	PUSH P,DEST			;SAVE PUMPKIN DESTINATION TERM
	SETZM DEST			;USE THE TTY
PUMP1:	MOVEM	A,.JBFF			;WITH BUFFERS
	CAMLE A,.JBREL
	CORE A,
	 JFCL				;CATCH IT LATER
	PUSHJ	P,LSTINI		;DO LISTING TERM.
	TLNN FL,L.PUMP
	JRST PUMP2
	POP P,DEST			;SORRY ABOUT THAT KLUDGE
	MOVEI	A,17
	MOVSI	B,'DSK'
	SETZ	C,
	OPEN	DSKMSC,A
	 PUSHJ	P,NODEV
	JUMPN Z,.+2			;JUMP IF WE HAVE EXPLICIT DEST
	MOVEI Z,[	'DSK   '	;ELSE GET DSK:*.*
			0
			ALLFIL!ALLEXT
			0	]
	MOVE A,FSEXT(Z)			;SET WILDCARD FLAGS AS NEEDED
	SKIPN B,FSNAM(Z)		;IF NO EXPLICIT FILENAME
	TROE A,ALLFIL			; AND NO EXPLICIT * EITHER,
	JRST PUMP21			;  (NO IMPLICIT .* IF ANY FILENAME)
	TLNN A,-1			; THEN SET .* IF NO EXPLICIT EXT
	TRO A,ALLEXT
PUMP21:	MOVEM A,FSEXT(Z)		;DON'T WORRY, IT WON'T CHANGE THE LITERAL
	GETPPN A,			;NOW SET UP VARIOUS DATA FOR ACCESS CHECKING
	MOVEM A,UPPN
	HRRZM A,UPRG
IFN STANSW,<
	MOVSI A,1			;MY JOB'S PASSIVE PRIVS
	GETPRV A,
	MOVEM A,PRIVS
	MOVEI A,0
	DSKPPN A,
	MOVEM A,ALIAS
>;IFN STANSW
PUMP2:
IFE STANSW,<
	TLZ FL,L.WLDS			;NO WILD STRUCTURE
>	;(A WILD STRUCTURE IS DSK: AS OPPOSED TO DSKB:)
;INITIAL PROCESSING OF SOURCE TERMS
	MOVE	R,TBASE
DLOC1:	CAML	R,FSPTR			;SKIP IF IN RANGE
IFN STANSW,<
	JRST	DLOC2			;DONE.
>
IFE STANSW,<
	JRST DLOC20
	SETZM ERSPPN
>
	SKIPN	A,FSDEV(R)		;IS THERE AN EXPLICIT DEVICE?
	MOVE	A,STKDEV
	MOVEM	A,STKDEV
	MOVEM	A,FSDEV(R)		;MAKE IT EXPLICIT
IFE STANSW,<
;; LET ME TAKE THIS OPPORTUNITY TO MENTION THAT, ONCE AGAIN, A DEVICE
;; NAME OF THREE OR FEWER CHARACTERS IS TAKEN TO MEAN MORE THAN ONE
;; STRUCTURE, WHILE FOUR OR MORE CHARS IS A SINGLE STRUCTURE!
	TRNN A,-1
	TLO FL,L.WLDS			;FLAG TO SCAN ALL STRUCTURES
	DEVCHR A,
	TLNN A,DEVDSK
	JRST NOTDSK
	MOVE A,FSDEV(R)			;GET THE NAME AGAIN
	MOVE B,A
	DEVPPN B,			;KLUDGE FOR ERSATZ DEVICES
	 JRST DLOC11			;NO SUCH THING
	CAMN B,USRPPN			;IF I'D WRITTEN THE UUO,
	JRST DLOC11			; IT'D RETURN 0 NOT USRPPN
	MOVEM B,ERSPPN			;SAVE ERSATZ PPN
	HRLI A,'DSK'			;TURN SYSB: INTO DSKB: ETC.
	MOVEM A,FSDEV(R)		;BUT NOT IN STKDEV
DLOC11:
>
	MOVEI	B,ALLPRJ!ALLPRG
	AND	B,FSEXT(R)
	SKIPN	A,FSPPN(R)
IFN STANSW,<
	JUMPE	B,[MOVE A,STKPPN
		MOVE	B,STKBIT	;GET STICKY BITS
		JRST	LOC1A]
>
IFE STANSW,<
	JUMPE B,[SKIPN A,ERSPPN		;NOTE THAT EXPLICIT PPN
		 SKIPA A,STKPPN		;OVERRIDES ERSATZ DEVICE
		 JRST LOC1A
		 MOVE B,STKBIT
		 JRST LOC1A]
>
	MOVEM	A,STKPPN
	MOVEM	B,STKBIT
LOC1A:	MOVEM	A,FSPPN(R)
	IORM	B,FSEXT(R)		;SAVE BITS
	MOVEI	B,ALLFIL+ALLEXT
	HRRZ	C,FSEXT(R)
	ANDI	C,ALLFIL+ALLEXT
	SKIPN	FSNAM(R)
	JUMPE	C,[IORM	B,FSEXT(R)
		JRST	.+1]
	TLNN FL,L.PUMP
	JRST PLOC1A
	MOVE C,FSEXT(R)			;CHECK FOR PUMPKIN *.*
	TRC C,ALLFIL!ALLEXT
	TRNE C,ALLFIL!ALLEXT
	JRST PLOC1A			;NO, OK
	OUTSTR [ASCIZ /PUMPKIN *.* is illegal.
/]
	JRST RESTAR

PLOC1A:	ADDI	R,FSLEN
	JRST	DLOC1

IFE STANSW,<
DLOC20:	SETZM RSTDEV			;INITIAL ARG FOR SYSSTR
DLOC2:	TLNN FL,L.WLDS			;HERE FOR NEXT STRUCTURE
	JRST DLOC22			;REG'S CODE WORKS IF NO WILD
	MOVE A,RSTDEV			;ELSE WE LOOP THROUGH ALL STRS
	SYSSTR A,
	 TLZA FL,L.WLDS			;ABORT TO REG MODE
	MOVEM A,RSTDEV
	TLNE FL,L.WLDS			;TEST AGAIN IN CASE SYSSTR FAILED
	JUMPE A,LOCFIN			;THIS IS OUR END TEST
DLOC22:
>
;HERE TO PROCESS ALL TERMS FOR ONE SOURCE DEVICE
IFN STANSW,<
DLOC2:
>
	MOVE	R,TBASE			;GET THE FIRST FREE ONE.
	CAML	R,FSPTR			;IN RANGE?
	JRST	LOCFIN			;DONE. FINISH LISTING FILE
	MOVE	A,FSDEV(R)
IFE STANSW,<
	TLNN FL,L.WLDS			;HANDS OFF MY STR LIST!
>
	MOVEM	A,RSTDEV		;PARAMETER FOR LOCRD1
	PUSH	P,.JBFF			;REMEMBER .JBFF
	PUSHJ	P,LOCRD1		;INITIALIZE LOCATE READER. READ INDEX FILES
	JRST	LOCPPS			;GO SELECT A PPN

;IN THE CODE THAT FOLLOWS, ANEED ON MEANS WE HAVE TO READ ARC, 
;			   DNEED ON MEANS WE HAVE TO READ DAT.
;NOTE THIS DIFFERENT FROM THEIR MEANINGS IN MERGE/ARCHIVE

LPPADV:	MOVE	A,[2,,2]		;INCREMENT TO AN AOBJN POINTER
	TLNE	FL,DNEED		;HERE TO ADVANCE OVER A PPN.
	ADDM	A,DATIDX		;ADVANCE IN DAT FILE
	TLNE	FL,ANEED
	ADDM	A,ARCIDX		;ADVANCE IN ARC FILE
LOCPPS:	TLO	FL,ANEED!DNEED		;HERE TO SELECT NEXT PPN. FLAG ASSUME BOTH
	SKIPL	Q,ARCIDX		;SKIP IF THERE ARE ARC PPNS LEFT
	JRST	LOCPP1			;NONE.  SELECT NEXT DAT PPN, IF ANY
	SKIPL	S,DATIDX		;SKIP IF THERE ARE DAT PPNS LEFT
	JRST	LOCPP2			;NONE. USE THE NEXT ARC PPN.
	MOVE	A,(Q)
	CAMN	A,(S)
	JRST	LOCPP3			;GO SELECT BOTH! (ARC AND DAT PPNS THE SAME)
	PUSHJ	P,UFDCNV
	MOVEM	A,DNX
	MOVE	A,(S)
	PUSHJ	P,UFDCNV
	MOVEM	A,TNX
	PUSHJ	P,PPNCMP
	JRST	LOCPP2			;DNX<TNX.  SELECT ARC NEXT.
LOCPP1:	SKIPL	DATIDX
	JRST	LOC9			;END OF ALL TERMS ON BOTH FILES
	TLZA	FL,ANEED		;FLAG DAT NEXT (NOT ARC)
LOCPP2:	TLZA	FL,DNEED		;FLAG ARC NEXT (NOT DAT)
LOCPP3:	SKIPA	A,DATIDX		;1 = DAT, 2 = ARC, 3 = BOTH
	MOVE	A,ARCIDX
	MOVE	A,(A)			;GET NEXT PPN.
	MOVEM	A,RSTPPN		;SAVE THE PPN NAME HERE FOR A WHILE.
	PUSHJ	P,LCPPCK		;CHECK IF WE'RE INTERESTED IN THIS PPN.
	JRST	LPPADV			;NO.  ADVANCE TO NEXT PPN.
					;NOW POSITION THE INPUT FILE(S)
	TLNN	FL,DNEED		;NEED DAT?
	JRST	LOCPP4			;NO
	MOVE	A,DATIDX		;ARGUMENT TO PPNPOS
	PUSHJ	P,PPNPOS		;POSITION AT PPN
	USETI	UFD,1(A)		;ARGUMENT TO PPNPOS
	PUSHJ	P,UFDRD			;ARGUMENT TO PPNPOS
	CAME	A,RSTPPN		;REDUNDANCY CHECK!
	HALT	.
	TLNE	FL,ANEED		;NEED BOTH DAT AND ARC?
	JRST	LOCPP4			;YES.
LCPP3A:	PUSHJ	P,LOCFPR		;READ EVERYTHING AND TYPE RELEVANT STUFF
	PUSHJ	P,UFDRD			;ARGUMENT
LCPP3B:	SKIPE	RSTNAM			;END OF CRUD YET?
	JRST	LCPP3A
	JRST	LOCPP5			;ADVANCE TO NEXT PPN

LOCPP4:	MOVE	A,ARCIDX		;ARGUMENT TO PPNPOS
	PUSHJ	P,PPNPOS		;POSITION AT PPN
	USETI	FILE,1(A)		;ARGUMENT TO PPNPOS
	PUSHJ	P,DFREAD		;ARGUMENT TO PPNPOS
	CAME	A,RSTPPN		;REDUNDANCY CHECK!
	HALT	.
	TLNE	FL,DNEED		;NEED BOTH DAT AND ARC?
	JRST	LOCPP6			;YES.  THIS IS HARDER
LCPP4A:	PUSHJ	P,LOCFPR		;RPEAD EVERYTHING AND TYPE RELEVANT STUFF
	PUSHJ	P,DFREAD		;ARGUMENT
LCPP4B:	SKIPE	RSTNAM
	JRST	LCPP4A
LOCPP5:	MOVE	Q,TBASE			;CHECK FOR NO MORE TERMS..
	CAMGE	Q,FSPTR
	JRST	LPPADV			;MORE WORK LEFT. ADVANCE TO NEXT PPN.
	POP	P,.JBFF
	CLOSE	UFD,
	CLOSE	FILE,
	JRST	LOCFIN			;RELEASE LISTING DEVICE.

;HERE WE HAVE TO READ BOTH FILES....
LOCPP6:	SETZM	ANAME
	SETZM	DNAME
LOCPP7:	SKIPE	ANAME
	JRST	LOCPP8			;WE HAVE ANAME ALREADY
	PUSHJ	P,DFREAD
	MOVEM	A,ANAME			;STORE ANAME
	JUMPE	A,LOCPP8		;LAST ONE DONE
	PUSHJ	P,DFREAD
	MOVEM	A,AEXT			;STORE EXTENSION
LOCPP8:	SKIPE	DNAME
	JRST	LOCPP9			;WE HAVE DNAME ALREADY
	PUSHJ	P,UFDRD			;READ NEXT FILE NAME
	JFCL
	MOVEM	A,DNAME
	JUMPE	A,LOCPP9		;JUMP IF LAST NAME READ
	PUSHJ	P,UFDRD			;READ EXT
	JFCL
	MOVEM	A,DEXT
LOCPP9:	SKIPN	ANAME			;ANY ARC DATA LEFT?
	JRST	LOCFPD			;NO. LET'S GO FLUSH DAT DATA
	SKIPN	A,DNAME			;ANY ARC DATA LEFT
	JRST	LOCFPA			;NONE LEFT
	CAMLE	A,ANAME			;
	JRST	LCPP11			;A<D - FLUSH A FIRST.
	CAME	A,ANAME			;A=D?
	JRST	LCPP10			;A>D - FLUSH D FIRST
	HLLZ	A,DEXT
	HLLZ	B,AEXT
	CAMLE	A,B
	JRST	LCPP11			;A<D
	CAMN	A,B
	JRST	LCPP12			;EQUAL.  THIS IS TOUGH.
LCPP10:	MOVE	A,DNAME			;A>D  FLUSHING DAT
	MOVEM	A,RSTNAM
	MOVE	A,DEXT
	PUSHJ	P,LOCFP0		;DO FILE.
	PUSHJ	P,UFDRD			;ARGUMENT
	SETZM	DNAME
	JRST	LOCPP8

LCPP11:	MOVE	A,ANAME			;A<D  FLUSHING ARC
	MOVEM	A,RSTNAM
	MOVE	A,AEXT
	PUSHJ	P,LOCFP0		;DO FILE.
	PUSHJ	P,DFREAD		;ARGUMENT
	SETZM	ANAME
	JRST	LOCPP7

LCPP12:	MOVE	A,DNAME
	MOVEM	A,RSTNAM
	MOVE	A,DEXT
	TLO FL,L.BOTH			;IF PUMPKIN COMMAND, WE NEED TO KNOW THIS
	PUSHJ	P,LOCFP0
	PUSHJ	P,UFDRD
	MOVE	A,AEXT
	HRRZM	A,WC
	PUSHJ	P,LOCFPX		;ENTER AND DECIDE WHETHER TO PRINT OR NOT
	PUSHJ	P,DFREAD
	SETZM	ANAME
	SETZM	DNAME
	JRST	LOCPP7


LOCFPD:	SKIPN	A,DNAME			;HERE TO FLUSH REST OF DAT IN MERGE
	JRST	LOCPP5			;NO DAT DATA LEFT.
	MOVEM	A,RSTNAM
	MOVE	A,DEXT
	PUSHJ	P,LOCFP0		;READ FILE DATA. TYPE IF RELEVANT
	PUSHJ	P,UFDRD			;ARGUMENT
	JRST	LCPP3B			;ADVANCE TO NEXT FILE

LOCFPA:	MOVE	A,ANAME			;HERE TO FLUSH REST OF ARC IN MERGE
	MOVEM	A,RSTNAM
	MOVE	A,AEXT
	PUSHJ	P,LOCFP0		;READ EVERYTHING AND TYPE RELEVANT STUFF
	PUSHJ	P,DFREAD		;ARGUMENT
	JRST	LCPP4B			;ADVANCE TO NEXT FILE
;LOCFPR LOCFP0 LOCFP1 LOCFP2 LOCFP3 LOCFP4 LOCFP5 LOCFP6 LOCFP7 LOCF7X LOCFP8 LOCFP9 LOCF8X LOCF9Y LOCF9W RELOOK ACCOK LOCLKF PBUSY PNOACC PNOAC1 PNOAC2 LOCF9X LOCF9P LOCF9Z LOCF9E LOCF8Z LOCF8Y LOCFPX LOCFXX LOCFPZ LOC9 LOC9A LOC9B PFIFP7 LOC9Z PPNPOS PPNPS1 LCPPCK LCPPC1 LCPPC2 LOCRD1 NEWARC LCR0.0 LCR0.1 LCR0.2 LCR0.3 LCR0.4 INDGET INDGT1 INDGTX CREARC LOCFIN LOCFRT PUMXIT PMPLUZ NULPUM ACCCHK OWNACC GRPCHK GRPWIN

;HERE'S THE ROUTINE THAT PRINTS THINGS.  CALL IT WITH RSTNAM AND RSTEXT SET UP
LOCFPR:	XCT	@(P)
	JFCL
	MOVEM	A,RSTNAM
	JUMPE	A,CPOPJ1		;END OF PPN DATA
	XCT	@(P)
	JFCL
LOCFP0:	HLLZM	A,RSTEXT
	HRRZM	A,WC			;SET UP NAME, EXT AND WORD COUNT
	MOVE	Q,TBASE			;GET THE BASE OF ALL TERMS
LOCFP1:	CAML	Q,FSPTR			;ARE WE IN RANGE?
	JRST	LOCFPZ			;NO.  SKIP THIS FILE.
	ADDI	Q,FSLEN
	MOVE	A,FSDEV-FSLEN(Q)
	CAME	A,RSTDEV		;SAME DEVICE?
IFE STANSW,<
	TRNN A,-1			;OK ALSO IF WILD STR
	JRST .+2			;IE DSK: OR ALL:
>
	JRST	LOCFP1			;NO.
	HRRZ	B,FSEXT-FSLEN(Q)	;GET FLAGS
	TRNE	B,ALLPRG
	JRST	LOCFP2			;ACCEPT PROGRAMMER NAME
	HRRZ	A,FSPPN-FSLEN(Q)	;GET THE PROGRAMMER
	HRRZ	C,RSTPPN
	CAME	A,C			;MATCH?
	JRST	LOCFP1			;NO. REJECT THIS TERM
LOCFP2:	TRNE	B,ALLPRJ
	JRST	LOCFP3			;ACCEPT PROJECT
	HLLZ	A,FSPPN-FSLEN(Q)
	HLLZ	C,RSTPPN
	CAME	A,C
	JRST	LOCFP1			;REJECT THIS TERM
LOCFP3:	TRNE	B,ALLFIL		;HERE PPN MATCHES.  FILE NAME OK?
	JRST	LOCFP4			;ANY FILE NAME IS OK
	MOVE	A,FSNAM-FSLEN(Q)
	CAME	A,RSTNAM
	JRST	LOCFP1			;FAILS TO MATCH THIS TERM
LOCFP4:	TRNE	B,ALLEXT		;EXTENSION OK?
	JRST	LOCFP5			;YES. ANY EXT WILL DO
	HLLZ	A,FSEXT-FSLEN(Q)
	CAME	A,RSTEXT
	JRST	LOCFP1			;EXT FAILS
LOCFP5:	MOVEI A,ALLFLG			;RANDOM FLAG BIT
	IORM A,FSEXT-FSLEN(Q)		;FLAG THIS ONE FOUND
	TRNE	B,ALLMSK		;WAS THERE ANYTHING WILD?
	JRST	LOCFP6			;YES. KEEP THIS SOURCE TERM FOR LATER
	SUBI	Q,FSLEN			;DECREMENT Q - FLUSH THIS SOURCE TERM 
	HRLZ	A,TBASE			;SOURCE - MOVE BOTTOM TERM UP ONTO THIS TERM
	HRRI	A,(Q)			;DESTINATION
	BLT	A,FSLEN-1(Q)		;COPY BOTTOM TERM TO THIS TERM
	MOVEI	A,FSLEN
	ADDM	A,TBASE			;PUSH TBASE UP PAST OLD COPY.
LOCFP6:	MOVE	A,RSTDEV		;PRINT DATA.  GET THE DEVICE NAME
	TLNE FL,L.PUMP
	MOVEM A,PDEV(X)			;SAVE IN PUMPKIN DATA BASE
	CAMN	A,['DSK   ']		;IS THE DEFAULT NAME?
	JRST	LOCFP7			;YES. DONT PRINT
	PUSHJ	P,SIXOUT		;TYPE SIXBIT DEVICE NAME
	MOVEI	A,":"
	PUSHJ	P,OUT.CH
	MOVEI	A,11
	PUSHJ	P,OUT.CH
LOCFP7:	MOVE	A,RSTNAM
	HLLZ	B,RSTEXT
	MOVE	D,RSTPPN
	TLNN FL,L.PUMP
	JRST LOCF7X			;JUMP IF NOT PUMPKIN CMD
	MOVEM A,PNAME(X)		;PUMPKIN, SAVE THE POOP
	MOVEM B,PEXT(X)
	MOVEM D,PPPN(X)
LOCF7X:	PUSHJ	P,TYFIL
	MOVEI	A,11
	JRST	LOCFP9			;JUMP INTO REST OF PRINT LOOP

LOCFP8:	TLNE FL,L.PUMP
	JRST LOCF8X			;NO MULTI-LINE TYPEOUT FOR PUMPKIN
	MOVEI	A,11			;HERE FOR SECOND&SUBSEQUENT LINES
	PUSHJ	P,OUT.CH
	PUSHJ	P,OUT.CH
	MOVE	B,RSTDEV
	CAME	B,['DSK   ']
	PUSHJ	P,OUT.CH
LOCFP9:	PUSHJ	P,OUT.CH
LOCF8X:	XCT	@(P)			;READ MORE.
	JFCL
	TLNN FL,L.PUMP			;PUMPKIN COMMAND?
	JRST LOCF9X			;NO, WE TAKE ANYTHING
	HLRZ B,SWITCH			;YES, DO WE WANT SPECIFIC TAPE?
	JUMPE B,LOCF9Y			;NO, SPECIFIC DATE
	HLRZ C,A			;YES, GET CANDIDATE TAPE
	CAIE C,(B)			;MATCH?
	JRST LOCF9Z			;NO
	JRST LOCF9W			;YES

LOCF9Y:	SKIPN B,SWITCH			;NO TARGET TAPE, TRY TARGET DATE
	JRST LOCF9W			;NO TARGET ANYTHING, WE'LL TAKE IT
	HRRZ C,A			;GET DATE
	CAILE C,(B)			;OK IF CANDIDATE  TARGET
	JRST LOCF9Z			;NOPE
LOCF9W:	MOVEM A,PTPDT(X)		;MATCH, SAVE THE POOP
	PUSH P,A			;SAVE TAPE,,DATE
	MOVE A,FSNAM(Z)			;SET UP ACS WITH DEST FILENAME FOR LOOKUP
	MOVE B,FSEXT(Z)
	SKIPN D,FSPPN(Z)
	MOVE D,ALIAS			;ALIAS IS DEFAULT PPN
	TRNE B,ALLFIL			;COPY SOURCE TOKENS AS PER * FLAGS
	MOVE A,PNAME(X)
	TRNE B,ALLEXT
	HLL B,PEXT(X)
	TRNE B,ALLPRJ
	HLL D,PPPN(X)
	TRNE B,ALLPRG
	HRR D,PPPN(X)			;(NOTE ALLPRJ AND ALLPRG DEFAULT OFF)
	HLLZS B			;FLUSH FLAGS FROM EXT WORD
	CAMN D,['  1  1']
	JRST PNOACC		;DON'T EVEN BOTHER TRYING THIS
	MOVEM D,LOCLUK		;PPN IS FILENAME FOR UFD
	HRLZI K,'UFD'
	MOVEM K,LOCLUK+1
	SETZM LOCLUK+2
	MOVE K,['  1  1']
	MOVEM K,LOCLUK+3
	LOOKUP DSKMSC,LOCLUK
	 JRST PNOACC		;NO ACCESS IF CAN'T LOOK UP UFD
	PUSHJ P,GRPCHK		;CHECK GROUP ACCESS BITS
	PUSHJ P,ACCCHK		;CHECK ACCESS
	 JRST PNOACC
	MOVEI K,20		;FILE BUSY RETRY COUNT
RELOOK:	MOVEM	D,LOCLUK+3
	MOVEM	A,LOCLUK
	HRRZM	B,LOCLUK+1
	SETZM	LOCLUK+2
	LOOKUP DSKMSC,LOCLUK	;NOW WE CHECK THE ACTUAL FILE
	 JRST LOCLKF		;LOOKUP FAILED, COMPLICATED
	PUSHJ P,ACCCHK		;CHECK FILE ACCESS
	 JRST PNOACC
ACCOK:	CLOSE DSKMSC,		;DONE READING FILE FOR ACCESS CHECK
	MOVE A,(P)		;GET BACK DATE WORD
	JRST LOCF9P		;ACCESS ALLOWED

LOCLKF:	HRRZ C,LOCLUK+1		;GET LOOKUP ERROR CODE
	JUMPE C,ACCOK		;NOT FOUND, ACCESS OK
	CAIE C,3		;FILE BUSY?
	JRST PNOACC		;NO, LOSE
	SOJLE K,PBUSY		;CAN'T WAIT FOREVER
	MOVEI C,1
	SLEEP C,
	JRST RELOOK

PBUSY:	PUSH P,D
	PUSH P,B
	PUSH P,A
	MOVEI B,[ASCIZ /file busy, can't check access to DSK:/]
	JRST PNOAC1

PNOACC:	PUSH P,D
	PUSH P,B
	PUSH P,A
	MOVEI B,[ASCIZ /no write access allowed to DSK:/]
PNOAC1:	PUSHJ P,STROUT
	POP P,A
	PUSHJ P,SIXOUT
	POP P,B
	JUMPE B,PNOAC2
	MOVEI A,"."
	PUSHJ P,OUT.CH
	MOVE A,B
	PUSHJ P,SIXOUT
PNOAC2:	POP P,A
	PUSHJ P,PPNOUT
	MOVEI B,CRLF
	PUSHJ P,STROUT
	CLOSE DSKMSC,
	SUB X,[PSIZE,,PSIZE]		;NOT OK, CORRECT FOR LATER ADD
	POP P,A
	JRST LOCF8Y			;PRETEND WE WON

LOCF9X:	PUSH	P,A			;SAVE TAPE NUMBER,,DATE LAST WRITTEN
LOCF9P:	HRRZ	A,A
	PUSHJ	P,TYDATE		;TYPE FILE DATE
	MOVEI	A,11
	PUSHJ	P,OUT.CH
	MOVEI	A,"P"			;ASSUME P CLASS TAPE
	SKIPGE	(P)
	MOVEI	A,"T"			;WRONG.  WAS T CLASS
	PUSHJ	P,OUT.CH
	POP	P,A
	HLRZ	A,A
	TRZ	A,400000		;FLUSH SIGN BIT
	PUSHJ	P,DECOUT		;TAPE NUMBER
	MOVEI	B,CRLF
	PUSHJ	P,STROUT
	TLNE FL,L.PUMP
	JRST LOCF8Y			;WINNER, THAT'S ALL IF PUMPKIN
LOCF9Z:	SOSLE	WC
	JRST	LOCFP8
	TLNN FL,L.BOTH			;MESSAGE PREMATURE IF STILL HAVE ARC TO READ
	TLNN FL,L.PUMP
	JRST LOCF9E
	MOVEI B,[ASCIZ /not available with specified tape or date.
/]
	PUSHJ P,STROUT
LOCF9E:	TRNE	FL,LSTTTY
	CLOSE	LST,			;IF LISTING ON TTY, FORCE IT NOW.
	SETZM	LQUIET
	JRST	CPOPJ1			;RETURN TO PROCESS NEXT FILE

LOCF8Z:	XCT	@(P)			;READ MORE.
	JFCL				; SKIPPING OVER UNNECESSARY TAPES
LOCF8Y:	SOSLE WC
	JRST LOCF8Z
	TLZ FL,L.BOTH			;IF WINNING IN DAT, DON'T NEED ARC
	ADD X,[PSIZE,,PSIZE]		;SKIP OVER WINNING ENTRY
	JUMPL X,LOCF9E
	CLOSE LST,
	OUTSTR [ASCIZ /Sorry, too many files requested.  Will only recover these.
/]
	JRST LOCFIN

LOCFPX:	TLNN FL,L.PUMP			;HERE TO READ ARC AFTER DAT, SAME NAME
	JRST LOCFXX			;RELATIVELY SIMPLE IF NOT PUMPKIN
	SKIPN LQUIET
	TLZN FL,L.BOTH			;DID WE GET A WINNER IN DAT?
	JRST LOCFPZ			;YES, MAKE IT QUIET
	JRST LOCF8X			;NO, KEEP TRYING OUT LOUD

LOCFXX:	SKIPN	LQUIET
	JRST	LOCFP8			;MAKE NOISE
LOCFPZ:	XCT	@(P)
	JFCL
	SOSLE	WC
	JRST	LOCFPZ
	SETOM	LQUIET
	JRST	CPOPJ1			;RETURN TO PROCESS NEXT FILE.

;HERE AT EOF ON DATA FILE FOR SOME SOURCE DEVICE.  FLUSH ALL TERMS FROM THAT DEVICE
LOC9:	POP	P,.JBFF
	CLOSE	UFD,
	CLOSE	FILE,
	SKIPA	R,TBASE			;BASE
LOC9A:	ADDI	R,FSLEN
LOC9B:	CAML	R,FSPTR			;TO THE END?
	JRST	DLOC2			;YES.  DO NEXT SOURCE DEVICE
	MOVE	A,FSDEV(R)		;GET DEVICE
	CAME	A,RSTDEV		;SAME AS THIS?
	JRST	LOC9A			;NO.  LEAVE THIS TERM FOR NEXT TIME
	MOVE Y,FSEXT(R)		;GET FLAG WORD
	TRNE Y,ALLFLG		;WAS THIS ONE FOUND?
	JRST LOC9Z		;YES
	SKIPE	A,FSDEV(R)		;PRINT DATA.  GET THE DEVICE NAME
	CAMN	A,['DSK   ']		;IS THE DEFAULT NAME?
	JRST	PFIFP7			;YES. DONT PRINT
	PUSHJ	P,SIXOUT		;TYPE SIXBIT DEVICE NAME
	MOVEI	A,":"
	PUSHJ	P,OUT.CH
	MOVEI	A,11
	PUSHJ	P,OUT.CH
PFIFP7:	MOVE	A,FSNAM(R)
	TRNE Y,ALLFIL
	MOVSI A,'*  '
	HLLZ	B,FSEXT(R)
	TRNE Y,ALLEXT
	MOVSI B,'*  '
	MOVE	D,FSPPN(R)
	TRNE Y,ALLPRJ
	HRLI D,'  *'
	TRNE Y,ALLPRG
	HRRI D,'  *'
	PUSHJ	P,TYFIL
	MOVEI B,[ASCIZ /	never dumped
/]
	PUSHJ P,STROUT
	CLOSE LST,
LOC9Z:	MOVSI	A,FSLEN(R)		;SOURCE OF BLT
	HRRI	A,(R)			;DESTINATION
	MOVNI	B,FSLEN			;CALC ENDING ADDRESS
	ADDB	B,FSPTR			;BY MOVING TOP OF TERMS DOWN
	BLT	A,-1(B)			;MOVE ALL SOURCE TERMS
	JRST	LOC9B			;LOOP BACK.  DON'T INCREMENT R.


PPNPOS:	MOVE	A,1(A)			;GET THE PPN LOCATION FROM INDEX
	IDIVI	A,200			;RECORD NUMBER IN A, WORDCOUNT IN B
	XCT	@(P)			;EXECUTE APPROPRIATE USETI
	AOS	(P)			;POINT TO NEXT ARGUMENT
IFE STANSW,<				;MAKE US DO AN INPUT NOW!
	MOVE K,@(P)			;K/ PUSHJ P,READROUTINE
	MOVE K,(K)			;K/ SOSG BUFFERCOUNT
	SETZM (K)			;USE UP THIS BUFFERLOAD
>
PPNPS1:	XCT	@(P)			;EXECUTE READ TO SKIP INTO RECORD
	JFCL				;(MAY SKIP)
	SOJGE	B,PPNPS1		;LOOP. SKIP THE PPN WORD ITSELF!
	JRST	CPOPJ1			;SKIP RETURN (PAST BOTH ARGS)

LCPPCK:
IFN STANSW,<
	MOVE	K,RSTDEV		;GET DEVICE NAME
>
	SKIPA	Q,TBASE			;TERM BASE
LCPPC1:	ADDI	Q,FSLEN			;FOR ALL TERMS, CHECK IF ANY MATCH THIS PPN
	CAML	Q,FSPTR
	POPJ	P,			;LOSE - GO REJECT PPN
IFN STANSW,<
	CAME	K,FSDEV(Q)
>
IFE STANSW,<
	MOVE K,FSDEV(Q)
	CAME K,RSTDEV
	TRNN K,-1
	JRST .+2
>
	JRST	LCPPC1			;THIS TERM DOESN'T MATCH
	CAMN	A,FSPPN(Q)
	JRST	CPOPJ1			;OUTRIGHT MATCH.
	MOVE	B,FSEXT(Q)
	TRNN	B,ALLPRG!ALLPRJ
	JRST	LCPPC1			;THIS TERM LOSES
	TRNE	B,ALLPRG
	JRST	LCPPC2			;* FOR PROGRAMMER
	HRRZ	C,FSPPN(Q)
	CAIE	C,(A)
	JRST	LCPPC1			;LOSER.
LCPPC2:	TRNE	B,ALLPRJ
	JRST	CPOPJ1			;PPN MATCHES
	HLLZ	C,FSPPN(Q)
	HLLZ	D,A
	CAME	C,D
	JRST	LCPPC1			;LOSER
	JRST	CPOPJ1

;LOCATE READER "MERGES" DART.DAT AND DART.ARC. 

;CHANNEL	FILE		MODE	BUFFER	GET(PUT) ROUTINE

;UFD		DART.DAT 	BUFFRD	UFDBUF	UFDRD	(SKIPS UNLESS EOF)
;FILE		DART.ARC	BUFFRD	FIBUF	DFREAD


LOCRD1:				;OPEN 2 DISK CHANNELS
	MOVEI	A,10
	MOVE	B,RSTDEV
	MOVEI	C,UFDBUF
	OPEN	UFD,A		;DART.DAT INPUT
	PUSHJ	P,NODEV
IFN STANSW,<
	INBUF	UFD,23		;SOME BUFFERS
>
IFE STANSW,<
	INBUF UFD,1
;; SUPER WINNING DEC SYSTEM DOESN'T FLUSH OUT THE BUFFERS WHEN YOU
;; USETI, SO WITH LOTS OF BUFFERS WE GET CONFUSED WHERE WE'RE UP TO.
;; I COULD HAVE WRITTEN A PIECE OF CODE USING INPUT UUOS WITH NONZERO
;; EFFECTIVE ADDRESSES AND GROVELING AROUND WITH USE BITS AND SO ON
;; BUT I'M A LAZY BUM AND THIS MAKES IT WORK.
>

	MOVEI	C,FIBUF
	OPEN	FILE,A		;DART.ARC INPUT
	PUSHJ	P,NODEV
IFN STANSW,<
	INBUF	FILE,23		;SOME BUFFERS
>
IFE STANSW,<
	INBUF FILE,1
>

	MOVE	A,['DART  ']
	MOVSI	B,'DAT'
	MOVEI	C,0
	MOVE	D,DUMPER
	LOOKUP	UFD,A		;SEEK DART.DAT FILE
	JRST	ARCB0	
NEWARC:	MOVSI	B,'ARC'
	MOVEI	C,0
	MOVE	D,DUMPER
	LOOKUP	FILE,A		;SEEK DART.ARC
IFN STANSW,<
	JRST	ARCB1		;Too risky to just create empty DART.ARC - EJG
>
IFE STANSW,<
	JRST	CREARC		;WE LOSE SOMEHOW.
>
LCR0.0:	MOVE	W,.JBFF		;INITIAL POINTER FOR STORING INDEX
LCR0.1:	PUSHJ	P,INDGET	;GET INDEX FROM DAT FILE
	PUSHJ	P,UFDRD		;PARAMETER TO INDGET
	JRST	LCR0.2		;ALL DONE.
	USETI	UFD,1(A)	;OTHERWISE NEED TO READ MORE
IFE STANSW,<
	SETZM UFDBUF+2		;FORCE AN INPUT UUO
>
	JRST	LCR0.1		;

LCR0.2:	MOVEM	W,DATIDX	;SAVE INDEX TO DAT FILE.
	MOVE	W,.JBFF
LCR0.3:	PUSHJ	P,INDGET	;GET INDEX FROM DAT FILE
	PUSHJ	P,DFREAD	;PARAMETER TO INDGET
	JRST	LCR0.4		;ALL DONE.
	USETI	FILE,1(A)	;OTHERWISE NEED TO READ MORE
IFE STANSW,<
	SETZM FIBUF+2
>
	JRST	LCR0.3

LCR0.4:	MOVEM	W,ARCIDX	;INDEX POINTER TO ARC FILE.
	POPJ	P,		;DONE WITH FIRST PART

INDGET:	HLRE	C,W		;-WC (SO FAR) INTO C
	MOVN	C,C
	ADDI	C,(W)		;CALC NEXT ADDRESS TO STORE
	MOVEI	B,176(C)	;CALC MAX ADDRESS FOR THIS CALL
	CAMGE	B,.JBREL	;SKIP IF THERE'S NO ROOM
	JRST	.+3
	CORE	B,		;MAKE ROOM
	JRST	NOCORE
	MOVEI	B,77		;COUNT OF PAIRS TO READ
INDGT1:	XCT	@(P)		;READ A WORD
	JFCL
	JUMPE	A,INDGTX	;END OF ALL INDEX DATA
	MOVEM	A,(C)		;STORE PPN
	XCT	@(P)
	JFCL
	MOVEM	A,1(C)
	ADDI	C,2
	ADD	W,[-2,,0]	;COUNT IN AOBJN POINTER TO INDEX DATA
	SOJG	B,INDGT1	;LOOP THRU INDEX WORDS
	XCT	@(P)
	JFCL
	JUMPE	A,INDGTX	;LAST INDEX BLOCK WAS FULL, BUT NO NEXT BLOCK
	LSH	A,-7		;CONVERT TO BLOCK NUMBER
	JRST	CPOPJ2

INDGTX:	MOVEM	C,.JBFF
	JRST	CPOPJ1		;RETURN. W HAS AOBJN PNTR.

IFE STANSW,<
CREARC:	TRNE B,-1		;NO DART.ARC:
	JRST ARCB1		;JUMP IF NOT FNF ERROR
	MOVE D,DUMPER		;DRD
	ENTER FILE,A		;MAKE AN EMPTY DART.ARC
	 JRST ARCB1		;OOPS
	CLOSE FILE,
	JRST NEWARC		;NOW LOOK IT UP
>

LOCFIN:	TLZN FL,L.PUMP		;PUMPKIN COMMAND?
	JRST LSTFIN		;NO
	MOVE A,PBASE		;YES, FINISH UP OUR BLOCK
	HRRZM A,PIOWD
	SOS PIOWD		;IOWD IS ADDR-1
	MOVEI X,(X)		;FLUSH LH COUNT
	SUBI X,(A)		;THIS IS THE NUMEER OF WORDS IN USE
	CAIG X,FSLEN+1		;WERE ANY FILES FOUND?
	JRST NULPUM		;NO, NOTHING TO DO
	MOVEM X,(A)		;SAVE AS FIRST WORD TO OUTPUT
	MOVNS X			;NEGATIVE WC
	HRLM X,PIOWD		;SAVE FOR OUTPUT COMMAND
	MOVEI X,1(A)		;NOW COPY THE DEST STUFF
	HRLI X,(Z)		;BLT POINTER
	BLT X,FSLEN(A)		;DO IT
	SKIPN X,FSPPN+1(A)	;TELL THE PUMPKIN OUR ALIAS
	MOVE X,ALIAS		; IF NO EXPLICIT DEST PPN
	MOVEM X,FSPPN+1(A)
	DATE X,			;GET DATE OF REQUEST
	MOVSI X,(X)		; IN LH
	HRR X,UPPN		;SINCE THE DEST DEVICE MUST BE DISK,
	MOVEM X,FSDEV+1(A)	; LET'S USE THAT WORD FOR THE REQUESTOR AND DATE
	MOVEI X,30		;RETRY COUNT FOR FILE BUSY
LOCFRT:	MOVE	A,['PUMPKI']
	MOVSI	B,'QUE'
	MOVEI	C,0
	MOVE	D,DUMPER
	LOOKUP	DSKMSC,A
	 TRNN B,-1		;LOOKUP FAILED.  WHY?
	SKIPA	D,DUMPER
	 JRST PMPLUZ		;LOOKUP FAILURE OTHER THAN FILE NOT FOUND
	ENTER	DSKMSC,A
	 JRST PMPLUZ
	UGETF DSKMSC,A		;MOVE TO EOF
	OUTPUT DSKMSC,PIOWD	;DO OUR BOOGIE
REPEAT 0,<
	OUTSTR [ASCIZ/
I hope you're not in a hurry.  The Great Pumpkin doesn't visit the
patch very often these days, but have faith, the G.P. will show eventually.
/]
>;REPEAT 0
PUMXIT:	RELEAS DSKMSC,		;THAT WAS EASY
	JRST LSTFIN

PMPLUZ:	MOVEI B,(B)		;GET ERROR CODE ALONE
	CAIN B,3		;FILE BUSY?
	SOJG X,[ MOVEI A,1
		 SLEEP A,
		 JRST LOCFRT ]
	OUTSTR [ASCIZ /? Can't access PUMPKI.QUE, please report via GRIPE.
/]
	JRST RESTAR

NULPUM:	OUTSTR [ASCIZ /No files in request.
/]
	JRST PUMXIT

ACCCHK:	MOVE K,LOCLUK+2		;GET PROTECTION
	SKIPN OWNER		;IF USER HAS GROUP ACCESS PRIVS TO THIS UFD,
	CAMN D,UPPN		; OR IF FILE PPN IS USER'S PPN,
	JRST OWNACC		; USE OWNER ACCESS
	LSH K,3			;ELSE USE LOCAL ACCESS (*** SHOULD CHECK LUP? ***)
OWNACC:	TLNN K,100000		;THE WRITE BIT SHOULD ALWAYS BE HERE NOW
	AOS (P)			;ACCESS OK
	POPJ P,

GRPCHK:	SETZM OWNER		;THIS WILL FLAG OWNER ACCESS
IFN STANSW,<
	MOVE K,PRIVS		;GET PASSIVE PRIVILEGES
	TLNE K,AAOPRV		;DO WE HAVE ACCESS-ALIAS-AS-OWNER?
	CAME D,ALIAS		;AND IS THIS OUR ALIAS?
	 JRST .+2		;NO AAO OR WRONG PPN
	JRST GRPWIN		;WIN, SET OWNER ACCESS
	MTAPE DSKMSC,PRVMTA	;READ RETRIEVAL
	 POPJ P,		;CAN'T, NO GROUP ACCESS
	SETZM PASWD		;JUST IN CASE WE HAVE INF
	MOVE K,GRPWD		;GET FILE ACCESS GROUPS FOR THIS UFD
	AND K,[GROUPS]		;JUST THE RIGHT BITS PLEASE
	MOVEI C,(D)		;PRG OF TARGET UFD
	CAME C,UPRG		;PRG OF OUR USER
	TRZ K,MASPRV		;NOT THE SAME, NO MAS ACCESS
;;;	TLO K,REAPRV!WRTPRV	;DON'T ALLOW REA AND WRT ACCESS ***
	TDNE K,PRIVS		;DOES USER HAVE ANY CORRESPONDING PRIVS?
GRPWIN:	SETOM OWNER		;YES! ALLOW OWNER ACCESS
>;IFN STANSW
	POPJ P,
;TURKEY TURK0 NONMBR TURK1 TURKL TURKL1 TURKL2 TURKD NOTURK NOBODY

	SUBTTL	TURKEY	-  TELL WHO LAST USED A TAPE

TURKEY:	SKIPA A,SAVDEL		;GET DELIMITER WHICH FOLLOWED COMMAND NAME
TURK0:	INCHWL A		;SKIP SPACES AND TABS
	CAIE A,40
	CAIN A,11
	JRST TURK0
	TLO FL,L.TURK		;FLAG TURKEY COMMAND GOR GETANS
	PUSHJ P,GETA11		;GET TAPE NUMBER FROM COMMAND LINE
	 JRST NONMBR		;OOPS, NO TAPE NUMBER
	 JRST TURK1		;OK RETURN
NONMBR:	OUTSTR [ASCIZ /Must give P or T number with this command.
/]
	TLZ FL,L.TURK		;DON'T CONFUSE POSSIBLE FOLLOWING COMMAND
	JRST RESTAR

TURK1:	TLZE FL,L.TURK		;P OR T?
	MOVNS B			;T CLASS, NEGATIVE NUMBER
	MOVEI K,(B)		;SAVE NUMBER AS HALFWORD
	MOVEI	A,17
	MOVSI	B,'DSK'
	SETZB	C,Z		;Z WILL HAVE THE LUSER'S PPN LATER ON
	OPEN	DSKMSC,A
	 PUSHJ	P,NODEV
IFN STANSW,<
	MOVE	A,['DART  ']
	MOVSI	B,'REC'
	MOVEI	C,0
	MOVE	D,TAPREG	;' SSSYS' OR DBGPPN
	LOOKUP	DSKMSC,A
	 JRST NOTURK		;CAN'T FIND IT
	MOVS	D,D
	MOVN	W,D
>
IFE STANSW,<
	MOVEI A,.RBSIZ		;ARG COUNT = 5
	MOVE B,TAPREG
	MOVE C,['DART  ']
	MOVSI D,'REC'
	MOVEI W,0
	LOOKUP DSKMSC,A
	 JRST NOTURK		;CAN'T FIND IT
	MOVE W,X
>
	JUMPE W,NOTURK		;NO INFORMATION
	IDIVI W,200		;FILE SIZE AS RECORDS PLUS WORDS
TURKL:	MOVNI A,(X)		;RESIDUE IF TIME FOR LAST RECORD
	JUMPE W,.+2		;JUMP IF LAST RECORD
	MOVNI A,200		;ELSE THIS IS A FULL ONE
	HRLZS A			;MAKE IOWD
	HRRI A,MEMBLK-1
	MOVEI B,0		;END OF LIST
	INPUT DSKMSC,A		;READ THE POOP
TURKL1:	MOVE B,1(A)		;GET TAPE NUMBER AND DATE
	CAIE K,(B)		;SAME TAPE?
	JRST TURKL2		;NO
	MOVE Y,B		;YES, SAVE DATE
	MOVE Z,2(A)		;GET PPN TOO
TURKL2:	AOBJN A,.+1		;SKIP TO NEXT ENTRY
	AOBJN A,TURKL1		; (2 WDS/ENTRY)
	SOJGE W,TURKL		;NO MORE THIS RECORD, MAYBE GET NEXT RECORD
	JUMPE Z,NOBODY		;NOBODY USED THE TAPE
	MOVE A,Z		;PPN IN A
	PUSHJ P,PPNOUT		;TYPE IT
	OUTSTR [ASCIZ / last used it on /]
	HLRZ A,Y		;DATE INTO A
	PUSHJ P,TYDATE		;TYPE IT
	OUTSTR CRLF		;DONE
TURKD:	RELEAS DSKMSC,
	POPJ P,

NOTURK:	OUTSTR [ASCIZ /? Can't find tape user file!
/]
	JRST TURKD

NOBODY:	OUTSTR [ASCIZ /That tape has not been read with DART.
/]
	JRST TURKD
;XGET6 GETSIX GETSX1 XGET6A QSET GETSX2 GETSX3 CPOPJ2 CPOPJ1 MAKLF CPOPJ SEMICO SEMIC1 SEMIC2 BLANK STAR ILSTAR ILLEG ILLEG1 DEVSCN DEVSC1 NUMCHR RDNUMB RDNUM0 RDNUM1 RDNUM2

	SUBTTL	GETSIX	READ SIXBIT COMMAND, FILE NAME, ETC RDNUMB
XGET6:	SETZ	A,			;ZERO A
	EXCH	A,SAVDEL		;EXCHANGE WITH OLD DELIMITER
	JUMPE	A,GETSIX		;IF NO OLD DELIMITER
	SETZB	B,QMODE
	TRZ	FL,ALLFLG
	MOVE	C,[POINT 6,B]
	JRST	XGET6A

GETSIX:	SETZB	B,QMODE			;B ACCUMULATES TEXT. QMODE FOR QUOTING
	TRZ	FL,ALLFLG		;NO * SEEN YET.
	MOVE	C,[POINT 6,B]
GETSX1:	TRNN	FL,INDON
	TTCALL	4,A			;READ A CHARACTER
	TRNE	FL,INDON
	PUSHJ	P,RINDIR		;
XGET6A:	ANDI	A,177			;STRIP OFF ANY BUCKY BITS
	MOVE	D,CHRTAB(A)		;GET NORMAL DISPATCH
	SKIPE	QMODE			;SKIP IF NORMAL
	MOVS	D,D			;USE QUOTE MODE DISPATCH
	JRST	(D)

QSET:	SETCMM	QMODE			;HERE FOR CTRL A (DOWN ARROW)
	JRST	GETSX1			;COMPLEMENT QUOTE FLAG AND GET MORE.

GETSX2:	TRZ	A,40			;HERE FOR LOWER CASE LETTER
GETSX3:	TRNE	FL,ALLFLG		;HAS A * BEEN SEEN?
	JRST	ILSTAR			;STAR MUST BE DELIMITED.
	SUBI	A," "			;HERE FOR UPPER CASE LETTER
	TLNE	C,770000		;BYTE OVERFLOW?
	IDPB	A,C			;NOT OVERFLOW. DEPOSIT BYTE
	JRST	GETSX1			;LOOP

CPOPJ2:	SPOPJ2:		AOS	(P)
CPOPJ1:	SPOPJ1:		AOSA	(P)
MAKLF:			MOVEI	A,12
CPOPJ:	DELIM:		POPJ	P,

SEMICO:	TRNE	FL,INDON		;INDIRECT FILE?
	JRST	SEMIC2			;YES.  FLUSH QUIETLY
SEMIC1:	TTCALL	4,A
	CAIE	A,12
	JRST	SEMIC1
	POPJ	P,

SEMIC2:	PUSHJ	P,RINDIR		;HERE WHEN ";" SEEN IN INDIRECT FILE.
	CAIE	A,12
	JRST	SEMIC2
	POPJ	P,

BLANK:	JUMPN	B,CPOPJ			;TRAILING BLANK IS A DELIMITER
	JRST	GETSX1			;LEADING BLANKS, TABS ARE FLUSHED

STAR:	JUMPN	B,ILLEG			;* ILLEGAL IN NAME UNLESS QUOTED
	TLNE FL,L.SWIT
	JRST ILLEG			;ILLEGAL INSIDE PUMPKIN SWITCH
	TRO	FL,ALLFLG		;ANNOUNCE A * HAS BEEN SEEN SPECIALLY
	JRST	GETSX1			;MUST SEE A DELIMITER NEXT

ILSTAR:	OUTSTR	[ASCIZ/"*" must be delimited or quoted.
/]
	JRST	ILLEG1

ILLEG:	OUTSTR	[ASCIZ/Illegal character "/]
	CAIE	A,15
	TTCALL	1,A
	OUTSTR	[ASCIZ/" occurred in scan/]
	SKIPE	QMODE
	OUTSTR	[ASCIZ/ while in quote mode/]
	SETZM	QMODE
	OUTSTR	CRLF
ILLEG1:	TTCALL	11,0
	JRST	RESTAR

DEVSCN:	MOVE	A,SAVDEL		;GET BACK THE DELIMITER OF OLD COMMAND
	CAIE	A,12
	CAIN	A,ALTMOD
	POPJ	P,			;RETURN QUICK IF THERE IS NO MORE.
	PUSHJ	P,GETSIX		;GET SOME SIXBIT QUANTITY.
	MOVEM	B,MTDEV			;SAVE DEVICE NAME.
	CAIE	A,":"			;WAS THE DELIMITER A COLON?
	JRST	DEVSC1			;NO
	PUSHJ	P,GETSIX		;GET MORE
	JUMPN	B,SYNTAX		;EXPECT TO SEE NOTHING BUT A CRLF
DEVSC1:	MOVEM	A,SAVDEL		;SAVE DELIMITER NAME
	POPJ	P,

NUMCHR:	TRNN	FL,INDON
	TTCALL	4,A			;READ A CHARACTER
	TRNE	FL,INDON
	PUSHJ	P,RINDIR		;
	ANDI	A,177			;STRIP OFF ANY BUCKY BITS
	POPJ P,

RDNUMB:	MOVEI B,0			;READ DECIMAL INTEGER
RDNUM0:	PUSHJ P,NUMCHR			;SKIP SPACES
	CAIE A,40
	CAIN A,11
	JRST RDNUM0
RDNUM1:	CAIL A,"0"
	CAILE A,"9"
	JRST RDNUM2
	IMULI B,12
	ADDI B,-"0"(A)
	PUSHJ P,NUMCHR
	JRST RDNUM1

RDNUM2:	CAIN A,12			;SKIP TO EOL
	POPJ P,
	PUSHJ P,NUMCHR
	JRST RDNUM2
;SLASH GOTMON GETYR REBILD EXYEAR SYSYR SLRET HYPHEN MONSIX MMDDYY SIXNUM SIXNU1 SIXNU9 SIXTAP BADATE SIXTA1

;SCANNING STUFF FOR PUMPKIN COMMAND

SLASH:	TLNN FL,L.PUMP			;IS THIS THE PUMPKIN COMMAND?
	JRST ILLEG			;NO, SLASH IS ILLEGAL
	TLOE FL,L.SWIT			;FLAG READING A SWITCH
	POPJ P,				;ALREADY IN SWITCH, THIS IS /MM/DD/YY
	SKIPE SWITCH
	JRST ILLEG			;ONLY ONE SWITCH ALLOWED
	SETOM SWITCH			;DON'T COME IN HERE AGAIN (/XX/YY/ZZ/WW)
	PUSH P,B			;SAVE TOKEN IF ANY
	PUSH P,C			;ALSO SAVE BPT TO B
	PUSHJ P,GETSIX			;READ TAPE NUMBER OR BEG OF DATE
	JUMPL B,SIXTAP			;STARTS WITH LETTER, BETTER BE P OR T
	SETZM YEAR			;ASSUME THIS YEAR BY DEFAULT
	CAIN A,"/"			;DATE, IS IT /MM/DD/YY?
	JRST MMDDYY			;YES
	CAIE A,"-"			;NO, IS IT /DD-MON-YY?
	JRST ILLEG			;MUST BE ONE OR THE OTHER
	PUSHJ P,SIXNUM			;CONVERT SIXBIT DIGITS TO NUMERIC DAY
	CAILE C,37
	JRST BADATE			;FUNNY CALENDAR YOU GOT THERE
	MOVEM C,DAY
	PUSHJ P,GETSIX			;READ MONTH NAME
	JUMPGE B,[	PUSHJ P,SIXNUM	;MONTH NUMBER IS OK TOO
			SOJA C,GOTMON ]	;S/HE TYPED JAN=1, WE WANT JAN=0
	HLLZS B				;IGNORE CHARS PAST THIRD
	MOVSI D,-NMOS			;NUMBER OF MONTHS
	CAME B,MONSIX(D)		;FIND MONTH IN TABLE
	AOBJN D,.-1
	JUMPGE D,BADATE			;NO SUCH MONTH
	MOVEI C,(D)			;JAN=0
GOTMON:	CAILE C,14
	JRST BADATE
	MOVEM C,MONTH
	CAIE A,"-"
	JRST REBILD			;PUT THE DATE TOGETHER AGAIN
GETYR:	TLZ FL,L.SWIT			;NO LONGER INSIDE A SWITCH
	PUSHJ P,GETSIX			;EXPLICIT YEAR
	JUMPL B,BADATE			;ALPHABETIC YEAR?
	PUSHJ P,SIXNUM
	MOVEM C,YEAR
REBILD:	SKIPE B,YEAR			;PUT THE DATE TOGETHER
	JRST EXYEAR			;EXPLICIT YEAR
	DATE B,				;WHAT YEAR IS THIS PLEASE?
	IDIVI B,14*37
	JRST SYSYR			;SYSTEM FORMAT YEAR

EXYEAR:	SUBI B,100			;HUMAN TYPED YEAR, SUBTRACT OFFSET
	CAILE B,1750			;MAYBE 4-DIGIT YEAR? (1750 := =1000)
	SUBI B,3554			;IF SO, FIX IT (=1900)
	JUMPL B,BADATE			;RIDICULOUS YEAR
SYSYR:	IMULI B,14
	ADD B,MONTH
	IMULI B,37
	ADD B,DAY
	SUBI B,1			;WE WANT 1=0
	HRRZM B,SWITCH			;SAVE DATE
SLRET:	POP P,C
	POP P,B
	TLZ FL,L.SWIT
	JRST XGET6A			;BACK TO THE REAL WORLD

HYPHEN:	TLNN FL,L.SWIT
	JRST ILLEG			;HYPHEN ILLEGAL OUTSIDE SWITCH
	POPJ P,				;DELIMITER INSIDE ONE

MONSIX:	'JAN',,0
	'FEB',,0
	'MAR',,0
	'APR',,0
	'MAY',,0
	'JUN',,0
	'JUL',,0
	'AUG',,0
	'SEP',,0
	'OCT',,0
	'NOV',,0
	'DEC',,0
DEF(NMOS,<.-MONSIX>)			;NEW SEMICONDUCTOR TECHNOLOGY

MMDDYY:	PUSHJ P,SIXNUM			;THIS IS THE MONTH IN B
	CAILE C,14
	JRST BADATE
	SUBI C,1			;JAN=0 PLEASE
	MOVEM C,MONTH
	PUSHJ P,GETSIX			;NOW READ THE DAY
	JUMPL B,BADATE			;MUST BE NUMBER
	PUSHJ P,SIXNUM
	CAILE C,37
	JRST BADATE
	MOVEM C,DAY
	CAIE A,"/"
	JRST REBILD			;IMPLICIT YEAR
	JRST GETYR			;EXPLICIT YEAR

SIXNUM:	PUSH P,A			;SAVE DELIMITER
	MOVEI C,0			;ACCUMULATE NUMBER HERE
	MOVE D,[POINT 6,B]
SIXNU1:	ILDB A,D			;GET NEXT CHAR FROM B
	JUMPE A,SIXNU9			;DONE WHEN NO MORE CHARS
	CAIL A,'0'
	CAILE A,'9'
	JRST BADATE			;NONDIGIT NOT ALLOWED
	IMULI C,12
	ADDI C,-'0'(A)
	JRST SIXNU1			;IF 6 CHARS IN B, NO PROBLEM, C LH 0

SIXNU9:	POP P,A
	POPJ P,

SIXTAP:	MOVEI C,0			;/Pn OR /Tn
	ROTC B,6			;GET INITIAL LETTER IN C
	CAIN C,'P'			;WHICH?
	TDZA C,C			;C=0 FLAGS P
	CAIN C,'T'
	JRST SIXTA1
BADATE:	OUTSTR [ASCIZ Switch format is /Pnnn or /Tnnn for a specific tape, or
/mm/dd or /mm/dd/yy or /dd-mon or /dd-mon-yy for a date.
]
	JRST RESTAR

SIXTA1:	PUSH P,C			;SAVE P/T FLAG
	PUSHJ P,SIXNUM			;MAKE TAPE NUMBER BINARY
	POP P,B				;RESTORE FLAG
	JUMPE B,.+2			;JUMP IF P TAPE
	TRO C,400000			;FLAG T TAPE
	HRLZM C,SWITCH			;DONE
	CAIE A,"/"
	CAIN A,"-"
	JRST BADATE			;SAY WHAT?
	JRST SLRET
;CHRTAB

	SUBTTL	CHARACTER TABLE FOR COMMAND PROCESSING
CHRTAB:	GETSX1,,GETSX1		;NULL
	QSET,,QSET		;CTRL A = DOWN ARROW. SETS QUOTE MODE
	ILLEG,,ILLEG		;2
	ILLEG,,ILLEG		;3
	ILLEG,,ILLEG		;4
	ILLEG,,ILLEG		;5
	ILLEG,,ILLEG		;6
	ILLEG,,ILLEG		;7
	ILLEG,,ILLEG		;10
	ILLEG,,BLANK		;11
	ILLEG,,DELIM		;12
	ILLEG,,ILLEG		;13
	ILLEG,,MAKLF		;14 INVENT LF FOR FF
	ILLEG,,GETSX1		;15 IGNORE
	ILLEG,,ILLEG		;16
	ILLEG,,ILLEG		;17
REPEAT 33-20,<ILLEG,,ILLEG>	;20-32 ARE ALL ILLEGAL
	ILLEG,,DELIM		;33 DEC ALTMODE
REPEAT 40-34,<ILLEG,,ILLEG>
	GETSX3,,BLANK		;40 BLANK IS A DELIMITER
	GETSX3,,ILLEG		;41 !
	GETSX3,,ILLEG		;42 "
	GETSX3,,ILLEG		;43 #
	GETSX3,,GETSX3		;44 $ LEGAL IN FILE NAMES
	GETSX3,,ILLEG		;45 %
	GETSX3,,ILLEG		;46 &
	GETSX3,,ILLEG		;47 '
	GETSX3,,ILLEG		;50 (
	GETSX3,,ILLEG		;51 )
	GETSX3,,STAR		;52 *
	GETSX3,,ILLEG		;53 +
	GETSX3,,DELIM		;54 , COMMA
	GETSX3,,HYPHEN		;55 -
	GETSX3,,DELIM		;56 . PERIOD
	GETSX3,,SLASH		;57 /
REPEAT 72-60,<GETSX3,,GETSX3>	;60-71 (0-9) ARE LEGAL
	GETSX3,,DELIM		;72 : 
	GETSX3,,SEMICO		;73 ;
	GETSX3,,ILLEG		;74 <
	GETSX3,,ILLEG		;75 =
	GETSX3,,ILLEG		;76 >
	GETSX3,,ILLEG		;77 ?
	GETSX3,,DELIM		;100 @
REPEAT 133-101,<GETSX3,,GETSX3>	;101-132 (A-Z) ARE LEGAL
	GETSX3,,DELIM		;133 [
	GETSX3,,ILLEG		;134 \
	GETSX3,,ILLEG		;135 ]
	GETSX3,,ILLEG		;136 ^
	GETSX3,,DELIM		;137 _
	ILLEG,,ILLEG		;140 `
REPEAT 173-141,<GETSX2,,GETSX2>	;141-172 (a-z) ARE LEGAL AND ALWAYS CONVERTED
	ILLEG,,ILLEG		;173
	ILLEG,,ILLEG		;174
	ILLEG,,DELIM		;175
	ILLEG,,ILLEG		;176
	ILLEG,,ILLEG		;177
;RDPPN RDPPN1 RDPPN2 OCTPPN OCTPP1 SIXPP1 SIXPPN RDPPN9 RDPPN9 RDPPN3 RDPPN4 DPOPJ RDPPN5

	SUBTTL	RDPPN

;READ A PPN FROM TTY OR INDIRECT FILE.
;CALLING:
;		MOVE	A,<LAST CHARACTER READ>
;		PUSHJ	P,RDPPN
;		<RETURN HERE> 
;CLOBBERS C, RETURNS PPN IN B, DELIMITER IN A, FLAGS IN FL.


RDPPN:	MOVEI	B,0
	TRZ	FL,ALLFLG
	CAIE	A,"["			;WILL THERE BE A PPN?
	POPJ	P,			;NO. RETURN ZERO.
	PUSHJ	P,RDPPN1		;READ PRJ
	TRZE	FL,ALLFLG
	TRO	FL,ALLPRJ
	HRLZ	B,C
	CAIE	A,","
	JRST	ILLPPN			;DELIMITER MUST BE ,
	PUSHJ	P,RDPPN1		;READ PRG
	TRZE	FL,ALLFLG
	TRO	FL,ALLPRG
	HRR	B,C
	PUSH	P,B			;SAVE B
	MOVEI	B,0
	CAIN	A,"]"			;IF DELIMITER IS "]" THEN
	PUSHJ	P,GETSIX		; GET ANOTHER BARE DELIMITER
	JUMPN	B,SYNTAX
	POP	P,B
	POPJ	P,

RDPPN1:	PUSH	P,D
	SETZB	C,D
IFN IRCPPN,<
	PUSH P,B
	MOVEI B,0
>
RDPPN2:	TRNE	FL,INDON		;READING @ FILE?
	PUSHJ	P,RINDIR		;YES.
	TRNN	FL,INDON		;READING TTY?
	TTCALL	0,A			;YES.
	CAIN	A,15
	JRST	RDPPN2			;FLUSH CR (LF WILL FOLLOW)
	CAIE	A," "
	CAIN	A,11
	JUMPE	C,RDPPN2		;FLUSH LEADING BLANKS AND TABS
	CAIN	A,"*"
	JRST	RDPPN5

IFE IRCPPN,<
IFE STANSW,<	CAIL	A,"0"		;ELSEWHERE, ONLY DIGITS ARE LEGAL
		CAIL	A,"0"+PPNDIV
		JRST	RDPPN3>
>;IRCPPN

IFN IRCPPN,<
	JUMPN B,(B)	;IF NOT FIRST CHAR, DISPATCH ON TYPE
	CAIL A,"0"
	CAILE A,"7"
	JRST SIXPP1	;ELSE FIGURE OUT TYPE
	MOVEI B,OCTPPN
	JRST OCTPP1

OCTPPN:	CAIL A,"0"
	CAILE A,"7"
	JRST RDPPN3
OCTPP1:	LSH C,3
	ADDI C,-"0"(A)
	AOJA D,RDPPN2

SIXPP1:	MOVEI B,SIXPPN
SIXPPN:
>

IFN STANSW!IRCPPN,<	CAIL	A,"0"	;AT STANFORD, LETTERS, DIGITS AND
		CAILE	A,"9"		;LOWER CASE LETTERS ARE LEGAL
		CAIA
		JRST	RDPPN9		;LEGAL DIGIT
		CAIL	A,"A"
		CAILE	A,"Z"
		CAIA
		JRST	RDPPN9		;LEGAL UPPER CASE
		CAIL	A,"A"+40
		CAILE	A,"Z"+40
		JRST	RDPPN3		;ILLEGAL
		TRZ	A,40		;TURN OFF LOWERCASE BIT>

IFE IRCPPN,<
RDPPN9:	IMULI	C,PPNDIV
	ADDI	C,-PPNADD(A)
	AOJA	D,RDPPN2		;COUNT CHARACTERS SEEN...
>
IFN IRCPPN,<
RDPPN9:	LSH C,6
	ADDI C,-40(A)
	AOJA D,RDPPN2
>

RDPPN3:	TRNE	FL,ALLFLG
	JRST	RDPPN4
	TLNN	C,-1			;NO BITS SHOULD BET SET IN THE LEFT
	JUMPN	C,DPOPJ			;BUT SOMETHING SHOULD BE SET.
	JRST	ILLPPN

RDPPN4:	JUMPN	C,ILLPPN		;* SEEN. MUST BE ALONE
DPOPJ:
IFN IRCPPN,<
	TRZ C,400000			;SILLY IRCAM FORMAT
	POP P,B
>
	POP	P,D
	POPJ	P,

RDPPN5:	JUMPN	D,ILLPPN		;* SEEN. MUST BE FIRST
	TRON	FL,ALLFLG		;SET * SEEN.  MUSTN'T SEE ANYTHING ELSE
	JRST	RDPPN2			;LOOP TO DELIMITER
	JRST	ILLPPN
;GETBLK GETBK1 PGTBLK PGTBK1 TGTBLK TGTBK1

	SUBTTL	GETBLK

GETBLK:	MOVEI	A,FSLEN			;GET A TERM BLOCK
	ADDB	A,FSPTR			;INCREMENT POINTER TO THE FREE BLOCK
	CAMG	A,.JBREL
	JRST	GETBK1
	CORE	A,
	JRST	NOCORE
	MOVE	A,FSPTR
GETBK1:	MOVSI	R,-FSLEN(A)
	HRRI	R,1-FSLEN(A)
	SETZM	-FSLEN(A)
	BLT	R,-1(A)
	MOVEI	R,-FSLEN(A)
	POPJ	P,


PGTBLK:	MOVEI	A,FSPLEN		;GET A TERM BLOCK
	ADDB	A,W			;INCREMENT POINTER TO THE FREE BLOCK
	CAMG	A,.JBREL
	JRST	PGTBK1
	CORE	A,
	JRST	NOCORE
	MOVE	A,W
PGTBK1:	MOVSI	R,-FSPLEN(A)
	HRRI	R,1-FSPLEN(A)
	SETZM	-FSPLEN(A)
	BLT	R,-1(A)
	MOVEI	R,-FSPLEN(A)
	POPJ	P,

TGTBLK:	MOVEI	A,3			;GET A TERM BLOCK
	ADDB	A,W			;INCREMENT POINTER TO THE FREE BLOCK
	CAMG	A,.JBREL
	JRST	TGTBK1
	CORE	A,
	JRST	NOCORE
	MOVE	A,W
TGTBK1:	MOVSI	R,-3(A)
	HRRI	R,1-3(A)
	SETZM	-3(A)
	BLT	R,-1(A)
	MOVEI	R,-3(A)
	POPJ	P,
;SCAN SCAN1 SCAN2 SCAN4 SCAN4A SCAN4B SCAN7 SCAN8

	SUBTTL	SCAN DUMP AND RESTORE COMMANDS

COMMENT $
DUMP {<DEST>_~<SOURCE>
RESTORE {<DEST>_~<SOURCE>

<DEST>  	{DEV:~{<FILNAM>{.<EXT>~~{[<PRJ>,<PRG>]~

<SOURCE>  {{DEV:~{[<PRJ>,<PRG>]~@~{DEV:~{<FILNAM>{.<EXT>~{[<PRJ>,<PRG>]~{,<SOURCE>~

$

SCAN:	SETZM	DEST			;LOCATION OF DESTINATION TERM
	MOVE	R,.JBFF
	MOVEM	R,FSPTR			;INITIALIZE FREE STORAGE POINTER
	MOVEM	R,TBASE			;SAVE BASE OF ALL TERMS.
	PUSHJ	P,GETBLK		;GET AN FSBLOCK. ADDRESS IN R.
	TRZ	FL,ALLMSK+INDEOF+INDON	;CLEAR WILD & INDIRECT COMMAND FLAGS
	PUSHJ	P,XGET6			;SCAN FOR A DESTINATION
	CAIE	A,":"			;IS THERE A DEVICE?
	JRST	SCAN1			;NO STRANGE DEVICE HERE.
	TRNE	FL,ALLFLG		;WILD DEVICE?
	JRST	ALLDEV			;YES. CAN'T DO THAT
	MOVEM	B,FSDEV(R)		;SAVE DEVICE NAME
	PUSHJ	P,GETSIX		;GET MORE
SCAN1:	MOVEM	B,FSNAM(R)		;SAVE THE FILE NAME
	TRNE	FL,ALLFLG		;WILD?
	TRO	FL,ALLFIL		;YES. SET BIT
	CAIE	A,"."			;IS THERE AN EXTENSION TO SCAN?
	JRST	SCAN2			;NO.
	PUSHJ	P,GETSIX
	HLLZM	B,FSEXT(R)		;SAVE IT
	TRNE	FL,ALLFLG		;WILD?
	TRO	FL,ALLEXT		;YES. SET BIT
SCAN2:	PUSHJ	P,RDPPN			;READ PPN IF ANY
	MOVEM	B,FSPPN(R)		;STORE IT.
	MOVEI	B,ALLMSK		;GET THE MASK
	AND	B,FL			;AND IN THE FLAGS
	HRRM	B,FSEXT(R)		;SAVE THE WILD BITS
	CAIE	A,"_"			;WAS THIS ALL REALLY THE DESTINATION?
	JRST	SCAN7			;NO. THERE IS NO EXPLICIT DESTINATION TERM
	MOVEM	R,DEST			;SAVE ADDRESS OF DESTINATION BLOCK
	MOVE	R,FSPTR			;GET THE CURRENT FREE POINTER
	MOVEM	R,TBASE			;SOURCE TERMS START HERE.

SCAN4:	PUSHJ	P,GETBLK		;GET A BLOCK
	TRZ	FL,ALLMSK		;ZERO FLAGS
	PUSHJ	P,GETSIX		;GET A SIXBIT TERM.
	CAIE	A,":"			;IS THIS A DEVICE?
	JRST	SCAN4A			;NOT DEVICE
	MOVEM	B,FSDEV(R)		;SAVE DEVICE NAME
	TRNE	FL,ALLFLG		;WILD?
	JRST	ALLDEV			;YES: DEVICE * IS ILLEGAL.
	PUSHJ	P,GETSIX		;GET MORE!
SCAN4A:	MOVEM	B,FSNAM(R)		;SAVE FILENAME
	TRNE	FL,ALLFLG		;WILD NAME?
	TRO	FL,ALLFIL		;YES. SET BIT
	CAIE	A,"."			;WILL THERE BE AN EXTENSION?
	JRST	SCAN4B			;NO.
	PUSHJ	P,GETSIX		;GET THE EXTENSION
	HLLZM	B,FSEXT(R)		;SAVE IT
	TRNE	FL,ALLFLG		;WILD?
	TRO	FL,ALLEXT		;YES.
SCAN4B:	PUSHJ	P,RDPPN			;READ PPN IF ANY
	MOVEM	B,FSPPN(R)		;STORE IT
	MOVEI	B,ALLMSK
	AND	B,FL
	HRRM	B,FSEXT(R)		;SAVE WILD FLAGS
SCAN7:	SKIPN	FSDEV(R)
	SKIPE	FSNAM(R)
	JRST	SCAN8
	SKIPN	FSEXT(R)
	SKIPE	FSPPN(R)
	JRST	SCAN8
	MOVEM	R,FSPTR			;RECLAIM STORAGE FROM NULL TERM
SCAN8:	CAIE	A,12			;LF?
	CAIN	A,ALTMOD		;OR ALTMODE
	POPJ	P,			;LF OR ALTMODE - TERMINATE SCAN.

	CAIN	A,","			;COMMA?
	JRST	SCAN4			;YES. FIND NEXT SOURCE TERM

	CAIN	A,"@"			;INDIRECTION.
	JRST	MSCAN			;OFF TO INDIRECT FILE
	JRST	SYNTAX			;SYNTAX ERROR. TERM ENDS
;MSCAN MSCAN1 SCAN8A SCAN8B SCAN8C SCAN8D SCAN9 SCAN9A SCAN9B SCAN9C SCAN9D SCAN9E SCAN9F SCAN9G SCAN10

	SUBTTL	MORE SCAN - INDIRECT COMMANDS.
MSCAN:	MOVEM	R,FSPTR			;RESET FREE STORAGE
	SKIPE	A,FSDEV(R)		;GET DEVICE
	MOVEM	A,DEFDEV		;SAVE DEFAULT DEVICE
	SKIPE	A,FSPPN(R)		;GET PPN
	MOVEM	A,DEFPPN		;SAVE PPN FOR THE REST OF COMMAND
	SKIPN	FSNAM(R)		;SKIP IF NAME PRESENT
	SKIPE	FSEXT(R)		;NO NAME. SKIP IF NO EXTENSION
	JRST	SYNTAX			;ATTEMPT TO SET STICKY NAME OR EXT
MSCAN1:	SETZM	IDEV			;ZERO BLOCK FOR THE INDIRECT FILE
	MOVE	A,[IDEV,,IDEV+1]
	BLT	A,IPPN
	PUSHJ	P,GETSIX
	CAIE	A,":"
	JRST	SCAN8A
	MOVEM	B,IDEV
	TRNE	FL,ALLFLG
	JRST	ALLDEV
	PUSHJ	P,GETSIX
SCAN8A:	MOVEM	B,INAM
	TRNE	FL,ALLFLG
	JRST	ALLIND			;CAN'T DO * IN INDIRECT NAME
	CAIE	A,"."			;PERIOD
	JRST	SCAN8B
	PUSHJ	P,GETSIX
	HLLZM	B,IEXT
	TRNE	FL,ALLFLG
	JRST	ALLIND			;CAN'T DO * IN INDIRECT EXTENSION
SCAN8B:	PUSHJ	P,RDPPN			;READ PPN IF ANY.
	MOVEM	B,IPPN			;STUFF IT.
	TRNE	FL,ALLPRJ+ALLPRG
	JRST	ALLIND			;ERROR IF [*,*] IN INDIRECT FILE NAME
SCAN8C:	CAIE	A,12
	CAIN	A,ALTMOD
	JRST	SCAN8D
	CAIE	A,","
	JRST	SYNTAX			;ERROR UNLESS COMMA, LF,ALTMODE
SCAN8D:	MOVEM	A,SAVDEL		;SAVE THE DELIMITER.
	MOVEI	A,0			;OPEN @ FILE IN ASCII MODE
	SKIPN	B,IDEV			;GET THE DEVICE
	MOVSI	B,'DSK'			;DEFAULT DEVICE IS DISK
	MOVEI	C,INDRBF		;INDIRECT BUFFER.
	OPEN	INDIR,A			;OPEN THE DEVICE.
	PUSHJ	P,NODEV			;DEVICE CAN'T BE OPENED.
	MOVEI	A,ALTBUF		;RECYCLE MAGTAPE BUFFERS FOR OUR USE
	EXCH	A,.JBFF
	INBUF	INDIR,2			;THESE BETTER FIT
	MOVEM	A,.JBFF			;RESTORE .JBFF
	MOVE	A,INAM
	MOVE	B,IEXT
	SETZ	C,
	SKIPN	D,IPPN
	MOVE	D,USRPPN
	MOVEM	D,IPPN
	LOOKUP	INDIR,A
	JRST	NOLOOK

	OUTSTR	[ASCIZ/(Reading /]	;TELL USER WHERE WE ARE
	MOVE	A,INAM
	HLLZ	B,IEXT
	MOVE	D,IPPN
	PUSHJ	P,TYFIL			;TYPE A FILE NAME
	OUTSTR	[ASCIZ/) /]

	TRZ	FL,INDEOF		;TURN OFF EOF.
	TRO	FL,INDON		;TURN ON INDIRECT COMMAND BIT
SCAN9:	PUSHJ	P,GETBLK		;GET A BLOCK
	TRZ	FL,ALLMSK		;ZERO FLAGS
	PUSHJ	P,GETSIX		;GET A SIXBIT TERM.
	CAIE	A,":"			;IS THIS A DEVICE?
	JRST	SCAN9A			;NOT DEVICE
	MOVEM	B,FSDEV(R)		;SAVE DEVICE NAME
	TRNE	FL,ALLFLG		;WILD?
	JRST	ALLDEV			;YES: DEVICE * IS ILLEGAL.
	PUSHJ	P,GETSIX		;GET MORE!
SCAN9A:	MOVEM	B,FSNAM(R)		;SAVE FILENAME
	TRNE	FL,ALLFLG		;WILD NAME?
	TRO	FL,ALLFIL		;YES. SET BIT
	CAIE	A,"."			;WILL THERE BE AN EXTENSION?
	JRST	SCAN9B			;NO.
	PUSHJ	P,GETSIX		;GET THE EXTENSION
	HLLZM	B,FSEXT(R)		;SAVE IT
	TRNE	FL,ALLFLG		;WILD?
	TRO	FL,ALLEXT		;YES.
SCAN9B:	PUSHJ	P,RDPPN			;SCAN PPN IF ANY
	MOVEM	B,FSPPN(R)		;SAVE IT
SCAN9C:	MOVEI	B,ALLMSK
	AND	B,FL
	HRRM	B,FSEXT(R)		;SAVE WILD FLAGS

	SKIPN	FSNAM(R)
	SKIPE	FSEXT(R)
	JRST	SCAN9D
	SKIPN	FSDEV(R)
	SKIPE	FSPPN(R)
	JRST	SCAN9D
	MOVEM	R,FSPTR			;FLUSH NULL TERMS
	JRST	SCAN9F			;FLUSH

SCAN9D:	SKIPN	B,FSPPN(R)		;SKIP IF EXPLICIT PPN
	TRNE	FL,ALLPRJ+ALLPRG	;NOT EXPLICIT. WAS IT WILD?
	JRST	SCAN9E			;WILD PPN OR EXPLICIT PPN
	MOVE	B,DEFPPN		;GET THE DEFAULT PPN SET BEFORE.
	MOVEM	B,FSPPN(R)		;SAVE IT
SCAN9E:	SKIPN	B,FSDEV(R)		;EXPLICIT DEVICE?
	MOVE	B,DEFDEV		;NO. USE DEFAULT
	MOVEM	B,FSDEV(R)		;SAVE IT BACK AGAIN
SCAN9F:	CAIN	A,","			;COMMA?
	JRST	SCAN9			;GOBBLE ANOTHER TERM
	CAIN	A,"@"			;INDIRECTION AGAIN?
	JRST	SCAN10			;YES.
	CAIE	A,ALTMOD		;ALTMODE IN FILE OR
	TRNE	FL,INDEOF		;END OF FILE YET?
	JRST	SCAN9G			;YES. FORCE THE RETURN UPLEVEL
	CAIN	A,12			;LF?
	JRST	SCAN9			;YES. CONTINUE UNTIL EOF.

SCAN9G:	MOVE	A,SAVDEL
	TRZ	FL,INDEOF+INDON
	CLOSE	INDIR,
	RELEAS	INDIR,
	OUTSTR	[ASCIZ/ (Closing @ file)
/]
	JRST	SCAN8

SCAN10:	SKIPN	FSDEV(R)
	SKIPE	FSNAM(R)
	JRST	SYNTAX
	SKIPN	FSEXT(R)
	SKIPE	FSPPN(R)
	JRST	SYNTAX
	OUTSTR	[ASCIZ/ (File switch)
/]
	JRST	MSCAN1			;DONT CHANGE DEFAULT DEVICE,PPN
	SUBTTL	PDUMP	PRIVILEGED - PERMANENT DUMP. FDUMP AND TDUMP


COMMENT	$	SYSTEM CLASS DUMPS.

	INITIALIZE
DEVSEL:	SELECT THE NEXT FILE STRUCTURE TO DUMP
	READ THE MFD FROM THAT STRUCTURE AND SORT IT
GETUFD:	LOOKUP A UFD FROM THE SORTED LIST
GETFIL:	LOOKUP	EACH FILE TO SEE IF IT SHOULD BE DUMPED
	FOR EACH FILE, ADD AN ENTRY TO THE SNAPSHOT DIRECTORY
	IF A FILE MUST BE DUMPED, DO SO. RENAME IT WITH A NEW DUMP DATE.
	LOOP TO GETFIL
	WHEN UFD IS FINISHED, CLOSE THE MAGTAPE AND LOOP TO GETUFD
	WHEN MFD IS DONE, LOOP TO DEVSEL.

FILES THAT GET WRITTEN TO HELP US FIND THINGS LATER, FIND THINGS NOW?

ON CURRENT STRUCTURE IN [DUMPER] AREA:
ALLDIR.DAT	DIRECTORY OF ALL FILES ON THE STRUCTURE WITH THE TAPE NUMBER
		WHERE THEY WERE DUMPED LAST.
DART.DAT	MERGE OF PREVIOUS DART.DAT AND CURRENT P0000N.DAT AT END OF
		EACH TAPE. AND AT END OF EACH STRUCTURE.

ON DSK IN [DUMPER] AREA
ALLDIR.MEM	TEMPORARY VERSION OF ALLDIR.DAT, WITH DATE WRITTEN
		INFORMATION ADDED FOR EACH FILE DUMPED IN THIS DUMP.
DTAPES.DAT	CONTAINS WHERE DUMPED AND WHEN WRITTEN FOR ALL FILES
		ON ALL TAPES IN THIS DUMP. (CREATED FROM ALLDIR.MEM BY SPLIT.)
DART.MEM	REMEMBER CURRENT COMMAND, TAPE NUMBER, DUMP PHASE.
DART.TAP	NUMBERS OF THE TAPES THAT HAVE BEEN USED THUS FAR.

$
;PICKUP PICKEN NOPICK LOKOUT NOPIC2 TABPIK PICKP1 PICKP3 PICKP2

	SUBTTL	PICKUP DUMP AFTER A SYSTEM CRASH
PICKUP:	SETOM	PICKON			;SIGNAL WE ARE DOING A PICKUP.
	GETPPN	A,
	CAME	A,DUMPER
	JRST	NOPRV			;THIS LOSER CAN'T DO A PICKUP.
	MOVEI	A,17			;INIT THE DISK.
	MOVSI	B,'DSK'
	MOVEI	C,0
	OPEN	DSKMEM,A
	PUSHJ	P,NODEV
	MOVE	A,['NODUMP']
	MOVSI	B,'PLS'
	MOVEI	C,0
	MOVE	D,DUMPER
	LOOKUP	DSKMEM,A		;SEEK FILE.
	 SKIPA	A,['DART  ']
	JRST LOKOUT			;LOCKOUT FILE EXISTS, LOSE
	MOVSI	B,'MEM'
	MOVEI	C,0
	MOVE	D,DUMPER
	LOOKUP	DSKMEM,A		;SEEK FILE.
	JRST	NOPICK
PICKEN:	MOVE	D,DUMPER
	ENTER	DSKMEM,A
	JRST	NOPIC2
	TLO	FL,DMEMRA		;SET DART.MEM OPEN IN READ ALTER
	JRST	PICKP1
NOPICK:	OUTSTR	[ASCIZ/File not found. DSK:DART.MEM; we can't do a PICKUP.
/]
	RELEAS	DSKMEM,
	POPJ	P,

LOKOUT:	OUTSTR	[ASCIZ/*** DON'T DO A SYSTEM CLASS DUMP TODAY!!! ***
A wizard has declared the dump facility unusable.
Do not try to do a dump without getting help!
/]
IFN STANSW!IRCPPN,<
	MOVNI A,1
	BEEP A,
>;IFN STANSW!IRCPPN
	RELEAS	DSKMEM,
	JRST RESTAR

NOPIC2:	OUTSTR	[ASCIZ/ENTER to remake DART.MEM has lost.
/]
	HALT	PICKEN

TABPIK:	PICKP3	;CODE 0 - MIDDLE OF A DUMP - POSITION TAPE - GETUFD
	PICKP2	;CODE 1 - END OF A STRUCTURE - DMPSTR
	PICKP3	;CODE 2 - END OF A STRUCTURE - POSITION TAPE - DMPSTR
	PICKP2	;CODE 3 - END OF A STRUCTURE. - DMPSTR
	PICKP2	;CODE 4 - END OF REEL IN MERGE. - GFREDO
	PICKP2	;CODE 5 - END OF REEL. NEED REWIND. - GFREDO
	PICKP2	;CODE 6 - END OF REEL & STRUCTURE. - DMPSTR
SDEF(TABPLN,.-TABPIK)

PICKP1:	INPUT	DSKMEM,[IOWD 200+MEMLEN,REELBF
			0]
	STATZ	DSKMEM,740000
	JRST	[OUTSTR	[ASCIZ/Input error DSK:DART.MEM. We can't PICKUP.
/]
		RELEAS	DSKMEM,
		POPJ	P,]
	HRRZ	A,MEMSAV+DCLASS
	MOVEM	A,CLASS
	HLRZ	A,MEMSAV+DCLASS
	ANDI	A,FULL!PCLASS
	TRZ	FL,FULL!PCLASS
	IORI	FL,(A)			;TURN ON THE FLAGS
	MOVE	A,MEMSAV+MMTDEV
	MOVEM	A,MTDEV			;SAVE DEVICE NAME.
	MOVE	A,MEMSAV+TAPNUM
	MOVEM	A,TAPNO
	PUSHJ	P,MTINIT		;WE'LL HAVE TO INIT IT ALL.
	PUSHJ	P,REELM0		;PREPARE TAPE NAMES AND THINGS
	MOVEI	A,17			;INIT THE DISK.
	MOVSI	B,'DSK'
	MOVEI	C,0
	OPEN	DSKMSC,A
	PUSHJ	P,NODEV
	HRRZ	A,MEMSAV+CHKNUM		;GET CHECKPOINT CODE.
	CAIGE	A,TABPLN
	JRST	@TABPIK(A)
	OUTSTR	[ASCIZ/Cannot interpret checkpoint number for PICKUP.
/]
	POPJ	P,

PICKP3:	PUSHJ	P,DOMOUNT		;REQUEST OPR TO MOUNT TAPE.
	PUSHJ	P,FIXPOS		;FIX POSITION BY LAST THING WE REMEMBER.
IFN DBGSW,<
	SKIPN	DBGNTP			;DON'T PLAY WITH TAPE IF NOT USING IT
>
	PUSHJ	P,MTASKF		;SKIP FORWARD.
	SETZM	MEMSAV+MTAPQU		;WE REALLY KNOW WHERE TAPE IS (MOSTLY)
PICKP2:	MOVE	A,MEMSAV+MSTRNA		;PICKUP STRUCTURE NAME.
	JRST	STRPIK			;JUMP TO PICKUP INSIDE A STRUCTURE.
;PURGE PURGE0 FDUMP PDUMP TDUMP TDUMP1 PDUMP1 PDUMP2 PDMP2Z PDMP2A PDUMP3 GETSTR JUST1S STRPIK NNSTR NNST0

	SUBTTL	SYSTEM CLASS DUMPS  FDUMP, PDUMP, TDUMP, PURGE
PURGE:	TRZ	FL,FULL			;PURGE IS NOT FULL
	TRO	FL,PURCOM+PCLASS	;IS A PURGE
	SKIPN	PPURGE			;PHONY PURGE?
	JRST	PURGE0
	OUTSTR	[ASCIZ/(This is a purger debugging run.  Nothing will be purged.)
DO NOT ATTEMPT TO USE THIS CORE IMAGE FOR ANYTHING ELSE BUT A SINGLE DEBUGGING RUN
/]
	MOVEI	A,0
IFE STANSW,<	GETPPN	A,	>;IFE STANSW
IFN STANSW,<		DSKPPN	A,	>;IFN STANSW
	MOVEM	A,DUMPER
	MOVE	A,['PPURGE']
	MOVEM	A,TAPNAM		;SET PHONY TAPE NAME
PURGE0:	MOVEI	A,2			;SET THE DUMP CLASS 2 = PERMANENT
	JRST	PDUMP1

FDUMP:	TROA	FL,FULL			;FLAG FOR FULL DUMP
PDUMP:	TRZ	FL,FULL			;CLEAR FULL DUMP FLAG
	TRZ	FL,PURCOM		;NOT PURGE COMMAND
	TRO	FL,PCLASS		;TURN ON PERMANENT CLASS
	MOVEI	A,2			;SET THE DUMP CLASS 2 = PERMANENT
	JRST	TDUMP1

TDUMP:	TRZ	FL,FULL!PCLASS!PURCOM	;NOT FULL - NOT PERMANENT - NOT PURGE
	MOVEI	A,1			;DUMP CLASS 1 = TEMPORARY
TDUMP1:	SKIPE	PPURGE
	JRST	[OUTSTR	[ASCIZ/PPURGE not zero.  You'd better get a new core image.
/]
		HALT CPOPJ]

PDUMP1:	MOVEM	A,CLASS			;SAVE DUMP CLASS.
	SETZM	PICKON			;NOT DOING A PICKUP.
IFE IRCPPN,<
	GETPPN	A,			;GET THE REAL PPN (NOT DSKPPN)
	 JFCL				;DEC NEEDS THIS
>
IFN IRCPPN,<
	HRROI A,2			;REAL PPN COMES FROM GETTAB
	GETTAB A,
	 GETPPN A,
	  JFCL
>
	CAME	A,DUMPER		;IS THIS THE RIGHT NAME?
	JRST	NOPRV			;HE IS NOT THE RIGHT GUY.

	MOVEI	A,17			;CHANNEL FOR DART.TAP,DART.REC, ETC.
	MOVSI	B,'DSK'			;DEFAULT STRUCTURE.
	MOVEI	C,0
	OPEN	DSKMEM,A		;OPEN CHANNEL
	PUSHJ	P,NODEV			;CAN'T HAPPEN
	OPEN	DSKMSC,A		;OPEN CHANNEL
	PUSHJ	P,NODEV			;CAN'T HAPPEN
	MOVE	A,['NODUMP']
	MOVSI	B,'PLS'
	MOVEI	C,0
	MOVE	D,DUMPER
	LOOKUP	DSKMEM,A		;SEEK LOCKOUT FILE
	 JRST	PDMP2Z
	JRST LOKOUT

PDMP2Z:	MOVE	A,['DART  ']
	MOVSI	B,'MEM'
	MOVEI	C,0
	MOVE	D,DUMPER
	LOOKUP	DSKMEM,A		;SEEK MEMORY FILE
	 JRST	PDUMP2
	OUTSTR	[ASCIZ/I still have a memory file!
If you intend to continue the interrupted dump, do a PICKUP.
Otherwise, you need help -- get a wizard.
/]
	EXIT

PDUMP2:	SETZM	MEMSAV
	MOVE	A,[MEMSAV,,MEMSAV+1]
	BLT	A,MEMSAV+MEMLEN-1	;ZERO THE PICKUP DATA.
	HRRZ	A,CLASS			;
	HRL	A,FL			;GET THE FLAGS
	MOVEM	A,MEMSAV+DCLASS		;SAVE FLAGS AND CLASS.

	PUSHJ	P,SCAN			;SCAN THE WORLD.
	SKIPN	R,DEST			;IS THERE A DESTINATION TERM?
	PUSHJ	P,GETBLK		;NO MAKE ONE
	MOVEM	R,DEST			;AND SAVE THE ADDRESS OF THE DESTINATION
	MOVE	A,FSDEV(R)		;GET THE DEVICE NAME.
	MOVEM	A,MTDEV			;SAVE WHERE MTINIT WILL SEE IT
	MOVEM	A,MEMSAV+MMTDEV		;SAVE DEVICE NAME HERE TOO.
	TRNN	FL,PURCOM		;PURGE?
	JRST	PDUMP3			;NO.  SKIP ANALYSIS OF SCANNED INPUT
	MOVE	R,FSPTR
	MOVEM	R,.JBFF			;SET .JBFF ABOVE ALL THE SOURCE TERMS
	HRRZ	R,TBASE			;GET BASE OF SOURCE TERMS
	CAML	R,FSPTR			;IF NONE, ERROR.
	JRST	PURERR			;IF NONE, ERROR.
	MOVSI	A,'DSK'			;DEFAULT SOURCE DEVICE.
PDMP2A:	CAML	R,FSPTR			;END OF THE LIST YET?
	JRST	PDUMP3
	SKIPN	B,(R)			;SKIP IF THERE'S AN EXPLICIT SOURCE DEVICE
	MOVE	B,A			;NO. USE THE STICKY ONE LEFT FROM LAST TIME
	MOVE	A,B			;SAVE THE STICKY ONE
	MOVEM	A,(R)			;SAVE IT IN THE TERMBLOCK TOO
	ADDI	R,FSLEN
	JRST	PDMP2A

PDUMP3:
IFE STANSW,<
;; this is a bug, we get here (if not a purge) with MTAn in A!!
	CAMN A,['DSK   ']
	MOVEI A,0
	MOVEM A,UNQSTR
>;IFE STANSW
	TLO	FL,MOUNT		;REMEMBER WE NEED TO MOUNT A TAPE.
	PUSHJ	P,GETTAP		;FIND OUT WHAT TAPE NUMBER TO USE.
	MOVE	A,TAPNO			;GET THE TAPE NUMBER
	MOVEM	A,MEMSAV+TAPNUM		;SAVE TAPE NUMBER HERE TOO.

IFE STANSW,<
	SKIPE A,UNQSTR
	JRST JUST1S			;IF EXPLICIT STRUCTURE, NO SYSSTR STUFF
>;IFE STANSW
	SETZM	STRNAM			;ZERO THE STRUCTURE NAME.
GETSTR:	MOVE	A,STRNAM		;SELECT THE FILE STRUCTTURE TO DO NEXT
IFE STANSW,<	SYSSTR	A,		;ASK SYSTEM FOR THE NEXT NAME>
	MOVSI	A,'DSK'			;UNIMPLEMENTED UUO. ASSUME DEVICE DSK
	CAMN	A,STRNAM		;SAME AS THE CURRENT NAME?
	SETZ	A,			;YES. ZERO THE NAME
JUST1S:	MOVEM	A,MEMSAV+MSTRNA		;SAVE TO REMEMBER

;CONTINUE HERE IN PICKUPS
STRPIK:	MOVEM	A,STRNAM		;SAVE THE STRUCTURE NAME.
	JUMPE	A,NNSTR			;NO NEXT STRUCTURE.
	PUSH	P,.JBFF			;SAVE .JBFF ON THE STACK
	PUSHJ	P,DMPSTR		;DUMP SELECTED STRUCTURE.
	POP	P,.JBFF			;RESTORE .JBFF TO RECYCLE BUFFERS
IFE STANSW,<
	SKIPN UNQSTR			;DONE IF JUST ONE STR
>;IFE STANSW
	JRST	GETSTR			;GET ANOTHER STRUCTURE.

NNSTR:	SKIPE	PPURGE
	JRST	NNST0			;AVOID STUFF IF PHONY PURGE
IFN DBGSW,<
	SKIPN	DBGNTP			;AVOID REWIND IF NO TAPE OUTPUT
>
	PUSHJ	P,MTAREW		;START THE REWIND
	PUSHJ	P,PUTTAP		;UPDATE TAPE NUMBERS ON DART.TAP
NNST0:	CLOSE	DSKMEM,
	SETZB	A,B
	SETZ	C,
	MOVE	D,DUMPER
	RENAME	DSKMEM,A		;DELETE DART.MEM
	JFCL

	PUSHJ	P,MTAREL		;RELEASE THE TAPE.
	RELEAS	DSKMEM,
	RELEAS	DSKMSC,
	OUTSTR	[ASCIZ/Dump complete.
/]
	SKIPE	PPURGE
	OUTSTR	[ASCIZ/(You might delete DART.DAT from this area.)
/]
	POPJ	P,
;DMPSTR DMPST0 DMPST3 DPIK2 DMPSTW DMPSTZ YMTA2 NOMTA2 DMPSTY PIK6 DMPSTX DPIK1 DMPST1 DMPST2 DPIK3 DPICKT DMPSTP DMPSP0 DMPSP1 DMPSP2

	SUBTTL	DMPSTR	DUMP AN ENTIRE FILE STRUCTURE

DMPSTR:	MOVEM	A,DEVNAM		;SAVE DEVICE NAME FOR PUT

	MOVEI	A,10+GARBIT		;READ MFD. PREVENT LOSSAGE FROM BAD RETR.
	MOVE	B,STRNAM		;DEVICE
	MOVEI	C,UFDBUF		;BUFFER HEADER FOR INPUT
	OPEN	UFD,A			;CHANNEL FOR MFD AND UFDS
	PUSHJ	P,NODEV			;LOSE BIG
	INBUF	UFD,23			;UFD'S ARE USUALLY SMALL. THE MFD IS READ ONCE
					;BUT STILL, UFD READS MAY BE LOTS OF DSKOPS

	MOVEI	A,10+DMPBIT+GARBIT	;READ FILES. 6 WORD LOOKUP/RENAME.
	MOVE	B,STRNAM		;ERROR RETURN ON BAD RETR.  NO REFTIM UPDATE
	MOVE	C,[FOBUF,,FIBUF]
	OPEN	FILE,A
	PUSHJ	P,NODEV
	INBUF	FILE,23			;ALLOCATE MORE BUFFERS FOR READING FILES.

	MOVEI	A,17			;DUMP MODE FOR MEMORY CHANNEL
	MOVE	B,STRNAM		;STRUCTURE NAME
	MOVEI	C,0			;NO BUFFERS FOR DUMP MODE
	OPEN	MEM,A			;OPEN CHANNEL
	PUSHJ	P,NODEV			;LOSE.

	PUSHJ	P,MFDSOR		;READ AND SORT THE MFD.
	CLOSE	UFD,			;CLOSE THE FILE.

	SKIPE	PICKON
	JRST	DMPSTP			;DO THE PICKUP.
DMPST0:	MOVE	A,['ALLDIR']		;NAME OF THE FILE
	MOVSI	B,'MEM'	
	MOVEI	C,0
	MOVE	D,DUMPER
	ENTER	MEM,A
	JRST	[OUTSTR	[ASCIZ/ENTER to make ALLDIR.MEM failed.
/]
		HALT	DMPST0]
	CLOSE	MEM,			;CLOSE-TO CREATE DIRECTORY ENTRY(EMPTY FILE)
	PUSHJ	P,ALLMIN		;RE-OPEN ALLDIR.MEM, INIT ALLSIZ

	MOVE	Q,MFDPTR		;GET THE POINTER TO THE MFD.
DMPST3:	MOVE	A,(Q)			;GET UFD NAME
	PUSHJ	P,GETUFD		;DUMP AN ENTIRE UFD
	AOBJN	Q,DMPST3		;LOOP DOING UFDS
	CLOSE	MEM,			;CLOSE ALLDIR.MEM


	PUSHJ	P,SPLIT			;CREATE ALLDIR.DAT(IF NOT PURGE), DTAPES.DAT

;PICKUP TYPE 2
DPIK2:	MOVEI	A,2
	MOVEM	A,MEMSAV+CHKNUM
	SETZM	MEMSAV+MERGFL
	SETZM	PICKON			;NOT NOW DOING A PICKUP.
	PUSHJ	P,SAVMEM		;SAVE DATA.

	MOVE	A,['ALLDIR']
	MOVSI	B,'MEM'
	SETZ	C,
	MOVE	D,DUMPER
	LOOKUP	UFD,A
	JRST	DMPSTW			;IF NO ALLDIR.MEM, DON'T DELETE IT
	SETZB	A,B
	MOVEI	C,0
	MOVE	D,DUMPER
	RENAME	UFD,A			;DELETE ALLDIR.MEM
	JFCL
DMPSTW:	TRNE	FL,PURCOM		;SKIP UNLESS PURGE
	JRST	DMPSTX			;AVOID ALLDIR HACKING FOR PURGE

DMPSTZ:	MOVE	A,['ALLDIR']		;NOW GOBBLE THE MASTER DIRECTORY.
	MOVSI	B,'DAT'
	MOVEI	C,0
	MOVE	D,DUMPER
	MOVE	W,[A,,FILBLK]
	BLT	W,FILBLK+3
IFN STANSW,<
	LOOKUP	FILE,A
	JRST	DMPSTX			;LOSE SOMEHOW
	MTAPE	FILE,['GODMOD'
			14
			IOWD 20,FILINF]
	JFCL			
	MTAPE	FILE,RDOFFS		;READ OFFSET FROM THE OFFSET BLOCK.
	MOVE	A,RDOFFS+2		;GET THE OFFSET NUMBER.
	MOVEM	A,FILINF+DDOFFS		;SAVE IT IN THE RETRIEVAL.
>
IFE STANSW,<
	PUSHJ P,DMPLKP
	 JRST DMPSTX
>
	LDB	A,PDATE				;GET THE FILE WRITE DATE
	LDB	B,PDATEH			;HIGH DATE - DATE75
	DPB	B,[POINT 3,A,23]		;STUFF HIGH DATE - DATE75
	HLL	A,FILINF+DDEXT			;GET THE EXTENSION.
	MOVEM	A,DATDAT			;SAVE EXT,,DATE FOR MERGE
	MOVEI	A,RECSIZ		;GET BUFFER SIZE
	MOVEM	A,WC			;SAVE AS WC
	SETZM	MTFILN
	MOVE	D,[FILBLK,,A]
	BLT	D,D
	PUSHJ	P,TYFIL
IFN STANSW,<
	MOVEI	A,2
	SUB	A,FILINF+DDOFFS
	USETI	FILE,(A)		;USETI TO THE FIRST REAL RECORD.
>	;THANK YOU MR. GORIN
	TLZ	FL,IGNEOT		;CAN'T IGNORE EOT.
	PUSHJ	P,DUMP
	JRST	DMPSTY			;LOSE.  NEED A NEW REEL OF TAPE
IFN DBGSW,<
	SKIPN	DBGNTP
	JRST	YMTA2
	PUSHJ	P,NXTOBF		;FAKE CLOSE IF NOT OUTPUTTING
	SKIPA
	JRST	DMPSTY	;TO FAKE AN EOT (FOR TESTING W/O TAPE)
	JRST	NOMTA2			;NO TAPE OPERATIONS IF NOT USING IT
YMTA2:
>;IFN DBGSW
	PUSHJ	P,MTACLZ
	STATZ	MTA,IOTEND
	JRST	DMPSTY
NOMTA2:	OUTSTR	CRLF
	JRST	DMPSTX

DMPSTY:	OUTSTR	[ASCIZ/- not saved. Physical end of tape.
/]
IFN DBGSW,<
	SKIPN	DBGNTP			;NO TAPE OPERATIONS IF NOT USING IT
>
	PUSHJ	P,MTAREW
	PUSHJ	P,PUTTAP
	AOS	A,TAPNO
	MOVEM	A,MEMSAV+TAPNUM
PIK6:	MOVEI	A,6
	MOVEM	A,MEMSAV+CHKNUM
	SETZM	PICKON
	PUSHJ	P,SAVMEM
	PUSHJ	P,DOMOUNT
	JRST	DMPSTZ

DMPSTX:	SETZM	MEMSAV+MERGFL		;ZERO THE MERGE FLAG
;PICKUP TYPE 1
DPIK1:	MOVEI	A,1			;PICKUP CODE 1
	MOVEM	A,MEMSAV+CHKNUM		;SAVE PICKUP CODE.
	SETZM	PICKON			;PICKUP IS NOT CURRENTLY IN PROGRESS.
	TRNN	FL,PURCOM		;SKIP IF PURGE
	PUSHJ	P,SAVMEM		;SAVE DATA.
	SKIPN	MEMSAV+MERGFL		;IS THIS A PICKUP THAT LOSES?
	PUSHJ	P,MERGE			;DO THE MERGE INTO DART.DAT ON THIS STRUCTURE

	RELEAS	FILE,
	RELEAS	MEM,
	TRNE	FL,PURCOM
	JRST	[RELEAS	UFD,
		POPJ	P,]			;RETURN QUICK FROM PURGE
	MOVE	A,['ALLDIR']
	MOVSI	B,'DAT'
	SETZ	C,
	MOVE	D,DUMPER
	LOOKUP	UFD,A			;IF THIS IS NOT HERE, DON'T LOOK AT .OLD
	JRST	[OUTSTR [ASCIZ/ALLDIR.DAT got lost: ALLDIR.OLD will not be deleted.
/]
		JRST	DMPST2]
	MOVE	A,['ALLDIR']
	MOVSI	B,'OLD'
	SETZ	C,
	MOVE	D,DUMPER
	LOOKUP	UFD,A			;SEEK OLD 
	JRST	DMPST1			;NONE THERE.
IFN STANSW,<
	CLOSE	UFD,			;CLOSE
>
	SETZB	A,B
	MOVE	D,DUMPER
	RENAME	UFD,A			;RENAME TO DELETE
	OUTSTR	[ASCIZ/Unable to delete ALLDIR.OLD
/]
DMPST1:	MOVE	A,['ALLDIR']
	MOVSI	B,'DAT'
	SETZ	C,
	MOVE	D,DUMPER
	LOOKUP	UFD,A			;SEEK FILE.
	JRST	DMPST2
IFN STANSW,<
	CLOSE	UFD,
>
	MOVE	A,['ALLDIR']
	HRLI	B,'OLD'			;DATE75 - PRESERVE HIGH DATE.
	MOVE	D,DUMPER
	RENAME	UFD,A			;RENAME THE FILE.
	OUTSTR	[ASCIZ/Unable to rename ALLDIR.DAT to ALLDIR.OLD
/]
DMPST2:	CLOSE	UFD,			;CLOSE.
	RELEAS	UFD,
;PICKUP TYPE 3.
DPIK3:	MOVEI	A,3
	MOVEM	A,MEMSAV+CHKNUM		;SAVE CODE
	SETZM	PICKUP
	PUSHJ	P,SAVMEM
	POPJ	P,			;NO UFDS LEFT. GET ANOTHER STRUCTURE.

DPICKT:	DPIK1
	DPIK2
	DPIK3

DMPSTP:	MOVE	A,MEMSAV+CHKNUM		;GET THE PICKUP CODE
	CAIL	A,1
	CAILE	A,3			;CODES 1 AND 3 ARE PROCESSED HERE.
	JRST	DMPSP0			;OUT OF RANGE
	JRST	@DPICKT-1(A)		;DISPATCH FOR CODES 1,2,3

DMPSP0:	CAIN	A,6
	JRST	PIK6			;PICKUP TYPE 6
	PUSHJ	P,ALLMIN		;OPEN ALLDIR.MEM, SET UP ALLSIZ
	MOVE	Q,MFDPTR		;GET THE POINTER TO THE UFD.
	MOVE	A,MEMSAV+LUSER		;GET THE NAME OF THE LAST GUY.
DMPSP1:	CAMN	A,(Q)			;GET THE NAME OF A UFD.
	JRST	DMPST3			;GOT IT! TRICKLE DOWN ANOTHER LEVEL.
	AOBJN	Q,DMPSP1		;LOOP LOOKING.
	SETZM	PICKON			;WILL NOT BE A PICKUP.
	PUSHJ	P,UFDCNV		;CONVERT TO SORT FORMAT.
	MOVEM	A,DNX
	MOVE	Q,MFDPTR
DMPSP2:	MOVE	A,(Q)
	PUSHJ	P,UFDCNV
	MOVEM	A,TNX
	PUSHJ	P,PPNCMP		;COMPARE PPNS.
	JRST	DMPST3			;D<T THIS WILL DO. TRICKLE DOWN
	AOBJN	Q,DMPSP2		;LOOP LOOKING
	JRST	DPIK1			;UFD NAME WAS BIGGER THAN ANYTHING THAT
					;EXISTS NOW.  WE MUST HAVE BEEN DONE.
;GETUFD GPUR1 GPUR2 GETUD1 ALLINI GETFIL GETFL1 GETFL2 GFLOOK GFTEST GFALLM GFPTS3 GFPTST GFPTS1 GFPTS2 GFTXL GFDUMP GFDMP1 GFDMP2 GFDP2A GFDP3A GDP3AA GFDP3B GDP3BA NNFIL GFDMP3 YMTA3 GFDMP4 GDP4BA GFDP4B GFDP4C GFDP4A TAPCMP TAPCP1 PUTEST PUTST0 PUTST1 PUTST2 MONTHB DATCNV
	SUBTTL	GETUFD	DUMP FILES FROM ONE UFD
GETUFD:	MOVE	A,THSDAT
	PUSHJ	P,DATCNV		;SYSTEM FORMAT DATE
	MOVEM	A,THSDAX		; TO NUMBER OF DAYS SINCE 1/1/64
	SKIPE	PICKON			;ARE WE IN THE MIDDLE OF A PICKUP?
	JRST	GFPICK			;YES. GO DO IT.
	TRNN	FL,PURCOM		;PURGE COMMAND?
	JRST	GETUD1			;NO. ORDINARY.

;HERE FOR PURGE COMMAND - SEE IF THERE'S ANYTHING TO FLUSH IN THIS UFD
	HRRZ	R,TBASE			;BASE OF ALL PURGE TERMS SCANNED
GPUR1:	CAML	R,FSPTR			;FIRST ADDRESS ABOVE PURGE TERMS
	POPJ	P,			;THERE ARE NO PURGE TERMS (LEFT ANYMORE)
	MOVE	A,(R)
	CAME	A,STRNAM		;DEVICE NAME MATCHES THIS STRUCTURE?
	JRST	GPUR2			;NO.  GET NEXT TERM
	MOVE	B,2(R)			;GET FLAGS
	MOVE	A,(Q)			;GET PROJ,PROG
	CAMN	A,3(R)			;MATCHES THIS TERM EXACTLY?
	JRST	GETUD1			;YES.  WE'LL HAVE TO DO SOMETHING HERE.
	HRRZ	C,3(R)
	CAIE	C,(A)
	TRNE	B,ALLPRG
	JRST	.+2			;PRG MATCHES OR IS *
	JRST	GPUR2
	HLRZ	A,(Q)
	HLRZ	C,3(R)
	CAIE	A,(C)
	TRNE	B,ALLPRJ
	JRST	GETUD1			;THIS MATCHES SOMEWHAT
GPUR2:	ADDI	R,FSLEN
	JRST	GPUR1


GETUD1:	MOVE	A,(Q)			;PICKUP A UFD NAME
	MOVSI	B,'UFD'
	SETZB	C,PICKON		;
	MOVE	D,GOD
	MOVE	X,[A,,FILBLK]
	BLT	X,FILBLK+3
	LOOKUP	UFD,A
	JRST	[TRZ FL,SAFETY
		PUSHJ P,LCHECK
		JFCL
		CLOSE UFD,
		SETZM PICKON		;A PICKUP CANNOT SURVIVE THIS
		POPJ P,]		;RETURN UPLEVEL
	MOVEM	A,MEMSAV+LUSER
	SKIPE	PPURGE			;PHONY PURGE?  (DEBUGGING ONLY!)
	TLZ	FL,MOUNT		;FOR PHONY PURGE, MOUNT NO TAPES!
	TLZE	FL,MOUNT
	PUSHJ	P,DOMOUNT		;REQUIRE TAPE MOUNT FIRST.

	PUSHJ	P,DPYSER		;DISPLAY USER NAME ON DPY
	MEMSAV+LUSER,,DPYPPN		;PPN ONLY (ALSO NO. OF FEET)

ALLINI:	MOVE	S,[IOWD 200,REELBF]	;INITIALIZE POINTER TO REEL DIRECTORY
	PUSH	S,(Q)			;SAVE THE UFD NAME
	MOVEM	S,REELPT		;SAVE POINTER TO REEL DIRECTORY
	MOVE	S,[IOWD 400,ALLBUF]	;INITIALIZE POINTER FOR ALLDIR
	PUSH	S,(Q)			;SAVE THE UFD NAME.
	MOVEM	S,ALLPTR		;SAVE THE POINTER.
	SETZM	1(S)			;INITIALIZE FOR EMPTY

GETFIL:	HLRZ	S,ALLPTR		;GET THE COUNT OF SPACE LEFT
	CAILE	S,-4			;NEED ROOM FOR 3 WORDS + A ZERO WORD
	JRST	GFDMP3			;IF NOT 4 WORDS LEFT, WE HAVE OVERFLOW
	PUSHJ	P,UFDRD			;READ THE UFD
	JRST	NNFIL			;NO NEXT FILE
	MOVEM	A,FILBLK		;SAVE A FILE NAME
	SKIPE	A
	MOVEM	A,MEMSAV+LFILE
	PUSHJ	P,UFDRD
	JFCL
	MOVEM	A,FILBLK+1
	SKIPE	FILBLK
	HLLZM	A,MEMSAV+LEXT
IFN STANSW,<
	MOVE	D,[-UFDN+2,,2]	;READ MORE
GETFL1:	PUSHJ	P,UFDRD
	JFCL
	MOVEM	A,FILBLK(D)
	AOBJN	D,GETFL1
>
	SKIPN	FILBLK
	JRST	GETFIL			;GET THE NEXT FILE. NAME WAS 0.
	TRNE	FL,PURCOM		;SKIP UNLESS PURGING.
	JRST	PUTEST			;(RETURN TO GFLOOK TO PURGE, ELSE TO GETFIL)
GETFL2:					;ENTER HERE TO RESTART P,T,FDUMP AFTER EOT
IFE STANSW,<
	MOVE D,(Q)			;GET PPN
	HLRZ B,FILBLK+1			;AND EXT
	CAIN B,'SYS'
	CAME D,SYSPPN
	JRST .+2
	JRST GETFIL			;DON'T DUMP SYS:*.SYS
>

IFN STANSW,<
	HLRZ	A,FILBLK+1		;GET THE EXTENSION
;	CAIE	A,'TMP'		;Don't flush TMP any more (09/04/78 EJG)
;	CAIN	A,'RPG'		;Don't flush RPG any more (12/05/77)
;	JRST	GETFIL			;FLUSH RPG AND TMP FILES.
	CAIN	A,'SND'	
	JRST	GETFIL			;FLUSH SOUND FILES
	HRRZ	A,FILBLK+3
	MOVEM	A,RRD1			;SAVE TRACK NUMBER FOR MTAPE
	TRZ	FL,LOOKDN		;SET A FLAG TO SAY NO LOOKUP DONE YET.
IFE FTLUFD,<
	MOVE	A,FILBLK		;GET FILE NAME
	HLLZ	B,FILBLK+1		;EXT ONLY
	MOVE	D,(Q)			;GET PPN
IFE DBGSW,<
	MTAPE	FILE,RRD		;DO ABSOLUTE MODE READ TO READ RETRIEVAL
>;IFE DBGSW
	JRST	GFLOOK			;LOSE SOMEHOW. DO A LOOKUP
	CAMN	D,FILINF+DDPPN		;CHECK FILE RETRIEVAL
	CAME	A,FILINF+DDNAM		;PPN AND NAME
	JRST	GFLOOK			;BAD RETRIEVAL. TRY THRU THE SYSTEM
	HLLZ	C,FILINF+DDEXT		;GET EXT
	CAMN	B,C
	JRST	GFTEST			;RETRIEVAL IS GOOD ENOUGH
>;IFE FTLUFD
IFN FTLUFD,<
	MOVE	A,FILBLK+UNAM
	MOVEM	A,FILINF+DDNAM
	MOVE	A,FILBLK+UEXT
	MOVEM	A,FILINF+DDEXT
	MOVE	A,FILBLK+UPRO
	MOVEM	A,FILINF+DDPRO
	MOVE	A,(Q)
	MOVEM	A,FILINF+DDPPN
	MOVE	A,FILBLK+ULOC
	MOVEM	A,FILINF+DDLOC
	MOVE	A,FILBLK+ULEN
	MOVEM	A,FILINF+DDLNG
	MOVE	A,FILBLK+UREFT
	MOVEM	A,FILINF+DREFTM
	MOVE	A,FILBLK+UDMPT
	MOVEM	A,FILINF+DDMPTM
	MOVE	A,[FILBLK+UQINFO,,FILINF+DQINFO]
	BLT	A,FILINF+DQINFO+3
	MOVE	A,FILBLK+UOFFST
	MOVEM	A,FILINF+DDOFFS
	JRST	GFTEST			;"RETRIEVAL" FROM UFD IS GOOD ENOUGH
>;IFN FTLUFD
>;IFN STANSW

GFLOOK:	MOVEI	C,0			;A,B,D ALREADY SET WITH NAME,EXT AND PPN
	TRZ	FL,SAFETY		;REAL LOOKUP
IFN STANSW,<
	MOVE	Y,[A,,FILBLK]
	BLT	Y,FILBLK+3
	LOOKUP	FILE,A			;SEEK FILE.
					;BEWARE: W,X ARE CLOBBERED BY 6 WORD LOOKUP
	JRST	[PUSHJ	P,LCHECK
		JFCL
		JRST	GETFIL]
	TRO	FL,LOOKDN		;LOOKUP DONE.
	MTAPE	FILE,['GODMOD'
			14
		     IOWD 20,FILINF]
	JFCL				;CANT LOSE. HA HA.
>
IFE STANSW,<
	MOVE A,FILBLK
	MOVEM A,FILINF+DDNAM
	HLLZ B,FILBLK+1
	MOVE D,(Q)
	MOVEM D,FILINF+DDPPN
	PUSHJ P,DMPLKP			;THIS SETS UP FILINF TOO
	 JRST GETFIL			;NOT FOUND
>
	TRNE	FL,PURCOM		;PURGE COMMAND?
	JRST	GFALLM			;YES.  GO OUTPUT TO ALLDIR.MEM, THEN DUMP
GFTEST:
	MOVE B,FILINF+DDMPTM		;GET DUMP INFO WORD
	TLNE B,10000			;SKIP UNLESS TO BE REAPED
	TRNN FL,PCLASS			;REAPEE.  PDUMP?
	JRST .+2			;NO REAP, OR TDUMP
	JRST GFALLM			;PDUMP AND REAP, IGNORE NO-DUMP FLAG
IFN STANSW,<
	SKIPL	FILINF+DDPRO		;SKIP IF DUMP NEVER
>
IFE STANSW,<
	MOVE B,LKBLK+.RBSTS
	TRNE B,240000			;NO-FAILSAFE OR IMPERVIUM BITS
	JRST GFTXL			;PREVENT DUMP
	MOVE B,FILINF+DDMPTM
	TLNN B,4000			;NON-STANFORD DUMP-NEVER BIT
>
	SKIPG B,FILINF+DDLNG		;SKIP IF NOT EMPTY FILE (ALSO GET LENGTH)
	JRST	GFTXL			;IGNORE EMPTY FILES AND DUMP NEVER FILES
					;DUMP NEVER = 400 BIT IN PROTECTION
IFE STANSW,<
	HLRZ C,FILINF+DDEXT
	TRNN FL,PCLASS			;IF TEMPORARY DUMP,
	CAIN C,'MSB'			; THEN THE LENGTH LIMIT ONLY APPLIES
>;IFE STANSW
	SKIPN MAXLEN			; TO MUSIC SAMPLE FILES
	JRST GFALLM			;NO LENGTH LIMIT, OR TDUMP AND NOT .MSB
	CAMLE B,MAXLEN			;COMPARE FILE LENGTH TO LIMIT
	JRST GFTXL			;DON'T SAVE MOBY MUSIC FILES ETC
					;...OR FILES THAT WON'T FIT ON A TAPE
GFALLM:	MOVE	S,ALLPTR		;GET POINTER
	PUSH	S,FILINF+DDNAM		;SAVE THE NAME OF THE FILE.
	LDB	B,PTAPEN		;GET THE LAST TAPE # IN THE RIGHT
IFN STANSW,<
	JUMPG	B,.+2			;JUMP IF DUMPED ON A REAL DART TAPE
	SETZM	FILINF+DDMPTM		;THIS MUST HAVE BEEN RESTORED BY DAEMON.
>
	HLL	B,FILINF+DDEXT		;GET THE EXTENSION
	SKIPGE	FILINF+DDMPTM		;WAS THIS T-DUMPED?
	IORI	B,400000		;YES. MARK IT.
	PUSH	S,B			;SAVE THIS FOR ALLDIR.MEM
	MOVEM	S,ALLPTR		;SAVE POINTER
	TRNE	FL,PURCOM		;PURGE COMMAND?
	JRST	GFDUMP			;YES.  SELECT THIS FILE FOR OUTPUT

					;DECIDE ABOUT DUMPING THIS FILE.
	MOVE	B,(Q)			;GET PPN OF THE UFD WE'RE DUMPING
IFN STANSW,<
	CAMN	B,['  1  4']		;IS THIS [1,4]?
	JRST	GFTXL			;YES. DON'T DUMP ANY [1,4] FILES.
>
	CAME	B,DUMPER		;IS THIS THE DUMPER
	JRST	GFPTS3			;NO.
	HLRZ	A,FILINF+DDEXT		;GET THE EXTENSION
	CAIN	A,'LST'
	JRST	GFTXL			;FLUSH DUMPER'S LST FILES.
	CAIN	A,'MEM'
	JRST	GFTXL			;FLUSH DUMPER'S MEM FILES.
	CAIE	A,'DAT'
	JRST	GFPTS3
	MOVE	A,FILINF+DDNAM		;GET FILE NAME
	CAMN	A,['ALLDIR']
	JRST	GFTXL			;FLUSH DUMPER'S ALLDIR.DAT

GFPTS3:
	TRNE	FL,FULL			;FULL DUMP?
	JRST	GFDUMP			;YES. DUMP THIS.
	LDB	A,PINVAL		;PICKUP THE DUMP DATE INVALID BIT
	JUMPN	A,GFDUMP		;THIS HAS TO BE DUMPED SINCE INVALID.
	TRNE	FL,PCLASS		;IS THIS A PERMANENT DUMP?
	JRST	GFPTST			;YES. GO DECIDE WHETHER TO PDUMP

	SKIPLE	A,FILINF+DDMPTM		;TEMPORARY DUMP. WAS THIS DUMPED BEFORE?
	JRST	GFTXL			;THIS WAS PDUMPED. DON'T DUMP IT AGAIN.
	JUMPE	A,GFDUMP		;IF NEVER DUMPED, DUMP IT NOW.
	LDB	A,PTAPEN		;GET THE TAPE NUMBER
	PUSHJ	P,TAPCMP		;WAS THIS DUMPED IN CURRENT SERIES?
	JRST	GFTXL			;THIS WAS T-DUMPED AT SOME OTHER TIME.
	JRST	GFDUMP			;THIS WAS DUMPED IN THIS SERIES.
					;DUMP IT AGAIN TO AVOID FUCKUP.

GFPTST:	MOVE A,FILINF+DDMPTM
	TLNE A,10000			;CHECK REAP (DELETE AFTER DUMPING) BIT
	JRST GFDUMP			;YES, DUMP IT
	SKIPG	FILINF+DDMPTM		;WAS THIS PDUMPED BEFORE?
	JRST	GFPTS2			;NEVER.
	LDB	A,PTAPEN		;GET THE TAPE NUMBER
	PUSHJ	P,TAPCMP		;WAS THIS DUMPED IN THIS SERIES?
	JRST	GFPTS1			;NO THIS HAS BEEN DUMPED ELSEWHERE.
	LDB	A,PCOUNT		;THIS WAS DUMPED IN THIS SERIES.
	SOJL	A,.+2			;DECREASE COUNT. DON'T DEPOSIT NEGATIVE
	DPB	A,PCOUNT
	JRST	GFDUMP			;FORCE THIS ONE TO BE DUMPED.

GFPTS1:	LDB	A,PCOUNT		;GET THE DUMP COUNT
	CAILE	A,1			;LESS THAN TWICE?
	JRST	GFTXL			;THIS HAS BEEN DUMPED ENOUGH
	JRST	GFDUMP			;THIS WAS PDUMPED BEFORE. DO IT AGAIN.

GFPTS2:	LDB	A,PDATE			;NEVER PDUMPED. GET THE DATE.
	LDB	B,PDATEH		;GET HIGH DATE
	DPB	B,[POINT 3,A,23]	;STUFF HIGH DATE
	PUSHJ	P,DATCNV		;CONVERT TO NUMBER OF DAYS SINCE 1/1/64
	ADDI	A,4			;ADD SOMETHING TO THE CREATION DATE
	CAMG	A,THSDAX		;HOW DOES IT COMPARE WITH THE DUMP DATE?
	JRST	GFDUMP			;OLD ENOUGH TO DUMP.
	MOVE	A,(Q)			;GET PPN AGAIN
	CAMN	A,DUMPER
	JRST	GFDUMP			;FOR DUMPER, WE DUMP REGARDLESS OF DATE.
GFTXL:	TRZE	FL,LOOKDN		;WAS A LOOKUP DONE?
	CLOSE	FILE,NUPACC		;YES. ZERO FLAG AND CLOSE FILE
	JRST	GETFIL			;GO GET ANOTHER FILE.

GFDUMP:					;HERE TO REALLY DUMP A FILE.
	TRZE	FL,LOOKDN			;WAS A LOOKUP DONE YET?
	JRST	GFDMP1				;YES. SKIP THIS
IFN STANSW,<
	MOVE	D,[FILINF+DDNAM,,A]		;GET THE FILE NAME FROM RETREIVAL
	BLT	D,D
	MOVE	X,[A,,FILBLK]
	BLT	X,FILBLK+3
	LOOKUP	FILE,A
	JRST	[TRZ	FL,SAFETY
		PUSHJ	P,LCHECK
		JFCL
		JRST	GETFIL]
IFN FTLUFD,<
	MTAPE	FILE,['GODMOD'		;READ THE RETRIEVAL FOR REAL
			14		;(UFD "RETRIEVAL" IS NOT COMPLETE)
		     IOWD 20,FILINF]
	JFCL				;CANT LOSE. HA HA.
>;IFN FTLUFD
>;IFN STANSW
GFDMP1:	TLZ	FL,IGNEOT			;CAN'T IGNORE THE END OF TAPE
	MOVE	D,[FILINF+DDNAM,,A]		;GET THE NAME
	BLT	D,D
	PUSHJ	P,TYFIL				;AND TYPE THE NAME.
	SKIPE	PPURGE				;SKIP UNLESS PHONY PURGE
	JRST	GFDP2A				;DON'T DUMP IF PHONY PURGE/DEBUGGING
IFN STANSW,<
	MTAPE	FILE,RDOFFS		;READ OFFSET FROM THE OFFSET BLOCK.
	MOVE	A,RDOFFS+2		;GET THE OFFSET NUMBER.
	MOVEM	A,FILINF+DDOFFS		;SAVE IT IN THE RETRIEVAL.
>;IFN STANSW
	TLZN	FL,MCLOSE			;IS THIS FIRST OPERATION ON MT FILE?
	JRST	GFDMP2				;NO. NOT THE FIRST
	MOVEI	A,RECSIZ
	MOVEM	A,WC	
	SETZM	MTFILN				;ZERO RECORD COUNT INSIDE FILE
	MOVE	A,FILINF+DDNAM
	MOVEM	A,MEMSAV+FFILE
	HLLZ	A,FILINF+DDEXT
	MOVEM	A,MEMSAV+FFEXT
	MOVE	A,(Q)
	MOVEM	A,MEMSAV+FUSER
GFDMP2:

IFN STANSW,<
	MOVEI	A,2
	SUB	A,FILINF+DDOFFS
	USETI	FILE,(A)			;USETI TO THE FIRST REAL RECORD.
>;IFN STANSW

	PUSHJ	P,DUMP				;DUMP THE FILE.
	JRST	GFREDX				;OOPS.	WE HIT EOT.
GFDP2A:	CLOSE	FILE,NUPACC			;RELEASE USER'S FILE.
	MOVE	S,ALLPTR			;GET POINTER TO ALLBUF
	MOVE	L,MTAPNO			;TAPE NUMBER+ IF T THEN 400000
	TRO	L,200000			;MARK DUMPED THIS TIME(DATE FOLLOWS)
	HRRM	L,(S)				;SAVE IT.
	LDB	A,PDATE				;GET THE FILE WRITE DATE
	LDB	B,PDATEH			;HIGH DATE - DATE75
	DPB	B,[POINT 3,A,23]		;STUFF HIGH DATE - DATE75
	PUSH	S,A				;SAVE THE DATA
	MOVEM	S,ALLPTR			;PUT BACK POINTER TO ALLBUF
	MOVE	D,[FILINF+DDNAM,,A]		;GET THE NAME INTO A,B,C,D
	BLT	D,D
	MOVE	W,FILINF+DREFTM			;GET THE REFERENCE TIME
	DATE	K,				;GET THE DATE
	DPB	K,PDDATE			;SAVE DATE
	DPB	L,PTAPEN			;SAVE THE REEL NUMBER
	MOVSI	L,420000
	MOVE	X,FILINF+DDMPTM
	TRZE	X,20000				;CLEAR DUMP DATE INVALID
	JRST	GFDP3A
	ANDCAM	L,FILINF+DDMPTM			;CLEAR TDUMP AND INVALID.
	MOVSI	L,400000
	TRNN	FL,PCLASS			;IS THIS PERMANENT?
	IORM	L,FILINF+DDMPTM			;TURN ON THE TDUMP BIT.
	LDB	L,PCOUNT			;GET THE COUNT
	ADDI	L,1
	CAILE	L,7
	MOVEI	L,7
	TRNN	FL,PCLASS			;ONLY INCREMENT FOR PCLASS DUMPS
	MOVEI	L,0
	DPB	L,PCOUNT
	MOVE	X,FILINF+DDMPTM			;GET THE OLD DUMP TIME

GFDP3A:
IFE STANSW,<
	MOVEM X,LKBLK+.RBNCA
>
	TRNN FL,PCLASS
	JRST GDP3AA				;JUMP UNLESS P-CLASS
	LDB L,PCOUNT				;HOW OFTEN P-DUMPED
	TLNE X,10000				;REAP BIT ON?
	CAIGE L,2				;YES, DUMPED TWICE?
	JRST .+2				;NOT REAPING, OR NOT DUMPED TWICE
	JRST GFDP3B				;YES, TREAT LIKE PURGE
GDP3AA:	TRNE	FL,PURCOM
	JRST	GFDP3B
IFN DBGSW,<
	JRST	GFDP3B
>
IFN STANSW,<
	RENAME	FILE,A				;LONG RENAME TO UPDATE DUMPTIME
>
IFE STANSW,<
	RENAME FILE,LKBLK
>
	OUTSTR	[ASCIZ/ - RENAME to update dump time failed. /]
GFDP3B:	MOVE	S,REELPT			;GET POINTER TO REEL BLOCK
	PUSH	S,FILINF+DDNAM			;SAVE THE FILE NAME
	LDB	A,PDATE				;GET THE FILE WRITE DATE
	LDB	B,PDATEH			;HIGH DATE - DATE75
	DPB	B,[POINT 3,A,23]		;STUFF HIGH DATE - DATE75
	HLL	A,FILINF+DDEXT			;GET THE EXTENSION.
	PUSH	S,A				;SAVE THE DATA
	MOVEM	S,REELPT			;SAVE REEL POINTER
	TRNE	FL,PURCOM
	SKIPE	PPURGE
	JRST	.+2				;NOT PURGE, OR PHONY PURGE
	JRST	GFDMP3				;IN PURGE, CLOSE MTA AFTER EACH FILE
	SKIPN PPURGE				;DON'T REAP IF PPURGE
	TRNN FL,PCLASS
	JRST GDP3BA				;JUMP UNLESS P-CLASS
	LDB L,PCOUNT				;HOW OFTEN P-DUMPED
	MOVE X,FILINF+DDMPTM
	TLNE X,10000				;REAP BIT ON?
	CAIGE L,2				;YES, DUMPED TWICE?
	JRST .+2				;NOT REAPING, OR NOT DUMPED TWICE
	JRST GFDMP3				;YES, TREAT LIKE PURGE
GDP3BA:	HLLO	S,S
	AOJE	S,GFDMP3			;REELPTR IS ABOUT TO OVERFLOW
	MOVE	A,MTFILN			;HOW MANY RECORDS ON THIS TAPE?
	CAIL	A,100				;
	JRST	GFDMP3				;MT FILE IS LONG ENOUGH. CLOSE IT.
	OUTSTR	CRLF
	PUSHJ	P,DPYSER		;DISPLAY USER NAME ON DPY
	MEMSAV+LUSER,,DPYPPN		;PPN ONLY (ALSO NO. OF FEET)
	JRST	GETFIL

NNFIL:	CLOSE	UFD,				;NO FILES LEFT IN UFD. CLOSE IT
	TLO	FL,UFDEOF			;END OF FILE ON UFD
GFDMP3:	SKIPN	PPURGE				;DON'T FUTZ MTA IF PHONY PURGE
	TLNE	FL,MCLOSE			;AVOID CLOSE IF ALREADY CLOSED
	JRST	GFDMP4
IFN DBGSW,<
	SKIPN	DBGNTP
	JRST	YMTA3
	PUSHJ	P,NXTOBF		;FAKE CLOSE IF NOT OUTPUTTING
	SKIPA		;SKIPA AVAILABLE FOR PATCHING
	JRST	GFREDO	;TO FAKE AN EOT (FOR TESTING W/O TAPE)
	JRST	GFDMP4			;NO TAPE OPERATIONS IF NOT USING IT
YMTA3:
>;IFN DBGSW
	PUSHJ	P,MTACLZ			;TIME TO CLOSE TAPE FILE.
	STATZ	MTA,IOTEND			;END OF TAPE?
	JRST	GFREDO				;SHIT, WHAT A BAD TIME TO LOSE.
GFDMP4:	TRNE	FL,PURCOM			;PURGE?
	JRST	GFDP4A				;YES. DO SPECIAL
	TRNN FL,PCLASS
	JRST GDP4BA				;JUMP UNLESS P-CLASS
	LDB L,PCOUNT				;HOW OFTEN P-DUMPED
	MOVE X,FILINF+DDMPTM
	TLNE X,10000				;REAP BIT ON?
	CAIGE L,2				;YES, DUMPED TWICE?
	JRST .+2				;NOT REAPING, OR NOT DUMPED TWICE
	JRST GFDP4A				;YES, TREAT LIKE PURGE
GDP4BA:	PUSHJ	P,ALLMEM			;UPDATE ALLDIR.MEM
	SETZM	MEMSAV+CHKNUM			;PICKUP CLASS 0
	PUSHJ	P,SAVMEM
GFDP4B:	TLZE	FL,UFDEOF			;WAS THIS END OF FILE ON UFD?
	JRST	GFDP4C				;YES.
	TLON	FL,MCLOSE			;REMEMBER THAT WE JUST CLOSED TAPE
	OUTSTR	CRLF				;CRLF FOR DONE WITH FILE.
	PUSHJ	P,DPYSER		;DISPLAY USER NAME ON DPY
	MEMSAV+LUSER,,DPYPPN		;PPN ONLY (ALSO NO. OF FEET)
	JRST	ALLINI				;CONTINUE THE DUMP OF THIS AREA

GFDP4C:	TLO	FL,MCLOSE			;WE'LL HAVE TO OPEN A NEW MTA FILE
	POPJ	P,				;YES. RETURN.

GFDP4A:	PUSHJ	P,ALLMEM			;SAVE REEL DATA (IN ALLDIR.MEM)
	SKIPN	PPURGE				;OR PHONY PURGE?
	TLNE	FL,UFDEOF			;END OF UFD?
	JRST	GFDP4B				;YES - NOTHING TO DELETE
	MOVEI	A,0
	MOVE	D,(Q)				;GET PPN
IFN DBGSW,<
	JRST	GFDP4B
>
	RENAME	FILE,A
	OUTSTR	[ASCIZ/ - DELETE failed /]
	JRST	GFDP4B

TAPCMP:	MOVE	B,MEMSAV+TTCNT
TAPCP1:	JUMPE	B,CPOPJ				;DIRECT RETURN IF NOT IN THIS DUMP
	HLRZ	C,MEMSAV+TTBUF-1(B)		;LOW BOUND
	HRRZ	D,MEMSAV+TTBUF-1(B)		;HIGH BOUND
	CAML	A,C				;SKIP IF A TOO LOW
	CAMLE	A,D				;SKIP IF A IN RANGE.
	SOJA	B,TAPCP1			;OUT OF BOUNDS. TRY ANOTHER TERM
	JRST	CPOPJ1				;TAPE WAS INCLUDED IN THIS DUMP.

PUTEST:	HRRZ	R,TBASE			;BASE OF ALL PURGE TERMS SCANNED
	JRST	.+2
PUTST0:	ADDI	R,FSLEN
	CAML	R,FSPTR			;FIRST ADDRESS ABOVE PURGE TERMS
	JRST	GETFIL			;THERE ARE NO PURGE TERMS (LEFT ANYMORE)
	MOVE	A,(R)
	CAME	A,STRNAM		;DEVICE NAME MATCHES THIS STRUCTURE?
	JRST	PUTST0			;NO.  GET NEXT TERM
	MOVE	B,2(R)			;GET FLAGS
	MOVE	A,(Q)			;GET PROJ,PROG
	CAMN	A,3(R)			;MATCHES THIS TERM EXACTLY?
	JRST	PUTST1			;YES.  LOOK FURTHER
	HRRZ	C,3(R)
	CAIE	C,(A)
	TRNE	B,ALLPRG
	JRST	.+2			;PRG MATCHES OR IS *
	JRST	PUTST0			;PRG DOESN'T MATCH.
	HLRZ	A,(Q)
	HLRZ	C,3(R)
	CAIE	A,(C)
	TRNE	B,ALLPRJ
	JRST	PUTST1			;THIS MATCHES SOMEWHAT
	JRST	PUTST0

PUTST1:	MOVE	A,1(R)
	CAME	A,FILBLK
	TRNE	B,ALLFIL
	JRST	.+2
	JRST	PUTST0
	HLLZ	A,FILBLK+1
	HLLZ	C,2(R)
	CAME	A,C
	TRNE	B,ALLEXT
	JRST	.+2
	JRST	PUTST0
;ACCEPT THIS FILE NAME.
	TRNE	B,ALLEXT!ALLFIL!ALLPRG!ALLPRG	;ANYTHING WILD?
	JRST	PUTST2				;YES.  WE'LL HAVE TO KEEP THIS TERM
	HRLI	R,FSLEN(R)			;SOURCE IN R LEFT, DEST IN RIGHT
	MOVNI	B,FSLEN
	ADDB	B,FSPTR				;CALC ENDING ADDRESS+1
	BLT	R,-1(B)				;POSSIBLY MOVE "NOTHING"
PUTST2:	MOVE	A,FILBLK
	HLLZ	B,FILBLK+1
	MOVE	D,(Q)
	SKIPN	PPURGE			;PHONY PURGE?
	JRST	GFLOOK			;REAL PURGE
	MOVE	B,FILBLK+1
	MOVE	C,FILBLK+2		;DATE AND TIME FROM UFD
	MOVE	Y,[A,,FILINF]		;HERE IF DOING PHONY PURGE!
	BLT	Y,FILINF+3		;STUFF NAME,EXT,PPN WHERE THEY'RE NEEDED
	JRST	GFDMP1	

	RADIX	5+5
MONTHB:	0			;JAN
	31			;FEB
	59			;MAR (ASSUMING LEAP YEAR!)
	90			;APR
	120			;MAY
	151			;JUN
	181			;JUL
	212			;AUG
	243			;SEP
	273			;OCT
	304			;NOV
	334			;DEC
	RADIX 5+3

;CALL WITH A CONTAINING SYSTEM FORMAT DATE.
;RETURN A CONTAINING NUMBER OF DAYS SINCE JAN 1, 1964
;B AND D CLOBBERED
DATCNV:	IDIVI	A,37		;DAY OF THE MONTH INTO B
	MOVEI	D,1(B)		;DAY INTO D
	IDIVI	A,14		;MONTHS IN B, YEARS IN A
	ADD	D,MONTHB(B)	;ADD NUMBER OF DAYS BEFORE THE 1st OF MONTH
	TRNN	A,3		;SKIP UNLESS LEAP YEAR
	CAIGE	B,2		;LY. SKIP IF AFTER FEBRUARY
	SUBI	D,1		;NOT LEAP YEAR. OR BEFORE MARCH
	MOVEI	B,3(A)
	LSH	B,-2		;NUMBER OF LY SINCE '64 NOT INCLUDING THIS YEAR
	IMULI	A,555		;NUMBER OF YEARS TIMES 365
	ADDI	A,(B)		;PLUS NUMBER OF PRIOR LEAP YEARS
	ADDI	A,(D)		;PLUS NUMBER OF DAYS SO FAR THIS YEAR.
	POPJ	P,
;GFREDX GFREDO PIK4 PIK5 NOMTA8 GFRED1 GFRD1A GFRED2 PIK0A GFRED4 GFRED5 GFRED6 GFPICK PIK0

	SUBTTL	GFREDO	WHAT TO DO AT END OF TAPE
GFREDX:	CLOSE	FILE,NUPACC
GFREDO:	OUTSTR	[ASCIZ/	not saved. - Physical end of tape.
/]
	MOVE	A,REELPT
	MOVEM	A,MEMSAV+PTRSAV		;SAVE REELPT (BEFORE PIK4!)
PIK4:	MOVEI	A,4
	MOVEM	A,MEMSAV+CHKNUM
	SETZM	PICKON
	PUSHJ	P,SAVMEM		;SAVE STATE
	PUSHJ	P,FIXPOS		;FIX THE MTAPE POSITION.
	TLO	FL,IGNEOT		;TURN ON THE IGNORE EOT INDICATOR
	PUSHJ	P,TAPTAI		;WRITE A TAPE TAIL
	TLZ	FL,IGNEOT		;
PIK5:	MOVEI	A,5
	MOVEM	A,MEMSAV+CHKNUM
	SETZM	PICKON
	PUSHJ	P,SAVMEM
IFN DBGSW,<
	SKIPE	DBGNTP
	JRST	NOMTA8
>;IFN DBGSW
	PUSHJ	P,MTAREW		;REWIND THE TAPE
	GETSTS	MTA,A
	TRZ	A,IOIMPM+IOTEND		;CLEAR SOME BITS
	SETSTS	MTA,(A)			;SET STATUS.

;LOOP THROUGH THE FILES WE DUMPED AND RENAME THEM.
NOMTA8:	HLRO	Y,MEMSAV+PTRSAV		;GET THE COUNT
	ADDI	Y,REELBF+177
	HLL	Y,MEMSAV+PTRSAV		;GET THE COUNT AGAIN.
GFRED1:	POP	Y,B			;LOAD EXTENSION
	POP	Y,A			;FILE NAME
	CAMGE	Y,[IOWD 177,REELBF+1]	;THIS IS SMALLEST LEGAL POINTER
	JRST	GFRED2			;JUMP IF SMALLER THAN SMALLEST LEGAL
	HLLZ	B,B
	SETZB	C,W
	SETZ	X,
	MOVE	D,REELBF		;GET PPN FROM HERE.
IFN STANSW,<
	LOOKUP	FILE,A			;DO EXTENDED LOOKUP
	JRST	GFRD1A			;FILE NOT THERE.
	MOVE	D,REELBF
>
IFE STANSW,<
	MOVEM A,LKBLK+.RBNAM
	MOVEM B,LKBLK+.RBEXT
	MOVEM D,LKBLK+.RBPPN
	LOOKUP FILE,LKBLK
	 JRST GFRD1A
	MOVE X,LKBLK+.RBNCA
>
	TLO	X,20000			;SET DUMP DATE INVALID BIT
	MOVE	Z,[A,,FILBLK]
	BLT	Z,FILBLK+3
	CLOSE	FILE,NUPACC
IFN DBGSW,<
	JRST	GFRED1
>
IFN STANSW,<
	RENAME	FILE,A
>
IFE STANSW,<
	MOVEM X,LKBLK+.RBNCA
	RENAME FILE,LKBLK
>
	JRST	[OUTSTR	[ASCIZ/
Unable to rename file to set dump date invalid. /]
		PUSHJ	P,TYFIL
		OUTSTR	CRLF
		JRST	.+1]
GFRD1A:	CLOSE	FILE,NUPACC
	JRST	GFRED1

GFRED2:
	PUSHJ	P,PUTTAP		;UPDATE DART.TAP WITH CURRENT TAPE NUMBER.
	AOS	A,TAPNO			;INCREMENT FOR NEXT TAPE NUMBER.
	MOVEM	A,MEMSAV+TAPNUM
	PUSHJ	P,DOMOUNT		;REQUIRE MOUNT OPERATION NOW.

PIK0A:	MOVE	A,(Q)			;GET THE CURRENT USER NAME
	MOVSI	B,'UFD'
	SETZ	C,
	MOVE	D,GOD
	MOVE	X,[A,,FILBLK]
	BLT	X,FILBLK+3
	LOOKUP	UFD,A
	JRST	[TRZ	FL,SAFETY
		PUSHJ	P,LCHECK
		JFCL
		POPJ	P,]
GFRED4:	PUSHJ	P,UFDRD			;READ FROM UFD
	JRST	GETUD1			;HOPELESS CONFUSION. DO IT OVER.
	MOVEM	A,FILBLK
IFN STANSW,<
	MOVE	D,[-UFDN+1,,1]		;READ MORE
>
GFRED5:	PUSHJ	P,UFDRD
	JFCL
	MOVEM	A,FILBLK(D)
IFN STANSW,<
	AOBJN	D,GFRED5
>
	MOVE	A,FILBLK
	HLLZ	B,FILBLK+1
	CAMN	A,MEMSAV+FFILE		;SAME NAME
	CAME	B,MEMSAV+FFEXT		;AND EXTENSION
	JRST	GFRED4			;NO MATCH. KEEP LOOKING
	MOVE	S,[IOWD 200,REELBF]
	PUSH	S,(Q)
	MOVEM	S,REELPT
	MOVE	S,[IOWD 400,ALLBUF]
	PUSH	S,(Q)
	MOVEM	S,ALLPTR
	SETZM	1(S)
	SKIPN	PICKON
	JRST	GFRED6			;JUMP IF NOT DOING A PICKUP
	SETZM	PICKON			;THIS IS THE NAME WE LAST LOOKED AT
	JRST	GETFIL			;SO GET THE NEXT NAME.

GFRED6:	TRNN	FL,PURCOM		;SKIP IF PURGING.
	JRST	GETFL2			;JUMP TO CODE TO CONTINUE DUMPS.
	MOVE	D,(Q)			;GET PPN
	JRST	GFLOOK			;GO DUMP&PURGE - PUTEST ALREADY DONE

GFPICK:	SKIPG	A,MEMSAV+CHKNUM
	JRST	PIK0			;USUAL TYPE PICKUP.
	CAIN	A,4
	JRST	PIK4
	CAIN	A,5
	JRST	PIK5
	OUTSTR	[ASCIZ/Internal confusion - illegal PICKUP number at GFPICK
/]
	JRST	RESTAR

PIK0:	MOVE	A,MEMSAV+LFILE		;GET THE NAME OF THE LAST FILE INSPECTED
	MOVEM	A,MEMSAV+FFILE		;SAVE FOR GFRED4
	HLLZ	A,MEMSAV+LEXT
	MOVEM	A,MEMSAV+FFEXT		;SAVE EXTENSION TOO.
	JRST	PIK0A			;WHIZ
;MFDSOR MFDSR1 MFDSR2 MFDS21 MFSOR0 MFSOR1 MFSOR3 MFSSOR MFSSR1 MFSSR2 MFSSR3 MFDSR3 MFDSR4 MFDSR7 MFDSR5 MFDSR6

	SUBTTL	MFDSOR	READ IN THE MFD AND SORT IT.
MFDSOR:	MOVE	A,GOD			;LOOKUP THE MFD
	MOVSI	B,'UFD'
	SETZ	C,
	MOVE	D,GOD
	MOVE	X,[A,,FILBLK]
	BLT	X,FILBLK+3
	TRZ	FL,SAFETY
	LOOKUP	UFD,A
	JRST	[PUSHJ P,LCHECK
		JFCL
		SETZM	MFDPTR
		CLOSE	UFD,
		POPJ	P,]
IFN DBGSW,<
	MOVEI	A,7			;DEBUGIING: ONLY READ THIS MANY MFD ENTRIES
	MOVEM	A,DBGMFC
>;IFN DBGSW
	MOVE	Q,.JBFF			;GET POINTER TO WHERE TO STUFF THE STUFF
	MOVEI	Z,(Q)			;.JBFF HERE TOO
MFDSR1:	PUSHJ	P,UFDRD			;READ DATA
	JRST	MFDSR5			;END OF FILE.
	JUMPE	A,MFDSR3		;FLUSH 3 MORE TERMS.
IFE STANSW,<
	CAMN A,GOD
	JRST MFDSR3			;I DON'T SEE WHY TO SAVE UFDS
>
IFN DBGSW,<
	SOSGE	DBGMFC			;ONLY READ PART OF MFD
	JRST	MFDSR5
>;IFN DBGSW
	CAMGE	Q,.JBREL		;ARE WE IN BOUNDS?
	JRST	MFDSR2			;YES.
	MOVE	B,.JBREL		;NO. PICKUP .JBREL
	ADDI	B,2000			;ADD ANOTHER K
	CORE	B,			;CORE UP
	JRST	NOCORE
MFDSR2:	HRRZ	B,A			;SAVE PRG
	HLRZ	C,A			;SAVE PRJ
	PUSHJ	P,UFDRD			;READ
	SETZ	A,
	HLLZ	A,A
	CAME	A,['UFD   ']
	JRST	MFDSR4
	JUMPE	C,MFDSR4
	JUMPE	B,MFDSR4
IFN IRCPPN,<
	TRNE B,777740
	TRNN C,777740
	JRST MFDS21			;RIDICULOUS IRCAM PPNS!
	TRNN C,77
	JRST MFDS21
>
IFN STANSW!IRCPPN,<
	TRNE	B,770000		;LEFT ADJUST THE PRG
	JRST	.+3
	LSH	B,6
	JUMPN	B,.-3
	TRNE	C,770000
	JRST	.+3
	LSH	C,6
	JUMPN	C,.-3
>
MFDS21:	HRLZ	A,B
	HRR	A,C			;A HAS KLUGED UP COPY OF PPN.
IFN IRCPPN,<
	TDO A,[400000,,400000]		;LOGICAL COMPARES NOT ARITH
>
IFN STANSW,<
	CAIE	B,'SYS'			;IS THIS SPECIAL?
	CAIN	B,'3  '			;SPECIAL
	JRST	MFSSOR			;YES.
	CAIN	B,'2  '			;SPECIAL?
	JRST	MFSSOR			;YES.
>
MFSOR0:	MOVEI	B,(Q)			;INSERTION SORT THE NEW ITEM
MFSOR1:	CAILE	B,(Z)			;ARE WE OFF THE END?
	CAML	A,-1(B)			;
	JRST	MFSOR3			;OFF THE END. OR CORRECT POSITION.
	MOVE	X,-1(B)			;PICKUP A BIG TERM
	MOVEM	X,(B)			;AND SAVE IT IN THE HOLE
	SOJA	B,MFSOR1

MFSOR3:	MOVEM	A,(B)			;SAVE THIS PPN.
	AOJA	Q,MFDSR4

IFN STANSW,<
MFSSOR:	MOVEM	A,(Q)			;SAVE FOR END CASE.
	EXCH	A,(Z)			;SAVE NEW PPN WHERE WE'LL SEE IT.
	MOVEM	A,(Q)			;RESET
	MOVEI	B,(Z)
	MOVE	A,(Z)
MFSSR1:	CAMG	B,.JBFF
	JRST	MFSSR3			;OFF THE EDGE OF THE WORLD
	MOVE	X,A
	XOR	X,-1(B)
	JUMPL	X,[JUMPL A,MFSSR3	;JUMP IF DIFFERENT SIGNS 
		JRST MFSSR2]		;IF A NEGATIVE THEN DONE. ELSE EXCH
	CAML	A,-1(B)
	JRST	MFSSR3
MFSSR2:	MOVE	X,-1(B)
	MOVEM	X,(B)
	SOJA	B,MFSSR1

MFSSR3:	MOVEM	A,(B)
	MOVE	A,(Q)
	AOJA	Z,MFSOR0		;WOW.
>

MFDSR3:	PUSHJ	P,UFDRD			;FLUSH EXTENSION.
	JFCL
MFDSR4:
IFN STANSW,<
	MOVE	D,[-UFDN+2,,2]
MFDSR7:	PUSHJ	P,UFDRD			;FLUSH REST OF DIRECTORY ENTRY
	JFCL
	AOBJN	D,MFDSR7
>
	JRST	MFDSR1			;LOOP UNTIL FILE EXHAUSTED.

MFDSR5:	MOVE	A,.JBFF			;GET OLD .JBFF
	SUBI	A,(Q)			;GET -WC IN A.
	EXCH	Q,.JBFF			;OLD .JBFF INTO Q TOO.
	HRL	Q,A
	MOVEM	Q,MFDPTR		;SAVE MFD POINTER.
MFDSR6:
IFN STANSW!IRCPPN,<
	HLLZ	B,(Q)			;GET THE FUNNY PRG
	HRRZ	C,(Q)			;AND THE FUNNY PRJ
	TLNE	B,77	
	JRST	.+3
	LSH	B,-6
	JRST	.-3
	TRNE	C,77
	JRST	.+3
	LSH	C,-6
	JRST	.-3
	HLL	C,B
IFN IRCPPN,<
	TDZ C,[400000,,400000]
>
	MOVSM	C,(Q)
	AOBJN	Q,MFDSR6
>
IFN DBGSW,<
	MOVE	Q,MFDPTR		;PICK UP MFD POINTER
	AOBJN	Q,.+1			;THROW AWAY FIRST ENTRY ([2,2])
	MOVEM	Q,MFDPTR
>;IFN DBGSW
	POPJ	P,
;ALLMIN ALLMI1 ALLMI2 ALLMEM REELMX REELM0 REELM1

	SUBTTL	PRESERVATION OF DUMPING INFORMATION

ALLMIN:					;ENTER HERE TO INITIALIZE ALLDIR.MEM,
					;ASSUMING IT ALREADY EXISTS!
	MOVE	A,['ALLDIR']
	MOVSI	B,'MEM'	
	MOVEI	C,0
ALLMI1:	MOVE	D,DUMPER
IFN STANSW,<
	LOOKUP	MEM,A
>
IFE STANSW,<
	MOVEM A,LKBLK+.RBNAM
	MOVEM B,LKBLK+.RBEXT
	MOVEM D,LKBLK+.RBPPN
	LOOKUP MEM,LKBLK
>
	JRST	[OUTSTR	[ASCIZ/I can't find ALLDIR.MEM !!
/]
		HALT	ALLMI1]
IFN STANSW,<
	MOVS	D,D
>
IFE STANSW,<
	MOVE D,LKBLK+.RBSIZ
>
	MOVMM	D,ALLSIZ		;GET FILE SIZE
ALLMI2:
IFN STANSW,<
	MOVE	D,DUMPER
	ENTER	MEM,A			;GET IT OPEN FOR READ-ALTER
>
IFE STANSW,<
	ENTER MEM,LKBLK
>
	JRST	[OUTSTR	[ASCIZ/ENTER to open ALLDIR.MEM for read-alter failed.
/]
		HALT	ALLMI2]
	MOVE	A,ALLSIZ
	IDIVI	A,200			;REMAINDER IN B
	JUMPE	B,CPOPJ			;EXACT BUFFER BOUNDARY, DON'T PRIME BUFFER
	USETI	MEM,1(A)
	INPUT	MEM,[IOWD 200,MEMBLK
			0]		;PRIME BUFFER WITH LAST RECORD
	POPJ	P,


ALLMEM:	MOVEI	S,ALLBUF		;ADDRESS OF DATA BASE
	HLRO	TX,ALLPTR		;GET THE COUNT
	ADDI	TX,400			;ADD THE OFFSET
	HRR	A,ALLPTR
	CAIG	TX,1			;MORE THAN ONE ITEM TO DUMP?
	POPJ	P,			;NO. IGNORE THIS
	ADDI	TX,1			;COUNT ONE MORE THING TO DUMP
	SETZM	1(A)			;AND ZERO THE LAST CELL
	MOVE	D,ALLSIZ		;GET FILE SIZE
	IDIVI	D,200			;REMAINDER IN W. 
	MOVEI	X,(D)			;SAVE USET POINTER

;NOW. TX CONTAINS THE NUMBER OF WORDS TO BLT. W CONTAINS INDEX TO MEMBLK
	MOVSI	A,(S)			;GET THE DATA SOURCE.
	HRRI	A,MEMBLK(W)		;DATA DESTINATION
	MOVEI	B,MEMBLK(W)		;GET THE DESTINATION AGAIN
	ADDI	B,-1(TX)		;NUMBER OF WORDS TO MOVE
	BLT	A,(B)			;DO THE BLT.
	USETO	MEM,1(X)		;DO A USET TO WRITE THE RECORD.
	ADDI	W,(TX)			;COMPUTE WORD COUNT OF RECORD.
	MOVN	W,W			;NEGATE WORD COUNT
	HRLZ	W,W			;-WC IN LEFT SIDE
	HRRI	W,MEMBLK-1		;MA-1 IN RIGHT
	MOVEI	X,0			;STOP THE DUMP MODE COMMAND LIST
	OUTPUT	MEM,W
IFN STANSW,<
	MTAPE	MEM,['GODMOD'
			17]		;UPDATE RETRIEVAL, TO AVOID CRASH LOSSAGE
>
	ADDM	TX,ALLSIZ		;ADD NEW STUFF INTO ALLSIZ
	HLRO	W,W
	MOVM	W,W			;GET WORD COUNT BACK
	IDIVI	W,200			;REMAINDER IN X
	JUMPE	X,CPOPJ			;NO PARTIAL BUFFER : RETURN
	JUMPE	W,CPOPJ			;PARTIAL BUFFER ALREADY AT LOW END
	IMULI	W,200			;GET DISTANCE TO BLT
	MOVSI	W,MEMBLK(W)		;DATA SOURCE
	HRRI	W,MEMBLK		;DATA DESTINATION
	MOVEI	X,MEMBLK-1(X)		;LAST DESTINATION
	BLT	W,(X)			;SUFFLE PARTIAL BUFFER TO LOW END
	
	POPJ	P,			;RETURN, SMILING.

REELMX:	TRZ	FL,PCLASS		;ENTER HERE FOR MRESTORE
	MOVE	A,TAPNO
	TRZN	A,400000
	TRO	FL,PCLASS
	MOVEM	A,TAPNO
REELM0:	MOVE	A,TAPNO			;GET THE TAPE NUMBER
	MOVEM	A,MEMSAV+TAPNUM		;THIS SHOULDN'T BE NEEDED.
	MOVE	C,[POINT 6,D,35]
	MOVE	D,['P00000']
	TRNN	FL,PCLASS
	HRLI	D,'T00'
REELM1:	IDIVI	A,12
	ADDI	B,'0'
	DPB	B,C
	ADD	C,[060000,,0]
	CAME	C,[360600,,D]
	JUMPN	A,REELM1
	MOVE	A,TAPNO
	TRNN	FL,PCLASS
	TRO	A,400000
	MOVEM	A,MTAPNO		;SAVE SPECIAL VERSION OF TAPE NUMBER
	MOVEM	D,TAPNAM		;SAVE NAME OF THE TAPE.
	POPJ	P,
;SAVMEM SAVME1 SAVME2 SAVME4 SAVME6 SAVORA SAVME3 SAVME5 SAVME7

	SUBTTL	SAVMEM	SAVE DUMP STATUS FOR PICKUPS.

SAVMEM:	TLON	FL,DMEMRA		;SET/SKIP ON DART.MEM ALREADY OPEN RA
	JRST	SAVORA			;GO OPEN IT UP IN READ ALTER
SAVME1:	USETO	DSKMEM,1		;POSITION TO FIRST RECORD
	OUTPUT	DSKMEM,[IOWD 200+MEMLEN,REELBF
			0]
	POPJ	P,


SAVME2:	OUTSTR	[ASCIZ/ENTER to make DART.MEM has lost.
/]
	HALT	SAVME3

SAVME4:	OUTSTR	[ASCIZ/I can't find the DART.MEM I just created !!
/]
	HALT	SAVME5

SAVME6:	OUTSTR	[ASCIZ/ENTER to open DART.MEM for read-alter failed.
/]
	HALT	SAVME7


SAVORA:	MOVE	A,['DART  ']
	MOVSI	B,'MEM'
	MOVEI	C,0
	MOVE	D,DUMPER
SAVME3:	ENTER	DSKMEM,A		;CREATE DART.MEM
	JRST	SAVME2
	OUTPUT	DSKMEM,[IOWD 200+MEMLEN,REELBF	;OUTPUT FIRST TIME
			0]
	CLOSE	DSKMEM,			;CLOSE, TO CREATE DIRECTORY ENTRY
	MOVE	D,DUMPER
SAVME5:	LOOKUP	DSKMEM,A		;GO FIND IT AGAIN
	JRST	SAVME4
	MOVE	D,DUMPER
SAVME7:	ENTER	DSKMEM,A		;AND OPEN IT FOR READ-ALTER
	JRST	SAVME6
	POPJ	P,
;SPLIT SPLIT1 SPLIT2 SPLIT3 SPLIT4 SPLIT5 SPLIT6 SPLIT7 SPLITX SPLITZ SPLITA SPLIT8

	SUBTTL	SPLIT
;SPLIT ALLDIR.MEM 
; INTO ALLDIR.DAT (CONTAINING WHERE LAST DUMPED FOR ALL FILES IN MFD)
;  AND DTAPES.DAT (CONTAINING WHERE DUMPED AND WHEN WRITTEN FOR ALL FILES
;		   ON ALL TAPES IN THIS DUMP)

;CHANNEL	FILE		I/O	BUFFER	GET(PUT) ROUTINE

;UFD		ALLDIR.MEM	I(B)	UFDBUF	UFDRD	(SKIPS UNLESS EOF)
;FILE		ALLDIR.DAT	O(B)	FOBUF	DFWRIT
;DSKMSC		DTAPES.DAT	O(D)	REELBF	DMPUT, DMINI

SPLIT:	CLOSE	UFD,				;CLOSE ALL CHANNELS THAT WE NEED
	TRNN	FL,PURCOM		;SKIP ALLDIR.DAT OPERATIONS IF PURGE COMMAND
	CLOSE	FILE,
	RELEAS	DSKMSC,
	MOVEI	A,17
	MOVE	B,STRNAM
	MOVEI	C,0
	OPEN	DSKMSC,A
	PUSHJ	P,NODEV
SPLIT1:	MOVE	A,['ALLDIR']
	MOVSI	B,'MEM'
	MOVEI	C,0
	MOVE	D,DUMPER
	LOOKUP	UFD,A				;SEEK INPUT FILE.
	JRST	[OUTSTR	[ASCIZ/ALLDIR.MEM lookup failed in SPLIT !!
/]
		HALT	SPLIT1]
	TRNE	FL,PURCOM			;IS THIS PURGE COMMAND?
	JRST	SPLIT3				;YES, SKIP ALLDIR.DAT OPERATIONS
	SETSTS	FILE,10				;FLUSH SPECIAL MODES OF FILE CHANNEL
	MOVEI	A,ALTBUF			;GET ROOM FOR SOME BUFFERS
	SETZM	ALTBUF
	EXCH	A,.JBFF
	OUTBUF	FILE,2				;MAKE BUFFERS FOR FILE OUTPUT
	MOVEM	A,.JBFF				;RESET .JBFF
SPLIT2:	MOVE	A,['ALLDIR']
	MOVSI	B,'DAT'
	MOVEI	C,0
	MOVE	D,DUMPER
	ENTER	FILE,A				;SELECT OUTPUT FILE.
	JRST	[OUTSTR	[ASCIZ/Unable to enter ALLDIR.DAT in SPLIT.
/]
		HALT	SPLIT2]
SPLIT3:	MOVE	A,['DTAPES']
	MOVSI	B,'DAT'
	MOVEI	C,0
	MOVE	D,DUMPER
	ENTER	DSKMSC,A
	JRST	[OUTSTR	[ASCIZ/Unable to enter DTAPES.DAT in SPLIT.
/]
		HALT	SPLIT3]
	SETZM	DSKMM0			;ZERO RECORD COUNT
	SETOM	DSKMM3			;SET BINARY MODE
	PUSHJ	P,DMINI
SPLIT4:	PUSHJ	P,UFDRD			;READ PPN FROM ALLDIR.MEM
	JRST	SPLITZ			;EOF
	MOVEM	A,SPPN			;SAVE PPN
	SETOM	DTAPPN			;FLAG NEW PPN READ(FOR DTAPES.DAT)
	TRNN	FL,PURCOM		;SKIP ALLDIR.DAT OPERATIONS IF PURGE COMMAND
	PUSHJ	P,DFWRIT		;WRITE PPN TO ALLDIR.DAT
SPLIT5:	PUSHJ	P,UFDRD			;READ FILENAME (OR ZERO) FROM ALLDIR.MEM
	PUSHJ	P,SPLITX		;EOF - SHOULDN'T HAPPEN
	JUMPE	A,SPLIT7		;GO PROCESS ZERO ENTRY
	MOVEM	A,SNAME			;SAVE FILENAME
	TRNN	FL,PURCOM		;SKIP ALLDIR.DAT OPERATIONS IF PURGE COMMAND
	PUSHJ	P,DFWRIT		;WRITE FILENAME TO ALLDIR.DAT
	PUSHJ	P,UFDRD			;READ EXT,,TAPNO FROM ALLDIR.MEM
	PUSHJ	P,SPLITX		;EOF - SHOULDN'T HAPPEN
	TRNN	A,200000		;WAS FILE DUMPED THIS TIME?
	JRST	[TRNN	FL,PURCOM	;(SKIP ALLDIR.DAT OPERATIONS IF PURGE)
		PUSHJ	P,DFWRIT	;NO, GO WRITE EXT,,TAPNO TO ALLDIR.DAT
		JRST	SPLIT5]		;AND GO GET A NEW FILENAME
	MOVEM	A,SEXT			;YES, SAVE EXT,,TAPNO
	TRZ	A,200000		;REMOVE FLAG BIT
	TRNN	FL,PURCOM		;SKIP ALLDIR.DAT OPERATIONS IF PURGE COMMAND
	PUSHJ	P,DFWRIT		;WRITE EXT,,TAPNO TO ALLDIR.DAT
	SKIPN	DTAPPN			;HAVE WE WRITTEN TO DTAPES.DAT THIS PPN?
	JRST	SPLIT6			;YES, DON'T WRITE OUT PPN AGAIN
	MOVE	A,SPPN			;PICK UP SAVED PPN
	PUSHJ	P,DMPUT			;WRITE IT TO DTAPES.DAT
	SETZM	DTAPPN			;FLAG PPN ALREADY WRITTEN
SPLIT6:	MOVE	A,SNAME			;PICK UP SAVED FILENAME
	PUSHJ	P,DMPUT			;WRITE IT TO DTAPES.DAT
	MOVE	A,SEXT			;PICK UP SAVED EXT,,TAPNO
	PUSHJ	P,DMPUT			;WRITE IT TO DTAPES.DAT
	PUSHJ	P,UFDRD			;READ DATE WRITTEN FROM ALLDIR.MEM
	PUSHJ	P,SPLITX		;EOF - SHOULDN'T HAPPEN
	PUSHJ	P,DMPUT			;WRITE IT TO DTAPES.DAT
	JRST	SPLIT5			;GO GET A NEW FILENAME
SPLIT7:	TRNN	FL,PURCOM		;SKIP ALLDIR.DAT OPERATIONS IF PURGE COMMAND
	PUSHJ	P,DFWRIT		;WRITE ZERO TO ALLDIR.DAT
	SKIPN	DTAPPN			;HAVE WE WRITTEN TO DTAPES.DAT THIS PPN?
	PUSHJ	P,DMPUT			;YES, WRITE ZERO TO DTAPES.DAT ALSO
	JRST	SPLIT4			;GO GET A NEW PPN

SPLITX:	OUTSTR	[ASCIZ/Unexpected EOF on ALLDIR.MEM in SPLIT.
/]
	HALT	.


SPLITZ:	CLOSE	UFD,			;CLOSE DART.MEM INPUT
	TRNE	FL,PURCOM			;IS THIS PURGE COMMAND?
	JRST	SPLITA				;YES, SKIP ALLDIR.DAT OPERATIONS
	CLOSE	FILE,			;CLOSE ALLDIR.DAT OUTPUT
	SETSTS	FILE,10+DMPBIT+GARBIT	;SET SPECIAL STATUS
SPLITA:	MOVE	A,DSKMM2
	SUBI	A,200			;GET -WC OF LAST DTAPES.DAT REC
	JUMPGE	A,SPLIT8		;NO WORK TO DO
	HRLZ	A,A			;-WC IN LEFT HALF
	HRRI	A,REELBF-1		;MA-1 IN RIGHT HALF
	MOVEI	B,0			;STOP THE DUMP MODE COMMAND LIST
	OUTPUT	DSKMSC,A		;OUTPUT LAST REC
	STATZ	DSKMSC,740000
	JRST	[OUTSTR	[ASCIZ/DTAPES.DAT output error.
/]
		HALT	.]
SPLIT8:	CLOSE	DSKMSC,
	RELEAS	DSKMSC,
	MOVEI	A,17
	MOVSI	B,'DSK'
	MOVEI	C,0
	OPEN	DSKMSC,A
	PUSHJ	P,NODEV
	POPJ	P,
;RT RD MERGE XMERGE YMERGE ZMERGE MERGRT MTSRT1 MTSRT2 MTSRT8 MTSRT3 MTSR3A MTSR3B MTSR3X MTSRT5 MTSRT4 MTSRT7

	SUBTTL	MERGE
;MERGE TAPE DATA (FROM DTAPES.DAT) INTO DART.DAT
;CREATE ASCII TAPE DATA FILE

;CHANNEL	FILE		I/O	BUFFER	GET(PUT) ROUTINE

;UFD		DART.DAT 	I(B)	UFDBUF	UFDRD	(SKIPS UNLESS EOF)
;MEM		DTAPES.DAT	I(D)	MEMBLK	TNREAD	(SKIPS UNLESS EOF)
;FILE		DART.DAT 	O(B)	FOBUF	DFWRTX
;DSKMSC		P/TNNNNN.LST	O(D)	REELBF	DMPUT, DMINI

COMMENT $	MERGE DIAGRAM
	D=DART.DAT FILE		T=TAPE DATA (FROM ALLDIR.MEM)

	DEOF_TEOF_FALSE;
	DNEED_TNEED_TRUE;
RT:	IF TEOFTNEED THEN READ TNAME AND TDATA; SORT;
	TNEED_FALSE;
	IF EOF THEN TEOF_TRUE;
RD:	IF DEOFDNEED THEN READ DNAME;
	DNEED_FALSE;
	IF EOF THEN DEOF_TRUE;
	IF DEOFTEOF THEN DONE;
	IF DEOF THEN WRITE TDATA; TNEED_TRUE; GO TO RT;
	IF TEOF THEN WRITE DDATA; DNEED_TRUE; GO TO RD;
	IF TNAME > DNAME THEN WRITE DDATA; DNEED_TRUE; GO TO RD;
	IF TNAME < DNAME THEN WRITE TDATA; TNEED_TRUE; GO TO RT;
	MERGE DDATA AND TDATA AND WRITE BOTH;
	TNEED_DNEED_TRUE; 	GO TO RT;
$

MERGE:	TLZ	FL,TEOF!DEOF!DNEED!TNEED	;INITIALIZE FLAGS
	CLOSE	UFD,				;CLOSE ALL CHANNELS THAT WE NEED
	CLOSE	FILE,
	CLOSE	MEM,
	RELEAS	DSKMSC,
	MOVEI	A,17
	MOVE	B,STRNAM
	MOVEI	C,0
	OPEN	DSKMSC,A
	PUSHJ	P,NODEV
	MOVE	A,['DART  ']			;READ THE MASTER FILE
	MOVSI	B,'DAT'
	MOVEI	C,0
	MOVE	D,DUMPER
	LOOKUP	UFD,A				;SEEK INPUT FILE.
	TLO	FL,DEOF				;NO INPUT FILE. SET EOF.

	SETSTS	FILE,10				;FLUSH SPECIAL MODES OF FILE CHANNEL
	MOVEI	A,ALTBUF			;GET ROOM FOR SOME BUFFERS
	SETZM	ALTBUF
	EXCH	A,.JBFF
	OUTBUF	FILE,2				;MAKE BUFFERS FOR FILE OUTPUT
	MOVEM	A,.JBFF				;RESET .JBFF
XMERGE:	MOVE	A,['DART  ']			;WRITE OVER THE MASTER FILE.
	MOVSI	B,'DAT'
	MOVEI	C,0
	MOVE	D,DUMPER
	ENTER	FILE,A				;SELECT OUTPUT FILE.
	JRST	[OUTSTR	[ASCIZ/Unable to enter DART.DAT to write merge.
/]
		HALT	XMERGE]
YMERGE:	MOVE	A,['DTAPES']			;GET THE INPUT FILE.
	MOVSI	B,'DAT'
	MOVEI	C,0
	MOVE	D,DUMPER
IFN STANSW,<
	LOOKUP	MEM,A				;SEEK MERGE INPUT FILE.
>
IFE STANSW,<
	MOVEM A,LKBLK+.RBNAM
	MOVEM B,LKBLK+.RBEXT
	MOVEM D,LKBLK+.RBPPN
	LOOKUP MEM,LKBLK
>
	JRST	[OUTSTR	[ASCIZ/MERGE confusion: I can't find DTAPES.DAT.
/]
		HALT	YMERGE]
IFN STANSW,<
	MOVSM	D,MEMWC				;SAVE - WC OF DTAPES.DAT.
>
IFE STANSW,<
	MOVN D,LKBLK+.RBSIZ
	MOVEM D,MEMWC
>
	SETZM	MEMWC2				;FORCE INPUT TO HAPPEN.
ZMERGE:	SKIPN	MEMSAV+TTCNT			;WERE THERE ANY OUTPUT TAPES?
	JRST	[OUTSTR	[ASCIZ/MERGE confusion: no tapes were used.
/]
		HALT	ZMERGE]
	SETZM	TRANGE			;SET TRANGE TO FIRST RANGE OF TAPES
	HLRZ	A,MEMSAV+TTBUF
	MOVEM	A,TAPNO			;SET UP NUMBER OF FIRST TAPE
	PUSHJ	P,REELM0		;SET UP TAPE NAME, ETC.
	MOVE	A,TAPNAM
	MOVEM	A,SPLNAM		;SAVE TEXT FILE NAME FOR SPOOLING
	MOVSI	B,'LST'
	MOVEI	C,0
	MOVE	D,DUMPER
	ENTER	DSKMSC,A
	JRST	[OUTSTR	[ASCIZ/Unable to enter reel text file.
/]
		HALT	ZMERGE]
	SETZM	DSKMM0			;ZERO RECORD COUNT
	SETZM	DSKMM3			;SET ASCII MODE
	PUSHJ	P,DMINI
	PUSHJ	P,TPGINI		;INITIALIZE THE OUTPUT PAGE
	SETZM	TPGNUM			;INITIALIZE THE OUTPUT PAGE NUMBER
	
	PUSHJ	P,UIDXIN		;INITIALIZE INDEX OUTPUT.

	TLNN	FL,DEOF			;SKIP IF NO INPUT FILE.
	PUSHJ	P,SKPIDX		;SKIP INDEX ON INPUT


MERGRT:	TLNE	FL,TEOF!TNEED			;EOF OR NO NEED?
	JRST	MERGRY				;YES. DON'T READ DATA
	PUSHJ	P,TNREAD			;READ DATA FROM FILE.
	JRST	MERGRX				;END OF FILE.
	MOVEM	A,TNAME				;SAVE UFD NAME FROM TAPE FILE
	MOVE	B,.JBFF				;CREATE UFD DATA BUFFER HERE.
MTSRT1:	MOVE	C,.JBREL
	SUBI	C,3-1				;ROOM FOR 3 WORDS
	CAMG	B,C				;MAKE SURE WE DON'T EXPAND TOO FAR
	JRST	MTSRT2				;OK
	ADDI	C,2000+3-1			;GET MORE CORE
	CORE	C,
	JRST	NOCORE
MTSRT2:	PUSHJ	P,TNRD1				;READ MORE DATA - A FILE NAME
	JUMPN	A,MTSRT3			;FILE NAME IS NOT ZERO
	PUSHJ	P,TNREAD			;IF THERE IS A ZERO, GET ANOTHER UFD
	JRST	MTSRT8				;NO UFD'S THERE.
	JUMPE A,.-2				;BH 11/6/78 CONSECUTIVE 0'S OK.
;;; The above instruction was added to allow a clobbered DTAPES.DAT file to be
;;; repaired by zeroing out the bad data.
	CAMN	A,TNAME				;GOT ONE. IS IT THE SAME AS BEFORE?
	JRST	MTSRT1				;SAME AS BEFORE. CONTINUE.
	SOS	MEMWC				;OOPS. PUT THIS UFD NAME BACK.
	SOS	MEMWC1				;CHANGE 2 COUNTS AND A BYTE POINTER.
	SOS	MEMWC2
MTSRT8:	MOVEM	B,MJBFF				;POINTER TO PLACE TO STUFF DART.DAT
	MOVE	C,.JBFF
	SUBI	C,(B)				;COMPUTE THE SIZE OF INCORE AREA
	HRLZ	C,C
	HRR	C,.JBFF				;-WC,,MA
	MOVEM	C,TPTR				;SAVE THE POINTER TO THE DATA
	JRST	MERGRY				;NO. WE ARE DONE WITH INPUT.

;HERE WE HAVE A FILE NAME FROM DTAPES.DAT
MTSRT3:	MOVEM	A,(B)				;STORE THE FILE NAME.
	PUSHJ	P,TNRD1				;READ EXTENSION
	TRZN	A,200000			;WAS IT DUMPED THIS TIME?
	PUSHJ	P,MTSR3X			;NO, CONFUSION:IT SHOULDN'T BE THERE
	HLLZM	A,1(B)				;STORE EXTENSION
	HRRZ	A,A				;GET TAPENO (+400000 FOR TCLASS)
	MOVEM	A,2(B)				;STORE TAPENO
	TRNE	FL,PCLASS			;SKIP IF DUMP TCLASS
	TRC	A,400000			;COMPLEMENT TAPE TCLASS BIT
	TRZN	A,400000			;CLEAR TAPE TCLASS, SKIP IF WAS SET
	PUSHJ	P,MTSR3X			;CLASSES DON'T MATCH:CONFUSION
	CAMN	A,TAPNO
	JRST	MTSR3B				;FILE IS ON SAME TAPE : THAT'S EASY
IFN STANSW,<
	EXCH	A,TAPNO				;SWAP NEW & OLD TAPE NUMBERS
	MOVE	D,TRANGE			;PICK UP WHICH RANGE OLD NUM WAS IN
	ADDI	A,1				;OLD TAPE NUMBER + 1
	HRRZ	X,MEMSAV+TTBUF(D)		;RANGE MAXIMUM TAPE NUMBER
	CAMG	A,X
	JRST	MTSR3A				;JUMP IF OLD+1 IS STILL IN RANGE
	AOS	D,TRANGE			;MOVE TO NEXT RANGE
	CAML	D,MEMSAV+TTCNT
	PUSHJ	P,MTSR3X			;NO MORE RANGES : CONFUSION
	HLRZ	A,MEMSAV+TTBUF(D)		;PICK UP FIRST NUM IN NEXT RANGE
MTSR3A:	CAME	A,TAPNO				;MAKE SURE IT'S THE EXPECTED ONE
	PUSHJ	P,MTSR3X			;DUMPED THIS TIME, BUT WRONG TAPNO
>
IFE STANSW,<
	MOVEM A,TAPNO
;; THE BUG TRAPPERY ABOVE DOESN'T WORK FOR MULTIPLE STRUCTURES
;; BECAUSE THE INITIAL VALUE OF TAPNO FOR EACH STRUCTURE IS TAKEN FROM
;; THE INITIAL VALUE FOR THE ENTIRE DUMP, SO A STRUCTURE STARTING
;; ANYWHERE OTHER THAN THE FIRST OR SECOND TAPE WILL WRONGLY GET BUG
;; TRAPPED ON ITS FIRST FILE.  SINCE I DON'T SEEM TO HAVE THE BUG THIS
;; IS TRAPPING, I JUST FLUSHED THE WHOLE MESS INSTEAD OF TRYING TO MAKE
;; IT TRAP THE RIGHT BUG.
>
	PUSHJ	P,TPGDON			;START DATA FOR NEW TAPE : NEW PAGE
	SETZM	TPGNUM				;INITIALIZE THE OUTPUT PAGE NUMBER
	PUSH	P,B				;SAVE REG (USED BY REELM0)
	PUSH	P,C				;SAVE REG (USED BY REELM0)
	PUSHJ	P,REELM0			;SET UP TAPE NAME, ETC.
	POP	P,C
	POP	P,B
MTSR3B:						;HERE IF FILE DUMPED THIS TIME
	PUSHJ	P,TNRD1				;READ THIRD WORD
	HRRM	A,1(B)				;SAVE DATE
	MOVE	A,TPGPDP			;GET PDL FOR STORING THE PAGE DATA
	PUSH	A,(B)				;STORE NAME
	PUSH	A,1(B)				;AND EXTENSION - DATE
	PUSH	A,TNAME				;AND UFD NAME
	MOVEM	A,TPGPDP			;STORE PDL
	AOBJN	A,.+2				;SEE IF THAT WAS THE LAST THING..
	PUSHJ	P,TPGPUT			;TIME TO WRITE THE ENTIRE PAGE.
	ADDI	B,3				;INCREMENT B TO POINT PAST THIS AREA
	MOVEI	C,-3(B)				;LOAD C WITH ADDRESS OF LAST NAME.
	MOVE	A,(C)				;LOAD A WITH LAST NAME.
	MOVE	W,1(C)				;LOAD W WITH EXTENSION AND DATE
	MOVE	Z,2(C)				;LOAD Z WITH TAPENO
	JRST	MTSRT4				;JUMP INTO THE SORT ROUTINE.

MTSR3X:	OUTSTR	[ASCIZ/MERGE confusion: DTAPES.DAT dump tapes not in expected order.
/]
	HALT	.

MTSRT5:	MOVE	D,-3(C)				;BUBBLE.  GET NAME FROM CORE AND
	MOVEM	D,(C)				;MOVE IT UP 2 PLACES
	MOVE	D,-2(C)				;SAME FOR EXTENSION.
	MOVEM	D,1(C)				;
	MOVE	D,-1(C)				;SAME FOR TAPENO.
	MOVEM	D,2(C)				;
	SUBI	C,3				;DECREMENT OUR POINTER.
MTSRT4:	CAMLE	C,.JBFF				;ARE WE RUNNING OFF THE END?
	CAMLE	A,-3(C)				;OR HAVE WE FOUND A HOME?
	JRST	MTSRT7				;ONE OF THE ABOVE.
	CAME	A,-3(C)				;POSSIBLY SAME NAME.
	JRST	MTSRT5				;NO. WE HAVE TO BUBBLE.
	HLLZ	X,-2(C)				;SAME NAME. GET EXT
	HLLZ	Y,W				;GET EXT ONLY FROM W.
	CAMGE	Y,X				;ARE WE IN ORDER?
	JRST	MTSRT5				;NO. WE HAVE TO BUBBLE.
MTSRT7:	MOVEM	A,(C)				;STORE FILE NAME
	MOVEM	W,1(C)				;AND EXT
	MOVEM	Z,2(C)				;AND TAPENO
	JRST	MTSRT1				;WE ARE DONE WITH THIS TERM.
;MERGRX MERGRY MERGRD MRGRD1 MRGRD2 MRGRD3 MERG1 MERG1A MERG1B MERG1D MERG2 MERG4 MERG4A MERG4C MERG4E MERG4B MERG4D MERG4Q MERG4Y MERG4X MERGRZ MERGZ0 MERGZ1

	SUBTTL	MERGE - MERGRX MERGRY MERGRD MERGRZ

MERGRX:	TLO	FL,TEOF				;SET EOF SEEN IN TAPE FILE.
MERGRY:	TLO	FL,TNEED			;NO NEED FOR MORE TAPE DATA.

MERGRD:	TLNE	FL,DEOF!DNEED			;EOF ALREADY OR NO NEED FOR DATA?
	JRST	MRGRD1				;YES TO ONE OF ABOVE. SKIP READ.
	PUSHJ	P,RDIPPN			;READ FROM DART.DAT
	TLO	FL,DEOF				;WAS END OF FILE.
	TLO	FL,DNEED			;DON'T NEED DATA
	MOVEM	A,DNAME				;SAVE THE NAME.
	JUMPN	A,MRGRD1			;JUMP IF REAL NAME.
	TLO	FL,DEOF				;FORCE EOF WHEN A ZERO NAME SEEN
MRGRD1:	TLC	FL,DEOF!TEOF			;COMPLEMENT BOTH EOF BITS.
	TLCN	FL,DEOF!TEOF			;EOF ON BOTH?
	JRST	MERGRZ				;YES. WE ARE DONE.
	TLNN	FL,DEOF				;EOF ON DART.DAT?
	JRST	MERG1				;NO.
;WRITE TAPE DATA TO DART.DAT
MRGRD2:	MOVE	A,TNAME				;GET THE UFD NAME ON TAPE FILE.
	TLZ	FL,TNEED			;WE NEED MORE TAPE DATA
	MOVE	D,TPTR				;GET POINTER TO DATA IN CORE
	JUMPG	D,MERGRT			;JUMP IF THIS IS EMPTY
	PUSHJ	P,UIDXBG			;BEGINNING OF UFD ENTRY
	PUSHJ	P,DFWRTX			;WRITE UFD NAME.
MRGRD3:	MOVE	A,(D)				;GET DATA
	PUSHJ	P,DFWRTX			;WRITE DATA
	HLLZ	A,1(D)				;GET DATA
	HRRI	A,1				;EXT,,COUNT. COUNT = 1.
	PUSHJ	P,DFWRTX			;WRITE DATA
	HRRZ	A,1(D)				;GET THE FILE LAST WRITTEN DATE
	HRL	A,2(D)				;GET MERGE VERSION OF TAPE NUMBER.
	PUSHJ	P,DFWRTX			;WRITE DATA
	ADD	D,[3,,3]
	JUMPL	D,MRGRD3
	SETZ	A,				;ZERO ENDS THE FILE LIST
	PUSHJ	P,DFWRTX			;WRITE IT.
	JRST	MERGRT				;READ MORE DATA FROM TAPE FILE.

MERG1:	TLNN	FL,TEOF				;EOF ON TAPE FILE?
	JRST	MERG2				;NO WE HAVE TO THINK ABOUT MERGE.
;READ DART.DAT AND WRITE IT
MERG1A:	PUSHJ	P,MMREAD			;READ DATA
	SKIPN	MMNAM				;IS THERE ANY NAME THERE?
	JRST	MERG1D				;NONE AT ALL.
	HRRZ	A,MMEXT				;GET THE COUNT
	JUMPE	A,MERG1A			;LOOP IF ENTRY IS EMPTY.
	MOVE	A,DNAME				;GET THE NAME FROM DART.DAT
	PUSHJ	P,UIDXBG			;BEGINNING OF UFD ENTRY
	PUSHJ	P,DFWRTX			;WRITE IN NEW FILE.
MERG1B:	PUSHJ	P,MMWRIT			;AND WRITE THE DATA.
	PUSHJ	P,MMREAD			;READ DATA FROM DART.DAT
	SKIPE	A,MMNAM				;IS THERE ANY FILE NAME THERE?
	JRST	MERG1B				;YES WRITE IT
	PUSHJ	P,DFWRTX			;WRITE 0 TO END LIST OF FILES.
MERG1D:	TLZ	FL,DNEED			;WE'LL NEED MORE DATA
	JRST	MERGRD				;GO GET IT.

;HERE THERE IS DATA PRESENT FROM BOTH FILES
MERG2:	MOVE	A,DNAME				;GET THE TWO NAMES.
	CAMN	A,TNAME				;SKIP IF DIFFERENT UFD NAMES.
	JRST	MERG4				;NAME ARE THE SAME. WE MERGE.
	PUSHJ	P,UFDCNV			;CONVERT NAME
	MOVEM	A,DNX				;SAVE FUNNY NAME
	MOVE	A,TNAME
	PUSHJ	P,UFDCNV
	MOVEM	A,TNX				;SAVE FUNNY NAME.
	PUSHJ	P,PPNCMP
	JRST	MERG1A				;D < T  DUMP D FIRST
	JRST	MRGRD2				;D > T  DUMP T FIRST

;HERE WE HAVE TO MERGE ONE PPN.
MERG4:	TLZ	FL,TNEED!DNEED			;WE WILL NEED BOTH INPUTS LATER.
	MOVE	A,DNAME				;GET THE NAME
	PUSHJ	P,UIDXBG			;INITIALIZE NEXT UFD
	PUSHJ	P,DFWRTX			;WRITE THE NAME
MERG4A:	PUSHJ	P,MMREAD			;READ FROM DART.DAT
	SKIPN	MMNAM				;IS THERE ANY DATA THERE?
	JRST	MERG4X				;END OF DART.DAT INPUT
	SKIPL	W,TPTR				;GET THE POINTER TO TAPE FILE.
	JRST	MERG4B				;NO T-DATA LEFT

;HERE THERE'S RELEVANT DATA LEFT IN BOTH FILES.
MERG4C:	MOVE	A,(W)				;GET T-DATA
	CAMLE	A,MMNAM				;SKIP IF TAPE DATA < DART.DAT
	JRST	MERG4B				;DART.DAT DATA GOES OUT FIRST.
	CAMN	A,MMNAM				;IS THE NAME THE SAME?
	JRST	MERG4D				;SAME NAME. HAVE TO THINK MORE.
MERG4E:	PUSHJ	P,MERG4Q			;TAPE DATA GOES FIRST. (NEW NAME)
	JUMPL	W,MERG4C			;JUMP IF THERE'S MORE T-DATA.
MERG4B:	PUSHJ	P,MMWRIT			;FLUSH CURRENT DAT ENTRY.
	JRST	MERG4A				;LOOP.

;HERE BOTH NAMES ARE THE SAME.  CHECK EXTENSIONS NEXT.
MERG4D:	HLLZ	C,1(W)				;GET EXTENSION
	HLLZ	B,MMEXT				;GET EXTENSION
	CAMLE	C,B				;SKIP IF T-DATA <= DAT-DATA
	JRST	MERG4B				;DAT-DATA GOES OUT FIRST.
	CAME	C,B				;SAME DATA?
	JRST	MERG4E				;NO. T-DATA GOES FIRST.
	HRRZ	C,1(W)
	HRL	C,2(W)
	MOVEM	C,MMDAT				;PARAMETER TO MMMWRT
	PUSHJ	P,MMMWRT			;MERGE T-DATA WITH DAT-DATA & WRITE
	ADD	W,[3,,3]
	MOVEM	W,TPTR
	JRST	MERG4A

;HERE TO WRITE ONE NEW T-DATUM TO OUTPUT FILE.
MERG4Q:	MOVE	A,(W)				;NAME
	PUSHJ	P,DFWRTX
	HLLZ	A,1(W)
	HRRI	A,1				;EXT,,1
	PUSHJ	P,DFWRTX
	HRRZ	A,1(W)				;0,,DATE
	HRL	A,2(W)				;TAPE NUMBER,,DATE
	ADD	W,[3,,3]
	MOVEM	W,TPTR				;ADVANCE AND STORE NEW TPTR
	JRST	DFWRTX				;WRITE TAPE NUMBER, RETURN TO CALLER

;ENTER AT MERG4X TO WRITE ALL THE T-DATA TO THE OUTPUT
MERG4Y:	PUSHJ	P,MERG4Q			;WRITE ONE T-DATUM TO OUTPUT
MERG4X:	SKIPGE	W,TPTR				;ANY T-DATA LEFT?
	JRST	MERG4Y				;YES. LOOP UNTIL DONE.
	MOVEI	A,0
	PUSHJ	P,DFWRTX			;WRITE ZERO TO FINISH THIS GUY.
	JRST	MERGRT				;READ MORE FROM BOTH INPUTS.

MERGRZ:	CLOSE	UFD,				;CLOSE DART.DAT INPUT
	PUSHJ	P,UIDXFR			;FORCE INDEX BLOCKS OUT.
	CLOSE	FILE,				;CLOSE DART.DAT OUTPUT
	SETSTS	FILE,10+DMPBIT+GARBIT		;SET SPECIAL STATUS
	TRNE	FL,PURCOM			;SKIP UNLESS PURGE
	JRST	MERGZ1				;NO PHONEY ALLDIR.DAT IF PURGE

	MOVE	A,MEMSAV+TTCNT
	HRRZ	A,MEMSAV+TTBUF-1(A)		;GET NUMBER OF LAST TAPE
	CAMN	A,TAPNO				;ARE WE ALREADY ON IT?
	JRST	MERGZ0				;YES - EASY
	MOVEM	A,TAPNO				;NO, SET IT IN
	PUSHJ	P,TPGDON			;CLOSE OFF TEXT PAGE
	PUSHJ	P,REELM0			;SET UP TAPE NAME, ETC.
MERGZ0:	MOVE	A,TPGPDP			;GET PDL FOR STORING THE PAGE DATA
	PUSH	A,['ALLDIR']			;FAKE IN ALLDIR.DAT ENTRY
	PUSH	A,DATDAT			;EXT,,DATE (SET UP BY DMPSTR)
	PUSH	A,DUMPER
	MOVEM	A,TPGPDP

MERGZ1:	PUSHJ	P,TPGCLS			;CLOSE REEL TEXT PAGE
	RELEAS	DSKMSC,
	MOVEI	A,17
	MOVSI	B,'DSK'
	MOVEI	C,0
	OPEN	DSKMSC,A
	PUSHJ	P,NODEV
	PUSHJ	P,SPOOL				;SPOOL TEXT OUTPUT FILE.
	SETOM	MEMSAV+MERGFL			;SET MERGE DONE FLAG
	PUSHJ	P,SAVMEM			;SAVE STATE.
	CLOSE	MEM,				;CLOSE TAPE FILE INPUT
	SETZB	A,B
	MOVEI	C,0
	MOVE	D,DUMPER
	RENAME	MEM,A				;DELETE DTAPES.DAT
	JFCL
	CLOSE	MEM,
	POPJ	P,
;PPNCMP PPNCP1 PPNCP2 PPNCP3 UIDXBW UIDXBG USET10 USET11 UIDXND UIDXFR UIDXIN UIDXWT SKPIDX SKPID1 RDIPP1 RDIPPN

	SUBTTL	MERGE - PPNCMP UIDXBG UIDXFR UIDXIN

PPNCMP:
IFN STANSW,<
	HLRZ	A,TNX				;COMPARE TNX AND DNX
	CAIE	A,'2  '				;DIRECT RETURN IF D LT T
	CAIN	A,'3  '				;SKIP RET IF D GT T
	JRST	PPNCP2
	CAIN	A,'SYS'
	JRST	PPNCP2
	HLRZ	A,DNX				;HERE IF T IS REGULAR
	CAIE	A,'2  '
	CAIN	A,'3  '
	POPJ	P,				;D SPECIAL LT T REGULAR
	CAIN	A,'SYS'
	POPJ	P,				;D SPECIAL, T REGULAR
>
PPNCP1:	MOVE	A,TNX				;HERE IF BOTH REGULAR, BOTH SPECIAL
	CAMG	A,DNX
	AOS	(P)				;TAPE FILE NAME < DART.DAT NAME
	POPJ	P,				;TAPE FILE NAME > DART.DAT NAME.

IFN STANSW,<
PPNCP2:	HLRZ	A,DNX				;HERE IF T SPECIAL
	CAIE	A,'2  '
	CAIN	A,'3  '
	JRST	PPNCP3				;T SPECIAL, D SPECIAL
	CAIE	A,'SYS'
	JRST	CPOPJ1				;T SPECIAL, D REGULAR
	HLRZ	A,TNX				;BOTH SPECIAL.
	CAIN	A,'SYS'				;BOTH SYS?
	JRST	PPNCP1				;YES.
	JRST	CPOPJ1				;T NE SYS AND T SPECIAL SO D GT T

PPNCP3:	HLRZ	A,TNX				;BOTH SPECIAL AND D NE SYS
	CAIN	A,'SYS'
	POPJ	P,				;T=SYS SO T GT D
	JRST	PPNCP1				;BOTH ARE NOT SYS.
>

;HERE WHEN THERE'S NO ROOM IN THE INDEX BLOCK WE'RE BUILDING.
UIDXBW:	EXCH	B,IDXPDP			;STRAIGHTEN OUT THE AC'S
	PUSH	P,A
	PUSH	P,B
	PUSHJ	P,UIDXND			;DO THE WORK
	POP	P,B
	POP	P,A				;FIX STACK AND TRY AGAIN.

;HERE TO INITIATE A NEW UFD INTO THE INDEX FILE
UIDXBG:	EXCH	B,IDXPDP
	CAMN	B,[-2,,IDXPDL+175]		;RUN OUT OF SPACE?
	JRST	UIDXBW				;YES.  THIS IS HARD.
	PUSH	B,A				;STORE THE UFD NAME
	PUSH	B,DATWC				;AND THE CURRENT WORD NUMBER
	EXCH	B,IDXPDP
	POPJ	P,

IFE STANSW,<
USET10:	PUSH P,A				;SAIL MONITOR FORCES OUT
	HRRZ A,FOBUF+1				;ALL BUFFERS BEFORE
	SUB A,FOBUF
	TRNN A,777776				;DOING USETO, BUT DEC
	JRST USET11
	OUTPUT FILE,				;DOESN'T, SO WE DO IT
	AOS FOBUF+2
USET11:	POP P,A					;FOR THEM HERE.
	POPJ P,
>

;HERE TO WRITE OLD INDEX, POINT IT TO A NEW ONE.  INITIALIZE A NEW INDEX
UIDXND:	MOVE	A,DATWC				;GET WORD COUNT
	ADDI	A,177
	TRZA	A,177				;CALC WORD NUMBER OF NEXT INDEX BLOCK
UIDXFR:	MOVEI	A,0				;END OF WORLD - FORCE LAST INDEX.
	EXCH	A,IDXPDL+176			;GET OLD INDEX BLOCK WORD NUMBER
	LSH	A,-7				;CONVERT TO RECORD NUMBER
IFE STANSW,<
	PUSHJ P,USET10				;DEC SYS HAS TO PREPARE
>
	USETO	FILE,1(A)			;SET THE BLOCK.
	PUSHJ	P,UIDXWT			;WRITE THE 128 WORDS OF INDEX.
	SKIPG	A,IDXPDL+176			;GET THE WORD NUMBER OF NEXT INDEX
	POPJ	P,				;ZERO MEANS LAST WAS FORCED AT EOF
	LSH	A,-7
IFE STANSW,<
	PUSHJ P,USET10
>
	USETO	FILE,1(A)			;SET TO WRITE BLANK INDEX BLOCK.
	JRST	.+2
UIDXIN:	SETZM	IDXPDL+176			;HERE TO INITIALIZE EVERYTHING
	MOVE	A,[-200,,IDXPDL-1]
	MOVEM	A,IDXPDP
	SETZM	IDXPDL
	MOVE	A,[IDXPDL,,IDXPDL+1]
	BLT	A,IDXPDL+175			;CLEAR FRESH INDEX BLOCK
	MOVEI	A,200
	ADD	A,IDXPDL+176
	MOVEM	A,DATWC				;COUNT THE INDEX IN THE WC
UIDXWT: MOVSI	B,-200
	MOVE	A,IDXPDL(B)
	PUSHJ	P,DFWRIT
	AOBJN	B,.-2
	POPJ	P,

SKPIDX:	PUSHJ	P,UFDRD
	POPJ	P,				;END OF FILE?
SKPID1:	MOVSI	B,-173
	PUSHJ	P,UFDRD
	JFCL
	AOBJN	B,.-2
	PUSHJ	P,UFDRD
	JFCL
	MOVEM	A,LSTIPP			;SAVE NAME OF LAST INDEXED PPN
	SETOM	LSTRPP				;NAME OF LAST PPN READ
	MOVSI	B,-3
	PUSHJ	P,UFDRD
	JFCL
	AOBJN	B,.-2
	POPJ	P,

;NOW, SKIP ZEROS UNTIL WE SEE THE NEXT INDEX BLOCK, IF ANY
RDIPP1:	JUMPE	A,CPOPJ				;JUMP IF LAST INDEXED PPN IS ZERO.
	PUSHJ	P,UFDRD
	POPJ	P,
	JUMPE	A,.-2				;SKIP NULLS.
	PUSHJ	P,SKPID1			;SKIP INDEX BLOCK
RDIPPN:	MOVE	A,LSTIPP			;GET NAME OF LAST PPN IN INDEX
	CAMN	A,LSTRPP			;SAME AS LAST PPN READ?
	JRST	RDIPP1				;YES. NOW SKIP TO INDEX...
	PUSHJ	P,UFDRD
	POPJ	P,				;END OF FILE.
	MOVEM	A,LSTRPP
	JRST	CPOPJ1
;DMFRC DMINI DMPUT1 DMPUTX DMPUT TPGDON TPGCLS DMCLOS DSMOC1 DSMOC2 DSMOC3 DSMPPN DSMPPO DSMPPN DSMSX2 DSMSX1 TPGPUT TPGPU1 TPGPU2 TPGPU3 TPGINY TPGINI TPGINX DSDATE DDDEC DMSTR DMSTR1 SPOOL SPOOL1 SPOOL2 SPOOL3 INTSPL INISP1

	SUBTTL	REEL TEXT FILE OUTPUT ROUTINES
DMFRC:	OUTPUT	DSKMSC,[IOWD 200,REELBF		;FORCE CURRENT BUFFER OUT.
			0]
	STATZ	DSKMSC,740000
	PUSHJ	P,[OUTSTR	[ASCIZ/Reel text file output error.
/]
		POPJ	P,]
DMINI:	SKIPE	DSKMM3			;SKIP IF ASCII MODE
	SKIPA	A,[POINT 36,REELBF]	;SET BINARY MODE
	MOVE	A,[POINT 7,REELBF]	;SET ASCII MODE
	MOVEM	A,DSKMM1
	MOVE	A,[SOSGE DSKMM2]
	MOVEM	A,XDMPUT		;SETUP INSTR. TO XCT.
	MOVEI	A,5*200
	SKIPE	DSKMM3			;SKIP IF ASCII
	MOVEI	A,200			;BINARY MODE
	MOVEM	A,DSKMM2
	MOVE	A,[REELBF,,REELBF+1]
	SETZM	REELBF
	BLT	A,REELBF+177
	POPJ	P,

DMPUT1:	OUTPUT	DSKMSC,[IOWD 200,REELBF
			0]
	STATZ	DSKMSC,740000
	PUSHJ	P,[OUTSTR	[ASCIZ/Reel text file output error.
/]
		POPJ	P,]
	PUSH	P,A
	PUSHJ	P,DMINI
	POP	P,A
	JRST	DMPUT
DMPUTX:	AOS	ARCWC		;WORD COUNT OF DART.ARC OUTPUT
DMPUT:	XCT	XDMPUT		;SOSGE DSKMM2, EXCEPT IN MRESTORE: JRST LSTOUT
	JRST	DMPUT1
	IDPB	A,DSKMM1
	POPJ	P,


TPGDON:	HRRZ	A,TPGPDP
	CAIL	A,TPBUF			;SKIP IF CURRENT PAGE IS EMPTY.
	PUSHJ	P,TPGPUT		;OUTPUT THE CURRENT PAGE.
	POPJ	P,

TPGCLS:	PUSHJ	P,TPGDON
	MOVEI	A,0
	DPB	A,DSKMM1		;CLOBBER THE FINAL FF, CLOSE FILE.
DMCLOS:	SETZB	A,DSKMM2
	PUSHJ	P,DMPUT
	CLOSE	DSKMSC,
	POPJ	P,

IFE STANSW,<
DSMOC1:	SUBI C,1
	IDIVI A,10
	JUMPE A,DSMOC2
	HRLM B,(P)
	PUSHJ P,DSMOC1
	HLRZ B,(P)
DSMOC2:	SOJL C,DSMOC3
	MOVEI A,40
	PUSHJ P,DMPUT
	JRST DSMOC2

DSMOC3:	MOVEI A,"0"(B)
	JRST DMPUT

IFE IRCPPN,<
DSMPPN:	PUSH P,B
>
DSMPPO:	HLRZ A,B
IFN IRCPPN,<
	MOVEI C,3
>
IFE IRCPPN,<
	MOVEI C,6
>
	PUSHJ P,DSMOC1
	MOVEI A,","
	PUSHJ P,DMPUT
	POP P,B
	MOVEI A,(B)
	MOVEI C,6
	PUSHJ P,DSMOC1
	MOVEI B,[ASCIZ /   /]
	JRST DMSTR
>

IFN IRCPPN,<
DSMPPN:	PUSH P,B
	TLNE B,777740
	TRNN B,777740
	JRST DSMPPO
	TLNN B,77
	JRST DSMPPO
	HLLZS B
	MOVEI C,3
	PUSHJ P,DSMSX2
	MOVEI A,","
	PUSHJ P,DMPUT
	POP P,B
	HRLZS B
	MOVEI C,9
DSMSX2:	TLNE B,770000
	TLO B,400000		;DROP INTO DSMSX1
>
DSMSX1:	MOVEI	A,0
	LSHC	A,6
	ADDI	A," "
	PUSHJ	P,DMPUT
	SOJG	C,DSMSX1
	POPJ	P,

TPGPUT:	PUSH	P,B
	DATE	A,
	PUSHJ	P,DSDATE		;WRITE CURRENT DATE
IFE STANSW,<
	MOVEI B,[ASCIZ /  /]
	PUSHJ P,DMSTR
	MOVE B,STRNAM
	MOVEI C,6
	PUSHJ P,DSMSX1
>
	MOVEI	B,[ASCIZ/  DART Tape Listing.   Tape Number /]
	SKIPE	TPGFLG
	MOVEI	B,[ASCIZ/     MRESTORE List			Tape Number /]
	PUSHJ	P,DMSTR
	MOVEI	C,12
	MOVE	B,TAPNAM		;TAPE NAME E.G., T00031
	PUSHJ	P,DSMSX1		;WRITE FILE NAME AND 4 SPACES
	MOVEI	B,[ASCIZ/Page /]
	PUSHJ	P,DMSTR
	AOS	A,TPGNUM		;INCREMENT PAGE NUMBER
	PUSHJ	P,DDDEC			;WRITE DECIMAL
	MOVEI	B,[BYTE(7)15,12,12]
	PUSHJ	P,DMSTR			;CR LF LF TO END HEADING.
	MOVSI	D,-<TPBUFL/2>
TPGPU1:	SKIPN	B,TPBUF(D)
	JRST	TPGPU3			;JUMP IF ALL DONE.
	MOVEI	C,10
	PUSHJ	P,DSMSX1		;FILE NAME
	HLLZ	B,TPBUF+1(D)
	MOVEI	C,6
	PUSHJ	P,DSMSX1		;EXTENSION
IFN STANSW,<
	HLLZ	B,TPBUF+2(D)
	MOVEI	C,3
	PUSHJ	P,DSMSX1		;PRJ
	MOVEI	A,","
	PUSHJ	P,DMPUT			;,
	HRLZ	B,TPBUF+2(D)
	MOVEI	C,6
	PUSHJ	P,DSMSX1		;PRG
>
IFE STANSW,<
	MOVE B,TPBUF+2(D)
	PUSHJ P,DSMPPN
>
	HRRZ	A,TPBUF+1(D)
	SKIPN	TPGFLG			;NO DATE IF MRESTORE
	PUSHJ	P,DSDATE		;DATE
	MOVEI	B,[ASCIZ/    /]
	PUSHJ	P,DMSTR			;SPACES
	SKIPN	B,TPBUF+<TPBUFL/2>(D)
	JRST	TPGPU2			;SECOND COLUMN ENDS EARLY
	MOVEI	C,10
	PUSHJ	P,DSMSX1		;FILE NAME
	HLLZ	B,TPBUF+1+<TPBUFL/2>(D)
	MOVEI	C,6
	PUSHJ	P,DSMSX1		;EXTENSION
IFN STANSW,<
	HLLZ	B,TPBUF+2+<TPBUFL/2>(D)
	MOVEI	C,3
	PUSHJ	P,DSMSX1		;PRJ
	MOVEI	A,","
	PUSHJ	P,DMPUT			;,
	HRLZ	B,TPBUF+2+<TPBUFL/2>(D)
	MOVEI	C,6
	PUSHJ	P,DSMSX1		;PRG
>
IFE STANSW,<
	MOVE B,TPBUF+2+<TPBUFL/2>(D)
	PUSHJ P,DSMPPN
>
	HRRZ	A,TPBUF+1+<TPBUFL/2>(D)
	SKIPN	TPGFLG			;NO DATE IF MRESTORE
	PUSHJ	P,DSDATE		;DATE
TPGPU2:	MOVEI	A,15
	PUSHJ	P,DMPUT			;CR
	ADD	D,[3,,3]
	JUMPGE	D,TPGPU3
	MOVEI	A,12
	PUSHJ	P,DMPUT
	JRST	TPGPU1

TPGPU3:	MOVEI	A,14
	PUSHJ	P,DMPUT			;FF TO END PAGE
	POP	P,B			;RESTORE B AND ....
TPGINY:	SETZM	TPBUF			;INITIALIZE NEW PAGE.
	MOVE	A,[TPBUF,,TPBUF+1]
	BLT	A,TPBUF+TPBUFL-1
	MOVE	A,[-<TPBUFL+1>,,TPBUF-1]	;PDL POINTER 1 EXTRA COUNT.
	MOVEM	A,TPGPDP			;SAVE IT
	POPJ	P,

TPGINI:	SETZM	TPGFLG
	JRST	TPGINY

TPGINX:	SETOM	TPGFLG			;FLAG THIS IS MRESTORE LISTING
	JRST	TPGINY

DSDATE:	IDIVI	A,37
	PUSH	P,A
	MOVEI	A," "
	CAIGE	B,11
	PUSHJ	P,DMPUT
	MOVEI	A,1(B)
	PUSHJ	P,DDDEC
	MOVEI	A,"-"
	PUSHJ	P,DMPUT
	POP	P,A
	IDIVI	A,14
	PUSH	P,A
	ADDI	B,MONTAB
	PUSHJ	P,DMSTR
	POP	P,A	
	ADDI	A,100		;ADD TO MAKE 1964, AND FALL INTO PRINTER
DDDEC:	IDIVI	A,12
	HRLM	B,(P)
	JUMPE	A,.+2
	PUSHJ	P,DDDEC
	HLRZ	A,(P)
	ADDI	A,"0"
	JRST	DMPUT


DMSTR:	HRLI	B,440700
DMSTR1:	ILDB	A,B
	JUMPE	A,CPOPJ
	PUSHJ	P,DMPUT
	JRST	DMSTR1

IFE STANSW,<SPOOL: JRST CPOPJ>
IFN STANSW,<
SPOOL:
IFN DBGSW,<POPJ P,>
	MOVE	A,USRPPN
	MOVEM	A,SPLREQ
	MOVEM	A,SPLPPN
	MOVE	A,STRNAM
	MOVEM	A,SPLDEV
	TIMER	A,
	IDIVI	A,74*74
	DATE	B,
	HRL	A,B
	MOVEM	A,SPLTIM
	TTCALL	6,A
	MOVEM	A,SPLJOB
	PJOB	A,
	HRLM	A,SPLJOB	;JOB,,LINE
	MOVE	A,DSKMM0	;GET THE NUMBER OF RECORDS.
	MOVEM	A,SPLSIZ
	DATE	A,
	TIMER	B,
	LSH	A,30
	OR	A,B		;INVENT A NAME.
	MOVEI	W,10
SPOOL1:	MOVSI	B,'SPX'
	MOVEI	C,0
	MOVE	D,PPNSPL
	LOOKUP	DSKMSC,A
	JRST	SPOOL2
	AOJA	A,SPOOL1
SPOOL2:	MOVE	D,PPNSPL
	MOVSI	B,'SPX'
	MOVEI	C,0
	SOJL	W,CPOPJ
	ENTER	DSKMSC,A
	AOJA	A,SPOOL1
	OUTPUT	DSKMSC,SPLIOW
	CLOSE	DSKMSC,
	MOVE	A,NAMSPL
	NAMEIN	A,
	JRST	INTSPL
SPOOL3:	SETZM	ALLBUF		;A HAS JOBNUMBER.
	MOVE	B,[ALLBUF,,ALLBUF+1]
	BLT	B,ALLBUF+37
	MOVEI	B,ALLBUF
	SEND	A
	JFCL
	POPJ	P,

INTSPL:	TRNE	A,2
	POPJ	P,		;MULTIPLE SPOOLERS EXIST.
	MOVEI	A,NAMSPL	;WAKE A SPOOLER
	WAKEME	A,
	POPJ	P,		;CAN'T WAKE ONE.
	MOVEI	B,30
INISP1:	MOVEI	A,1
	SLEEP	A,
	MOVE	A,NAMSPL
	NAMEIN	A,
	SOJGE	B,INISP1
	JUMPGE	B,SPOOL3
	POPJ	P,		;SPOOLER DOESN'T HAPPEN.
>;IFN STANSW
;TNREAD TNRDR1 TNRD3 TNRD1 TNRD2 UFDCNV UFDCN1 MMREAD MMRED1 MMRED2 MMRED3 MMRED4 MMWRIT MMWRT0 MMWRT1 MMMWRT

	SUBTTL	TNREAD UFDCNV MMREAD MMWRIT MMMWRT
TNREAD:	AOSLE	MEMWC
	POPJ	P,
	AOSL	MEMWC2
	JRST	TNRDR1
	ILDB	A,MEMWC1
	JRST	CPOPJ1

TNRDR1:	INPUT	MEM,[IOWD 200,MEMBLK
			0]
	STATZ	MEM,740000
	JRST	TNRD2
TNRD3:	MOVE	A,[POINT 36,MEMBLK]
	MOVEM	A,MEMWC1
	MOVNI	A,200
	MOVEM	A,MEMWC2
	ILDB	A,MEMWC1
	JRST	CPOPJ1

TNRD1:	PUSHJ	P,TNREAD
	CAIA
	POPJ	P,
	OUTSTR	[ASCIZ/Unexpected end of file on tape data file.
/]
	MOVEI	A,
	POPJ	P,

TNRD2:	OUTSTR	[ASCIZ/Disk data error reading tape data file during MERGE.
/]
	SETZM	MEMBLK
	MOVE	A,[MEMBLK,,MEMBLK+1]
	BLT	A,MEMBLK+177
	JRST	TNRD3


UFDCNV:
IFN IRCPPN,<
	TLNE A,777740
	TRNN A,777740
	JRST UFDCN1
	TLNN A,77
	JRST UFDCN1
>
IFN STANSW!IRCPPN,<
	PUSH	P,B
	HRRZ	B,A
	TRNE	B,770000
	JRST	.+3
	LSH	B,6
	JUMPN	B,.-3
	HLRZ	A,A
	TRNE	A,770000
	JRST	.+3
	LSH	A,6
	JUMPN	A,.-3
	HRL	A,B
	POP	P,B
>
IFN IRCPPN,<
UFDCN1:	TDO A,[400000,,400000]
>
	POPJ	P,

;READ FILE DATA FROM DART.DAT.
MMREAD:	MOVE	B,MJBFF				;GET ADDRESS OF FIRST FREE
	PUSHJ	P,UFDRD				;READ FROM DART.DAT
	JFCL
	MOVEM	A,MMNAM				;SAVE FILE NAME
	JUMPE	A,CPOPJ
	PUSHJ	P,UFDRD				;READ EXTENSION
	JFCL
	MOVEM	A,MMEXT				;SAVE EXTENSION.
	HRRZ	C,A				;GET THE COUNT.
MMRED1:	PUSHJ	P,UFDRD				;READ DATA.
	JFCL
	CAMG	B,.JBREL
	JRST	MMRED2
	MOVE	D,.JBREL
	ADDI	D,2000
	CORE	D,
	JRST	NOCORE
MMRED2:	MOVEM	A,(B)				;STUFF THE DATA.
	HLRZ	A,A				;GET THE TAPE NUMBER ONLY
	TRNE	FL,PCLASS			;SKIP IF DUMP TCLASS
	TRC	A,400000			;COMPLEMENT TAPE TCLASS BIT
	TRZN	A,400000			;CLEAR TAPE TCLASS, SKIP IF WAS SET
	JRST	MMRED3				;CLASSES DON'T MATCH:NOT THIS DUMP
	PUSH	P,B				;SAVE REG (USED BY TAPCMP)
	PUSH	P,C				;SAVE REG (USED BY TAPCMP)
	PUSHJ	P,TAPCMP			;WAS DART.DAT TAPNO USED THIS DUMP?
	SETO	A,				;NO SKIP RET:NO
	POP	P,C				;SKIP RET:YES
	POP	P,B
	JUMPGE	A,.+2				;WAS DART.DAT TAPNO USED THIS DUMP?
MMRED3:	AOJA	B,MMRED4			;NO. SO WE INCREMENT B.
	SOS	MMEXT				;YES. DECREMENT COUNT IN MMEXT,
						;TO DELETE THIS OVERRIDDEN TAPE ENT.
MMRED4:	SOJG	C,MMRED1
	POPJ	P,


;WRITE DATA FROM CORE TO DART.DAT
MMWRIT:	HRRZ	A,MMEXT				;GET THE COUNT
	JUMPE	A,CPOPJ
	MOVE	A,MMNAM				;GET THE NAME.
	PUSHJ	P,DFWRTX			;WRITE IT
	MOVE	A,MMEXT				;GET THE EXT, COUNT
	PUSHJ	P,DFWRTX
	HRRZ	C,A
MMWRT0:	MOVE	B,MJBFF
MMWRT1:	MOVE	A,(B)
	PUSHJ	P,DFWRTX
	ADDI	B,1
	SOJG	C,MMWRT1
	POPJ	P,

;WRITE DATA FROM CORE AND AUGMENT
MMMWRT:	MOVE	A,MMNAM				;GET NAME
	PUSHJ	P,DFWRTX
	AOS	A,MMEXT				;INCREASE COUNT
	PUSHJ	P,DFWRTX
	MOVEI	C,-1(A)				;COUNT OF INCORE DATA
	MOVE	A,MMDAT				;THE EXTRA WORD
	PUSHJ	P,DFWRTX
	JUMPN	C,MMWRT0
	POPJ	P,
;FIXPOS FIXPS0 FIXPS1 FIXPS2 FIXPS3 FIXPS4

	SUBTTL	FIXPOS	FIX MAGTAPE POSITION.
COMMENT $
THIS ROUTINE IS USED TO MOVE THE MAGTAPE FROM SOME UNKNOWN
POSITION TO A KNOWN ONE.  THE POSITION DESIRED IS: 
	AT THE FRONT OF THE LAST MTFILE DUMPED
SUCESSFULLY.  THE NAME (OR OTHER DESCRIPTION) AT THE FRONT
OF THAT FILE IS KNOWN IN MEMSAV. OUR SCHEME IS TO INIT THE MTA WITH ONLY
ONE BUFFER. BACKSPACE 4 FILES (THAT OUGHT TO BE ENOUGH) AND
READ THE FIRST RECORD FROM EACH FILE UNTIL WE SEE WHAT WE WANT.
WHEN WE SEE WHAT WE WANT, WE BACKF AND SKIPF TO POSITION OURSELVES
AT THE FRONT OF THAT FILE.  NOTE THAT THE CALLER MAY WANT TO 
SKIPF PAST THIS FILE!

$

FIXPOS:
IFN DBGSW,<
	SKIPE	DBGNTP
	POPJ	P,			;IF NOT USING TAPE, GET OUT QUICK
>;IFN DBGSW
	PUSHJ	P,MTAREL		;RELEASE THE DRIVE
	PUSHJ	P,MINIT1		;INIT DRIVE WITH ONE BUFFER.
	PUSHJ	P,MTABKF
	PUSHJ	P,MTABKF
	PUSHJ	P,MTABKF
	PUSHJ	P,MTABKF
	PUSHJ	P,MTASKF
	SETZM	FIXCNT			;ZERO COUNT
FIXPS0:	TLO	FL,RDHACK		;TURN ON SPECIAL HACK FLAG.
	PUSHJ	P,RDFIL			;GET THE FILE NAME FROM THE TAPE.
	TLZN	FL,RDHACK		;TURN OFF AND TEST FOR HACK.
	JRST	FIXPS2			;WE HAVE BEEN HACKED!
	MOVE	A,FILINF+DDNAM
	HLLZ	B,FILINF+DDEXT
	MOVE	D,FILINF+DDPPN
	CAMN	A,MEMSAV+FFILE
	CAME	D,MEMSAV+FUSER
	JRST	FIXPS3			;THIS IS NOT WHAT WE WANTED.
	CAME	B,MEMSAV+FFEXT
	JRST	FIXPS3
FIXPS1:	PUSHJ	P,MTABKF		;BACK TO THE FRONT
	PUSHJ	P,MTASKF		;FORWARD TO THE FRONT OF FILE.
	PUSHJ	P,MTAREL		;RELEASE MTA AND
	PUSHJ	P,MTINIT		;GET IT AGAIN WITH 3 BUFFERS.
	POPJ	P,			;TAPE IS POSITIONED.

FIXPS2:	MOVE	A,MEMSAV+FUSER		;HERE IF WE HAVE SPECIAL HACK!
	CAMN	A,['*HEAD*']		;IS SPECIAL DATA REMEMBERED?
	JRST	FIXPS1			;YES. WE HAVE RIGHT POSITION NOW.

FIXPS3:	AOS	A,FIXCNT		;HERE WE HAVE LOST.
	CAILE	A,3			;HAVE WE DONE THIS ENOUGH?
	JRST	FIXPS4			;YES.
	PUSHJ	P,MTABKF		;BACK TO IN FRONT OF THIS
	PUSHJ	P,MTASKF		;FORWARD TO FRONT OF THIS
	PUSHJ	P,MTASKF		;FORWARD TO NEXT
	PUSHJ	P,MTACLZ		;FORGET BUFFERS.
	GETSTS	MTA,A
	TRZ	A,20000
	SETSTS	MTA,(A)
	JRST	FIXPS0			;TRY AGAIN.

FIXPS4:	OUTSTR	[ASCIZ/Unable to reposition the magtape correctly.
/]
;	PUSHJ	P,MTABKF
;	PUSHJ	P,MTASKF
;	PUSHJ	P,MTAREL
;	JRST	MTINIT			;INIT MTA AND RETURN UP.
	JRST	RESTAR		;Give up after this horrible error,
				; else might clobber a rewound tape!!
;GETTAP GETTP1 PUTTAP PUTTP1 PUTTP2

	SUBTTL	GETTAP	GET A TAPE NUMBER FROM DART.TAP
GETTAP:	MOVE	A,['DART  ']
	MOVSI	B,'TAP'
	SETZB	C,TAPBLK
	SETZM	TAPBLK+1
	MOVE	D,DUMPER
	LOOKUP	DSKMSC,A
	JRST	GETTP1
	INPUT	DSKMSC,[IOWD 2,TAPBLK
			0]
	CLOSE	DSKMSC,
GETTP1:	MOVEI	A,TAPBLK
	TRNN	FL,PCLASS
	ADDI	A,1
	AOS	A,(A)
	MOVEM	A,TAPNO		;SAVE TAPE NUMBER
	MOVEM	A,MEMSAV+TAPNUM	;SAVE..
	POPJ	P,

PUTTAP:	MOVE	A,['DART  ']
	MOVSI	B,'TAP'
	SETZB	C,TAPBLK
	SETZM	TAPBLK+1
	MOVE	D,DUMPER
	LOOKUP	DSKMSC,A
	JRST	PUTTP1
	INPUT	DSKMSC,[IOWD 2,TAPBLK
			0]
	CLOSE	DSKMSC,
PUTTP1:	MOVEI	A,TAPBLK
	TRNN	FL,PCLASS
	ADDI	A,1
	MOVE	B,TAPNO		;GET TAPE NUMBER
	MOVEM	B,(A)
	MOVE	A,['DART  ']
	MOVSI	B,'TAP'
	MOVEI	C,0
	MOVE	D,DUMPER
	ENTER	DSKMSC,A
	JRST	PUTTP2
	OUTPUT	DSKMSC,[IOWD 2,TAPBLK
			0]
	CLOSE	DSKMSC,
	POPJ	P,
PUTTP2:	OUTSTR	[ASCIZ/ENTER to update DART.TAP has failed.
/]
	MOVEI	A,10
	SLEEP	A,
	JRST	PUTTP1		;TRY AGAIN.
;OPRZER OPRERR DOMOUNT TELOPR TELOP0 TELOP1 TELOP5 TELOP8 TELOP9 NOMTA9 TELP10 GETANS GETAN1 GETA11 GETAN5 GETAN2 GETAN3 GETAN4

	SUBTTL	TELOPR	TELL OPERATOR WHAT TAPE TO MOUNT.

OPRZER:	OUTSTR	[ASCIZ/Tape number zero illegal !!!
/]
	CAIA
OPRERR:	OUTSTR	[ASCIZ/Illegal response: invalid "GO", "P" or "T" or not digits
/]
	TTCALL	11,
DOMOUNT:				;TELL OPERATOR WHAT TO MOUNT NEXT.
	SKIPN	PICKON			;PICKUP IN PROGRESS?
	JRST	TELOPR			;NO DO THE NORMAL THINGG
	TTCALL	11,			;FLUSH TYPE AHEAD
IFN DBGSW,<
	SKIPE	DBGNTP			;SKIP IF REALLY USING TAPE
	OUTSTR	[ASCIZ/(PRETEND) /]
>;IFN DBGSW
	OUTSTR	[ASCIZ/Verify that tape number /]
	PUSHJ	P,REELM0
	MOVE	A,TAPNAM
	PUSHJ	P,SIXOUT
	OUTSTR	[ASCIZ/ is mounted and type GO<return>: /]
	PUSHJ	P,GETANS
	JRST	OPRERR			;error return
	JRST	OPRERR			;tape number typed return
	PUSHJ	P,MTINIT
IFN DBGSW,<
	SKIPE	DBGNTP			;SKIP IF REALLY USING TAPE
	POPJ	P,			;ELSE GET OUT EARLY
>;IFN DBGSW
	PUSHJ	P,MTANOP
	TLO	FL,MCLOSE
	STATO	MTA,IOBOT		;FRONT OF TAPE?
	POPJ	P,			;NO. DONE.
;	PUSHJ	P,TELWCK		;Make sure not write locked if rewound
	MOVE	A,['*HEAD*']
	MOVEM	A,MEMSAV+FUSER
	JRST	TAPHED			;WRITE HEADER

TELOPR:	MOVE	A,TAPNO			;GET TAPE NUMBER
	TRNN	FL,PCLASS		;T-DUMP?
	CAIE	A,NTTAPE+1		;YES. ASKING TO MOUNT TMAX+1?
	JRST	TELOP0
DEFINE TELOPM (NNN) <
	OUTSTR	[ASCIZ/(Finished with NNN tape series. Starting over.)
/]
>;TELOPM
	RADIX	5+5
	TELOPM(\NTTAPE)
	RADIX	4+4
	MOVEI	A,1
	MOVEM	A,TAPNO			;SET T1 INSTEAD OF T32
TELOP0:	PUSHJ	P,REELM0		;FORM THE TAPE FILE AND REEL NAME
	TTCALL	11,			;FLUSH TYPE AHEAD.
IFN STANSW!IRCPPN,<
	SETO	A,
	BEEP	A,			;Wake up the operator, if any
>;IFN STANSW!IRCPPN
IFN DBGSW,<
	SKIPE	DBGNTP			;SKIP IF REALLY USING TAPE
	OUTSTR	[ASCIZ/(PRETEND) /]
>;IFN DBGSW
	OUTSTR	[ASCIZ/Mount tape number /]
	MOVE	A,TAPNAM
	PUSHJ	P,SIXOUT		;TYPE IN SIXBIT
	OUTSTR	[ASCIZ\ and type GO<return>, or type P/T<num> <return>: \]
	PUSHJ	P,GETANS
	JRST	OPRERR			;error return
	JRST	TELOP1			;tape number typed return
	JRST	TELOP5			;GO typed return
TELOP1:	JUMPE	B,OPRZER		;special test for zero tape #
	MOVEM	B,TAPNO
	MOVEM	B,MEMSAV+TAPNUM
TELOP5:	PUSHJ	P,REELM0
	OUTSTR	[ASCIZ/Using tape number /]
	MOVE	A,TAPNAM
	PUSHJ	P,SIXOUT
	OUTSTR	CRLF
	TTCALL	11,			;DEPT REDUNDANCY DEPT
	SKIPG	B,MEMSAV+TTCNT		;ARE THERE ANY TAPE TERMS ALREADY?
	JRST	TELOP8			;NONE. BUILD ONE.
	HRRZ	A,MEMSAV+TTBUF-1(B)	;GET THE LAST TERM.
	CAMN	A,TAPNO			;Is it the same as new tape num?
	JRST	[OUTSTR [ASCIZ\Are you SURE that's correct? (type GO or P/T<num>): \]
		 PUSHJ  P,GETANS
		 JRST   OPRERR		;error return
		 JRST   TELOP1		;tape number typed return
		 JRST   TELOP9]		;GO typed return - no new tape term - weird
	ADDI	A,1
	CAME	A,TAPNO			;IS THIS THE EXPECTED NUMBER?
	JRST	TELOP8			;NO. WE BUILD A NEW TERM NOW.
	HRRM	A,MEMSAV+TTBUF-1(B)	;STORE INCREMENTED NUMBER
	JRST	TELOP9

TELOP8:	AOS	B,MEMSAV+TTCNT		;INCREMENT THE COUNT.
	CAILE	B,20
	JRST	TELP10			;OOPS.
	HRLZ	A,TAPNO
	HRR	A,TAPNO
	MOVEM	A,MEMSAV+TTBUF-1(B)
TELOP9:	PUSHJ	P,MTINIT		;INITIALIZE THE MAGTAPE
IFN DBGSW,<
	SKIPE	DBGNTP			;SKIP IF REALLY USING TAPE
	JRST	NOMTA9			;ELSE SKIP TAPE OPERATIONS
>;IFN DBGSW
	PUSHJ	P,MTAREW		;MAKE SURE IT IS REWOUND
	PUSHJ	P,MTANOP		;WAIT FOR REWIND TO FINISH
	GETSTS	MTA,A
	TRZ	A,IOIMPM+IOTEND		;CLEAR SOME BITS
	SETSTS	MTA,(A)			;SET STATUS.
;	PUSHJ	P,TELWCK		;Make sure not write locked if rewound
NOMTA9:	TLO	FL,MCLOSE		;WE ARE AT BEGINNING OF AN MT FILE
	MOVE	A,['*HEAD*']		;PICKUP ODDNESS
	MOVEM	A,MEMSAV+FUSER		;SAVE IN SPECIAL PLACE.
	JRST	TAPHED			;MAKE A TAPE HEADER.

TELP10:	OUTSTR	[ASCIZ/Tape term block overflow.  No place to store tape number.
/]
	HALT	TELOPR

REPEAT 0,< ;This was a great idea, but you have to try and write on the
	   ;silly tape before the system will let you know it's write locked!

TELWCK:		; Check tape for write lock if rewound: make sure operator
		;  puts in a write ring, and then rewind for good measure.
		; If not rewound (not at front of tape), just return.
	PUSHJ	P,MTANOP		;NO-OP so status will be available
	GETSTS	MTA,A
	TRNN	A,IOBOT			;Front of tape?
	 POPJ	P,			;No, just return
TELWC1:	TRNE	A,IOTEND		;Not IOTEND
	 POPJ	P,
	TRNN	A,IOIMPM		;and IOIMPM implies write locked
	 POPJ	P,
	TTCALL	11,
TELWC2:	OUTSTR	[ASCIZ/This tape is write-locked!  If you are SURE you want to continue
and write on the tape, put the write ring in and type GO<return>: /]
	PUSHJ	P,GETANS
	JRST	TELWC2			;error return
	JRST	TELWC2			;tape number typed return
	PUSHJ	P,MTAREW		;Make sure it is rewound
	PUSHJ	P,MTANOP		;Wait for rewind, make status avail.
	GETSTS	MTA,A
	JRST	TELWC1
>; REPEAT 0

GETANS:
GETAN1:	TTCALL	4,A			;GET A CHARACTER.
GETA11:	CAIN	A,15			;TURKEY ENTERS HERE WITH CHAR IN A
	JRST	GETAN1
	CAIN	A,12
	JRST	CPOPJ			;ERROR RET - JUST CR TYPED
	CAIE	A,"G"+40
	CAIN	A,"G"
	JRST	[TTCALL	4,A
		 CAIE	A,"O"+40
		 CAIN	A,"O"
		 CAIA
		 JRST	CPOPJ
		 TTCALL	4,A
		 CAIE	A,15
		 JRST	CPOPJ
		 TTCALL	4,A
		 CAIE	A,12
		 JRST	CPOPJ
		 JRST	CPOPJ2]		;"GO" RETURN
	MOVEI	B,0			;ZERO THE NUMBER OF THE OPR'S TAPE.
	CAIE	A,"P"+40
	CAIN	A,"P"
	JRST	[TLNE FL,L.TURK		;TURKEY COMMAND?
		JRST GETAN5		;YES, OK (TURN OFF L.TURK FOR P CLASS)
		TRNE	FL,PCLASS
		JRST	GETAN2
		JRST	CPOPJ]
	CAIE	A,"T"
	CAIN	A,"T"+40
	JRST	[TLNE FL,L.TURK		;TURKEY COMMAND?
		JRST GETAN2		;YES, OK (LEAVE L.TURK SET FOR T CLASS)
		TRNN	FL,PCLASS
		JRST	GETAN2
		JRST	CPOPJ]
	JRST	CPOPJ			;ANYTHING ELSE IS AN ERROR

GETAN5:	TLZ FL,L.TURK			;FLAG P CLASS (RECYCLE TURK FLAG)
GETAN2:	TTCALL	4,A			;EXPECT A DIGIT
GETAN3:	CAIL	A,"0"
	CAILE	A,"9"
	JRST	GETAN4
	IMULI	B,12
	ADDI	B,-"0"(A)
	JRST	GETAN2
GETAN4:	CAIN	A,15
	JRST	GETAN2
	CAIE	A,12
	JRST	CPOPJ
	JRST	CPOPJ1			;TAPE NUMBER TYPED RETURN
;DOMT0B DOMT0 DOMT0A DOM0G2 DOMT0G DOM0G1 DOMT1 DOMT2 DOMT3 DOMT4

	SUBTTL	DOMT0	TELL OPERATOR WHAT TAPE TO MOUNT FOR MRESTORE
;CALL WITH TAPNO SET UP TO THE NEXT TAPE NEEDED FOR THE MRESTORE
;	PUSHJ P,DOMT0
;	<HERE IF OPERATOR WANT TO SKIP THAT TAPE.  MRTPNO SET POSSIBLY>
;	<OPERATOR COMPLIED WITH REQUEST>


DOMT0B:	OUTSTR	[ASCIZ/Illegal tape number: need "P", "T", "X", or crlf
/]
DOMT0:	TTCALL	11,			;FLUSH TYPE AHEAD
	SETZM	MRTPNO			;NO OPR INSTRUCTION ABOUT WHAT TAPE TO USE
	OUTSTR	[ASCIZ/Mount tape number /]
	MOVE	A,TAPNO
	MOVEM	A,STAPNO		;SAVE ORIGNIAL FORM FOR DOMT4
	PUSHJ	P,REELMX
	MOVE	A,TAPNAM
	PUSHJ	P,SIXOUT
	OUTSTR	[ASCIZ/ and type return,
or type X to skip this tape,
or type the tape number that you want to restore next: /]
	MOVEI	B,0			;COUNT IF X IS SEEN
DOMT0A:	TTCALL	4,A
	CAIE	A,"X"
	CAIN	A,"X"+40
	AOJA	B,DOMT0A
	CAIE A,"G"
	CAIN A,"G"+40
	JRST DOMT0G			;"GO" SAME AS CR
	CAIE	A,"P"
	CAIN	A,"P"+40
	JRST	DOMT1
	CAIE	A,"T"
	CAIN	A,"T"+40
	JRST	DOMT2
	CAIN	A,15
	JRST	DOMT0A
	CAIE	A,12
	JRST	DOMT0B
	JUMPN	B,CPOPJ
DOM0G2:	AOS	(P)			;FORCE SKIP RETURN
	JRST	MTINIT			;INIT MTA AND RETURN

DOMT0G:	TTCALL 4,A			;GOT A G, LOOK FOR O
	CAIE A,"O"
	CAIN A,"O"+40
DOM0G1:	TTCALL 5,A			;INCHSL
	JRST DOMT0B			;ILLEGAL WITHOUT O
	CAIN A,15
	JRST DOM0G1			;SKIP CR
	CAIE A,12
	JRST DOMT0B			;SOMETHING BESIDES CRLF AFTER THE GO
	JRST DOM0G2			;GO SAME AS BARE CRLF

DOMT1:	TROA	FL,PCLASS
DOMT2:	TRZ	FL,PCLASS
DOMT3:	TTCALL	4,A			;EXPECT A DIGIT
	CAIL	A,"0"
	CAILE	A,"9"
	JRST	DOMT4
	IMULI	B,12
	ADDI	B,-"0"(A)
	JRST	DOMT3

DOMT4:	CAIN	A,15
	JRST	DOMT3			;SKIP CR
	CAIE	A,12
	JRST	DOMT0B			;ANYTHING ELSE IS ILLEGAL
	TRZN	FL,PCLASS
	TRO	B,400000		;SET BIT 18 IF T CLASS TAPE
	CAMN	B,STAPNO		;IS ARGUMENT SAME AS WHAT WE WANTED?
	JRST	DOMT0			;YES.  WELL, TELL HIM TO TYPE RETURN!
	MOVEM	B,MRTPNO		;SET FLAG FOR CALLER
	POPJ	P,			;TELL THEM UP THERE WE HAVE OTHER IDEAS.
;ARCHIVE ARC.RT ARC.RD ARC.TS ARCHIV ARCH0 ARCCOM ARC0.0 ARC.RT ARC.RD ARC.TS ARC.TF ARCTF1 ARCTF2 ARC.DF ARCDF0 ARCDF1 ARCDF2 ARC.M ARC.M0 ARC.M1 ARC.M2 ARCM2A A.MAF A.MAF0 A.MAF1 A.MDF A.MDF2 A.MDF1 ARCTS1 ARCDRD ARCDR1 ARCDR2 ARCDR3 AR.DR3 ARCDR4 ARCDR5 ARCDR6 ARCDR7 AIDXBW AIDXBG AIDXND AIDXFR AIDXIN AIDXWT SKPADX SKPAD1 RDAPP1 RDAPPN ARCB0 ARCBX ARCB1 ARCB2 ARCB3

	SUBTTL	ARCHIVE COMMAND
;ARCHIVE MERGES DART.DAT AND DART.ARC, PRODUCING A BIGGER DART.ARC
;AND A SMALLER DART.DAT WHICH CONTAINS ONLY THE T-DUMP DATA.
;THE OBJECT IS TO REDUCE THE SIZE OF DART.DAT WHICH IS FREQUENTLY
;REFERENCED DURING THE DUMP PROCESS.

;CHANNEL	FILE		I/O	BUFFER	GET(PUT) ROUTINE

;UFD		DART.DAT 	I(B)	UFDBUF	UFDRD	(SKIPS UNLESS EOF)
;MEM		DART.ARC	I(D)	MEMBLK	TNREAD	(SKIPS UNLESS EOF)
;FILE		DART.DAT 	O(B)	FOBUF	DFWRTX
;DSKMSC		DART.ARC 	O(D)	REELBF	DMPUT, DMINI

COMMENT $
	ARCHIVE DIAGRAM	(ALMOST THE SAME AS MERGE, ELSEWHERE IN THIS PROGRAM.)
	D=DART.DAT FILE INPUT
	A=DART.ARC FILE INPUT

ARCHIVE:DEOF_AEOF_FALSE;
	DNEED_ANEED_TRUE;
ARC.RT:	IF AEOFANEED THEN READ ANAME;
	IF EOF ON A THEN AEOF_TRUE;
	ANEED_FALSE;
ARC.RD:	IF DEOFDNEED THEN READ DNAME;
	IF EOF ON D THEN DEOF_TRUE;
	DNEED_FALSE;
ARC.TS:	IF DEOFAEOF THEN DONE;
	IF DEOF THEN SPLIT ADATA; ANEED_TRUE; GO TO RA;
	IF AEOF THEN SPLIT DDATA; DNEED_TRUE; GO TO RD;
	IF ANAME > DNAME THEN SPLIT DDATA; DNEED_TRUE; GO TO RD;
	IF ANAME < DNAME THEN WRITE ADATA; ANEED_TRUE; GO TO RA;
	MERGE DDATA AND ADATA AND SPLIT BOTH;
	ANEED_DNEED_TRUE;
 	GO TO RT;
$

ARCHIV:	SETZM	RSTDEV			;INITIALIZE DEVICE NAME
IFN IRCPPN,<
	HRROI A,2
	GETTAB A,
>
	GETPPN	A,			;IS THIS THE REAL DUMPER?
IFE STANSW,<
	 JFCL
>
	CAME	A,DUMPER
	JRST	NOPRV			;LOSER.
ARCH0:	MOVE	A,RSTDEV		;GET THE LAST NAME USED
IFE STANSW,<
	SYSSTR	A,			;GET NEXT STRUCTURE NAME
>
	MOVSI	A,'DSK'			;USE DSK IF NO STRUCTURES
	CAMN	A,RSTDEV		;DIFFERENT FROM LAST NAME?
	POPJ	P,			;NO. RETURN
	JUMPE A,CPOPJ			;REG IS CONFUSED ABOUT SYSSTR
	MOVEM	A,RSTDEV		;SAVE STRUCTURE NAME
	PUSH	P,.JBFF
	PUSHJ	P,ARCCOM		;DO ARCHIVE FOR ONE STRUCTURE
	POP	P,.JBFF
	JRST	ARCH0

ARCCOM:
;OPEN 4 DISK CHANNELS
	MOVEI	A,10
	MOVE	B,RSTDEV
	MOVSI	C,FOBUF
	OPEN	FILE,A		;DART.DAT OUTPUT
	PUSHJ	P,NODEV
	OUTBUF	FILE,23		;SOME BUFFERS

	MOVEI	C,UFDBUF
	OPEN	UFD,A		;DART.DAT INPUT
	PUSHJ	P,NODEV
	INBUF	UFD,23		;SOME BUFFERS

	MOVEI	A,17
	MOVEI	C,0
	OPEN	MEM,A		;DART.ARC INPUT
	PUSHJ	P,NODEV

	OPEN	DSKMSC,A	;DART.ARC OUTPUT
	PUSHJ	P,NODEV
	SETOM	DSKMM3		;SET BINARY MODE FOR DMINI
	PUSHJ	P,DMINI		;INITIALIZE FOR OUTPUT

;SET FLAGS (NEED FLAGS ARE 1 FOR no NEED!)
	TLZ	FL,AEOF!DEOF!ANEED!DNEED
	MOVE	A,['DART  ']
	MOVSI	B,'DAT'
	MOVEI	C,0
	MOVE	D,DUMPER
	LOOKUP	UFD,A		;SEEK DART.DAT FILE
	JRST	ARCB0

	MOVSI	B,'DAT'
	MOVEI	C,0
	MOVE	D,DUMPER
	ENTER	FILE,A		;ENTER NEW COPY
	JRST	ARCB2

	MOVSI	B,'ARC'
	MOVEI	C,0
	MOVE	D,DUMPER
IFN STANSW,<
	LOOKUP	MEM,A		;SEEK DART.ARC
>
IFE STANSW,<
	MOVEM A,LKBLK+.RBNAM
	MOVEM B,LKBLK+.RBEXT
	MOVEM D,LKBLK+.RBPPN
	LOOKUP MEM,LKBLK
>
	TLOA	FL,AEOF		;SET EOF ON INPUT AND SKIP. (ASSUME NON-EX FILE)
	JRST	ARC0.0		;FILE EXISTS
	TRNE	B,-1		;MAKE SURE LOOKUP CODE = 0, NON-EX FILE
	JRST	ARCB1		;WE LOSE SOMEHOW.
IFN STANSW,<
	MOVEI	D,0
>
IFE STANSW,<
	TDZA D,D
>
ARC0.0:
IFE STANSW,<
	MOVN D,LKBLK+.RBSIZ
	MOVEM D,MEMWC		;TDZA SKIPS TO HERE
>
IFN STANSW,<
	MOVSM	D,MEMWC		;SAVE -WC OF ARC FILE.
>
	SETZM	MEMWC2		;CONTROL CELLS FOR TNREAD
	MOVSI	B,'ARC'
	MOVEI	C,0
	MOVE	D,DUMPER
	ENTER	DSKMSC,A
	JRST	ARCB3		;ENTER FAILED.

	PUSHJ	P,SKPIDX	;SKIP FIRST INDEX BLOCK ON DAT FILE.
	PUSHJ	P,UIDXIN	;INITIALIZE FOR  INDEX OUTPUT ON DAT FILE
	PUSHJ	P,SKPADX	;SKIP FIRST INDEX BLOCK ON ARC FILE
	PUSHJ	P,AIDXIN	;INITIALIZE FOR INDE OUTPUT ON DAT FILE.

ARC.RT:	TLNE	FL,AEOF!ANEED	;NEED ARC INPUT AND NOT EOF?
	JRST	ARC.RD		;NO. EITHER WE HAVE TNAME OR EOF
	PUSHJ	P,RDAPPN	;READ TNAME. - SKIPPING INDEX
	TLO	FL,AEOF		;EOF OK HERE.
	TLO	FL,ANEED	;NO NEED FOR ANOTHER TNAME
	MOVEM	A,TNAME		;SAVE PPN
	JUMPN	A,ARC.RD	;JUMP IF REAL PPN
	TLO	FL,AEOF		;0 MEANS EOF, EVEN IF THERE'S MORE DATA!

ARC.RD:	TLNE	FL,DEOF!DNEED
	JRST	ARC.TS		;WE HAVE DNAME ALREADY. (OR EOF)
	PUSHJ	P,RDIPPN	;READ DNAME - IGNORING INDEX BLOCK.
	TLO	FL,DEOF		;EOF.
	TLO	FL,DNEED	;DNAME IS LOADED.
	MOVEM	A,DNAME	
	MOVEM	A,DNAMEO	;DNAME FOR DOUTPUT (DAT FILE)

ARC.TS:	TLC	FL,DEOF!AEOF
	TLCN	FL,DEOF!AEOF
	JRST	ARCTS1		;EOF ON BOTH INPUT FILES. WE'RE DONE.
	TLNE	FL,DEOF		;EOF ON DART.DAT?
	JRST	ARC.TF		;YES. GO FLUSH ARC (T) DATA TO OUTPUT.
	TLNE	FL,AEOF		;EOF ON ARC FILE?
	JRST	ARC.DF		;YES. GO FLUSH DAT DATA TO OUTPUT.
	MOVE	A,DNAME
	CAMN	A,TNAME
	JRST	ARC.M		;HERE WE HAVE TO MERGE. (DIFFICULT)
	PUSHJ	P,UFDCNV	;CONVERT USER NAME IN FUNNY WAY.
	MOVEM	A,DNX		;SAVE FUNNY VERSION.
	MOVE	A,TNAME
	PUSHJ	P,UFDCNV
	MOVEM	A,TNX
	PUSHJ	P,PPNCMP	;COMPARE T AND D
	JRST	ARC.DF		;D<T (FLUSH D)
				;T>D (FLUSH T) (FALL THROUGH)

;HERE TO FLUSH ARC FILE. EITHER DEOF OR TNAME<DNAME.  FLUSH CURRENT UFD.
ARC.TF:	MOVE	A,TNAME		;FLUSH ARC DATA TO NEW ARC FILE.
	PUSHJ	P,AIDXBG	;ADD PPN TO ARC INDEX
	PUSHJ	P,DMPUTX	;WRITE PPN
	TLZ	FL,ANEED	;WILL NEED MORE DATA AFTER WE'RE DONE HERE.
ARCTF1:	PUSHJ	P,TNRD1		;READ A FILE NAME (EOF IS ILLEGAL)
	PUSHJ	P,DMPUTX	;WRITE FILE NAME
	JUMPE	A,ARC.RT	;END OF THIS UFD ENTRY. GET NEXT UFD NAME.
	PUSHJ	P,TNRD1		;READ DATA (EXTENSION)
	PUSHJ	P,DMPUTX	;WRITE IT.
	MOVEI	B,(A)		;GET THE COUNT OF THE NUMBER OF ENTRIES.
ARCTF2:	PUSHJ	P,TNRD1		;READ DATA ENTRY
	PUSHJ	P,DMPUTX	;WRITE DATA
	SOJG	B,ARCTF2	;LOOP THROUGH DATA PORTION.
	JRST	ARCTF1		;SEEK NEXT FILE NAME.


;HERE TO FLUSH DAT FILE. EITHER AEOF, OR DDATA<TDATA.  FLUSH CURRENT UFD.
ARC.DF:	PUSHJ	P,ARCDRD	;YES. HERE WE COPY FROM DAT FILE.
	SKIPN	MMNAM		;DONE WITH THIS UFD?
	JRST	ARCDF2		;YES. TIME TO SEE ANOTHER UFD
	HRRZ	W,MMEXT		;IS THERE ANY DATA TO WRITE?
	JUMPE	W,ARC.DF	;NO.
	MOVEI	A,0
	EXCH	A,DNAME		;GET THE UFD NAME
	JUMPE	A,ARCDF0	;JUMP IF UFD NAME HAS BEEN WRITTEN ALREADY. (ARC)
	PUSHJ	P,AIDXBG	;ADD PPN TO ARC INDEX
	PUSHJ	P,DMPUTX	;WRITE UFD NAME.
ARCDF0:	MOVE	A,MMNAM		;WRITE FILE NAME, EXT AND COUNT.
	PUSHJ	P,DMPUTX
	MOVE	A,MMEXT
	PUSHJ	P,DMPUTX
	MOVE	B,.JBFF
ARCDF1:	MOVE	A,(B)		;LOOP WRITING DATA.
	PUSHJ	P,DMPUTX
	ADDI	B,1
	SOJG	W,ARCDF1
	JRST	ARC.DF		;GET NEXT FILE IN UFD.

ARCDF2:	TLZ	FL,DNEED	;WE SHALL NEED MORE DATA NEXT.
	SKIPN	A,DNAME		;DID WE WRITE THE UFD NAME?
	PUSHJ	P,DMPUTX	;YES. SO WE WRITE ZERO NOW TO STOP UFD ENTRY.
	JRST	ARC.RD		;NOW, READ MORE DATA.


;HERE TNAME=DNAME.  WE HAVE TO (ICK) MERGE.
ARC.M:	TLZ	FL,DNEED!ANEED	;WE SHALL NEED MORE OF BOTH LATER.
	MOVE	A,DNAME		;FOR SURE WE SHALL HAVE TO WRITE THE UFD NAME.
	PUSHJ	P,AIDXBG	;ADD PPN TO ARC INDEX
	PUSHJ	P,DMPUTX	;IN THE ARC FILE (SINCE ARC FILE NEVER SHRINKS)
	SETZM	MMNAM		;FORCE DAT READ.
	SETZM	TTNAM		;FORCE ARC READ.

;HERE TO RELOAD TTNAM AND TTEXT.
ARC.M0:	SKIPE	TTNAM
	JRST	ARC.M1
	PUSHJ	P,TNRD1		;GET THE FILE NAME FROM TAPE.
	MOVEM	A,TTNAM		;SAVE ARC FILE NAME
	JUMPE	A,ARC.M1	;JUMP IF THERE'S NO ARC DATA.
	PUSHJ	P,TNRD1
	MOVEM	A,TTEXT		;SAVE ARC FILE EXTENSION
ARC.M1:	SKIPN	MMNAM		;SKIP IF WE GOT DATA
	PUSHJ	P,ARCDRD	;READ FROM THE DAT FILE.
	SKIPN	MMNAM		;IS THERE A FILE NAME HERE?
	JRST	A.MAF		;NO. FLUSH THE ARC FILE.
	SKIPN	A,TTNAM		;ANY DATA FROM ARC FILE?
	JRST	A.MDF		;NO. FLUSH THE DAT FILE ENTRY.
	CAMLE	A,MMNAM		;SKIP IF TTNAM  MMNAM
	JRST	A.MDF		;TTNAM>MMNAM.  FLUSH DAT DATA
	CAME	A,MMNAM		;SKIP IF TTNAM=MMNAM
	JRST	A.MAF		;TTNAM<MMNAM.  FLUSH ARC DATA
	HLLZ	B,MMEXT
	HLLZ	A,TTEXT
	CAMLE	A,B		;SKIP IF TTEXT  MMEXT
	JRST	A.MDF		;TTEXT>MMEXT.  FLUSH DAT DATA
	CAME	A,B
	JRST	A.MAF		;TTEXT<MMEXT.  FLUSH ARC DATA
;HERE WE HAVE THE SAME FILE NAMES.  FLUSH DAT FIRST (NEWER) THEN ARC.
	HRRZ	W,MMEXT		;GET DAT COUNT.
	JUMPE	W,A.MAF		;IF NULL, FLUSH ARC DATA. (WRITE TTNAM FIRST)
	MOVE	A,TTNAM		;GET FILE NAME
	PUSHJ	P,DMPUTX	;WRITE IT.
	MOVE	A,TTEXT		;GET EXTENSION
	ADDI	A,(W)		;ADD TO ARC COUNT THE DAT COUNT
	PUSHJ	P,DMPUTX	;WRITE EXTENSION AND COUNT.
	MOVE	B,.JBFF
ARC.M2:	MOVE	A,(B)		;LOOP WRITING DATA.
	PUSHJ	P,DMPUTX
	ADDI	B,1
	SOJG	W,ARC.M2
	HRRZ	W,TTEXT		;GET THE COUNT
ARCM2A:	PUSHJ	P,TNRD1		;READ ARC
	PUSHJ	P,DMPUTX	;WRITE ARC
	SOJG	W,ARCM2A
	SETZM	TTNAM		;FORCE ARC RELOAD
	SETZM	MMNAM		;FORCE DAT RELOAD
	JRST	ARC.M0		;RELOAD TTNAM FROM ARC FILE.
			
;HERE, ARC DATA IS FLUSHED OUT.  EITHER EOD ON DAT FILE, OR MMNAM>TTNAM
A.MAF:	MOVE	A,TTNAM		;GET THE ARC DATA.
	PUSHJ	P,DMPUTX	;WRITE THE DATA.
	JUMPE	A,ARC.RT	;IF TTNAM=0 THEN WE'RE DONE WITH UFD.
	MOVE	A,TTEXT		;GET THE EXTENSION
	PUSHJ	P,DMPUTX
A.MAF0:	HRRZ	W,TTEXT		;GET THE COUNT
A.MAF1:	PUSHJ	P,TNRD1		;READ ARC
	PUSHJ	P,DMPUTX	;WRITE ARC
	SOJG	W,A.MAF1
	SETZM	TTNAM		;FORCE ARC RELOAD
	SKIPE	MMNAM		;EOD ON DAT UFD?
	JRST	ARC.M0		;RELOAD TTNAM FROM ARC FILE.
;HERE IF WE'VE FINISHED UFD IN DAT FILE.
	PUSHJ	P,TNRD1		;RELOAD ARC DATA
	MOVEM	A,TTNAM
	JUMPE	A,A.MAF		;JUMP IF EOD ON ARC UFD
	PUSHJ	P,TNRD1
	MOVEM	A,TTEXT
	JRST	A.MAF

;HERE, DAT DATA IS FLUSHED OUT. EITHER EOD ON ARC FILE, OR MMNAM<TTNAM
A.MDF:	HRRZ	W,MMEXT		;IS THERE ANY DATA TO WRITE?
	JUMPE	W,A.MDF1	;NO. RETURN.
	MOVE	A,MMNAM		;WRITE FILE NAME, EXT AND COUNT.
	PUSHJ	P,DMPUTX
	MOVE	A,MMEXT
	PUSHJ	P,DMPUTX
	MOVE	B,.JBFF
A.MDF2:	MOVE	A,(B)		;LOOP WRITING DATA.
	PUSHJ	P,DMPUTX
	ADDI	B,1
	SOJG	W,A.MDF2
A.MDF1:	SETZM	MMNAM		;FORCE RELOAD FROM DAT
	JRST	ARC.M1		;GO REFILL FROM DAT FILE.

ARCTS1:	CLOSE	UFD, 		;DAT IN
	RELEAS	UFD,
	CLOSE	MEM,		;CLOSE ARC IN
	RELEAS	MEM,
	PUSHJ	P,AIDXFR	;FORCE LAST ARC INDEX BLOCK (LAST DATA BLOCK TOO)
	CLOSE	DSKMSC,		;CLOSE ARC OUT.
	PUSHJ	P,UIDXFR	;FORCE LAST DAT INDEX BLOCK
	CLOSE	FILE,		;DAT OUT
	RELEAS	FILE,
	RELEAS	DSKMSC,
	POPJ	P,

;READ DAT DATA (FOR ONE FILE) INTO CORE.
;FLUSH THE TEMPORARY DATA TO NEW DAT OUTPUT.
;COMPACT THE PERMANENT DATA.
ARCDRD:	MOVE	B,.JBFF		;GET ADDRESS OF FIRST FREE
	PUSHJ	P,UFDRD		;READ FROM DART.DAT
	JFCL
	MOVEM	A,MMNAM		;SAVE FILE NAME
	JUMPE	A,ARCDR7	;JUMP IF NO FILE NAME (END OF FILE ENTRY)
	PUSHJ	P,UFDRD		;READ EXTENSION
	JFCL
	MOVEM	A,MMEXT		;SAVE EXTENSION.
	HRRZ	C,A		;GET THE COUNT.
	MOVEI	W,0		;COUNT THE TEMPORARIES.
ARCDR1:	PUSHJ	P,UFDRD		;READ DATA.
	JFCL
	CAMG	B,.JBREL
	JRST	ARCDR2
	MOVE	D,.JBREL
	ADDI	D,2000
	CORE	D,
	JRST	NOCORE
ARCDR2:	MOVEM	A,(B)		;STORE THE DATA.
	JUMPGE	A,.+2		;JUMP IF P-DUMP
	ADDI	W,1		;T-DUMP. INCREMENT THE T COUNT
	ADDI	B,1		;INCREMENT B.
ARCDR3:	SOJG	C,ARCDR1	;LOOP.
	JUMPE	W,CPOPJ		;JUMP IF NOTHING TO WRITE IN DAT
	MOVEI	A,0
	EXCH	A,DNAMEO	;GET UFD NAME
	JUMPE	A,AR.DR3	;JUMP IF UFD NAME HAS BEEN WRITTEN(DAT)
	PUSHJ	P,UIDXBG	;ADD UFD NAME TO FILE INDEX
	PUSHJ	P,DFWRTX	;WRITE UFD NAME.
AR.DR3:	MOVE	A,MMNAM		;GET THE NAME
	PUSHJ	P,DFWRTX
	MOVE	A,MMEXT		;GET THE EXT
	HRRI	A,(W)		;AND THE COUNT.
	PUSHJ	P,DFWRTX
	MOVE	B,.JBFF		;GET POINTER TO THE DATA.
	MOVE	D,.JBFF		;ANOTHER POINTER. THE COMPACT ONE.
	HRRZ	C,MMEXT		;AND THE COUNT
	HLLZS	MMEXT		;CLEAR COUNT.
ARCDR4:	SKIPL	A,(B)		;SKIP IF WE WANT TO WRITE THIS.
	AOJA	D,ARCDR5	;DONT WRITE THIS, BUT COMPACT IT.
	PUSHJ	P,DFWRTX	;WRITE IN T FILE.
	JRST	ARCDR6

ARCDR5:	MOVEM	A,-1(D)		;STORE, COMPACTING.
	AOS	MMEXT		;COUNT ONE.
ARCDR6:	ADDI	B,1		;INCREMENT TAKER.
	SOJG	C,ARCDR4	;LOOP.
	POPJ	P,

ARCDR7:	SKIPN	A,DNAMEO	;WAS THE UFD NAME WRITTEN TO THE DAT FILE?
	PUSHJ	P,DFWRTX	;YES. SO WE WRITE A ZERO TO END IT.
	POPJ	P,		;DONE.

;ROUTINES FOR HANDLING THE INDEX ON THE ARC FILE.
;HERE WHEN THERE'S NO ROOM IN THE INDEX BLOCK WE'RE BUILDING.
AIDXBW:	EXCH	B,ADXPDP			;STRAIGHTEN OUT THE AC'S
	PUSH	P,A
	PUSH	P,B
	PUSHJ	P,AIDXND			;DO THE WORK
	POP	P,B
	POP	P,A				;FIX STACK AND TRY AGAIN.

;HERE TO INITIATE A NEW UFD INTO THE INDEX FILE
AIDXBG:	EXCH	B,ADXPDP
	CAMN	B,[-2,,ADXPDL+175]		;RUN OUT OF SPACE?
	JRST	AIDXBW				;YES.  THIS IS HARD.
	PUSH	B,A				;STORE THE UFD NAME
	PUSH	B,ARCWC				;AND THE CURRENT WORD NUMBER
	EXCH	B,ADXPDP
	POPJ	P,

;HERE TO WRITE OLD INDEX, POINT IT TO A NEW ONE.  INITIALIZE A NEW INDEX
AIDXND:	MOVE	A,ARCWC				;GET WORD COUNT
	ADDI	A,177
	TRZA	A,177				;CALC WORD NUMBER OF NEXT INDEX BLOCK
AIDXFR:	MOVEI	A,0				;END OF WORLD - FORCE LAST INDEX.
	PUSH	P,A
	PUSHJ	P,DMFRC				;FORCE CURRENT BLOCK OUT
	POP	P,A
	EXCH	A,ADXPDL+176			;GET OLD INDEX BLOCK WORD NUMBER
	LSH	A,-7				;CONVERT TO RECORD NUMBER
	USETO	DSKMSC,1(A)			;SET THE BLOCK.
	PUSHJ	P,AIDXWT			;WRITE THE 128 WORDS OF INDEX.
	SKIPG	A,ADXPDL+176			;GET THE WORD NUMBER OF NEXT INDEX
	POPJ	P,				;ZERO MEANS LAST WAS FORCED AT EOF
	LSH	A,-7
	USETO	DSKMSC,1(A)			;SET TO WRITE BLANK INDEX BLOCK.
	JRST	.+2
AIDXIN:	SETZM	ADXPDL+176			;HERE TO INITIALIZE EVERYTHING
	MOVE	A,[-200,,ADXPDL-1]
	MOVEM	A,ADXPDP
	SETZM	ADXPDL
	MOVE	A,[ADXPDL,,ADXPDL+1]
	BLT	A,ADXPDL+175			;CLEAR FRESH INDEX BLOCK
	MOVEI	A,200
	ADD	A,ADXPDL+176
	MOVEM	A,ARCWC				;COUNT THE INDEX IN THE WC
AIDXWT: MOVSI	B,-200
	MOVE	A,ADXPDL(B)
	PUSHJ	P,DMPUT
	AOBJN	B,.-2
	JRST	DMFRC				;GO FORCE THIS BLOCK OUT.

SKPADX:	PUSHJ	P,TNREAD
	POPJ	P,				;END OF FILE?
SKPAD1:	MOVSI	B,-173
	PUSHJ	P,TNREAD
	JFCL
	AOBJN	B,.-2
	PUSHJ	P,TNREAD
	JFCL
	MOVEM	A,ALTIPP			;SAVE NAME OF LAST INDEXED PPN
	SETOM	ALTRPP				;NAME OF LAST PPN READ
	MOVSI	B,-3
	PUSHJ	P,TNREAD
	JFCL
	AOBJN	B,.-2
	POPJ	P,

;NOW, SKIP ZEROS UNTIL WE SEE THE NEXT INDEX BLOCK, IF ANY
RDAPP1:	PUSHJ	P,TNREAD			;SKIP ANY NULLS PRECEDING NEXT INDEX
	POPJ	P,
	JUMPE	A,.-2				;SKIP NULLS.
	PUSHJ	P,SKPAD1			;SKIP INDEX BLOCK
RDAPPN:	MOVE	A,ALTIPP			;GET NAME OF LAST PPN IN INDEX
	CAMN	A,ALTRPP			;SAME AS LAST PPN READ?
	JRST	RDAPP1				;YES. NOW SKIP TO INDEX...
	PUSHJ	P,TNREAD
	POPJ	P,				;END OF FILE.
	MOVEM	A,ALTRPP
	JRST	CPOPJ1

ARCB0:	OUTSTR	[ASCIZ/Can't find or access DART.DAT for archive - LOCATE.
/]
ARCBX:	RESET	
	HALT	.

ARCB1:	OUTSTR	[ASCIZ/Can't find or access DART.ARC for archive - LOCATE.
/]
	JRST	ARCBX

ARCB2:	OUTSTR	[ASCIZ/Can't enter new DART.DAT
/]
	JRST	ARCBX

ARCB3:	OUTSTR	[ASCIZ/Can't enter new DART.ARC
/]
	JRST	ARCBX
;ILMRS1 ILMRS2 ILMRS3 MRESTO MRES1 MRESL MRESL1 MRESL2 MRES2 MRESA MRESA0 MRESA7 MRESA6 MRESA8 MRESA9 MRESA1 MRESA2 MRES3 MRTS MRTS1 MRTS2 MRTS3 MRTS4

	SUBTTL	MRESTORE

;Major Restore Command.  This command may be used to restore a list of directories,
;or, after some catastrophe, all directories.

;Requirements:
; First, restore ALLDIR.DAT[DMP,SYS] from the END of the (last tape of the)
; last dump completed prior to the castrophe.
; Then typein the MRESTORE command followed by a series of arguments, e.g.,
;   MRESTORE [*,*]
;   MRESTORE [*,FOO],[2,BAR]
; Note there is no point in trying to MRESTORE a individual files
; since the LOCATE command will find the particular tapes of interest.

ILMRS1:	OUTSTR	[ASCIZ/Destination term illegal in MRESTORE
/]
	JRST	RESTAR

ILMRS2:	OUTSTR	[ASCIZ/Individual names illegal in source term.  Only *.* legal.
/]
	JRST	RESTAR

ILMRS3:	OUTSTR	[ASCIZ/I need ALLDIR.DAT.  You'd better find one from some old tape.
Alternatively, if you wanted ALLDIR.OLD, copy it as ALLDIR.DAT.
/]
	JRST	RESTAR




MRESTO:	PUSHJ	P,SCAN			;SCAN THE COMMAND LINE.
	SETZM	MRSTDV-1		;KLUGE
	SKIPN	R,DEST			;WAS THERE ANY DESTINATION GIVEN
	MOVEI	R,MRSTDV-1		;KLUGE TO ZERO MRSTDV BLOCK
	MOVSI	R,(R)			;SOURCE OF BLT
	HRRI	R,MRSTDV		;DESTINATION
	BLT	R,MRSTPN		;DO THE TRANSFER
	MOVEI	A,ALLMSK		;ASSUME DSK:*.*[*,*]
	SKIPN	DEST			;WAS THERE EXPLICIT DEST TERM
	MOVEM	A,MRSTET		;NO. SET *.* FLAGS
	SKIPN	A,MRSTDV		;GET THE DEVICE NAME
	MOVSI	A,'DSK'			;NONE THERE. USE DISK
	MOVEM	A,MRSTDV		;SAVE AS RESTORE DEVICE.
	MOVE	B,MRSTET		;GET SPECIAL BITS 
	CAIE	B,ALLMSK
	JRST	ILMRS1			;ILLEGAL DESTINATION TERM

	HRRZ	W,TBASE			;GET THE BASE OF ALL TERMS
	CAME	W,FSPTR			;ARE THERE ANY SOURCE TERMS AT ALL?
	JRST	MRES1			;YES.
	PUSHJ	P,GETBLK		;GET A TERM BLOCK
	MOVEI	A,ALLMSK		;RESTORE *.*[*,*]
	MOVEM	A,FSEXT(R)		;STORE WILD FLAGS
MRES1:	MOVE	A,USRPPN		;INITIAL STICKY PPN
	MOVEM	A,STKPPN		;SAVE IT
	SETZM	A,STKBIT		;SAVE STICKY BITS
	MOVE	A,FSDEV(W)		;LOOK FOR A DEVICE
	MOVEM	A,MTDEV			;DEV NAME GIVEN IN FIRST TERM. SAVE IT.
	MOVE	A,FSPTR
	MOVEM	A,.JBFF			;MAKE .JBFF FROM FREE POINTER.
MRESL:	HRRZ	B,FSEXT(W)		;GET MAGIC BITS
	TRON	B,ALLFIL+ALLEXT		;IS THE NAME WILD?
	SKIPE	FSNAM(W)		;NOT WILD. IS THERE ANY NAME?
	MOVEI	B,0			;WILD NAME OR EXPLICIT NAME
	IORB	B,FSEXT(W)		;NO NAME AND NOT WILD. ASSUME *.*
	TRC	B,ALLFIL!ALLEXT
	TRCE	B,ALLFIL!ALLEXT
	JRST	ILMRS2
	ANDI	B,ALLPRJ!ALLPRG		;SELECT ONLY THE PPN BITS.
	SKIPN	A,FSPPN(W)		;PICKUP ANY EXPLICIT PPN
	JUMPE	B,MRESL1		;JUMP IF THERE IS NO EXPLICT BITS
	MOVEM	A,STKPPN		;SAVE NEW STICKY PPN
	MOVEM	B,STKBIT		;SAVE STICKY BIT
	JRST	MRESL2

MRESL1:	MOVE	A,STKPPN		;GET STICKY PPN
	MOVEM	A,FSPPN(W)
	HRRZ	B,STKBIT
	IORM	B,FSEXT(W)		;SAVE STICKY BITS HERE TOO
MRESL2:	ADDI	W,FSLEN			;INCREMENT W
	CAML	W,FSPTR			;ARE WE DONE?
	JRST	MRES2			;YES.
	SKIPE	A,FSDEV(W)		;PICKUP DEVICE NAME
	CAMN	A,MTDEV			;EXPLICIT DEVICE 
	JRST	MRESL			;NO DEVICE, OR SAME DEVICE
	OUTSTR	[ASCIZ/Multiple source devices.
/]
	JRST	RESTAR

MRES2:	MOVEI	A,10+GARBIT		;READ MFD. PREVENT LOSSAGE FROM BAD RETR.
	MOVE	B,MRSTDV		;DEVICE
	MOVEI	C,UFDBUF		;BUFFER HEADER FOR INPUT
	OPEN	UFD,A			;CHANNEL FOR READING ALLDIR.DAT
	PUSHJ	P,NODEV			;LOSE BIG
	INBUF	UFD,23
	MOVE	A,['ALLDIR']
	MOVSI	B,'DAT'
	MOVEI	C,0
	MOVE	D,DUMPER
	LOOKUP	UFD,A			;SEEK FILE
	JRST	ILMRS3			;FATAL ERROR!
	MOVE	S,.JBFF			;GET POINTER TO FREE SPACE.
	MOVEM	S,MRBASE

MRESA:	PUSHJ	P,UFDRD			;READ PPN FROM ALLDIR.DAT
	JRST	MRES3			;EOF.
	JUMPE	A,MRES3			;OR ZERO ENDS THE LIST?
	MOVE	Z,A			;Z_PPN
;CHECK FOR ANY INTEREST IN THIS PPN	;SET UP INSTR. TO XCT.
	MOVE	R,TBASE			;BASE OF TERMS
MRESA0:	HRRZ	B,FSEXT(R)
	ANDI	B,ALLPRG!ALLPRJ
	CAIN	B,ALLPRG!ALLPRJ
	JRST	MRESA9			;FOR [*,*] IS EASY.
	HLLZ	C,FSPPN(R)
	HLLZ	D,Z
	TRNN	B,ALLPRJ		;[*,?
	CAMN	C,D			;NO THEY MATCH?
	JRST	MRESA6			;PRJ MATCHES
MRESA7:	ADDI	R,FSLEN
	CAMGE	R,FSPTR
	JRST	MRESA0
	JRST	MRESA8			;REJECT

MRESA6:	HRRZ	C,FSPPN(R)
	TRNN	B,ALLPRG
	CAIN	C,(Z)
	JRST	MRESA9
MRESA8:	SKIPA	Y,[JRST MRESA1]
MRESA9:	MOVSI	Y,(<JFCL>)
MRESA1:	PUSHJ	P,UFDRD			;READ FILE NAME
	JFCL
	SKIPN	W,A			;MOVE FILE NAME TO W.
	JRST	MRESA			;ZERO TERMINATES PPN
	PUSHJ	P,UFDRD			;GET EXTENSION
	JFCL
	MOVE	X,A			;SAVE EXT IN X.
	XCT	Y			;EITHER JRST MRESA1 OR JFCL
	MOVEI	A,3(S)			;MAKE SURE THERE'S ROOM
	CAMGE	A,.JBREL
	JRST	MRESA2			;JUMP IF THERE'S ROOM LEFT
	CORE	A,			;GET MORE CORE
	JRST	NOCORE			;NONE AVAILABLE
MRESA2:	MOVEM	W,0(S)			;STUFF FILE
	MOVEM	X,1(S)			;STUFF EXT,,TAPE NUMBER
	MOVEM	Z,2(S)
	ADDI	S,3
	JRST	MRESA1

MRES3:	RELEAS	UFD,			;RELEASE CHANNEL
	CAIG	S,(R)			;JUMP IF THERE ARE ANY TERMS AT ALL.
	POPJ	P,			;NONE?!!
	HRLZ	A,MRBASE		;WIPE OUT TERM BASE CRUD.
	HRR	A,TBASE			;SOURCE,,DESTINATION  BLT DOWNWARDS.
	MOVEI	B,(S)
	SUB	B,MRBASE		;CALC LENGTH OF BLT
	ADDI	B,(A)
	BLT	A,-1(B)			;MOVE TERMS OVER ON TOP OF SCAN CRUD
	MOVEM	B,.JBFF			;SET .JBFF.
	MOVEM	B,FSPTR			;WELL, NOT REALLY, BUT IT WILL BE USED.
	MOVEI	S,-3(B)			;NEW TOP OF TERMS (POINTS AT LAST TERM)
	HRRZ	R,TBASE
	CORE	B,			;REDUCE CORE
	JFCL
	CAIGE	R,(S)			;SKIP IF ZERO OR ONE TERMS.
	PUSHJ	P,MRSORT		;ANOTHER INCREDIBLE SORT.
;TBASE=BOTTOM, FSPTR=TOP
	PUSHJ	P,MRLIST		;MAKE LISTING FILE IF DESIRED
	SETZM	MRTPNO			;OPR DOESN'T CARE WHICH TAPE, YET.
MRTS:	MOVE	A,TBASE
	CAML	A,FSPTR
	JRST	MRTS4			;DONE IF NO "TERMS" LEFT
	HRRZ	B,1(A)			;GET TAPE NUMBER FROM FIRST TERM.
	MOVEM	B,TAPNO
MRTS1:	ADDI	A,3
	CAML	A,FSPTR
	JRST	MRTS2			;OFF THE END - THIS WILL BE LAST TAPE.
	HRRZ	C,1(A)
	CAMN	B,C
	JRST	MRTS1
MRTS2:	PUSH	P,A			;A=LAST ADDRESS (WILL BE NEXT TBASE)
	PUSH	P,FSPTR			;SAVE REAL LAST ADDRESS
	MOVEM	A,FSPTR			;STORE CURRENT LAST ADDRESS!
	PUSH	P,.JBFF
	SKIPE	B,MRTPNO		;GET OPR DESIRED TAPE NUMBER
	CAMN	B,TAPNO			;SAME AS TAPE WE PROPOSE?
	JRST	.+2			;OPR DOESN'T CARE (YET) OR WE MATCH IT.
	JRST	MRTS3			;OPR CARES AND WE AREN'T THERE YET.
	PUSHJ	P,DOMT0			;CAUSE TAPE TO BE MOUNTED.
	JRST	MRTS3			;SKIP RESTORE IF OPERATOR REQUESTS TAPE "X"
	PUSHJ	P,MRTV			;RESTORE FROM ONE TAPE.
MRTS3:	POP	P,.JBFF
	POP	P,FSPTR			;POINTER TO THE VERY END
	POP	P,TBASE			;POINTER TO OLD END=NEW BEGINNING
	JRST	MRTS			;LOOP UNTIL STRANGE FMT LIST EXHAUSTED.

MRTS4:	SKIPE	MRTPNO
	OUTSTR	[ASCIZ/Sorry, the tape you requested was not needed for this restore
/]
	POPJ	P,
;MRSORT MRST1 MRST2 MRST3 MRST4 MRST5 MRST6 MRLIST MRLST1 MRLST2 MRLST3

	SUBTTL	MRESTORE - MRSORT MRLIST

;THIS IS QUICKSORT WITHOUT STRAIGHT INSERTION SORT FOR SMALL SUBFILES.
;R=LEFT SIDE (SMALL) S=RIGHT SIDE(LARGE)
MRSORT:	MOVEI	A,(R)			;LEFT POINTER
	MOVEI	B,(S)			;RIGHT POINTER
	HRRZ	C,1(A)			;"KEY LEFT" ELEMENT
MRST1:	HRRZ	D,1(B)			;ANOTHER KEY
	CAML	C,D			;IF "KEY LEFT">"KEY RIGHT"
	JRST	MRST2			;NEED TO EXCHANGE (OR MAYBE STOP?)
	SUBI	B,3			;MOVE RIGHT SIDE TOWARD CENTER
	JRST	MRST1			;LOOP

MRST2:	CAIN	A,(B)			;REACHED THE MIDDLE YET?
	JRST	MRST4			;YES. NOW TIME TO SORT THE SUBFILES.
	MOVE	D,(A)
	EXCH	D,(B)
	MOVEM	D,(A)
	MOVE	D,1(A)
	EXCH	D,1(B)
	MOVEM	D,1(A)
	MOVE	D,2(A)
	EXCH	D,2(B)
	MOVEM	D,2(A)
MRST3:	ADDI	A,3			;MOVE LEFT END TOWARD CENTER
	HRRZ	D,1(A)			;LOAD "KEY LEFT"
	CAMLE	C,D
	JRST	MRST3			;"KEY RIGHT">"KEY LEFT"
	CAIN	A,(B)			;REACHED THE MIDDLE YET?
	JRST	MRST4			;YES. NOW TIME TO SORT THE SUBFILES.
	MOVE	D,(A)
	EXCH	D,(B)
	MOVEM	D,(A)
	MOVE	D,1(A)
	EXCH	D,1(B)
	MOVEM	D,1(A)
	MOVE	D,2(A)
	EXCH	D,2(B)
	MOVEM	D,2(A)
	SUBI	B,3			;MOVE RIGHT SIDE TOWARD CENTER
	JRST	MRST1			;LOOP

MRST4:	MOVEI	C,(S)
	SUBI	C,(R)
	JUMPE	C,CPOPJ			;IF S=R, THE ONE ELEMENT FILE IS SORTED
	LSH	C,-1			;C=1/2 SIZE OF ORIGINAL FILE.
	MOVEI	D,(S)
	SUBI	D,(B)			;D=SIZE OF RIGHT SUBFILE
	CAILE	C,(D)			;IF D>C THEN SORT LEFT SUBFILE FIRST.
	JRST	MRST5			;C>D SORT RIGHTSUBFILE FIRST.
	MOVSI	C,3(A)
	HRRI	C,(S)			;LEFT EDGE,,RIGHT EDGE OF RIGHTSUBFILE
	MOVEI	S,(A)			;SET RIGHT EDGE OF SMALL SUBFILE
	JRST	MRST6

MRST5:	MOVSI	C,(R)
	HRRI	C,-3(A)
	MOVEI	R,(A)
MRST6:	PUSH	P,C			;STUFF ON STACK.
	PUSHJ	P,MRSORT		;!
	POP	P,C
	MOVEI	S,(C)
	HLRZ	R,C
	JRST	MRSORT

MRLIST:	OUTSTR	[ASCIZ/Type Y to make restore listing (direct to LPT:)  /]
	TTCALL	11,
	TTCALL	4,A
	CAIE	A,"Y"
	CAIN	A,"Y"+40
	JRST	.+2
	POPJ	P,
	MOVE	A,FSPTR
	MOVEM	A,.JBFF
	MOVEI	A,0
	MOVSI	B,'LPT'
	MOVSI	C,LSTBUF		;OUTPUT BUFFER HEADER
	OPEN	LST,A
	PUSHJ	P,NODEV			;OOPS.
	OUTBUF	LST,2
	MOVE	A,['MRESTO']
	MOVSI	B,'LST'
	SETZB	C,D
	ENTER	LST,A
	JFCL				;IGNORE ENTER FAILURE.
	MOVE	A,[JRST LSTOUT]
	MOVEM	A,XDMPUT		;SET INSTR TO XCT
	PUSHJ	P,TPGINX		;INITIALIZE PAGE OUTPUT -SPECIAL
	SETZM	TPGNUM
	MOVE	R,TBASE
;HERE TO START A NEW PAGE.  FIRST FINISH OLD, IF ANY.
MRLST1:	HRRZ	A,TPGPDP
	CAIL	A,TPBUF
	PUSHJ	P,TPGPUT
	CAML	R,FSPTR
	JRST	MRLST3			;DONE IF NO "TERMS" LEFT
	HRRZ	B,1(R)			;GET TAPE NUMBER FROM FIRST TERM.
	MOVEM	B,TAPNO
	PUSHJ	P,REELMX		;SETUP TAPNAM
	HRRZ	B,1(R)
MRLST2:	CAML	R,FSPTR
	JRST	MRLST1			;OFF THE END - FINISH PAGE.
	HRRZ	C,1(R)
	CAME	C,B
	JRST	MRLST1			;FINISH OLD PAGE
	MOVE	A,TPGPDP
	PUSH	A,(R)			;NAME
	PUSH	A,1(R)			;EXT,,TAPE NUMBR
	PUSH	A,2(R)			;PPN
	MOVEM	A,TPGPDP
	AOBJN	A,.+2
	PUSHJ	P,TPGPUT		;FORCE PAGE NOW. (PRESERVE B)
	ADDI	R,3
	JRST	MRLST2

MRLST3:	MOVEI	A,0
	DPB	A,LSTBUF+1
	CLOSE	LST,
	RELEAS	LST,
	POPJ	P,
;MRTV MTRV1 MTRV2 MTRV3 MTRV4 MTRV5 MTRV6 MTRM MTRM1 MTRM2 MTRM3 MTRM4 MTRM5 MTRM6

	SUBTTL	MRESTORE - MRTV MTRM

;HERE WE ACTUALLY START MOVING A TAPE!
MRTV:	MOVEI	A,10			;DEVICE MODE
	SKIPN	B,MRSTDV		;GET THE DESTINATION DEVICE
	MOVSI	B,'DSK'
	MOVEM	B,MRSTDV		;SAVE
	MOVSI	C,FOBUF			;NO BUFFERS
	TLZ	FL,UDPGO		;ASSUME NOT UDP

	MOVE	D,B			;GET DEVICE NAME
	DEVCHR	D,
	TLNE	D,DEVDSK
	JRST	MTRV1

IFE UDPSW,<	JRST	NOTDSK	>

IFN UDPSW,<	TLNN	D,DEVUDP	;IS THIS A UDP?
		JRST	NOTDSK		;NO.
		INIUDP	B		;INITIALIZE UDP
		TLO	FL,UDPGO
		MOVEI	A,10		;BETTER TRY MODE 10
		MOVSI	C,FOBUF		;AND OUTPUT ONLY
		UOPEN	FILE,A		;DO THE OPEN >;IFN UDPSW

MTRV1:	OPEN	FILE,A			;ATTEMPT TO OPEN OUTPUT DEVICE
	PUSHJ	P,NODEV			;OOPS.
IFN UDPSW,<	TLNN	FL,UDPGO	;SKIP IF WE ARE THE UDP>
	OUTBUF	FILE,22			;TELL SYSTEM TO BUILD US SOME BUFFERS
MTRV2:	PUSHJ	P,RDFIL			;READ RETRIEVAL FROM MTAPE
	TRNE	FL,MTAEOT		;SKIP UNLESS END OF TAPE
	JRST	MTRV5

	PUSHJ	P,DPYSER		;DISPLAY FILE NAME FROM THE TAPE
	FILINF+DDNAM,,DPYFIL

	MOVE	W,TBASE			;GET THE BASE OF TERM BLOCK.
MTRV3:	MOVE	Y,(W)			;GET THE NAME
	CAME	Y,FILINF+DDNAM		;SAME AS MAGTAPE NAME?
	JRST	MTRV4			;NO. NO MATCH WITH THIS TERM.
	HLLZ	Y,1(W)			;GET EXT FROM THIS TERM
	HLLZ	Z,FILINF+DDEXT		;GET EXT FROM MT
	CAME	Y,Z			;SAME AS MAG TAPE EXTENSION?
	JRST	MTRV4			;NO MATCH
	MOVE	Y,2(W)			;GET PPN
	CAMN	Y,FILINF+DDPPN		;COMPARE WITH MT PPN
	JRST	MTRM			;WIN. MOVE A FILE.
MTRV4:	ADDI	W,3			;POINT TO NEXT TERM
	CAMGE	W,FSPTR			;IS THIS OVERRUN YET?
	JRST	MTRV3			;NO. CONTINUE LOOKING THRU TERM BLOCKS
	PUSHJ	P,RDFILX		;FLUSH THROUGH THE END OF THIS FILE
	TRNN	FL,MTAEOT		;SKIP IF EOT
	JRST	MTRV2			;LOOK FOR ANOTHER FILE ON THE TAPE
MTRV5:	TRZ	FL,MTAEOT
	OUTSTR	[ASCIZ/End of tape but there are unrestored files.
Type return to continue anyway/]
	TTCALL	11,
	TTCALL	4,A
	TTCALL	11,
	PUSHJ	P,MTAREW
;THIS IS THE WAY TO GET OUT.
MTRV6:	RELEAS	FILE,			;RELEASE DESTINATION DEVICE
IFN UDPSW,<	TLZE	FL,UDPGO
		SETZM	USYNC		;MAKE SURE WE CAN'T DIDDLE THE UDP >
	PUSHJ	P,MTAREL		;RELEASE SOURCE DEVICE
	TRZ	FL,SAFETY
	POPJ	P,

;	HERE WE MOVE A FILE.
MTRM:	MOVNI	X,3			;LOAD - LENGTH OF BLOCK.
	ADDB	X,FSPTR			;SHRINK TERM BLOCK STORAGE
	MOVSI	Z,(X)			;SOURCE OF BLT  FILL HOLE WITH LAST BLOCK
	HRRI	Z,(W)			;DESTINATION
	BLT	Z,2(W)			;BLT LAST TERM DOWN ONTO THIS ONE.
	MOVE	A,FILINF+DDNAM		;SET UP THE DEFAULTS
	MOVE	B,FILINF+DDEXT
	MOVE	C,FILINF+DDPRO
	MOVE	D,FILINF+DDPPN
IFN STANSW,<
	MOVE	X,[A,,FILBLK]		;SAVE THE FILE NAME SOMEWHERE.
	BLT	X,FILBLK+3		;SAVE..
	TRO	FL,SAFETY

IFN UDPSW,<	TLNE	FL,UDPGO	;ON THE UDP?
		ULOOK	FILE,A		;YES. ASK RPH >

	LOOKUP	FILE,A			;LOOKUP THE FILE.
	JRST	.+2			;LOOKUP FAILURE IS A GOOD WAY TO START
	HRRI	B,-1			;THIS IS LOOKUP SUCCESS CODE.
	TLNN	FL,UDPGO
	CLOSE	FILE,NUPACC		;AVOID BEING IN READ/ALTER MODE
	PUSHJ	P,LCHECK		;CHECK THE OMENS.
	JRST	MTRM6			;FOR SOME REASON, DON'T RESTORE.
	TRZ	FL,SAFETY
	MOVE	D,[FILBLK,,A]
	BLT	D,D

IFN UDPSW,<	TLNE	FL,UDPGO	;SKIP UNLESS THIS IS ENTER ON UDP
		JRST	MTRM1		;ENTER ON UDP. DON'T CLEAR PROTECT >

	SETZ	C,			;MAKE SURE WE DON'T PROTECT IT TOO MUCH
	JRST	MTRM2			;GO DO DISK ENTER

IFN UDPSW,<
MTRM1:		SKIPN	PASFLG		;HAS THERE BEEN A PASSWORD CHECK?
		PASCHK			;NO. DO IT. RETURN WHEN IT'S OK
		UENTER	FILE,A		>
MTRM2:	ENTER	FILE,A			;
>;IFN STANSW
IFE STANSW,<
	PUSHJ P,RSTPRE
	 JRST MTRM6
	ENTER FILE,LKBLK
>

	JRST	[OUTSTR [ASCIZ/ENTER failed: /]
		MOVE	D,[FILBLK,,A]
		BLT	D,D
		PUSHJ	P,TYFIL
		JRST	MTRM6]
IFN STANSW,<
	MOVE	D,INVERS		;GET THE TAPE VERSION NUMBER
	MOVE	C,FILINF+DDOFFS		;GET THE NEEDED OFFSET.
	CAIL	D,2			;DART VERSION 4 (FORMAT 2) HAS THIS KLUGE
	CAIG	C,1			;OTHER THAN NORMAL?
	JRST	MTRM4			;EARLY VERSION OR NORMAL FILE.
	TLNE	FL,UDPGO
	JRST	MTRM3			;CAN'T DO IT ON (OLD) UDPS.
	MOVEM	C,WROFFS+2		;SET FOR WRITE OFFSET UUO.
	MTAPE	FILE,WROFFS		;WRITE THE FILE OFFSET
	MOVEI	C,2
	SUB	C,FILINF+DDOFFS
	USETO	FILE,(C)
	JRST	MTRM4

MTRM3:	OUTSTR	[ASCIZ/UDP OUTPUT FILE WILL NOT HAVE RECORD OFFSET
/]
>;IFN STANSW
MTRM4:	MOVE	D,[FILBLK,,A]
	BLT	D,D
	PUSHJ	P,TYFIL			;TYPE A FILE NAME
	PUSHJ	P,RFDATA		;GO DO THE RESTORE
IFN STANSW,<
	TLNE	FL,UDPGO
	JRST	MTRM5			;AVOID RENAME IF UDP
	MOVE	D,[FILBLK,,A]
	BLT	D,D
	TLZ	C,400000		;AVOID RESTORING WITH PROT=400
	RENAME	FILE,A			;RENAME TO OLD CREATION DATE
	OUTSTR	[ASCIZ/ (RENAME TO UPDATE DATE OF CREATION FAILED) /]
>
MTRM5:	OUTSTR	CRLF
	MOVE	W,TBASE
	CAMGE	W,FSPTR
	JRST	MTRV2			;RETURN - READ NEXT TAPE FILE.
	PUSHJ	P,MTAREW	;REWIND THE TAPE, WE'RE THROUGH.
	JRST	MTRV6		;ALL TERMS FOR THIS TAPE HAVE BEEN PROCESSED!

;HERE TO FLUSH CURRENT FILE.
MTRM6:	PUSHJ	P,RDFILX		;FLUSH THROUGH THE END OF THIS FILE
	TRNE	FL,MTAEOT		;SKIP UNLESS EOT
	JRST	MTRV5			;NOTHING WE CAN DO ABOUT THAT.
	JRST	MTRM5
;.UUCON UUOCN1 UUSKP2 UUSKP1 UUORET UPDLOV UUOERR UUTAB UDPINX UDPCHX

	SUBTTL	UUO HANDLER
.UUCON:	PUSH	P,UUOCON	;SAVE RETURN ADDRESS LIKE A PUSHJ
	MOVEM	16,17(P)	;HERE FROM A PUSHJ 17,UUCON IN JOB41
	MOVEI	16,1(P)		;SOURCE,,DESTINATION
	BLT	16,16(P)	;SAVE 0-16 ON STACK
	ADD	P,[XWD 17,17]	;ADJUST STACK
	JUMPG	P,UPDLOV
UUOCN1:	MOVEM	D,UUOTMP	;SAVE D TEMPORARILY.
	HRRZ	D,UUO		;GET THE EFFECTIVE ADDRESS
	CAIGE	D,17		;SKIP IF NOT IN THE AC'S (AT OR ABOVE P=17)
	ADDI	D,-16(P)	;RELOCATE ARGUMENT TO POINT AT STACK
	HRRM	D,UUO		;SET NEW ARGUMENT WHERE IT WILL BE SEEN
	LDB	D,[POINT 9,UUO,8];GET OP CODE
	CAIL	D,UUMAX		;ARE WE IN RANGE?
	MOVEI	D,0		;SET OPCODE TO ZERO TO MAKE ERROR.
	MOVE	D,UUTAB(D)	;GET DISPATCH
	EXCH	D,UUOTMP	;RESTORE D, JUMP ADDRESS IN UUOTMP
	PUSHJ	P,@UUOTMP	;DISPATCH
	JRST	UUORET		;NON SKIP RETURN
	JRST	UUSKP1
UUSKP2:	AOS	-17(P)		;DOUBLE SKIP
UUSKP1:	AOS	-17(P)		;HERE TO DO A SKIP RETURN
UUORET:	SUB	P,[XWD 17,17]
	MOVSI	16,1(P)
	BLT	16,16		;RESTORE AC'S AND RETURN
	POPJ	P,


UPDLOV:	OUTSTR	[ASCIZ/PDL OV AT UUOCON
/]
	HALT	UUOCN1

UUOERR:	OUTSTR	[ASCIZ/ILLEGAL USER UUO.
/]
	HALT	CPOPJ

UUTAB:	UUOERR

IFN UDPSW,<
	OUTUDP
	INUDP
	LOKUDP
	ENTUDP
	RENUDP
	OPNUDP
	CLSUDP
	UDPM2
	UDPINX
	UDPCHX
>	

SDEF(UUMAX,.-UUTAB)
IFN UDPSW,<
UDPINX:	MOVE	0,@UUO			;GET THE ARGUMENT INTO 0
	JRST	INTUDP			;CALL ROUTINE.

UDPCHX:	OUTSTR	[ASCIZ/UDP WRITE PASSWORD: /]
	PTYUUO	16,[0
		3]			;ECHO OFF.
	PPIOT	6,1400			;POSITION DPY PAGE PRINTER
	PUSHJ	P,GETSIX		;GET SIXBIT TERM FROM TTY
	PPIOT	6,0			;RESET PAGE PRINTER
	PTYUUO	16,[0
		4]			;ECHO ON.
	MOVE	0,B			;GET IT INTO REGISTER 0
	OUTSTR	CRLF
	PUSHJ	P,UDPCHK		;ASK HELLIWELL IF I'M RIGHT
	JRST	.+2
	POPJ	P,
	CLRBFI				;CLEAR INPUT BUFFER
	JRST	UDPCHX			;AROUND
>
;HELPPN HELPER HELP1 HELP2 HLPOK HLPUND HLPEOF HLPFIN

;	HELPER	- HELP PUT THE WORLD BACK TOGETHER AFTER A TAPE RUNS AWAY.

;CALLED FROM DDT ONLY


HELPPN:	0			;PPN OF FIRST FAILING RECORD.

HELPER:	INIT	FILE,10	
	'DSK   '
	FOBUF,,
	HALT	.
	INIT	UFD,10
	'DSK   '
	0,,UFDBUF
	HALT	.
	MOVE	A,['ALLDIR']
	MOVSI	B,'MEM'
	SETZB	C,D
	LOOKUP	UFD,A
	HALT	.
	MOVE	A,['ALLDIR']
	MOVSI	B,'MEM'
	SETZB	C,D
	ENTER	FILE,A
	HALT	.
	SKIPN	HELPPN
	HALT	.
HELP1:	PUSHJ	P,UFDRD		;READ A WORD
	JRST	HLPEOF
	CAMN	A,HELPPN	;IS THIS THE PPN TO STOP AT?
	JRST	HLPOK		;YES.
HELP2:	PUSHJ	P,DDFWRT	;NO. WRITE A PPN. (OR, WRITE AN EXT OR DATE WORD)
	PUSHJ	P,UFDRD		;READ A FILE NAME.
	JRST	HLPUND		;UNEXPECTED EOF
	PUSHJ	P,DDFWRT	;WRITE A FILE NAME
	JUMPE	A,HELP1		;ZERO FILE NAME MEANS A PPN IS NEXT.
	PUSHJ	P,UFDRD		;READ EXTENSION AND DUMP TAPE WORD
	JRST	HLPUND		;UNEXPECTED EOF
	TRNN	A,200000	;WAS FILE DUMPED THIS TIME?
	JRST	HELP2		;NO, WRITE THE WORD, AND LOOP
	PUSHJ	P,DDFWRT	;WRITE EXT,,TAPNO
	PUSHJ	P,UFDRD		;READ DATE WRITTEN WORD
	JRST	HLPUND		;UNEXPECTED EOF
	JRST	HELP2		;WRITE THE WORD, AND LOOP

HLPOK:	OUTSTR	[ASCIZ/FOUND THE DESIRED PPN.
/]
	JRST	HLPFIN

HLPUND:	OUTSTR	[ASCIZ/UNEXPECTED EOF
/]
	JRST	HLPFIN

HLPEOF:	OUTSTR	[ASCIZ/EOF WITHOUT HAVING FOUND THE PPN.
/]
HLPFIN:	CLOSE	FILE,
	CLOSE	UFD,
	RELEAS	FILE,
	RELEAS	UFD,
	OUTSTR	[ASCIZ/(TERMINATION AFTER CLOSING ALL FILES)
/]
	HALT	.
	SUBTTL	END OF FILE - LIST OF NEEDED FEATURES, BUGS, ETC
COMMENT `
FEATURES STILL NEEDED.

0. bug: if ALLDIR.DAT winds up alone on a tape, the old DAT info about
	that tape fails to be invalidated.
     08/01/76 EJG - FIXED.

1. MRESTO COMMAND
2. SWITCHES IN COMMANDS

3. NO? ALLDIR FOR EACH STRUCTURE SHOULD BE DUMPED AFTER ALL STRUCTURES,
	NOT AFTER EACH STRUCTURE.
4. POSITION COMMAND
7. Feature to expunge dump info for a user, a file, etc?
8. Make DART.MEM and Xnnnnn.DAT one file to eliminate lookups/enters
     08/01/76 EJG - SUPERSEDED : Xnnnnn.DAT eliminated.
9. Maintain ALLDIR.DAT with read/alter constantly, use update rtrv uuo.
     08/01/76 EJG - DONE : ALLDIR.DAT info starts out in ALLDIR.MEM, using R/A.
10. At beginning of dump ALLDIR.OLD_ALLDIR.DAT (if it exists). write
	ALLDIR.TMP.  solves problem of restarting dump clobbers OLD
     08/01/76 EJG - DONE : ALLDIR.DAT renamed to ALLDIR.OLD at end of dump.
11. Don't make Xnnnnn.DAT for each tape.  Make only one merge at
	end of dump, after dumping alldir.dat.
     08/01/76 EJG - DONE.
12. More error recovery features for system-class dumps.
	0. Feature to restart a tape (if it gets munged)
	1. no eot mark - better way than hack using HELPER
	2. pickup fails to correct tape position.
	3. Able to restart an entire tape.
13. ARCHIVE command should run faster.  Increase (dump mode) buffer sizes.
14. System-class dumps: speed up with info in new 16-word UFD entries,
	instead of using extra DSKOPS to read retrieval.
     02/10/78 EJG - DONE.

26-Jan-78  1155	TED  	DART FEATURES AND BUGS  
Make PICKUP at least give up if it can't position the tape.
TAPE ID IN FOOTAGE HEADER
ILL UUO AFTER INIT FAILURE - "Start" after "Can't init..."ILLUUO
<ESC>I INTERRUPTION
LOGICAL DEVICE "MTA" FEATURE
/Q IN COMMAND LINE
GOOD LUCK

22-Feb-78  1047	TED  	you're gonna hate me for this
I just thought of another feature I would like to have in dart (i can hear the
groan).  I would like a beep when Dart wants a new tape.  This will save me
having to keep looking at it if I am responsible for the terminal.  Sounds
easy.  Next recompile will be soon enough.   -TED

31-Jul-78  1544	BH  	more dart stuff
- If a file is bigger than a magtape, don't even try to dump it.

22-Aug-78  2303	BH  	I know you're not working on DART but...
it might be nice if a system-class dump put something like "37/854 UFDs"
on the third line along with the tape position stuff.  I guess that isn't
a very precise indicator of how much you have left to do but it's the
easiest thing I can think of offhand.


06-Sep-79	  ME&EJG	Re-starting a dump at beginning of current tape
Here is how you try to restart the current tape of the dump at the
beginning of that tape, for instance if the tape broke in the middle
or the drive wasn't writing correctly for that tape only.
(To restart from the first tape of a dump, you should just delete the
two .MEM files and start the dump over (TDUMP or PDUMP), since the
procedure below won't work to restart the first tape of a dump.)

.r dart

*dd
(DDT.  Return with CPOPJ$G)

DART$:	
helppn/	0	$"/dmpsys/
helper$g
FOUND THE DESIRED PPN.
(TERMINATION AFTER CLOSING ALL FILES)
Halt at user mumble
^C
.r dart

*dd
(DDT.  Return with CPOPJ$G)

DART$:	
pickp3-5;PICKP1+24		
PICKP1+24/	HRRZ A,MEMSAV+1	.$b	cpopj$g
*pick
$1B>>PICKP1+24	memsav chknum/	0	5
memsav luser/	TLZA Q,637163(D)	$6t;RMDSYS	$"/dmpsys/
.$6t/	DMPSYS	
memsave fuser/	TLZA Q,637163(D)	$"/dmpsys/
.$6t/	DMPSYS	
memsav ffile$6t/	REMQUE	$"/dart/	;First file in UFD eligible
memsav ffext$6t/	QUE   	$"/dat/		; to be dumped.
memsav ttbuf/	24,,25	24,,24
tapno/	25	24
memsav tapnum/	25	24
tapnam[	642020,,202221	$6t;T00021	$"/T00020/
$b	$p

Mount tape number T00021 and type GO<return>, or type P/T<num> <return>: go
Using tape number T00021
DART   DAT   DMP,SYS
DART   TAP   DMP,SYS
...

end of comment `


IFE UDPSW,<	END	START >		;IF NO UDP, END OF PROGRAM
	PAGE
	SUBTTL	R. P. HELLIWELL'S UDP ROUTINES
	.INSERT	UDP[CSP,SYS]