;-*- Mode:MIDAS -*-

TITLE DUMPER

.SYMTAB 11657.,5000.		;be-bip be-beh

SUBTTL AC, DIRECTORY DEFINITIONS

ZR=0
A=1
B=2
C=3
D=4
E=5
N=6

SYM=7
TER=10
RTAPE"T=SYM
RTAPE"TT=TER
NETWRK"T=SYM
NETWRK"TT=TER

U=11
V=12
W=13
X=14
USRUFD=15
P=17

IF1,[
PRINTX /WHICH MACHINE? /
.TTYMAC A
.TTYFLG==.TTYFLG+1
PRINTX/A
/
.TTYFLG==.TTYFLG-1

;When using this macro, also check the WRONG flag if you really care
DEFINE MCOND B
<IFSN A,B,[1]>,TERMIN
MCHN==SIXBIT/A/
TERMIN
]

NEWCOD==1			; Assume a KS unless otherwise informed
IFE MCOND MX, NEWCOD==0		;Use old code on MX KL only (running old ITS)

DEFINE SYSCAL OP,ARGS
	.CALL [SETZ ? SIXBIT/OP/ ? ARGS ((SETZ))]
TERMIN


 ;GET DEFINITION OF SYMBOLS FOR DIRECTORY FORMAT
.INSRT SYSTEM;FSDEFS > 

 ;THESE PARAMETERS CONTROL THE 'SYSENG; MACRO TAPES' FILE.
;DON'T CHANGE THESE IF YOU'RE NOT RJL
;AND EVEN THEN YOU SHOULD BE CAREFUL
MAXTAP==3000.	;MAXIMUM TAPE NUMBER +1
IFE MCOND AI, MAXTAP==4000.	;EVEN THOUGH I'M NOT RJL
IFE MCOND MX, MAXTAP==5000.	; I'm not RJL either...  -Alan
TPINFL==10.	;NUMBER OF WORDS OF INFO PER TAPE
SUBTTL I/O CHANNEL, UUO DEFINITIONS

MFDCH==1	;MASTER FILE DIRECTORY INPUT
UFDCH==2	;FILE DIRECTORY INPUT
DSKIN==3	;DISK INPUT
MAGOUT==4	;MAG TAPE OUTPUT 
TYIC==5		;TTY INPUT
TYOC==6		;TTY OUTPUT
DSKOUT==7	;DISK OUTPUT
MAGIN==10	;MAG TAPE INPUT
LPTCH==11	;LPT OR TPL OUTPUT
ERRC==12	;ERR DEVICE INPUT
STATC==13	;TAPE STATUS STORED ON DISK
SAVET==14	;SAVED TAPE FILE NAMES
SNPLCH==15	.SEE SNPLACE

RTAPE"RSICH==16
RTAPE"RSOCH==17

LPDL==100	;LENGTH OF PDL
LPAT==1000	;LENGTH OF PATCH AREA

BUFSIZ==5
PAGSIZ==2000

RPCNT==0
UUOTAB:		;THIS TABLE GENERATED BY FOLLOWING IRP
IRP X,,[PSIS,PDPT,POCT,PERR,PASC,SIXTYP,OPEN]
RPCNT==RPCNT+1
IRPS Y,,X
Y=RPCNT_33
.ISTOP
TERMIN
LOC UUOTAB+RPCNT-1
A!X
TERMIN
LUUOTB==RPCNT
IFG LUUOTB-37,.ERR TOO MANY UUOS DEFINED

;PRINT A FIXED STRING ON LPT (IF LPTSW) OR ON TTY
DEFINE PRINT ARG
	PASC [ASCIZ \ARG\]
TERMIN

;PRINT A STRING THEN ERR OUT
DEFINE DIE ARG
	PERR [ASCIZ /ARG/]
TERMIN

;PRINT SOME FILE NAMES
DEFINE	PRTFNS
	PRINT _
	PSIS SNAME
	PRINT [;]
	PSIS FN1
	PSIS FN2
TERMIN

SUBTTL MISCELLANEOUS VARIABLES

ZZ==.
LOC 41
	JSR UUOH
	JSR INT
LOC ZZ
TYIPD:	0	;DEPTH IN IO-PUSHES ON TYIC
DISPLY:	0	;0 => HARD COPY, 1 => SCREEN
PRNAM1:	.FNAM1	;PROGRAM NAME
PRNAM2:	.FNAM2	;PROGRAM VERSION NUMBER
WRONG:	1	;0 => ON RIGHT MACHINE, -1 => ON WRONG MACHINE
GARBAG:	0	;READ INTO HERE TO IGNORE
ERRPDP:	0	;PDL LEVEL AT ADMP4
CTRLG:	0	;0 NORMAL, -1 DEFER CONTROL-G, +1 DEFERRED CONTROL-G PENDING
MYNAME:	0	;ORIGINAL SNAME
USNM:	SIXBIT /FIRST/	;CURRENT SNAME
LUSNM:	0	;LAST USER NAME DUMP COMPLETED FOR
FUSNM:	0	;FIRST USER NAME ON TAPE
RFDATE:	0	;REFERENCE DATE
UNRNDW:	0	;UNRNDM WORD FROM RRDATE SYSTEM CALL
NTAPES:	-1	;NUMBER OF REEL IN CURRENT DUMP, -1==> WE DON'T KNOW THIS PARAMETER
FDATE:	0	;CREATION DATE OF FILE
AUTHOR:	0	;AUTHOR OF FILE
BLOCKS:	0	;BLOCKS IN UDIR
QUOTA:	0	;QUOTA OF UDIR
OFINDF:	0	;-1 IF DOING AN OFIND, 0 OTHERWISE
TEST1:	TDNN B,(A)	;SORT TEST 1
TEST2:	TDNE B,(C)	;SORT TEST 2
UFDDAT:	-1	;DATE OF UFD INPUT
MFDDAT:	-1	;DATE OF MFD INPUT
DMPMFD:	0	;DUMP MFD IF -1
DMPUFD:	0	;DUMP UFD IF -1
DMPDIR:	0	;OR OF DMPUFD AND DMPMFD
DMPLNK:	0	;-1 => DUMP LINKS
RELOSW:	0	;-1 IF DOING A RELOAD
		;CAUSES DUMPBIT, REAPBIT, AUTHOR, AND REFDATE OF LOADED
		; FILE TO BE RESTORED FROM TAPE COPY OF UFD.  ALSO,
		; CAUSES TAPE UFDS TO BE READ, LINKS TO BE RESTORED,
		; DUMPBIT, REAPBIT, AUTHOR, REFDATE TO BE RESTORED,
		; AND CAUSES OLD FILES ON DISK BUT NOT ON TAPE-UFD
		; TO BE DELETE, THUS RESTORING THE FILE SYSTEM COMPLETELY.
PDIRSW:	0	;-1 => PRINT DIRECTORY FROM TAP AT MAGOP1.
MRGSW:	0	;-1 => MERGE (I.E. NEVER LOAD OVER ANY EXISTING FILE)
		;0 => BASE ON VARIOUS OTHER CRITERIA.
CAREF:	0	;-1 DONT OVERWRITE FILES WHICH HAVEN'T BEEN DUMPED
LOSRSW:	0	;-1 SORRY MODE, ALWAYS WRITE OVER EXISTING COPIES IN LOAD
		;0 => DON'T WRITE OVER FILES WITH NEWER DATE. (ASK FIRST)
NOASK:	0	;-1 => DON'T ASK QUESTIONS
APPENF:	-1	;-1 => NO FILES DUMPED FOR CURRENT USER YET
LDPACK:	-1	;NON-NEGATIVE => PACK# OF SINGLE PACK BEING RELOADED, IGNORE
		;FILES ON OTHER PACKS, DELETE NEW FILES ON THIS PACK SINCE
  .SEE DIRUPN	;NOT REALLY THERE (SEE DIRUPN)
  .SEE DIRU2	;ALSO
		;IF YOU USE THE LDPACK FEATURE, USE THE 'RELOAD L SORRY'
		; COMMAND OR YOU WILL BE SORRY.
BBPACK:	-1	;LIKE LDPACK, BUT DOESNT MUNGE DISK DIRECTORIES BECUZ WE ASSUME
		;THEY ARE CORRECT.  DOESNT DELETE ANYTHING.
DEADPK:	-1	;Non-negative => Number of pack lost in head crash that
		; left the rest of the filesystem OK.  Files referenced on
		; this pack from existing UFD's need to be restored.
CRDIR:	0	;-1 TO CREATE DIRECTORIES WHEN LOADING FILES FROM TAPE
FILN:	0	;FILE NUMBER IN FIND (I.E. SEQUENCE NUMBER ON TAPE)
FLNI:	-1	;-1 FIRST TIME THRU FNG (NEED TO OPEN FILE DIRECTORY)
		;SETOM THIS WHEN CHANGING THE SNAME.
GFRFQ:	-1	;FIRST TIME FLAG FOR QUOTA PRINTOUT
FCDMAP:	0	;-1 => MEANS WE HAVE MAPPED IN CORE PAGES FOR BUFFER
   .SEE FCDMP
MFDIN:	-1	;-1 FIRST TIME THRU M.F.D. (NEED TO OPEN M.F.D.)
ITAPE:	-1	;-1 IF JUST REWOUND (NEED TO READ/WRITE TAPE-HEADER)
TAPTYP:	0	;1 LOCAL, -1 REMOTE, -2 REMOTE AND MOUNTED, 0 NOT DECIDED YET
TAPHST:	BLOCK 2	;ASCIZ HOST FOR REMOTE TAPE
TAPDRV:	BLOCK 2	;ASCIZ DRIVE NAME
TAPDIR:	BLOCK 2	;ASCIZ READ, WRITE, OR BOTH
RMTUSR:	BLOCK 2	;ASCIZ REMOTE USER NAME
RMTPSW:	BLOCK 2	;ASCIZ REMOTE PASSWORD
TAPEF:	0	;HOLDS TAPE STATUS (IFN NEWCOD,[ .STATUS ] .ELSE CONI 344,)
IFE NEWCOD,[
 TF%BOT==100000	;BEGINNING OF TAPE
 TF%EOT==4000	;PHYSICAL END OF TAPE
 TF%EOF==10000	;END OF FILE SEEN
 TF%RDY==40	;DRIVE ONLINE AND NOT BUSY
];IFE NEWCOD
IFN NEWCOD,[ 
 TF%BOT==4000	;BEGINNING OF TAPE
 TF%EOT==10000	;PHYSICAL END OF TAPE
 TF%EOF==200000	;END OF FILE SEEN
;--- This is wrong, JTW seems to have misunderstood this bit in the old code
;--- really need a drive on-line indication
;--- but OPEN returns an error if it's not on-line
 TF%RDY==100000	;DRIVE ONLINE AND NOT BUSY
];IFN NEWCOD
LFDIR:	0	; STORAGE FOR LAST FILE POINTER (IN FIND)
TFIL:	BLOCK LUNBLK	; TEMPORARY STORAGE FOR FILE SORT IN FIND

MTCMD:	0	;STORAGE FOR .MTAPE
MAGOPN:	0	; 0=> MAGOUT NOT OPEN,-1=> OPEN
GTSYNF:	0	; GETSYL NEGITIVE FLAG
GTSYCC:	0	;GETSYL NUMBER OF CHARACTERS
LNKFLG:	0	;-1=>DUMPING OR LOADING A LINK
DMPMOD:	0	;-1 DUMPING, 0 RETRIEVING
TCOPYF:	0	;-1 => COPYING TAPES
OTAPE:	0	;OUTPUT VERSION OF ITAPE, IN TCOPY
DPACK:	0	;PACK TO DUMP OR -1 IF ALL
INCREM:	0	;-1 DUMP INCREMENTAL, 0 ALL FILES
FULLDMP:0	;-1 FULL DUMP, 0 SPECIFIC FILES
MICFLG:	0	;-1 MICROTAPE, 0 DISK [NOTHING SETS THIS] *******
LPTSW:	0	;-1 LPT OR TPL OUTPUT ON, 0 OUTPUTTING TO TTY
EOTFLG:	0	;-1 WHEN HIT EOT ON READ, RESET BY REWIND [NOTHING LOOKS AT THIS] *******
EXPERM:	0	;-1 WHEN ONLY EXPERIMENTING => .DMPCH NOT SET, BYPASS LCHECK
CKIDMP:	0	;0=> CHECK INCREMENTAL DUMPS (SET TO -1 BY 'NO' OPTION)
REAPSW:	0	;-1 IF A REAP TO BE DONE AFTER DUMP
NFTDMP:	0	;NUMBER OF FILES THIS DUMP OR THIS TAPE, WHICHEVER IS SMALLER.
CDMFL:	0	;-1 CONTINUE A FULL DUMP FROM GIVEN USER, 0 ORDINARY DUMP
LSTWHL:	0	;-1 LIST WHILE DOING DUMP OR LOAD
CHKFLG:	0	;-1 CHECK OPERATION, 0 DUMP/LOAD
DECIDF:	0	;-1 DECIDE WHICH TAPES TO USE [NOTHING LOOKS AT THIS] *******
DATEF:	0	;-1 DUMP ONLY FILES WITH CREATION DATES GREATER THAN OR EQUAL TO DATE
DATESF:	0	;-1 DUMP ONLY FILES BETWEEN TWO DATES
DATE:	0	;STORAGE FOR ABOVE
DATE1:	0	;STORAGE FOR UPPER BOUND IF THERE IS ONE
ARCHVF:	0	;-1 CALL THIS AN ARCHIVE
DEVICE:	0	;DEVICE IF SPECIFIED [THIS IS NEVER USED] *******
SUPERC:	0	;-1 TO SUPPRESS DATA ERROR MESSAGES (USED BY CHECK)
BASE:	10.	;OUTPUT BASE IN DPT/DOT ROUTINE
FLENTH:	0	;FILE LENGTH
RDERR:	0	;-1 => READ DATA ERROR OCCURRED
PHYEOT:	0	;-1 => PHYSICAL END OF TAPE
;TABLE OF "SECONDARY" DISKS.
;THESE ARE THE SAME AS IN ITS
NQS==10
QPKID:	BLOCK NQS	;PACK NUMBER
QRESRV:	BLOCK NQS	;PACK NAME OR RESERVED FLAG

;BIT MASK FOR THE PACK NUMBERS OF SECONDARY DISKS
SECMSK:	0		;SET UP AT SETSCM
PRIMSK:	0		;THE PRIMARY DISKS

;WORDS USED BY CHECKER
ERRCNT:	0	;ERRORS ENCOUNTERED THIS FILE ON TAPE IN
ERRDSK:	0	;ERRORS ENCOUNTERED THIS FILE IN DISK IN
PNTALL:	0	;-1 TO PRINT ALL FILES AS THEY GO
ERRALL:	0	;SET IF ANY ERRORS HAPPENED
NEWCHR:	0	;DUMP CHARACTER FOR THIS FILE
WRDONG:	0	;COUNT OF BAD WORDS
LNTCNT:	0	;DIFFERENCE IN LENGTH OF TWO FILES
ALLWRD:	0	;TOTAL WORDS ON THIS REEL SO-FAR

LENGTH:	0	;NUMBER OF FILE SPECS TYPED IN BY USER AND NOT
		; SATISFIED YET.  ALSO LENGTH OF TAPE FILE IN FNDCON.
EOFF:	0	;EOF FLAG FOR TAPE FILES ON DISK.  USED IN AFIND COMMAND
DIRIDX:	0	;POINTER TO FILE DIRECTORY BUFFER(FDIRBF)
BARROW:	0	;BACK-ARROW FLAG
ACLODF:	0	;-1 => GOT TO EXECU VIA ACLOAD, DON'T ASK FOR FILES
TTYST1:	0	;TTY VARS
TTYST2:	0
TTYSTS:	0
DKMFDP:	0	.SEE DKAUTH	; -1 If DSKMFD is in
DKUFDP:	0	.SEE DKLOOK	; SIXBIT of DSKUFD currently in
DKBLK:	0	.SEE DKBLKF	; Saved name block pointer for DKBLKF

LLIST==200.		;NUMBER OF FILE SPECS ALLOWED
IRP Y,,[TO,FM]
IRP X,,[DEV,SNM,FN1,FN2]
Y!!X:	BLOCK LLIST
TERMIN
TERMIN

FMDUMP:	BLOCK LLIST	;-1 => THIS SPEC SATISFIED AT LEAST ONCE.

IRP X,,[DEV,SNM,FN1,FN2]
TIN!X:	0		;HOLDS SPECS FOR FILGET
TERMIN

IRP X,,[DEV,SNM,FN1,FN2]
TYN!X:	0		;HOLDS SPECS FOR FILGET
TERMIN

DAYTIM:	0	;HOLDS CREATION DATE AND TIME OF FILE DURING FIND COMMAND
PSNAM:	0	;SNAME TO BE PRINTED BY FIND COMMAND
PFF1:	0	;FILE NAME TO BE PRINTED BY FIND COMMAND
PFF2:	0	;..
WRDCNT:	0	;COUNT OF WORDS IN FILE
SAVAOB:	0	;AOB OF FIRST BAD WORD

INTAC:	BLOCK 20	;SAVED ACS DURING INTERRUPT

GREATF:	-1		;0 ==> > FILE HACKED DURING DUMP

THBLK:	-LTHBLK,,0	;TAPE-HEADER-BLOCK
THTPN:	-1	;TAPE NUMBER,,NUMBER OF REEL IN THIS DUMP, -1==> WE DON'T YET KNOW THIS PARAMETER
THDATE:	0	;TAPE CREATION DATE (SIXBIT)
THTYPE:	0	;0 RANDOM, >0 FULL DUMP, <0 INCREMENTAL DUMP
LTHBLK==.-THBLK
LTHTPN:	-1	;LAST THTPN

HBLK:	-LHBLK,,0		;FILE-HEADER-BLOCK
HSNM:	0	;SYS NAME
HFN1:	0	;FN1
HFN2:	0	;FN2
LHBLKZ==.-HBLK			; Must be at least this long
HPKN:	0	;LINK FLAG,,PACK NUMBER (SAME INFO AS 3RD VALUE FROM
		; FILBLK, BUT IN A DIFFERENT FORMAT)
HDATE:	0	;CREATION DATE AND TIME OF FILE ON DISK (DISK-FORMAT) (4TH
		; VALUE FROM FILBLK)
				; Next two added 7/14/89 by Alan
HRDATE:	0	;REFERENCE DATE, AUTHOR INDEX, BYTE SIZE AND BYTE COUNT
		; (5TH VALUE FROM FILBLK)
HLEN:	0	;LENGTH OF FILE IN WORDS (FROM FILLEN)
LHBLK==.-HBLK			; Must not be longer than this

HFNL:	0

STAPST:		;BLOCK OF DATA STORED ON DISK FOR TAPE STATUS (IN SYSENG;MACRO TAPES)
STAPEN:	0	;TAPE NUMBER,,REEL NUMBER
STDATE:	0	;DATE TAPE LAST WRITTEN
STYPE:	0	;TYPE OF DATA LAST WRITTEN AS THTYPE ABOVE
SFUSNM:	0	;FIRST USER ON THIS TAPE
SLUSNM:	0	;LAST USER ON THIS TAPE
SUSER:	0	;UNAME OF PERSON WHO DUMPED THIS TAPE
SDONE:	0	;ZERO IF DUMP NOT COMPLETED,-1 REGULAR, 1 ARCHIVE
	BLOCK TPINFL+.-STAPST

INTERR:	SIXBIT /DEVICE/		;USED FOR DISK ERROR ANALYSIS
	SIXBIT /RANDOM/
	SIXBIT /FILE/
	SIXBIT /LOSER/
SUBTTL OPEN-BLOCKS, .CALL BLOCKS

LPTO:	SIXBIT /  !LPT/	;OUTPUT TO LPT (AND TPL ETC.)
	SIXBIT /WALL/
	SIXBIT />/
	0
	0		;LEAVE THESE HERE !!!!

MAGI:	26,,(SIXBIT /MT0/)	; BLOCK IMAGE, DON'T FLUSH TO EOF ON CLOSE
	SIXBIT /MACRO/
	SIXBIT /IN/
	0
	0		;LEAVE ALONE

MAGO:	SIXBIT /  'MT0/	;OUTPUT TO MAG-TAPE
	SIXBIT /MACRO/
	SIXBIT /OUT/
	0
	0

MFO:	(SIXBIT /DSK/)	;MASTER FILE DIRECTORY IN
	SIXBIT /M.F.D./
	SIXBIT /(FILE)/
	0
	0

FNO:	SIXBIT /  &DSK/		;FILE DIRECTORY IN
	SIXBIT /.FILE./
	SIXBIT /(DIR)/
	0
	0

CRUFD:	SIXBIT /   DSK/
	SIXBIT /..NEW./
	SIXBIT /(UDIR)/

TRNI:	SIXBIT /  &DSK/	;INPUT FROM DISK
FN1:	0	;FILE NAME 1
FN2:	0	;FILE NAME 2
SNAME:	0
	0	;HERE IN CASE OF .FDELE TRNI

;*****   ***** KEEP THESE NEXT 6 LOCATIONS TOGETHER FOR LINK INFO *****
LNKBLK:	200000,,(SIXBIT /DSK/)
	0
	0
LNKNM1:	0	; LINK FN1
LNKNM2:	0	;LINK FN2
PACKN:	0	;PACK NUMBER OR SNAME IN LINK IF LEFT HALF NON ZERO
;******   *****			*****

CPYO:	SIXBIT /  #DSK/	;OUTPUT TO DISK
LFN1:	0
LFN2:	0
	0
	0

ERROP:	0,,(SIXBIT/ERR/)
	1
	0
	0
	0

SPLACE:	SIXBIT /SYSENG/	;PLACE TO STORE MACRO TAPES
STATOP:	SIXBIT /   DSK/	;FILE TO SAVE TAPE DATA IN
	SIXBIT /MACRO/
	SIXBIT /TAPES/
	0
	0

USRDEL:	0		;FOR .FDELE
	0
	0
NPLACE:	SIXBIT /.TAPE0/	;TAPE DIRECTORY DIRECTORY, OR 0 IF HAVEN'T DECIDED YET
NSVOP:	SIXBIT /  'DSK/
	SIXBIT /TAPE/
NSVTPN:	0
	0		;FOR .FDELE
	0
	0

TDIRN:	0			;CURRENT INDEX IN TDIRTB

SNBUF:	BLOCK UDNAMP+1		;USED TO GET UDNAMP TO ESTIMATE DIR FULLNESS

SNTRY:	SETZ
	SIXBIT /OPEN/
	3000,,E
	MOVEI SNPLCH
	[SIXBIT/DSK/]
	[SIXBIT/TAPE/]
	SNTRYN
	SETZ TDIRTB(A)

SNTRYN:	0

RUSN:	0	;NAMES USED IN SINGLE FILE RESTORE
RFN1:	0
RFN2:	0
	0
	0

CUSN:	0	;CURRENT USER NAME USED WHEN LSTWHL IS ON
RDATE:	SETZ
	SIXBIT /RFDATE/
	[DSKIN]
	SETZ FDATE(2000)

RQDATE:	SETZ
	SIXBIT /RQDATE/
	SETZM HDATE

SDATE:	SETZ
	SIXBIT /SFDATE/
	[DSKOUT]
	SETZ FDATE

SRDT:	SETZ
	SIXBIT /SRDATE/
	[DSKOUT]
	SETZ RFDATE

FILLEN:	SETZ
	SIXBIT /FILLEN/
	[DSKIN]
	SETZM LENGTH

FILBLK:	SETZ
	SIXBIT /FILBLK/
	[DSKIN]
	2000,,0
	2000,,0
	2000,,0
	2000,,FDATE
	SETZM RFDATE


SRFDAT:	SETZ
	SIXBIT /SRDATE/
	[DSKIN]
	SETZ RFDATE

CLBIT:	SETZ
	SIXBIT /SDMPBT/
	[STATC]
	SETZ [0]

RESRDT:	SETZ	;RESTORE REF DATE
	SIXBIT /RESRDT/
	SETZ [DSKIN]

RRDATE:	SETZ
	SIXBIT /FILBLK/
	1000,,DSKIN
	2000,,0
	2000,,0
	2000,,UNRNDW
	2000,,0
	402000,,RFDATE

CREFDT:	SETZ	;COPY REF DATE INTO FDATE
	SIXBIT /SFDATE/
	[DSKIN]
	SETZ RFDATE

RHDATS:	SETZ
	SIXBIT /FILBLK/
	MOVEI DSKIN
	MOVEM 0			; FN1
	MOVEM 0			; FN2
	MOVEM 0			; RND
	MOVEM HDATE
	SETZM HRDATE

RHLEN:	SETZ
	SIXBIT /FILLEN/
	MOVEI DSKIN
	SETZM HLEN

TTYGET:	SETZ
	SIXBIT /TTYGET/	
	MOVEI TYOC
	MOVEM TTYST1
	MOVEM TTYST2
	SETZM TTYSTS

TTYSET:	SETZ
	SIXBIT /TTYSET/
	MOVEI TYOC
	TTYST1
	TTYST2
	SETZ TTYSTS

TRRDFO:	SETZ		;OPEN BLOCK FOR INDIRECT COMMAND FILES FROM DISK
	SIXBIT /OPEN/
	1000,,TYIC
	TINDEV
	TINFN1
	TINFN2
	SETZ TINSNM
SUBTTL UUO HANDLER

UUOH:	0
	PUSH P,40
	PUSH P,UUOH		;FOR RECURSIVE UUOS
	PUSH P,A
	PUSH P,B
	PUSH P,C
	LDB C,[330600,,40]	;OP CODE
	CAILE C,0
	 CAILE C,LUUOTB
	  .VALUE		;ILLEGAL UUO
	PUSHJ P,@UUOTAB-1(C)
	 CAIA			;REGULAR RETURN
	  JRST SKPRET		;SKIP RETURN
	POP P,C
	POP P,B
	POP P,A
	POP P,UUOH
	POP P,40
	JRST 2,@UUOH

SKPRET:	POP P,C
	POP P,B
	POP P,A
	POP P,UUOH
	POP P,40
	AOS UUOH
	JRST 2,@UUOH

;MTAPE UUO.  AC IS OPERATION, E IS SUBCOMMAND.
;THIS IS NEVER USED, TAKES THE WRONG ARGUMENTS, AND DOESN'T
;WORK SINCE IT USES THE 'MTAPE' SYMBOLIC SYSTEM CALL,
;WHICH DOES NOT EXIST!!    *******
;
;AMTAPE:	PUSH P,40		;PUSH OF 40 IS SUPERFLUOUS *******
;	OPEN MAGIN,MAGI
;	 JRST RET
;	POP P,40
;	LDB A,[270400,,40]	; SPACE, DO SOMETHING ELSE, OR SET MODE(S)
;	HRRZ B,40	;SUBCOMMAND
;	.CALL TAPBLC
;	 .LOSE 1000
;	POPJ P,
;
;TAPBLC:	SETZ
;	XWD SIXBIT /   MTA/,SIXBIT /   PE/		;SO NMTAPE WILL NOT FIND THIS
;	[MAGIN]
;	A
;	SETZ B

;PSIS UUO.  PRINT A SPACE THEN A SIX CHARACTER SIXBIT WORD.
APSIS:	PUSHJ P,TYOS

;SIXTYP UUO.  PRINT A SIX CHARACTER SIXBIT WORD.
ASIXTYP:MOVE B,@40
	JRST SIXTYO

;DPT UUO.  PRINT A DECIMAL NUMBER RIGHT-JUSTIFIED IN 6 COLUMNS.
;PAY NO ATTENTION TO THE MOVE C,-1(P) IT'S SUPERFLUOUS!
APDPT:	MOVE C,-1(P)	;PRINT DECIMAL NUMBER
	MOVE A,@40
	PUSHJ P,ADJUS
	JRST DPT

ADJUS:	PUSH P,A	;'FIXED' FORMAT HACK
	MOVM B,A
	SKIPN B
	 MOVEI B,1
	MOVEI C,10000.
	SKIPGE A
	 IDIVI C,10.	;FOR THE MINUS SIGN
ADJUS1:	PUSHJ P,TYOS
	CAML B,C
	 JRST POPAJ
	IMULI B,10.
	JRST ADJUS1

;POCT UUO.  PRINT SIGNED OCTAL NUMBER, PRECEDED BY SPACE.
;PAY NO ATTENTION TO THE MOVE C,-1(P) IT'S SUPERFLUOUS!
APOCT:	MOVE C,-1(P)	;PRINT OCTAL NUMBER
	PUSHJ P,TYOS
	MOVE A,@40
	JRST DOT

;PERR UUO.  MAINLY FOR DIE MACRO.
APERR:	SETZM LPTSW	;SURELY THESE SHOULD NOT GO INTO WALLPAPER FILE
	PUSHJ P,APASC	;PRINT ASCII AND DIE
	JRST ERR

;OPEN UUO.  LIKE .OPEN, BUT IF IT FAILS GIVES MESSAGE ON TTY.
AOPEN:	MOVEI A,<.OPEN_-27.>
	MOVE B,40
	DPB A,[331100,,B]
	MOVSI C,10	;DO NOT SET REFERENCE DATE ON DSKIN
	LDB A,[270400,,B]
	CAIN A,DSKIN
	 IORM C,@40
	SETZM A
	XCT B
	 SETOM A
	LDB B,[270400,,B]
	CAIN B,DSKIN
	 ANDCAM C,@40
	SKIPN A
	 JRST POPJ1	;SUCCEEDED
	PUSH P,LPTSW
	SETZM LPTSW	;TYPE ERROR MESSAGE ON TTY
	PUSH P,40
	HRRZ B,UUOH
	SOS B
	POCT B		;PC OF OFFENDING OPEN
	POP P,A
	.SUSET [.RSNAM,,B]
	PUSHJ P,TELL
	POP P,LPTSW
	POPJ P,

;ALSO CALLED FROM INT4 (DISK DATA ERROR)
TELL:	PSIS (A)
	PRINT :
	PSIS 1(A)
	PSIS 2(A)
	PSIS B
	PASC [ASCIZ /;/]
	PUSHJ P,OPINFL
	JRST CRR

OPINFL:	PUSH P,A	;ANALYZE IOC ERROR
	.OPEN ERRC,ERROP
	 .VALUE		;LOSING COMPLETELY!
	MOVEI A,40	;SPACE
ERRLOP:	PUSHJ P,TYO
	.IOT ERRC,A
	CAIL A,40
	 JRST ERRLOP
	.CLOSE ERRC,
	PUSHJ P,CRR
POPAJ:	POP P,A
	POPJ P,

;PASC UUO.  MAINLY FOR PRINT MACRO.
APASC:	MOVE B,40	;PRINT ASCIZ STRING
	HRLI B,440700
PRINL5:	ILDB A,B
	JUMPE A,CPOPJ
	CAIN A,^Q	;CONTROL-Q TURNS OFF UNDERSCORE MISFEATURE
	 JRST [	ILDB A,B ? PUSHJ P,TYO ? JRST PRINL5 ]
	CAIN A,"_	;UNDERSCORE GETS MAPPED INTO CR-LF
	 JRST [ PUSHJ P,CRR ? JRST PRINL5 ]
	  PUSHJ P,TYO
	JRST PRINL5

SIXTYO:	MOVE C,[440600,,B]	;TYPE 6 SIXBIT CHARACTERS
SIXTY1:	ILDB A,C
	ADDI A,40
	PUSHJ P,TYO
	TLNE C,770000
	 JRST SIXTY1
	POPJ P,

DOT:	SKIPA B,[8]
DPT:	 MOVEI B,10.
	MOVEM B,BASE
	JUMPL A,NDPT
DPT1:	IDIV A,BASE	;DECIMAL OUTPUT ROUTINE
	HRLM B,(P)
	SKIPE A
	 PUSHJ P,DPT1
	HLRZ A,(P)
	ADDI A,"0
	JRST TYO

NDPT:	PUSH P,A
	MOVEI A,"-
	PUSHJ P,TYO
	POP P,A
	MOVNS A
	JRST DPT1
SUBTTL FNG - GET NEXT FILE

;FNG GETS THE NEXT FILE, MAPPING OVER THE WHOLE WORLD BUT EXCLUDING
; SOME FILES ON BASIS OF DATE, ETC.
;RETURNS FILE NAME AND ATTRIBUTES IN A FEW MILLION VARIABLES,
; WHICH SHOULD BE LISTED HERE.
;CLOBBERS JUST ABOUT ALL THE ACS.

;THIS ISN'T THE ENTRY, JUMPS HERE IF CAN'T READ UFD.
FUNCT:	.STATUS UFDCH,A
	LDB A,[220600,,A]	;OPEN-LOSS CODE
	CAIN A,20
	 POPJ P,		;DIRECTORY DOESN'T EXIST, FAIL.
	PUSH P,LPTSW
	SETZM LPTSW
	PSIS CHNTAB+UFDCH	;MAY JUST BE 'DEVICE NOT AVAILABLE'
	PUSHJ P,OPINFL
	PUSHJ P,CRR
	POP P,LPTSW
	MOVEI A,150.
	.SLEEP A,
	JRST FNG8

;ENTRY.
FNG:	AOSE FLNI		;PUT ONE FILE NAME AND PACK # IN FN1,FN2,PACKN
	 JRST NEXFLN		;NOT THE FIRST TIME
FNG8:	.OPEN UFDCH,FNO
	 JRST FUNCT		;MAYBE TOO MUCH DISK ACTIVITY
	MOVE A,[-2000,,FDIRBF]
	.IOT UFDCH,A
	.CLOSE UFDCH,
	SKIPN GFRFLG
	 JRST FNG1
	HRRZ A,FDIRBF+UDBLKS
	MOVEM A,BLOCKS
	HLRZ A,FDIRBF+UDBLKS
	MOVEM A,QUOTA
	SKIPE GFREVR
	 JRST FNG1
	HLRZ A,FDIRBF+UDALLO
	JUMPE A,FNG1
	MOVEI B,1
	LSH B,(A)		;BIT FOR PACK ALLOCATED TO
	TDNN B,SECMSK		;ALLOCATED TO SECONDARY DOESN'T COUNT
	 SKIPE GFRALO		;DON'T REAP ALLOCATED DIRS?
	  JRST FNG1		; REAP THE SUCKERS!
	POPJ P,			;ALLOCATED, DON'T REAP

FNG1:	MOVE A,FDIRBF+UDNAMP
	MOVEM A,DIRIDX
	ADDI A,FDIRBF		;A POINTS TO BEGINNING OF NAME AREA
	MOVE C,A
GETNM:	CAILE A,FDIRBF+1777-4
	 JRST OUTENT		;END OF NAME AREA
	SKIPN W,(A)
	 JRST NEXENT		;EMPTY SLOT [SHOULDN'T HAPPEN!]
	MOVE B,UNRNDM(A)
	SKIPN GFRFLG
	 JRST GETNM2
	SKIPE GFREVR
	 JRST GETNM1
	TLNN B,UNREAP		;DON'T REAP FILES WITH REAP BIT ON
	 TLNN B,UNDUMP		;DON'T REAP FILES NOT YET DUMPED
	  JRST NEXENT
	PUSH P,A
	LDB A,[UNPKN B]
	MOVEI D,1
	LSH D,(A)		;BIT FOR PACK IT'S ON
	POP P,A
	TDNN D,GFRPNM
	 JRST NEXENT		;DON'T REAP OFF THIS DISK
GETNM2:	TLNN B,UNLINK
	 JRST GETNM1
	SKIPN DMPLNK
	 JRST NEXENT
GETNM1:	SKIPL INCREM
	 SKIPGE DATEF
	  CAIA
	  JRST IGNORQ
	TLNE B,UNLINK		; LINK
	 JRST NEXENT		; DON'T INCREMENTAL DUMP LINKS
	SKIPGE DATEF
	 JRST IGNORQ
	TLNE B,UNDUMP		;FILE-DUMPED BIT
	 JRST NEXENT
	MOVE D,3(A)
	CAMN D,[-1]
	 PUSHJ P,SM1DT		;MINUS 1 DATE, CHANGE INTO TODAY.
IGNORQ:	TLNE B,UNIGFL
	 JRST NEXENT		;FILE IS EITHER OPEN FOR WRITING OR SOME FLAVOR OF BEING DELETED
	MOVE D,DATE
	SKIPGE DATEF
	 CAMG D,3(A)		;IF DATE SPECIFIED, DISREGARD IF CREATION
	  CAIA			; DATE IS BEFORE SPECIFIED DATE
	   JRST NEXENT
	MOVE D,DATE1
	SKIPGE DATESF
	 CAMLE D,3(A)		;IF DATES SPECIFIED, DISREGARD IF CREATION
	  CAIA			; DATE IS AFTER SPECIFIED DATE
	   JRST NEXENT
	TLNE B,UNLINK
	 JRST GETLNK
	MOVEM W,(C)		;FIRST NAME
	MOVE W,1(A)
	MOVEM W,1(C)
	LDB W,[UNPKN B]
	MOVEM W,2(C)		;PACK #
	MOVE W,3(A)
	MOVEM W,3(C)
	HLRZ W,4(A)		;REFERENCE DATE
	SKIPN W
	 MOVEI W,177777
	ANDI W,177777
	SKIPE GFRCRE		;GET CREATION DATE INSTEAD OFF REFERENCE DATE.
	 HLRZ W,3(A)
	MOVSM W,4(C)
	SKIPN GFRFLG
	 JRST FNGOK
	PUSHJ P,LNTH
	JUMPE B,NEXENT		;ZERO-LENGTH FILES DON'T GET REAPED
	MOVE B,(C)
	CAME B,[SIXBIT/-READ-/]
	 JRST FNGOK
	MOVE B,1(C)
	CAME B,[SIXBIT/-THIS-/]	;THESE FILES WORTH KEEPING AROUND
FNGOK:	 ADDI C,LUNBLK		;ACCEPT THIS FILE INTO THE LIST
NEXENT:	ADDI A,5
	JRST GETNM

SM1DT:	MOVEI D,.BII		;FILE SEEN WITH -1 CREATION DATE,
	HRLM D,TRNI		; AND NOT DUMPED YET.  FIX.
	MOVE D,(A)
	MOVEM D,FN1
	MOVE D,1(A)
	MOVEM D,FN2
	.OPEN DSKIN,TRNI
	 POPJ P,
	.CALL RRDATE	;READ REF DATE (= NOW SINCE JUST OPENED!!)
	 SKIPA
	 .CALL CREFDT	;COPY INTO CREATION DATE
	  JFCL
	.CLOSE DSKIN,
	POPJ P,

;HACKED ALL ENTRIES, NOW SORT
OUTENT:	MOVEM C,LFDIR
	SETZM (C)		;ZERO ENTRY MEANS END OF DIRECTORY
	SETZM 1(C)
	SETZM 4(C)
	MOVE A,DIRIDX
	ADDI A,FDIRBF
	MOVEI D,LUNBLK
	MOVEI N,0		;USUALLY BY FN1
	SKIPE GFRFLG
	 SKIPN GFRQUO
	  JRST OUTEN1
	MOVEI N,4	;SORT BY REFDATE IF GFR AND QUOTA
	PUSHJ P,SORT
	MOVE A,DIRIDX
	ADDI A,FDIRBF
	MOVEI N,3
	MOVE C,A
OUTEN2:	SKIPN B,4(A)
	 JRST OUTLUP
OUTEN3:	ADDI C,LUNBLK
	CAMN B,4(C)
	 JRST OUTEN3
	PUSHJ P,SORT
	JRST OUTEN2

OUTEN1:	PUSHJ P,SORT
	MOVE A,DIRIDX
	ADDI A,FDIRBF
	MOVEI N,1		;SORT BY FN2 WITHIN EQUAL FN1
	MOVE C,A
BLUP:	SKIPN B,(A)
	 JRST OUTLUP
BLUP1:	ADDI C,LUNBLK
	CAMN B,(C)
	 JRST BLUP1
	PUSHJ P,SORT		
	JRST BLUP
OUTLUP:	;ESCAPE FROM ABOVE SORTING.  DROP INTO NEXFLN.

;HERE TO EXTRACT A FILE FROM THIS MUNGED DIRECTORY.
NEXFLN:	SETZM RFDATE
	MOVE A,DIRIDX
	SKIPN B,FDIRBF(A)
	 POPJ P,		;NO MORE FILES
	MOVEM B,FN1
	MOVE B,FDIRBF+1(A)
	MOVEM B,FN2
	MOVE B,FDIRBF+2(A)
	MOVEM B,PACKN
	MOVE B,FDIRBF+3(A)
	MOVEM B,LNKNM1
	SKIPE GFRFLG
	 MOVEM B,FLENTH
	MOVE B,FDIRBF+4(A)
	MOVEM B,LNKNM2
	ADDI A,LUNBLK
	MOVEM A,DIRIDX
	SETZM LNKFLG
	HLRZ A,PACKN
	SKIPE A
	 SETOM LNKFLG
	SKIPN LNKFLG
	 MOVEM B,RFDATE
POPJ1:	AOS (P)
CPOPJ:	POPJ P,

GETLNK:	MOVEM W,(C)		;FIRST NAME
	MOVE W,1(A)
	MOVEM W,1(C)
	LDB B,[UNDSCP+UNRNDM(A)]	;GET FIRST BYTE INDEX
	PUSH P,B+1
	IDIVI B,UFDBYT
	ADDI B,FDIRBF+UDDESC
	MOVNI N,-6(C)
	IMULI N,6
	HRLI N,60200		;ASSUMING B=2 !!!
	ROT N,30.
	POP P,B+1
	PUSHJ P,GETLSL
	CAMN W,[SIXBIT /BACKUP/]	; DON'T BACKUP LINKS TO THE BACKUP DIRECTORY
	 JRST NEXENT
	SKIPN W
	 SETOM W	;IN CASE OF ZERO SNAME
	MOVEM W,2(C)	; SNAME
	PUSHJ P,GETLSL
	MOVEM W,3(C)	; LINK FN1
	PUSHJ P,GETLSL
	MOVEM W,4(C)
	ADDI C,LUNBLK
	JRST NEXENT

;GETLSL	GET LINK SYLLABLE. 6 BIT CHARACTERS. AT MOST 6 TO A WORD RETURNED IN W
;	NEXT CHARACTER QUOTED BY : DELIMITER IS ; OR ZERO CHARACTER
GETLSL:	PUSH P,A
	PUSH P,C
	PUSH P,D
	MOVEI D,6	;AT MOST 6 CHARACTERS
	MOVE C,[440600,,W]
	SETZM W
GETLS1:	ILDB A,N
	CAIE A,0
	 CAIN A,';	; END?
	  JRST GETLS2
	CAIN A,':	; QUOTE NEXT CHAR
	 ILDB A,N
	IDPB A,C	; STORE CHARACTER
	SOJG D,GETLS1
GETLS2:	POP P,D
	POP P,C
	POP P,A
	POPJ P,

LNTH:	LDB D,[UNDSCP+B]
	SETZM B
	IDIVI D,6
	HLL D,QBTBLI(E)
	ADDI D,UDDESC+FDIRBF
	PUSHJ P,LN1
	MOVEM B,3(C)
	POPJ P,

LN1:	ILDB E,D
	SKIPN E
	 POPJ P,
	CAILE E,UDTKMX
	 JRST LN2
	ADD B,E
	JRST LN1

LN2:	CAIGE E,UDWPH
	 AOJA B,LN1
	CAIN E,UDWPH
	 JRST LN1
	REPEAT 2, IBP D
	AOJA B,LN1

QBTBLI:	440600,,
	360600,,
	300600,,
	220600,,
	140600,,
	060600,,
	000600,,

;THE FOLLOWING ROUTINE READS IN AND ALPHABETIZES THE MASTER FILE
;DIRECTORY OF THE DISK USING THE ASSUMED NAME M.F.D. (FILE).
;THE DIRECTORY IS READ IN WITH BLOCK IMAGE MODE INPUT INTO MFDLST,
;AND IS ASSUMED TO BE COMPLETELY CONTAINED IN 2000 OCTAL LOCATIONS.
;THE FIRST ENTRY IS ASSUMED TO BE IN LOCATION MFDLST+N, WHERE N IS THE CONTENTS OF MFDLST+1.
;EVERY ENTRY IS ASSUMED TO TAKE TWO LOCATIONS WITH THE NAME TO BE ALPHABETIZED IN THE FIRST
;LOCATION OF THE TWO.
;  THE FINAL ALPHABETIZED LIST IS ONE WORD ENTRIES STARTING AT MFDLST.

;NEXT MFD ENTRY (FOR FNG)
MFDN:	SETOM APPENF
	AOS A,MFDIN
	MOVE A,MFDLST(A)
	JUMPE A,CPOPJ
	MOVEM A,USNM
	JRST POPJ1

;READ IN MFD
INMFD:	MOVEI A,.BII
	HRLM A,MFO
	OPEN STATC,MFO
	 .VALUE			;HOW CAN WE POSSIBLY WIN WITHOUT MFD?
	MOVE A,[-2000,,MFDLST]
	.IOT STATC,A
	.CLOSE STATC,
	MOVEI B,0		;FIRST, COPY IT DOWN INTO CONTIG WORDS
	MOVE A,MFDLST+MDNAMP	;LOCATION OF FIRST ENTRY
NEXUFD:	SKIPN C,MFDLST(A)
	 JRST GOON
	MOVEM C,MFDLST(B)
	ADDI B,1
GOON:	ADDI A,2
	CAIGE A,2000
	 JRST NEXUFD
	SETZM MFDLST(B)		;MARK END
	MOVEI A,MFDLST		;NOW SORT IT
	MOVEI C,MFDLST(B)
	MOVEI N,0
	MOVEI D,1
	JRST SORT
SUBTTL SORT ROUTINE

;THIS ROUTINE SORTS A BLOCK OF CORE LOGICALLY (NOT ARITHMETICALLY)
;ARGUMENTS:
;A POINTS TO FIRST ENTRY
;C POINTS TO LOCATION AFTER LAST ENTRY
;N HOLDS ADDRESS OF KEY WORD RELATIVE TO BEGINNING OF BLOCK
;D HOLDS NUMBER OF WORDS TO BE MOVED TOGETHER
;THE METHOD IS RADIX EXCHANGE
;BORROWED FROM SYSENG;PRUFD >
SORTDN:	MOVE [TDNE B,(A)]
	MOVEM TEST1
	MOVE [TDNN B,(C)]
	MOVEM TEST2
	JRST SORTI
SORT:	MOVE [TDNN B,(A)]
	MOVEM TEST1
	MOVE [TDNE B,(C)]
	MOVEM TEST2
SORTI:	MOVSI B,(SETZ)
SORT1:	HRLM C,(P)	;SAVE UPPER BOUND
	MOVN W,D
	ADD W,C
	CAML A,W
	 JRST SORT7	;ONE OR ZERO ENTRIES
	PUSH P,A	;SAVE LOWER BOUND
SORT3:	ADD A,N
	XCT TEST1	;BIT SET IN LOWER ENTRY?
	 JRST SORT5	;NO, INCREMENT TO NEXT AND MAYBE TRY AGAIN
	SUB A,N
	SUB C,D
	ADD C,N
	XCT TEST2	;BIT CLEAR IN UPPER ENTRY?
	 JRST SORT8	;NO, CHECK FOR END, DECREMENT C, AND TRY AGAIN
	SUB C,N
	IMUL D,[-1,,]	;MAKE AOBJN POINTER
SHUFFL:	ADDI A,(D)
	ADDI C,(D)
	MOVE W,(A)
	EXCH W,(C)
	MOVEM W,(A)
	SUBI A,(D)
	SUBI C,(D)
	AOBJN D,SHUFFL
SORT4:	ADD A,D		;INCREMENT LOWER BOUND POINTER TO NEXT ENTRY
SORT2:	CAME A,C	;ANY MORE ENTRIES LEFT?
	 JRST SORT3	;YES, GO PROCESS THEM
		;A AND C NOW BOTH POINT TO FIRST ENTRY WITH BIT SET
	ROT B,-1	;ROTATE BIT INDICATOR TO NEXT (LESS SIGNIFICANT) BIT
	POP P,A		;RESTORE LOWER BOUND OF ENTIRE SORT
	JUMPL B,SORT6	;JUMP IF NO MORE KEY TO SORT ON
	PUSHJ P,SORT1	;SORT BOTTOM PART OF TABLE
	HLRZ C,(P)	;RESTORE UPPER BOUND (SORT1 CLOBBERED A TO MIDDLE)
	PUSHJ P,SORT1	;SORT TOP PART OF TABLE
SORT6:	ROT B,1		;BACK UP KEY AGAIN SO AS TOO "NOT CLOBBER B"
SORT7:	HLRZ A,(P)	;MAKE A POINT ABOVE TABLE ENTRIES SORTED
	POPJ P,

SORT5:	SUB A,N
	JRST SORT4

SORT8:	SUB C,N
	JRST SORT2
SUBTTL PROGRAM STARTS HERE

START:	SKIPN MYNAME		;DON'T CHANGE IF NOT JUST LOADED
	 .SUSET [.RSNAME,,MYNAME]
	.SUSET [.SSNAM,,MYNAME]
	.SUSET [.ROPTION,,A]
	TLO A,%OPOPC		;STORE PROPER PC ON INTERRUPTS
	.SUSET [.SOPTION,,A]
	.OPEN TYOC,[%TJDIS+.UAO,,(SIXBIT /TTY/)]
	 .LOSE 1400
	MOVEI P,PDL
	.CORE CORSIZ
	 JRST .-1
	.SUSET [.SMASK,,[%PIIOC+%PITYI]]	;ALLOW IOC, TYPEIN
	;COPY QPKID AND QRESRV ARRAYS OUT OF ITS
	MOVE C,[SQUOZE 0,NQS]
	.EVAL C,
	 .LOSE
	MOVE A,[SQUOZE 0,QPKID]
	.EVAL A,
	 .LOSE
	MOVSS A
	HRRI A,QPKID
	MOVE B,C
	.GETLOC A,
	ADD A,[1,,1]
	SOJG B,.-2
	MOVE A,[SQUOZE 0,QRESRV]
	.EVAL A,
	 JRST NORSRV
	MOVSS A
	HRRI A,QRESRV
	.GETLOC A,
	ADD A,[1,,1]
	SOJG C,.-2
NORSRV:	;SET UP SECMSK TO BE ALL THE PACKS THAT ARE ON-LINE AND RESERVED
	SETZM SECMSK
	SETZM PRIMSK		;AND PRIMSK THE ON-LINE NON-RESERVED PACKS
	MOVSI C,-10	
SETSCM:	MOVEI A,1
	SKIPGE QPKID(C)
	 JRST SETSC1		;NOT ON-LINE
	LSH A,@QPKID(C)
	SKIPE QRESRV(C)
	 IORM A,SECMSK
	SKIPN QRESRV(C)
	 IORM A,PRIMSK
SETSC1:	AOBJN C,SETSCM
	PUSHJ P,INMFD
	.OPEN TYIC,[10,,(SIXBIT /TTY/)] ;DDT MODE
	 .LOSE 1400
	.CALL TTYGET		;TRY TO TURN ON **MORE** PROCESSING
	 JFCL
	MOVSI C,%TSMOR
	ANDCAM C,TTYSTS
	.CALL TTYSET
	 JFCL
	.STATUS TYOC,A
	LDB A,[300,,A]
	MOVEM A,DISPLY
	SOS DISPLY		;0==> PAPER  1==> SCREEN

	;PRINT _		;CRLF
	;PUSHJ P,FORMF		;CLEAR SCREEN IF DISPLAY
	SIXTYP PRNAM1
	PRINT .
	SIXTYP PRNAM2
	PUSHJ P,CRR
	SETOM ITAPE		;Assume tape is / will be rewound
	SETOM MFDDAT
	SETOM UFDDAT
	SKIPGE TAPTYP
	 SETOM TAPTYP		;Dismount remote tape
	SKIPG WRONG		;Else SETIT will make local/remote decision
	 JRST MLP
	SETZM WRONG		;See if on right machine (first time only)
	.CALL [ SETZ ? 'SSTATU ? REPEAT 5,[MOVEM A ? ] SETZM A ]
	 .VALUE
	CAMN A,[MCHN]
	 JRST MLP
	PRINT *** WRONG VERSION OF DUMP--ASSEMBLED FOR
	PSIS [MCHN]
	PRINT  BUT RUNNING ON
	PSIS A
	PRINT  ***_*** CERTAIN TAPE OPERATIONS WON'T BE ALLOWED ***
	SETOM WRONG
	;JRST MLP		;drops through
SUBTTL MAIN COMMAND LOOP

RET:	 ;FAILURE RETURN FROM VARIOUS COMMANDS
MLP:	.CORE CORSIZ
	 JRST .-1	;NO CORE
	SETZM CTRLG
	SETZM ACLODF
	SETZM GFRFLG
	SETZM GFRCRE
	SETZM EOTFLG
	SETZM USRDEL
	SETZM DATEF
	SETZM DATESF
	SETZM RELOSW
	SETZM PDIRSW
	SETZM DMPDIR
	SETZM DMPUFD
	SETZM DMPMFD
	SETZM DMPLNK
	SETZM DFINDF
	MOVEI P,PDL
	CLEARM LPTSW
	.CLOSE SAVET,
	MOVNI A,1
	SKIPE LPTBFC
	 PUSHJ P,LPTTYO		;EMPTY THE LPT BUFFER
	.CLOSE LPTCH,
	.RESET MAGIN,		;ASSUMING MTAPE USES MAGIN AS ITS CHANNEL
	.CLOSE MAGIN,		;BEGINNING AND ERROR RESTART
	.CLOSE MAGOUT,
	SETZM MAGOPN
	SETZM LNKFLG
	.IOPDL			;FLUSH ANY PUSHED DSKIN, ETC.
	.CALL TTYSET		;TURN ECHOING BACK ON, IF OFF
	 JFCL
PROMPT:	PUSHJ P,CRR
	MOVEI A,"_
	PUSHJ P,TYO		;PROMPT THE LOSER
	PUSHJ P,TYI
	CAIN A,"?
	 JRST AHELP
	PUSHJ P,GETSL1		;READ THE COMMAND
	 JRST PROMPT
	JUMPE SYM,RET		;JUST A CR OR FF, REPROMPT
	CLEARM SUPERC
	CLEARM DMPMOD
	CLEARM CHKFLG
	CLEARM TCOPYF
	MOVSI B,-NCOMS
	CAME SYM,COMT(B)	;SEARCH THE COMMAND TABLE
	 AOBJN B,.-1
	MOVEI C,0		;USED IN SOME COMMANDS AS DEFAULT
	JUMPL B,MLP1		;NOT REASONABLE COMMAND ?
ERR:	PRINT  ? 
	JRST MLP

FORMF:	SKIPG DISPLY
	 POPJ P,
	PASC [ASCIZ /C/]
	POPJ P,

MLP1:	SKIPGE COMDTB(B)	;NOT ALL COMMANDS USE THE TAPE DRIVE
	 PUSHJ P,SETITN		;SETIT, and show who used it last.
	PUSHJ P,@COMDTB(B)	;DO COMMAND
	JRST RET

AHELP:	PASC COMHLP		;GIVE COMMAND NAMES AND DESCRIPTION
	JRST MLP
;	MOVSI D,-NCOMS		;LIST COMMANDS
;	PUSHJ P,CRR
;HELP1:	PSIS COMT(D)
;	PUSHJ P,CRR
;	AOBJN D,HELP1
;	JRST MLP
SUBTTL COMMAND LOOK-UP TABLES

 ;NOTE IF YOU CHANGE THIS, CHANGE COMDTB AND COMHLP (ALSO ON THIS PAGE)
COMT:	SIXBIT /LOCAL/	;USE LOCAL TAPE DRIVE
	SIXBIT /REMOTE/	;USE REMOTE TAPE DRIVE
	SIXBIT /TAPED/	;GENERATE TAPE DIRECTORY FROM MOUNTED TAPE
	SIXBIT /FIND/	;FIND WHAT TAPE PARTICULAR FILE IS ON
	SIXBIT /OFIND/	;FIND COMMAND USING A TAPE FOR INFO
	SIXBIT /DFIND/	;FIND COMMAND FOR A DECEASED ITS.
	SIXBIT /DUMP/	;DUMP FILES
	SIXBIT /LOAD/	;LOAD FILES
	SIXBIT /RELOAD/	;LOAD FILES, MODIFY DIRECTORY FROM TAPE COPY
	SIXBIT /CLOAD/	;CONTINUE PREVIOUS LOAD OPERATION
	SIXBIT /CDUMP/	;CONTINUE FULL DUMP
	SIXBIT /REWIND/	;REWIND MAG TAPE
	SIXBIT /UNLOAD/	;REWIND/UNLOAD
	SIXBIT /FLAP/	;REWIND/UNLOAD
	SIXBIT /EOT/	;GO TO END OF TAPE
	SIXBIT /LIST/	;LIST FILES ON TAPE
	SIXBIT /MFD/	;LIST OUT MFD
	SIXBIT /LISTF/	;LIST OUT FILE DIRECTORY
	SIXBIT /HELP/	;TYPE OUT COMMANDS
	SIXBIT /SPACE/	;SPACE FORWARD N FILES
	SIXBIT /LSPACE/	;SPACE FORWARD AND LIST FILES
	SIXBIT /CHECK/	;CHECK FILES
	SIXBIT /LCHECK/	;CHECK FILES AND LIST THEM
	SIXBIT /TAPES/	;LIST ALL SAVED TAPE INFO
	SIXBIT /TAPE/	;LIST SAVED INFO ABOUT ONE TAPE
	SIXBIT /TAPSET/	;SET TAPE INFO FOR ONE TAPE
	SIXBIT /TLIST/	;LIST FILES ON A TAPE(AS STORED ON DISK)
	SIXBIT /GFR/	;GRIM FILE REAPER
	SIXBIT /QUIT/	; REWIND AND KILL
	SIXBIT /ICHECK/
	SIXBIT /ERRSTS/	;TAPE CONTROL STATUS AS OF LAST ERROR
	SIXBIT /ALLOC/	;SET/GET DIRECTORY ALLOCATION
	SIXBIT /LSTALC/	;LIST ALL ALLOCATED DIRECTORIES
	SIXBIT /PTDIR/	;PRINT DIRECTORIES FROM TAPE
NCOMS==.-COMT

COMHLP:	ASCIZ\
LOCAL	Use local tape drive on this machine
REMOTE	Use remote tape drive over the Chaos network
FIND	Find what tape a particular file is on
OFIND	FIND command using a tape for info
DFIND	FIND command for a deceased ITS
DUMP	Dump files
LOAD	Load files
RELOAD	Load files, modify directory from tape copy
CLOAD	Continue previous LOAD/RELOAD operation
CDUMP	Continue full dump
REWIND	Rewind mag tape
UNLOAD	Rewind/unload
EOT	Go to end of tape
SPACE	Space forward n files
LSPACE	Space forward and list files, hit <space> after each
LIST	List files on tape
MFD	List MFD from disk
LISTF	List a file directory from disk
HELP	Type out commands
CHECK	Check files on tape against disk
LCHECK	Check files and list them
ICHECK	Check files on incremental dump, update dump-check bits
TAPED	Generate tape directory from mounted tape
TAPES	List all saved tape info
TAPE	List saved info about one tape
TAPSET	Set tape info for one tape
TLIST	List files on a tape (from tape directory stored on disk)
GFR	Grim File Reaper (Don't use this, please)
QUIT	return to DDT
ERRSTS	Print tape control status as of last error
ALLOC	Examine or change directory allocation
LSTALC	List all directories with allocations
PTDIR   Print directories from tape
\

COMDTB: ALOCAL		;SETZ MEANS THAT COMMAND USES THE TAPE DRIVE
	AREMOTE
	ATAPED
	AFIND
	SETZ OFIND
	DFIND
	SETZ DUMP
	SETZ LOAD
	SETZ RELOAD
	SETZ ACLOAD
	SETZ ACDUMP
	ARWND
	AUNLD
	AUNLD
	AEOT
	SETZ ALIST
	AMFD
	ALISTF
	AHELP
	SETZ ASPACE
	SETZ ALSPACE
	SETZ ACHECK
	SETZ ALCHEC
	ATAPES
	ATAPE
	TAPSET
	ATLIST
	AGFR
	AQUIT
	AICHEC
	ERRSTS
	DALLOC
	LSTALC
	SETZ APTDIR
IFN .-COMDTB-NCOMS, .ERR COMDTB NOT SAME LENGTH AS COMT
SUBTTL TTY I/O

TYI:	.IOT TYIC,A	;TTY IN
	JUMPL A,TYICC1	;EOF ON INDIRECT FILE
	CAIN A,^C	;IGNORE GARBAGE CHARS
	 JRST TYI
	CAIN A,^G
	 JRST TYI
	CAIL A,"a	;UPPER CASE LOWER CASE LETTERS
	 CAILE A,"z
	  CAIA
	   SUBI A,40
	SKIPE TYIPD
	 JRST TYIDSK
	CAIE A,15
	 POPJ P,
	PUSHJ P,CAR	;CR ECHOS AS CRLF
	MOVEI A,15
	POPJ P,

TYIDSK:	CAIN A,12
	 JRST TYI	;IGNORE LINE FEEDS IN DISK INPUT
	JRST TYO	;ECHO STUFF ON TTY

TYICC1:	SKIPG TYIPD
	 POPJ P,
	SOS TYIPD	;AT END OF INDIRECT FILE
	.IOPOP TYIC,
	JRST TYI

;RETURN CARRIAGE
CRR:	MOVEI A,15
CAR:	PUSHJ P,TYO
	MOVEI A,12
	JRST TYO

;TTY/LPT/TPL OUT
TYO:	SKIPGE LPTSW
	 JRST LPTTYO
TYO1:	.IOT TYOC,A
	POPJ P,

LPTBUF:	BLOCK 40
LPTBEP:	010700,,.-1
LPTBBP:	440700,,LPTBUF
LPTBFP:	440700,,LPTBUF
LPTBFC:	0

LPTTYO:	PUSH P,B
	JUMPL A,LPTTO1
	IDPB A,LPTBFP
	AOS LPTBFC
	CAIN A,^J
	 JRST LPTTO1
	MOVE B,LPTBFP
	CAME B,LPTBEP
	 JRST POPBJ
LPTTO1:	MOVE B,LPTBBP
	MOVEM B,LPTBFP
	.CALL [	SETZ
		SIXBIT /SIOT/
		MOVEI LPTCH
		MOVE B
		SETZ LPTBFC ]
	 .LOSE 1000
	SETZM LPTBFC
POPBJ:	POP P,B
	POPJ P,

TYOS:	PUSH P,A
	MOVEI A,40	;OUTPUT SPACE
	PUSHJ P,TYO
	JRST POPAJ
SUBTTL SYLLABLE INPUT

;THE FOLLOWING ROUTINE INPUTS A SYLLABLE.
;THE SYLLABLE ENDS UP AS SIXBIT IN SYM.
;IF IT IS COMPOSED OF DIGITS, THEY ARE COMPILED INTO A DECIMAL NUMBER
;AND STORED IN N.
;CARRIAGE RETURN, LINEFEED, SEMI-COLON, COLON, BACKARROW, AND ALTMODE END THE
;SYLLABLE BUT ARE NOT PART OF IT. THE TERMINATOR IS PUT IN TER.
;NON-SIXBIT CHARACTERS CAUSE GETSYL TO PRINT ?? AND WAIT FOR THE
;ENTIRE SYLLABLE AGAIN.  SINGLE CHARACTER RUBOUT WORKS,
;BUT IF YOU RUBOUT BEYOND THE FIRST CHARACTER, GETSYL RETURNS WITHOUT
;SKIPPING.  SUCCESSFUL RETURN IS A SKIP RETURN.  ^Q MAY BE USED TO ENTER
;A TERMINATOR AS SIXBIT SUCH AS SEMI-COLON, OR COLON.
;RUBBED OUT CHARACTERS ARE ECHOED.
GETSYL:	SETZB N,GTSYCC		;CLEAR SIXBIT VALUE, NUMERIC VALUE,
	SETZB SYM,GTSYNF	; CHARACTER COUNT, NEGATIVE FLAG
	MOVE B,[440600,,SYM]
GETCH:	PUSHJ P,TYI
SKCHAR:	CAIN A,177
	 JRST RUBOUT
	CAIE A,"_		;BACK-ARROW
	 CAIN A,33		;ALTMODE
	  JRST OUTSYL
	CAIE A,15		;CARRIAGE RETURN
	 CAIN A,12		;LINEFEED
	  JRST OUTSYL
	CAIE A,";		;SEMI-COLON
	 CAIN A,":		;COLON
	  JRST OUTSYL
	CAIN A,40		;SPACE
	 JRST OUTSYL
	CAIN A,^L		;SO USER CAN CLEAR SCREEN
	 JRST GETSFF
	CAIN A,^Q
	 JRST QUOTE
	CAIGE A,40
	 JRST OUTSYL		;ANY RANDOM CONTROL TERMINATES
	CAIN A,"-
	 SETCMM GTSYNF
NUMQ:	CAIGE A,40
	 JRST CHERR
	CAIL A,"0
	 CAILE A,"9
	  JRST NONUM
	IMULI N,10.
	ADDI N,-"0(A)
NONUM:	SUBI A,40
	TLNE B,770000
	 IDPB A,B
	AOS GTSYCC
	JRST GETCH

QUOTE:	PUSHJ P,TYI
	CAIE A,177
	 JRST NUMQ	;RUB OUT QUOTE RATHER THAN QUOTING RUBOUT
	.CALL [	SETZ ? 'CNSGET ? MOVEI TYOC
		REPEAT 4,[ MOVEM A ? ] SETZM A ]	;GET TTYOPT
	 MOVEI A,0
	TLNE A,%TOOVR
	 TLNE A,%TOERS
	  JRST [ PRINT XX
		 JRST GETCH ]
	PRINT ^Q
	JRST GETCH

GETSFF:	SKIPN GTSYCC
	 JRST OUTSYL		;NOTHING TYPED, TERMINATE
	PUSH P,N		;OTHERWISE, RE-ECHO
	MOVE N,[440600,,SYM]
	SETZM GTSYCC		;NOTE TRUNCATES TO AT MOST 6 CHARS
GETSF1:	ILDB A,N
	ADDI A,40
	AOS GTSYCC
	PUSHJ P,TYO
	CAME N,B
	 JRST GETSF1
	POP P,N
	JRST GETCH

RUBOUT:	SKIPN GTSYCC
	 JRST RUB1
	LDB A,B
	ADDI A,40
	PUSH P,C
	.CALL [	SETZ ? 'CNSGET ? MOVEI TYOC
		REPEAT 4,[ MOVEM C ? ] SETZM C ]	;GET TTYOPT
	 MOVEI C,0
	TLNE C,%TOOVR
	 TLNE C,%TOERS
	  JRST [ PUSH P,A
		 MOVEI A,^P
		 PUSHJ P,TYO
		 MOVEI A,"X
		 PUSHJ P,TYO
		 POP P,A
		 JRST RUB0 ]
	PUSHJ P,TYO
RUB0:	POP P,C
	CAIL A,"0
	 CAILE A,"9
	  JRST NOUNM
	SUBI N,-"0(A)
	PUSH P,SYM
	IDIVI N,10.
	POP P,SYM		;DIVISION CLOBBERS SYM
NOUNM:	SOS A,GTSYCC
	CAIL A,6
	 JRST GETCH
	SETZ A,
	DPB A,B
	ADD B,[60000,,]
	JRST GETCH

RUB1:	PRINT ??
	PUSHJ P,TYOS
	POPJ P,

CHERR:	PRINT ??
	PUSHJ P,TYOS
	JRST GETSYL

OUTSYL:	MOVEM A,TER
	AOSN GTSYNF
	 MOVNS N
	JRST POPJ1

GETSL1:	SETZB N,GTSYCC		;CLEAR SIXBIT VALUE, NUMERIC VALUE,
	SETZB SYM,GTSYNF	; CHARACTER COUNT, NEGATIVE FLAG
	MOVE B,[440600,,SYM]
	JRST SKCHAR
SUBTTL INTERRUPT ROUTINE

INT:	0
	0
	PUSH P,A
	MOVE A,INT
	TRZE A,%PITYI
	 JRST TYILK	;CHARACTER TYPED
	POP P,A
INTGO:	MOVEM 17,INTAC+17
	MOVEI 17,INTAC
	BLT 17,INTAC+16	;SAVE ACS
	MOVE 17,INTAC+17
	PUSH P,LPTSW
	SETZM LPTSW	;TYPE IOCER MESSAGE ON TTY NOT LPT
	MOVE A,INT
	TRNN A,%PIIOC
	 JRST RNDINT	;NOT TTY OR IOC
	.SUSET [.RBCHN,,A]	;IOCER, GET CHANNEL
	CAIN A,MAGIN
	 JRST INT1
	CAIN A,DSKIN
	 JRST INT3
	CAIN A,DSKOUT
	 JRST INT5
	CAIE A,RTAPE"RSICH
	 CAIN A,RTAPE"RSOCH
	  JRST [ SKIPGE TAPTYP
		  SETOM TAPTYP	;REMOTE TAPE CONNECTION BROKEN
		 JRST .+1 ]
	CAIE A,MAGOUT	;NOT MACRO-TAPE INPUT
	 JRST NTMGTP	;NOT MACRO TAPE OUTPUT EITHER !
	SKIPN DMPMOD
	 JRST NTDMMP	;NOT DUMPING ON MACRO-TAPE
	.STATUS MAGOUT,A
	LDB A,[330600,,A]	;IOCER FIELD
	CAIE A,9
	 JRST NTNDOF	;NOT END OF TAPE
NTNDO1:	MOVEI A,FOOB	;AH ! I KNOW HOW TO HANDLE END OF TAPE !
	SKIPGE FULLDMP
	 JRST INTX1	;CAUSE PROGRAM TO RESTART AT FOOB
	PRINT _PHYSICAL END OF TAPE
	.DISMISS [ERR]

RNDINT:	PRINT _INTERRUPT 
	POCT A
	.DISMIS [ERR]

NTMGTP:	PRINT _INTERRUPT ON CHANNEL
	POCT A
	PSIS CHNTAB(A)	;TYPE DEVICE AND DIRECTION
	.DISMIS [NAUGHT]

NTDMMP:	PRINT _INTERRUPT MAG TAPE OUT WHEN NOT DUMPING 
	.DISMIS [NAUGHT]

NTNDOF:	PUSH P,A
	PUSHJ P,ERRSTS		;PRINT MAGTAPE ERROR STATUS
	POP P,A
	PRINT _INTERRUPT
	POCT A
	PRINT  MAG TAPE OUT .. SIMULATING E-O-T ..
	JRST NTNDO1

CHNTAB:	SIXBIT /RANDOM/
	SIXBIT /MFD IN/
	SIXBIT /DRC IN/
	SIXBIT /DSK IN/
	SIXBIT /MAGOUT/
	SIXBIT /TTY IN/
	SIXBIT /TTYOUT/
	SIXBIT /DSKOUT/
	SIXBIT /MAG IN/
	SIXBIT /LPTOUT/
	SIXBIT /ERR IN/
	SIXBIT /STATUS/
	SIXBIT /SAVET/
	SIXBIT /SNPLCH/
	SIXBIT /RMT IN/
	SIXBIT /RMTOUT/

;IOCER ON DISK OUTPUT, MOST LIKELY DEVICE OR DIRECTORY FULL
;LET DDT HANDLE IT.
INT5:	MOVE A,INT+1		;SAVE PC
	MOVEM A,IOCPC'
	JSP A,INTX1		;DISMISS AND COME BACK
				;PASS THE ERROR TO DDT
	.CALL [SETZ ? SIXBIT/LOSE/ ? MOVEI <1+.LZ %PIIOC> ? SETZ IOCPC]
	 .VALUE

;DISK INPUT ERROR
INT3:	.STATUS DSKIN,A
	LDB A,[330600,,A]	;IOCER FIELD
	CAIN A,3
	 JRST INT4		;JUMP IF IRRECOV DATA ERROR
	PRINT INTERRUPT
	POCT A
	PRINT  DISK IN
	.DISMIS [NAUGHT]

INT4:	SKIPN SUPERC
	 PRINT  DATA ERROR DISK IN_
	AOS ERRDSK
	SETOM ERRALL
	HRRZ C,INT+1
	POCT C		;PC OF LOSING INSTRUCTION
	MOVE A,[DSKIN,,INTERR]
	.RCHST A,
	MOVEI A,INTERR
	MOVE B,INTERR+3
	PUSHJ P,TELL
	AOS INT+1	;ABANDON THE .IOT THAT LOST
	JRST INTX

TYILK:	MOVEM A,INT		; DON'T DROP OTHER INTERRUPTS!
TYILK1:	MOVEI A,TYIC	;CHARACTER TYPED
	.ITYIC A,
	 JRST POPEN
	CAIE A,^G
	 JRST TYILK1
	.RESET TYOC,
	SKIPN A,CTRLG	;SKIP IF DEFERRED
	 .DISMIS [ERR]	;DEATH TO CURRENT OPERATION
	MOVNM A,CTRLG	;SET IT POSITIVE TO FLAG DEFERRED 
	JUMPL A,TYILK1	;JUMP IF ^G TYPED FOR THE FIRST TIME
	SKIPGE TAPTYP	;^G WHILE DEFERRED, KILL REMOTE TAPE CONNECTION
	 SETOM TAPTYP
	.DISMIS [ERR]

CTRLGX:	AOSG CTRLG
	 POPJ P,	;NO ^G HAPPENED WHILE DEFERRED
	JRST ERR

POPEN:	POP P,A
	SKIPE INT		; Any more pending?
	 JRST INTGO		; Yes, go do 'em
	.DISMIS INT+1		; No, all done

NAUGHT:	PUSHJ P,OPINFL
	JRST ERR

;Can only get here for local tape drive
INT1:	PUSH P,TAPTYP		;Select local drive if in TCOPY
	MOVEI A,1
	MOVEM A,TAPTYP
	PUSHJ P,ERRSTS		;PRINT MAG TAPE ERROR STATUS
	.STATUS MAGIN,A		;INTERUPT ON MAG TAPE INPUT
	LDB A,[330600,,A]	;IOCER FIELD
	CAIN A,3
	 JRST INT2		;NON RECOV DATA ERR
	POP P,TAPTYP
	CAIN A,9
	 SKIPE TCOPYF
	  JRST INT1B		;PHYSICAL EOT OR TCOPYING
	SKIPE DMPMOD		;IF DOING A DUMP, MUST BE A COMPARE
	 JRST INT1A
	PRINT _INTERRUPT
	POCT A
	PRINT  MAG TAPE IN
	.DISMIS [NAUGHT]

;--- This is preposterously bogus, but fortunately is never reached
;--- since ICHECK+5 doesn't check last directory on reel
INT1A:	POP P,LPTSW
	.DISMIS [ICKEOT]

INT1B:	SETOM RDERR
	SETOM PHYEOT
	PRINT PHYSICAL END OF INPUT TAPE_
	AOS INT+1		;CAUSE .IOT TO RETURN WITHOUT READING
	JRST INTX

INT2:	AOS ERRCNT
	SETOM ERRALL
	PUSHJ P,TAPN
	PSIS HSNM
	PSIS HFN1
	PSIS HFN2
	PRINT DATA ERROR TAPE IN ..FILE BEING SKIPPED.._
	PUSHJ P,OPINFL
	SETOM RDERR
IFN NEWCOD, .STATUS MAGIN,B
	.CLOSE MAGIN,
IFE NEWCOD, CONI 344,B
	TRNE B,TF%EOF	;EOF?
	 JRST INT2X	;YES
	.OPEN MAGIN,MAGI	;NO, SKIP TO EOF
	 JFCL
	AOS INT+1	;SKIP OVER THE .IOT THAT LOST, NOTE THAT
	PUSHJ P,FILSKP	; 'RDERR' HAS BEEN SET, HOPEFULLY WE WERE
INT2X:	POP P,TAPTYP	; IN 'MAGREAD' WHEN THE ERROR OCCURRED.
	JRST INTX
SUBTTL MAG TAPE STATUS DECODER

ERRSTS:	SKIPGE TAPTYP
	 JRST RTAPE"PRSTS	;Print remote tape status
	PRINT _MAG TAPE STATUS 
	MOVE A,[SQUOZE 0,MGEMTC]	
	.EVAL A,
	 .LOSE
	MOVSS A
	HRRI A,A
	.GETLOC A,		;A GETS CONI MTC, AT TIME OF ERROR
IFE NEWCOD,[
	LDB B,[110400,,A]	;FUNCTION
	PASC @(B)[[ASCIZ/NO-OP/]	;0
		 [ASCIZ/REWIND/]
		 [ASCIZ/READ/]
		 [ASCIZ/READ-COMPARE/]
		 [ASCIZ/WRITE/]
		 [ASCIZ/WRITE-EOF/]
		 [ASCIZ/SPACE-FWD/]
		 [ASCIZ/SPACE-REV/]
		 [ASCIZ/AWAIT-UNIT-READY/] ;10
		 [ASCIZ/UNLOAD/]
		 [ASCIZ/READ-MULTI-RECORD/]
		 [ASCIZ/READ-COMPARE-MULTI-RECORD/]
		 [ASCIZ/ERASE-THEN-WRITE/]
		 [ASCIZ/ERASE/]
		 [ASCIZ/SPACE-FILE-FWD/]
		 [ASCIZ/SPACE-FILE-REV/]]
	LDB B,[060200,,A]
	PSIS (B)[SIXBIT/200BPI556BPI800BPI???BPI/]
	LDB B,[160100,,A]
	SIXTYP (B)[SIXBIT/ ODD   EVEN /]
	PRINT PAR
	LDB B,[150100,,A]
	SKIPN B
	 PRINT  IBM MODE
	PRINT _
	SETCM D,A
	ANDI D,7		;= 0 IF DATA CHANNEL
	MOVE A,[SQUOZE 0,MGEMTS]
	.EVAL A,
	 .LOSE
	MOVSS A
	HRRI A,A
	.GETLOC A,		;A GETS CONI MTS, AT TIME OF ERROR
	SKIPE D
	 TLZ A,170		;CLEAR CHANNEL STATUS IF NO CHANNEL
	MOVSI B,-LMTSTB/2
ERRST1:	TDNE A,MTSTAB(B)
	 PASC @MTSTAB+1(B)
	AOS B
	AOBJN B,ERRST1
	POPJ P,

MTSTAB:	10 ? [ASCIZ/WRITE-LOCK /]
	200 ? [ASCIZ/BAD-TAPE /]
	400 ? [ASCIZ/DATA-LATE /]
	2000 ? [ASCIZ/READ-COMPARE-ERROR /]
	4000 ? [ASCIZ/END-OF-TAPE /]
	10000 ? [ASCIZ/END-OF-FILE /]
	20000 ? [ASCIZ/TAPE-PARITY-ERROR /]
	40000 ? [ASCIZ/ILLEGAL-COMMAND /]
	100000 ? [ASCIZ/BEGINNING-OF-TAPE /]
	200000 ? [ASCIZ/REWINDING /]
	400000 ? [ASCIZ/UNIT-HUNG /]
	20,, ? [ASCIZ/CHANNEL-DATA-PARITY-ERROR /]
	40,, ? [ASCIZ/CHANNEL-NXM-ERROR /]
	100,, ? [ASCIZ/CHANNEL-CONTROL-WORD-PARITY-ERROR /]
LMTSTB==.-MTSTAB
];IFE NEWCOD
.ELSE [;--- JTW missed this routine
	DIE TM03 error status decode routine needs to be written
];IFN NEWCOD
SUBTTL DIRECTORY ALLOCATION COMMAND

DALLOC:	PRINT [ DIR=]
	PUSHJ P,GETSYL
	 POPJ P,
	.CALL [	SETZ ? SIXBIT/OPEN/ ? [.BII,,UFDCH]
		[SIXBIT/DSK/] ? [SIXBIT/.FILE./] ? [SIXBIT/(DIR)/] ? SETZ SYM]
	 JRST OPINFL
	MOVE A,[-2000,,UFDBUF]
	.IOT UFDCH,A
	.CLOSE UFDCH,
	HLRZ A,UFDBUF+UDBLKS
	JUMPE A,[ PRINT [_NO QUOTA]
		  JRST DALLC1 ]
	PRINT [_QUOTA=]
	PDPT A
DALLC1:	PRINT [, USED=]
	HRRZ A,UFDBUF+UDBLKS
	PDPT A
	SKIPN UFDBUF+UDALLO
	 JRST [	PRINT [, NO ALLOCATION]
		JRST DALLC2 ]
	PRINT [, ALLOCATED TO PACK ]
	HLRZ A,UFDBUF+UDALLO
	PDPT A
	HRRZ A,UFDBUF+UDALLO
	JUMPE A,DALLC2
	PRINT [, BLKS=]
	PDPT A
DALLC2:	PRINT [_CHANGE ALLOCATION?]
DALLC3:	PUSHJ P,TYI
	MOVE D,A
	PUSHJ P,CRR
	CAIE D,"N
	 CAIN D,"Y
	  JRST DALLC4
	PRINT [(Y or N) ]
	JRST DALLC3

DALLC4:	CAIE D,"Y
	 POPJ P,
	.SUSET [.SSNAME,,UFDBUF+UDNAME]
	MOVE A,UFDBUF+UDNAMP
	CAIN A,2000
	 JRST [	MOVSI B,'FOO		;DIR EMPTY, MAKE DUMMY FILE
		MOVEM B,FN1
		MOVEM B,FN2
		MOVEI B,.UIO
		HRLM B,TRNI
		OPEN DSKIN,TRNI
		 POPJ P,
		PUSHJ P,DALLC5
		.FDELE TRNI
		 JFCL
		POPJ P, ]
	MOVE B,UFDBUF+UNFN1(A)
	MOVEM B,FN1
	MOVE B,UFDBUF+UNFN2(A)
	MOVEM B,FN2
DALLC5:	MOVEI B,.BII+30		;DON'T SET REF DATE, DON'T CHASE LINKS
	HRLM B,TRNI
	OPEN DSKIN,TRNI
	 POPJ P,
	PRINT [NEW QUOTA=]
	PUSHJ P,GETSYL
	 POPJ P,
	MOVE W,N
	PRINT [_NEW ALLOCATED PACK=]
	PUSHJ P,GETSYL
	 POPJ P,
	HRLZ X,N
	PRINT [_NEW ALLOCATED #BLOCKS=]
	PUSHJ P,GETSYL
	 POPJ P,
	HRR X,N
	.CALL [	SETZ ? 'DIRSIZ ? MOVEI DSKIN ? MOVE W ? SETZ X ]
	 JRST OPINFL
	PRINT [_DONE]
	POPJ P,

;COMMAND TO LIST ALL DIRECTORY ALLOCATIONS

LSTALC:	PUSHJ P,DEVGET
	SETOM MFDIN
	MOVEI A,.BII
	HRLM A,FNO
LSTAL1:	PUSHJ P,MFDN
	 POPJ P,
	.SUSET [.SSNAME,,USNM]
	OPEN UFDCH,FNO
	 POPJ P,
	MOVE A,[-2000,,UFDBUF]
	.IOT UFDCH,A
	.CLOSE UFDCH,
	HLRZ A,UFDBUF+UDBLKS	;QUOTA
	SKIPN UFDBUF+UDALLO
	 JUMPE A,LSTAL1		;SKIP THIS IF NOTHING INTERESTING
	SIXTYP USNM
	JUMPE A,LSTAL2
	PRINT [ QUOTA=]
	PDPT A
LSTAL2:	SKIPN UFDBUF+UDALLO
	 JRST LSTAL3
	PRINT [ ALLOCATED TO PACK #]
	HLRZ A,UFDBUF+UDALLO
	PDPT A
	HRRZ A,UFDBUF+UDALLO
	JUMPE A,LSTAL3
	PRINT [, ALLOCATION=]
	PDPT A
LSTAL3:	PRINT [, BLOCKS USED=]
	HRRZ A,UFDBUF+UDBLKS
	PDPT A
	PUSHJ P,CRR
	JRST LSTAL1
SUBTTL END OF TAPE ROUTINE

FOOB:	MOVE P,ERRPDP		;POPJ P, will return from ADMP3
	POP P,A			;Remove that return PC from pdl
	MOVEM P,INTAC+P
	SKIPL LSTWHL
	 JRST FOOB1
	MOVEI A,^L
	SKIPE LPTSW
	 PUSHJ P,TYO	;PAGE THROW ON LPT BETWEEN REELS
FOOB1:	PUSH P,LPTSW
	SETZM LPTSW
	SKIPL TAPTYP
	 .CLOSE MAGOUT,
	SKIPG TAPTYP
	 PUSHJ P,RTAPE"BUFRST
	SETZM MAGOPN
	SKIPN EXPERM
	 SKIPN INCREM
	  JRST FOOE	;JUMP IF NOT TO CHECK
	SKIPE CKIDMP
	 JRST FOOE	;..
	PRINT _REWINDING
IFE MCOND DM,[
	MOVE B,NFTDMP
	SOS B
	MOVN N,NFTDMP
	CAMN B,ITAPE	;IF NOT EQUAL, THEN IT IS NOT THE WHOLE TAPE
	 JRST FOOB1A
	PUSHJ P,ASPAC1
	 SKIPA
]
FOOB1A:	  PUSHJ P,ARWND
	PRINT _CHECKING INCREMENTAL DUMP_
	PUSH P,USNM
	PUSHJ P,ICHECK
	POP P,USNM
	.SUSET [.SSNAM,,USNM]
	SETZM NFTDMP
FOOE:	PUSHJ P,ARWND	;REWIND IT
	PUSHJ P,GESELL	;GIVE AWAY BEGINNING AND LAST USER ON THIS REEL
	.RESET TYIC,
FOOD:	PRINT _MOUNT NEW TAPE THEN TYPE OK.  
	PUSHJ P,GETSYL
	 JRST .-1
	MOVE A,SYM
	CAMN A,[SIXBIT /OK/]
	 JRST FOOC
	CAMN A,[SIXBIT /STOP/]
	 JRST MAYBE
	JRST FOOD

FOOC:	PUSHJ P,ARWND
	AOS NTAPES
	MOVE A,USNM
	CAME A,FUSNM	;SEE IF ONE DIR FILLED UP THE WHOLE REEL
	 JRST FOOF
	SIXTYP A
	PRINT [ DIRECTORY FILLS WHOLE REEL, CONTINUING ONTO ANOTHER REEL._]
	SOS FLNI	;DO MOST RECENT FILE AGAIN
	MOVEI A,ADMP2
	JRST INTX1

FOOF:	MOVEM A,FUSNM
	SKIPGE FULLDMP
	 SETOM DMPMFD	;DUMP THE MFD AGAIN AT START OF NEXT REEL
	SKIPGE FULLDMP
	 SETOM DMPDIR	;REDO SAME DIRECTORY AGAIN
	SETOM APPENF	;SO USER UFD WILL BE OPENED
	MOVEI A,DMPAGN	;RESTART LOCATION FOR NEXT REEL
INTX1:	HRRZM A,INT+1
INTX:	POP P,LPTSW
	MOVSI 17,INTAC
	BLT 17,17	;RESTORE ACS
	.DISMIS INT+1

MAYBE:	PRINT  GIVE UP ?
	PUSHJ P,TYI
	CAIE A,"Y
	 JRST FOOD
	JRST MLP	;HE REALLY WANTS TO STOP DUMPING NOW

GESELL:	SETOM SDONE
	MOVEI A,1
	SKIPE ARCHVF
	 MOVEM A,SDONE
	PUSHJ P,SINFO
	PRINT  REEL 
	PDPT NTAPES	;OUTPUT REEL NUMBER AND USER SPAN ON THIS REEL
	PRINT  FIRST USER = 
	PSIS FUSNM
	PRINT  LAST USER = 
	PSIS LUSNM
	JRST CRR
SUBTTL LOAD, RELOAD, DUMP, CDUMP COMMANDS

RELOAD:	PRINT THIS WILL SMASH YOUR DIRECTORY.  
	PUSHJ P,CHECK
	SETOM RELOSW	;RELOAD DISKS FROM TAPE
	JRST LOAD

ACDUMP:	SETOM CDMFL	;CONTINUE FULL DUMP
	SKIPA
DUMP:	 CLEARM CDMFL
	SETOM DMPMOD	;GENERALISED DUMP
	SKIPA
LOAD:	 CLEARM DMPMOD	;GENERALISED LOAD
	MOVSI A,-NFIGS	;CLEAR OPTIONS
	CLEARM @FIGTB2(A)
	AOBJN A,.-1
	CLEARM MICFLG
	CLEARM CUSN
	SETOM DPACK
	MOVEI A,1
	MOVEM A,THTYPE
	CAIN TER,15
	 JRST EXECU		;NO SWITCHES FORTH COMING
LOOP:	PUSHJ P,TYI
	CAIN A,"?
	 JRST FIGLST		;GIVE INFO ON OPTIONS AVAILABLE
	PUSHJ P,GETSL1
	 POPJ P,		;OVER-RUBOUT, FLUSH
	PUSHJ P,SPACET		;PROCESS OPTION
	CAIN TER,15
	 JRST EXECU
	JRST LOOP

SPACET:	JUMPE SYM,CPOPJ
	MOVSI A,-NFIGS
	CAMN SYM,FIGTB1(A)
	 JRST SPASED
	AOBJN A,.-2
	SUB P,[1,,1]		;UNKNOW OPTION, BARF
	PRINT  ? 
	PSIS SYM
	PUSHJ P,TYOS
	PRINT IGNORED
	PUSHJ P,TYOS
	JRST LOOP		;BUT DON'T GIVE UP ENTIRELY

SPASED:	SETOM @FIGTB2(A)	;SET FLAG FOR OPTION SPECIFIED
	POPJ P,

FIGLST:	PASC FIGHLP		;LIST OPTIONS AND DESCRIPTIONS
	JRST LOOP

;CONTINUE LOADING WITH SAME OPTIONS COMMAND
ACLOAD:		.SEE FLUSH	;AS IT STANDS, THIS CAN'T WORK!!
	DIE SORRY THIS COMMAND DOESN'T WORK
	MOVE A,CLOADF		;RESTORE OPTIONS
	MOVEM A,DMPMOD
	JUMPL A,[DIE [LAST OPERATION WAS DUMP]]
	MOVE A,CLOADF+1
	MOVEM A,RELOSW
	MOVE A,CLOADF+2
	MOVEM A,LENGTH
	MOVSI A,-NFIGS
	MOVEI B,3
ACLOD1:	MOVE C,CLOADF(B)
	MOVEM C,@FIGTB2(A)
	ADDI B,1
	AOBJN A,ACLOD1
	SETOM ACLODF
	JRST EXECU		;GO EXECUTE IT

 ;NOTE IF UPDATE THIS, UPDATE FIGTB2 AND FIGHLP (ALSO ON THIS PAGE)
FIGTB1:	SIXBIT /INCREM/
	SIXBIT /I/
	SIXBIT /MERGE/
	SIXBIT /M/
	SIXBIT /FULL/
	SIXBIT /F/
	SIXBIT /CARE/
	SIXBIT /C/
	SIXBIT /EXPERI/
	SIXBIT /E/
	SIXBIT /LIST/
	SIXBIT /L/
	SIXBIT /SORRY/
	SIXBIT /S/
	SIXBIT /NOASK/
	SIXBIT /DECIDE/
	SIXBIT /D/
	SIXBIT /DATE/
	SIXBIT /DATES/
	SIXBIT /ARCHIV/
	SIXBIT /A/
	SIXBIT /REAP/
	SIXBIT /R/
	SIXBIT /NO/
	SIXBIT /LINKS/
	SIXBIT /CRDIR/
NFIGS==.-FIGTB1

FIGHLP:	ASCIZ\
INCREM, I   Do an Incremental dump
FULL, F	    Do a Complete dump
LIST, L	    Generate a listing of files loaded or dumped
MERGE, M    Don't load over existing file with the same name
CARE, C	    Don't load over files not yet backed up
EXPERI, E   Don't set has-been-backed-up bits
SORRY, S    Go ahead and load over files with newer creation dates
NOASK       Don't ask whether a file should be loaded over, assume "no"
DATE	    Dump only files with creation date greater or equal specified
DATES	    Dump only files with creation date between two dates specified
ARCHIV, A   Declare this dump tape to be Archival.
REAP, R	    Do a reap after dumping (don't use this, please)
DECIDE, D   (Supposedly controls tape number assignment)
NO	    Don't check incremental dump (one pass instead of two)
LINKS	    Dump links as well as files
CRDIR       Create directories that files are being loaded into
  OPTIONS: \

FIGTB2:	INCREM
	INCREM
	MRGSW
	MRGSW
	FULLDMP
	FULLDMP
	CAREF
	CAREF
	EXPERM
	EXPERM
	LSTWHL
	LSTWHL
	LOSRSW
	LOSRSW
	NOASK
	DECIDF
	DECIDF
	DATEF
	DATESF
	ARCHVF
	ARCHVF
	REAPSW
	REAPSW
	CKIDMP
	DMPLNK
	CRDIR
IFN .-FIGTB2-NFIGS, .ERR FIGTB2 NOT SAME LENGTH AS FIGTB1
;NOTE: ABOVE LOCATIONS ARE MUNGED OVER BY EXECU AND
;THEN SET TO DIFFERENT VALUES THAN JUST WHETHER THE
;USER GAVE THE SWITCH OR NOT, IN SOME CASES.

;BEGIN EXECUTION OF LOAD OR DUMP OPERATION.
;FIRST STEP IS TO CLEAN UP OPTIONS AND ASK FOR ADDITIONAL INFO.

EXECU:	MOVE A,DMPMOD		;SAVE CRUFT FOR 'CLOAD' COMMAND
	MOVEM A,CLOADF
	MOVE A,RELOSW
	MOVEM A,CLOADF+1
	MOVSI A,-NFIGS
	MOVEI B,3
EXECU0:	MOVE C,@FIGTB2(A)
	MOVEM C,CLOADF(B)
	ADDI B,1
	AOBJN A,EXECU0
;Make sure the tape is not positioned in the middle of a file
;Also decide whether the first thing read/written should be a tape header
	MOVE A,TAPEF		;Tape status left by SETIT
	TRNN A,TF%BOT
	 JRST [	PUSHJ P,SPRF	;Space reverse file
		PUSHJ P,SETIT1	;Get status again
		TRNE A,TF%BOT
		 JRST .+1	;That moved it to beginning of tape
		PUSHJ P,SPFF	;Get to beginning of next file
		JRST .+2 ]
	  SETOM THTPN		;At front of tape, we don't know the number
	SKIPE REAPSW
	 PUSHJ P,REAPCK
	SETZM NPLACE
	SKIPGE DATESF
	 SETOM DATEF
	SETZM NFTDMP
	SKIPGE CDMFL
	 SETOM FULLDMP		;CDUMP IS A FULL ONE
	CLEARM PACKN
	SKIPE MICFLG
	 CLEARM INCREM		;NO INCREMENTAL DUMPS FROM DEC-TAPE
	SETZM THTYPE		;DEFAULT TO RANDOM TYPE OF TAPE
; Removed by Alan 11/17/86, who didn't think it was a feature.
;	SKIPGE DATEF
;	 SETOM FULLDMP		;DATES SPECIFIED => DUMP ALL
	SKIPGE FULLDMP
	 SETOM EXPERM		;IF DUMPING ALL, DON'T SET DMPCHK BIT!
	SKIPGE DATESF
	 SKIPE ACLODF
	  CAIA
	   PUSHJ P,GETUDT	;GET UPPER DATE
	SKIPGE DATEF
	 SKIPE ACLODF
	  CAIA
	   PUSHJ P,GETLDT	;GET LOWER DATE
	SKIPGE FULLDMP
	 AOS THTYPE
	SKIPGE INCREM
	 SOS THTYPE
	SKIPGE A,INCREM
	 SETOM FULLDMP		;AN INCREMENTAL DUMP IS ALWAYS A FULL ONE
	SKIPN ACLODF
	 JRST [	SKIPGE DMPMOD
		 SKIPL FULLDMP
		  PUSHJ P,FILGET ;GET FILE NAMES OF FILES TO DUMP OR LOAD
		JRST .+1 ]
	SKIPE LSTWHL
	 SKIPE ACLODF
	  CAIA
	   PUSHJ P,DEVGET	;GET LISTING DEVICE
	SETZM ACLODF
	.SUSET [.SSNAME,,USNM]
	SKIPN DMPMOD
	 JRST RETRV0		;LOAD
	SKIPL CDMFL
	 SKIPE ITAPE
	  CAIA
	   CLEARM NTAPES	;COMMAND WAS DUMP ONLY DO THIS IF NOT CDUMP AND TAPE IS REWOUND
	SETOM MFDIN
	SETOM FLNI
	SKIPE CDMFL
	 JRST EXECU1
	SKIPL FULLDMP
	 JRST ADUMP2		;SINGLE FILE DUMP
	SETOM DMPMFD		;STARTING FULL OR INCREMENTAL DUMP, SO
	SETOM DMPDIR		;DUMP THE MFD AT THE FRONT AND DUMP
	JRST ADMP1		;EACH UFD THAT HAS CHANGED.

REAPCK:	PUSHJ P,CRR
	PRINT YOU SPECIFIED REAP
	PUSHJ P,CHECK
	POPJ P,

GETUDT:	PRINT LATEST DAY - 
	PUSHJ P,GETDAT
	MOVE A,DATE
	HLLOM A,DATE1
	POPJ P,

GETLDT:	PRINT EARLIEST DAY - 
	JRST GETDAT

SUBTTL CONTINUING A COMPLETE DUMP, GET TAPE AND MFD BACK INTO PHASE

;TAPE FILE MISSING, DO REEL OVER
EXECU2:	PRINT _MAY I REWIND AND RESTART THIS REEL ??
	PUSHJ P,CHECK2
	PUSHJ P,ARWND
	PRINT ON THE LAST REEL_
EXECU1:	SKIPGE ITAPE		;REWOUND ???
	 JRST SETFNG		;YES
	PUSHJ P,TAPEMB
	PUSHJ P,SNPLAC
	MOVEI A,.BII
	HRLM A,NSVOP
	OPEN SAVET,NSVOP	;GET .TAPEn; TAPE nnn FILE
	 JRST EXECU2
	MOVE B,[-LTHBLK-1,,BUF]	;FIND OUT LAST USER DUMPED
	.IOT SAVET,B
	SETOM A
EXECU3:	MOVE B,[-2000,,BUF]
EXECU4:	SKIPL A
	 JRST LOOKSM
	.IOT SAVET,B
	HLLZS B
	SKIPGE B
	 SETZM A
	MOVE C,[-2000,,BUF]
	SUB C,B
	SETOM D
EXECU5:	CAME D,(C)
	 AOBJN C,EXECU5
	HLRE B,C
	SKIPN B
	 JRST EXECU3	;COUNT RAN OUT
	AOJE B,EXECU6	;ON BLOCK BOUNDRY?
	AOBJN C,.+1
	MOVE B,(C)
	MOVEM B,USNM
	JRST EXECU5

EXECU6:	HRROI B,USNM
	.IOT SAVET,B
	MOVE B,[-1777,,BUF+1]
	SETZM BUF
	JRST EXECU4

LOOKSM:	PUSHJ P,SPRF		;BACK OVER TWO FILES
	PUSHJ P,SPRF
	PUSHJ P,SETIT1		;Get tape status
	TRNN A,TF%BOT		;Unless BOT,
	 PUSHJ P,SPFF		; Forward one file
	PUSHJ P,SETIT
	SKIPGE ITAPE		;DID WE BACK UP TO BEGINING OF TAPE ???
	 JRST SETFNG		;YES
	PUSHJ P,MAGOP		;READ HEADER FOR DIRECTORY NAME
	 .VALUE			;EOT AFTER BACKSPACING ?????
	MOVE A,USNM		;IS DIRECTORY NAME OF FILE ON TAPE THE SAME
	CAME A,HSNM		; AS THE ONE WE ARE LOOKING FOR ???
	 JRST LOOKSM		;NO
	PUSHJ P,FILSKP		;YES, FLUSH TO END OF THIS FILE
	MOVE B,USNM		;I.E. END OF LAST DIRECTORY DUMPED ON TAPE
	JRST KSUSER

SETFNG:	PUSH P,LPTSW
	SETZM LPTSW
	PRINT WHAT WAS THE LAST DIRECTORY DUMPED ?
	POP P,LPTSW
	PUSHJ P,GETSYL
	 JRST SETFNG
	MOVE B,SYM
;HAVING FOUND WHAT DIRECTORY TO CONTINUE DUMPING WITH, ADVANCE
;MFD TO THERE, THEN JOIN REGULAR DUMP CODE
KSUSER:	PUSHJ P,MFDN
	 DIE NO SUCH DIRECTORY
	CAME B,USNM
	 JRST KSUSER
	JRST ADMP1		;GOT IT, START THE DUMP
SUBTTL DUMPING FROM USER-GIVEN FILE LIST

;RUNS THROUGH ALL FILES IN WORLD, IF THEY MATCH DUMP 'EM
ADUMP2:	SETZM STYPE
	SETOM MFDIN
NXUFD:	PUSHJ P,MFDN		;GET SNAM INTO USNM
	 JRST DUNG		;NO MORE SNAMES LEFT
	MOVN W,LENGTH
	HRLZS W			;MAKE AOBJN POINTER TO FILE SPEC LIST
SNMCHK:	SKIPN A,FMSNM(W)
	 JRST UGLY		;ANY SNAME MATCHES, INVESTIGATE
	CAMN A,USNM
	 JRST UGLY		;SOME SNAME MATCHES, INVESTIGATE
	AOBJN W,SNMCHK		;CONTINUE CHECKING
	JRST NXUFD		;NO MATCH POSSIBLE

;SNAME MATCHES, RUN THROUGH ALL FILES ON THIS DIRECTORY
UGLY:	MOVEI V,0
	SETOM GREATF		;FOR > AND < FILE HACKERY
	.SUSET [.SSNAM,,USNM]
	SETOM FLNI
NXFIL:	PUSHJ P,FNG
	 JRST EODIRK		;NO MORE FILES IN THIS DIRECTORY
	MOVN W,LENGTH
	HRLZS W			;AOBJN POINTER TO FILE SPECS LIST
	MOVS A,FMDEV(W)
	HRLI A,.BII
	MOVEM A,TRNI
CMCON:	SKIPN D,FMSNM(W)
	 JRST CMFN1
	CAME D,USNM
	 JRST NXCOM
CMFN1:	SKIPN D,FMFN1(W)
	 JRST CMFN2
	CAME D,[SIXBIT /</]
	 CAMN D,[SIXBIT />/]
	  CAIA
	   JRST RCMFN1
	SKIPN LNKFLG
	 MOVEM D,FN1
	SETZM GREATF
	JRST CMFN2

;SNAME AND FN1 SEEM TO MATCH, THINK ABOUT FN2
RCMFN1:	CAME D,FN1
	 JRST NXCOM
CMFN2:	SKIPE D,FMFN2(W)
	 CAMN D,FN2
	  JRST DUMPIT
	CAME D,[SIXBIT /</]
	 CAMN D,[SIXBIT />/]
	  CAIA
	   JRST NXCOM
	SKIPN LNKFLG		;'>' AND '<' FILES DON'T GET OPENED FOR LINKS
	 MOVEM D,FN2
	SETZM GREATF		;WE FOUND A < OR >
	JRST DUMPIT

NXCOM:	AOBJN W,CMCON
	JRST NXFIL

;END OF DIRECTORY
EODIRK:	PUSHJ P,FILAPP
	SKIPGE APPENF		;ANY FILES DUMPED FOR THIS USER ???
	 JRST NXUFD
EODIR3:	MOVN W,LENGTH		;YES, MAYBE REMOVE SOME SPECS
	HRLZS W
EODIR2:	CAMN A,USNM		;IS THIS ENTRY ONE FOR USER JUST DUMPED ?
	 JRST REMOVE		;YES
EODIR1:	AOBJN W,EODIR2		;NO
	JRST NXUFD

REMOVE:	SKIPN FMDUMP(W)
	 JRST EODIR1		;DON'T REMOVE SPEC IF NOTHING EVER MATCHED IT
	PUSHJ P,FLUSH		;DELETE SPEC
	 POPJ P,		;NO MORE SPECS LEFT
	ADD W,[1,,]
	JRST EODIR2

;OK, DUMP THE FILE
DUMPIT:	SKIPE LNKFLG
	 JRST AWRITE
	.SUSET [.SSNAM,,USNM]	;IF NOT LINK, SEE IF ALREADY DUMPED
	OPEN DSKIN,TRNI
	 JRST NXCOM		;JUST CONTINUE
	MOVE A,[DSKIN,,TRNI]
	PUSH P,TRNI
	.RCHST A,
	POP P,TRNI
	MOVEI A,0
	MOVE B,FN1
	MOVE C,FN2
LOOP69:	CAML A,V
	 JRST APPEND
	CAME B,BIF(A)
	 JRST LUP691
	CAMN C,BIF+1(A)
	 JRST EODIR3
LUP691:	ADDI A,2
	JRST LOOP69

APPEND:	MOVEM B,BIF(A)
	MOVEM C,BIF+1(A)
	ADDI V,2
	JRST AWRITE

;ACTUALLY WRITE OUT THE FILE.
AWRITE:	PUSHJ P,ADMP3
	SETOM FMDUMP(W)		;MARK THIS ARG AS HAVING BEEN SATISFIED AT LEAST ONCE
	SKIPN FMSNM(W)
	 JRST NXCOM		;DON'T DELETE ENTRY IF ANY "*" IN IT
	SKIPE FMFN1(W)
	 SKIPN FMFN2(W)
	  JRST NXCOM
	PUSHJ P,FLUSH
	 POPJ P,
	ADD W,[1,,]
	SOJA W,NXCOM

;DONE DUMPING, SEE IF ANY SPECS WEREN'T SATISFIED.
DUNG:	MOVN W,LENGTH
	HRLZS W
REMOV2:	SKIPN FMSNM(W)
	 JRST REMOV1		;"*;"
	SKIPE FMFN1(W)		;"* *"
	 SKIPN FMFN2(W)
	  JRST REMOV1
REMOV3:	AOBJN W,REMOV2
	PRINT _NOT DUMPED:_
	MOVN W,LENGTH
	HRLZS W
NOREM1:	IRP X,,[SNM,FN1,FN2]
	SKIPN A,FM!X(W)
	 MOVSI A,(SIXBIT /*/)
	PSIS A
	IFSE X,SNM,[PASC [ASCIZ /;/]]
TERMIN
	PUSHJ P,CRR
	AOBJN W,NOREM1
	POPJ P,

REMOV1:	SKIPL FMDUMP(W)		;WAS ANYTHING DUMPED FOR THIS SPEC ??
	 JRST REMOV3		;NO
	PUSHJ P,FLUSH
	 POPJ P,
	ADD W,[1,,]
	JRST REMOV2
SUBTTL DUMPING ALL FILES (FULL OR INCREMENTAL)

ADMP1:	PUSHJ P,TAPEMB		;GET TAPE NUMBER IF DON'T HAVE YET
	PUSHJ P,MFDN		;READ A LOSER NAME FROM M.F.D.
	 JRST RAT		;DONE
	SKIPE LSTWHL		;LIST ?
	 PUSHJ P,LDMUT1
ADMPL1:	MOVE A,USNM
	SKIPGE ITAPE
	 MOVEM A,FUSNM		;FIRST LOSER DUMPED
	.SUSET [.SSNAM,,A]	;SO FNG READS THE CORRECT DIRECTORY
;COME HERE OUT OF END-OF-REEL INTERRUPT
DMPAGN:	SETOM FLNI		;RESTART ON NEW REEL
	SKIPL FULLDMP
	 POPJ P,		;THIS PROBABLY RETURNS FROM ADMP3
				;IN THE CASE OF A GFR OR FILE BY FILE
				;DUMP THAT USES UP THE REEL.  CLEARLY
				;THE WRONG THING TO DO, BUT CLOSE.
	SETOM DMPUFD
	SETOM DMPDIR
	.SUSET [.SSNAM,,USNM]
	PUSHJ P,ADMP4		;DUMP THE DIR AND RETURN
;THIS IS WHERE COMPLETE AND INCREMENTAL DUMPS LOOP
ADMP2:	PUSHJ P,TAPEMB		;GET TAPE NUMBER IF NEEDED
	.SUSET [.SSNAM,,USNM]
	PUSHJ P,FNG		;READ ANOTHER FILE NAME
	 JRST FULNMF		;NO MORE
	MOVE A,PACKN
	SKIPL DPACK		;RIGHT PACK ?
	 CAMN A,DPACK
	  PUSHJ P,ADMP3		;YES, OR ANY WILL DO, CALL DUMPER
	JRST ADMP2		;NOT RIGHT PACK

FULNMF:	PUSHJ P,FILAPP		;END OF THIS DIRECTORY, FINISH
	JRST ADMP1		;AND GO BACK FOR MORE

;PRINT LISTING LINE WHEN STARTING A NEW UFD
LDMUT1:	PUSHJ P,CRR
	PUSHJ P,TAPN		;PRINT SEQUENCE NUMBER
	PSIS USNM		;PRINT DIRECTORY NAME
	PUSH P,LPTSW
	SETZM LPTSW
	PUSHJ P,CRR
	PSIS USNM		;PRINT JUST DIRECTORY NAME ON CONSOLE
	POP P,LPTSW
	POPJ P,

;INCREMENT FILE SEQUENCE NUMBER AND PRINT IT
TAPN:	MOVE D,ITAPE
	AOS D
	PDPT D
	POPJ P,

;DUMP A FILE (FROM EITHER TYPE OF DUMP)
;THIS IS A SUBROUTINE. CALL WITH SNAME SET UP AND NAME IN FN1, FN2
ADMP3:	SKIPE LNKFLG
	 JRST ADMP4
	OPEN DSKIN,TRNI		;OPEN DISK INPUT
	 POPJ P,		;FILE DOESN'T SEEM TO EXIST AFTER ALL
	.CALL [ SETZ ? 'FILLEN ? MOVEI DSKIN ? SETZM A]	;A GETS NUMBER OF WORDS IN FILE
	 .LOSE %LSFIL
	CAMGE A,[2500.*2000]	; :BUG MUDDLE BEFORE DECREASING THIS CONSTANT!
	 JRST ADMP4		;FILE NOT TOO BIG
	PUSH P,LPTSW
	SETZM LPTSW
	PRINT _
	.SUSET [.RSNAME,,A]
	PSIS A
	PRINT [;]
	PSIS FN1
	PSIS FN2
	PRINT [ - FILE IS TOO DAMNED BIG, ]
	;SKIPN GFRFLG		;IF DOING GFR, DUMP ANYWAY, USER CAN QUIT OUT AND DELETE
	 SKIPGE FULLDMP		; THE FILE IF THAT BECOMES NECESSARY.
	  JRST [		;IF DOING INCREMENTAL OR FULL, DON'T DUMP IT
		PRINT [NOT DUMPED._]
		POP P,LPTSW
		POPJ P, ]
	PRINT [IT MAY NOT FIT ON TAPE, WILL TRY ANYWAY._]
	POP P,LPTSW
ADMP4:	MOVEM P,ERRPDP		;SAVE STUFF IN CASE OF REMOTE TAPE ERROR
	MOVEM 16,INTAC+16
	MOVEM 17,INTAC+17
	MOVEI 16,INTAC
	BLT 16,INTAC+15
	MOVE 16,INTAC+16
	PUSHJ P,TAPEMB
	AOSE APPENF		;SKIP IF FIRST FILE THIS DIRECTORY
	 JRST ADMP5
	PUSHJ P,SNPLAC
	SETZM USRUFD
ADMP5:
IFE MCOND DM,[
	SKIPGE ITAPE
	 PUSHJ P,EXTPCK		; TAPE ALREADY EXIST?
]
	.SUSET [.SSNAM,,USNM]	;SO .OPEN DSKIN, LOOKS ON THE CORRECT DIRECTORY
	SKIPE MAGOPN		; OPEN YET?
	 JRST ADMP7		; YES
	SETOM MAGOPN
	SKIPL TAPTYP
	 JRST ADMP6		;Local tape
	PUSHJ P,RMTSTS		;Make sure it's mounted (this also
	TRNE A,TF%RDY		; drains queued status)
	 JRST ADMP7
	DIE OUTPUT TAPE NOT MOUNTED

ADMP6:	OPEN MAGOUT,MAGO	;OPEN MAG TAPE OUTPUT
	 JRST RET
ADMP7:	SETOM EOTFLG
	AOSE ITAPE		;BEGINNING OF TAPE ?
	 JRST LP2A		;NO
	PUSH P,LPTSW
	SETZM LPTSW
	PUSHJ P,GINFO
	SKIPG SDONE
	 JRST LP2B
	PRINT THAT'S AN ARCHIV TAPE.
	PUSHJ P,CHECK		;ALREADY DELETED THE TAPE FILE FOR IT???
LP2B:	MOVSI A,-1		;TEST TAPE # BUT NOT REEL #
	SKIPE SDONE
	 TDNN A,STAPEN		;CHECK FOR REUSE OF RECENT TAPE
	  JRST LP2BB		;THAT WASN'T ABORTED, AND NOT TAPE0
	MOVE A,STDATE
	PUSHJ P,SBDTTN		;CONVERT TAPE DATE TO NUMBER OF DAYS
	MOVE B,A
	.RDATE A,		;CURRENT DATE
	PUSHJ P,SBDTTN
	ADDI B,30.
	CAMLE A,B
	 JRST LP2BB
	PRINT THAT TAPE IS LESS THAN 30 DAYS OLD
	PUSHJ P,CHECK
LP2BB:	POP P,LPTSW
	SETZM NSVTPN+1		;BOT, START A NEW .TAPEn; TAPE nnn FILE
	.SUSET [.SSNAM,,NPLACE]
	.FDELE NSVOP		;SO WE DON'T APPEND TO ANY OLD ONE
	 JFCL
	.SUSET [.SSNAM,,USNM]
	SETZM SDONE
	AOSE A,NTAPES		;IS THIS THE FIRST RUN FOR THIS LOADING?
	 SOS A,NTAPES		;NO.  WE WEREN'T SUPPOSED TO TOUCH NTAPES
	HRRM A,THTPN		;REEL NUMBER IN CURRENT DUMP
	PUSHJ P,SINFO
	.RDATE A,
	MOVEM A,THDATE
	;.SUSET [.RSNAM,,E]		;doesn't seem to get used.
	JRST LP2C

EXTPCK:	.SUSET [.SSNAM,,NPLACE]
	HLRZ A,NSVOP
	HRRZS NSVOP	.SEE .UAI
	.OPEN DSKOUT,NSVOP
	 JRST EXTPK1
	HRLM A,NSVOP
	PUSH P,LPTSW
	SETZM LPTSW
	PRINT YOU ARE NOT AT THE END OF TAPE.
	PUSHJ P,CRR
	PRINT YOU WILL DESTROY USEFUL DATA!
	POP P,LPTSW
	JRST CHECK

EXTPK1:	HRLM A,NSVOP
	POPJ P,

;COMPLETE OR INCREMENTAL DUMP IS, UH, COMPLETE.
;NOTE SIMILARITY OF THIS CODE TO 'FOOB'
RAT:	PUSH P,LPTSW		;REPORT THE CRUD TO TTY
	SETZM LPTSW
	PUSHJ P,GESELL		;SAY WHAT USERS ON THIS REEL
	PUSHJ P,CLSOUT		;CLOSE MAGOUT, WRITE LOGICAL EOT ON TAPE
	SKIPE INCREM
	 SKIPE CKIDMP
	  JRST RAT2
	SKIPE EXPERM
	 JRST RAT2
		;MUST CHECK, AND SET DUMPCHECK BITS
	SETOM LUSNM		;SO WE WILL GET LAST USER
	PRINT _REWINDING
IFE MCOND DM,[
	MOVN N,NFTDMP		;[SOMEONE SHOULD DOCUMENT THIS]
	MOVE B,NFTDMP
	SOS B
	CAMN B,ITAPE		;IF EQUAL, THEN IT IS THE WHOLE TAPE
	 JRST RAT1
	PUSHJ P,ASPAC1
	SKIPA
]
RAT1:	 PUSHJ P,ARWND
	PRINT _CHECKING INCREMENTAL DUMP
	PUSHJ P,ICHECK
	PUSHJ P,ARWND
RAT2:	POP P,LPTSW
	SKIPN REAPSW		;DO REAP IF ASKED
	 JRST RET
	JRST INCGFR

;CONVERT SIXBIT DATE IN A TO NUMBER OF DAYS IN A
SBDTTN:	CAMN A,[-1]
	 POPJ P,
	PUSH P,B
	PUSH P,C
	PUSH P,D
	PUSH P,E
	MOVE B,[440600,,A]
	PUSHJ P,SBDTN1		;YEARS
	IMULI C,12.*31.		;EL CHEAPO!
	MOVE D,C
	PUSHJ P,SBDTN1		;MONTHS
	IMULI C,31.
	ADD D,C
	PUSHJ P,SBDTN1		;DAYS
	ADD D,C
	MOVE A,D
	POP P,E
	POP P,D
	POP P,C
	POP P,B
	POPJ P,

;GET TWO SIXBIT CHARS AND CONVERT TO NUMBER IN C
SBDTN1:	ILDB E,B
	SUBI E,"0
	ILDB C,B
	SUBI C,"0
	IMULI E,10.
	ADD C,E
	POPJ P,

;HERE'S THE ROUTINE THAT ACTUALLY, FINALLY, WRITES ON THE TAPE.
;HERE IF NEED A TAPE HEADER FIRST (WE'RE AT FRONT OF TAPE)
LP2C:	MOVE A,[THBLK,,LISTBF]	;LISTBF IS BUFFER FOR OUTPUT TO
	ADD A,USRUFD		;THE .TAPEn; TAPE nnn FILE
	BLT A,LISTBF+LTHBLK-1(USRUFD)
	MOVE A,[-3,,0]
	ADDI USRUFD,LTHBLK
	MOVEM A,LISTBF(USRUFD)
	AOS USRUFD
	MOVE A,[-LTHBLK,,THBLK]	;OUTPUT TAPE-HEADER
	PUSHJ P,MAGWRI
;HERE IF NOT AT FRONT OF TAPE
LP2A:	AOSN DMPDIR
	 JRST DIRDMP		;DON'T DUMP A FILE, DUMP A DIR INSTEAD.
	PUSHJ P,DFHBLK		; Set defaults in file header
	MOVE A,USNM		;SET UP FILE HEADER
	MOVEM A,HSNM
	MOVE A,FN1
	MOVEM A,HFN1
	MOVE A,FN2
	MOVEM A,HFN2
	MOVE A,PACKN
	MOVEM A,HPKN
	MOVE A,[SETZ]
	MOVEM A,HDATE		;CREATION DATE OF LINK IS 400000,,0
	MOVEI A,3
	MOVEM A,HLEN		; Length of link is always 3
	SKIPE LNKFLG
	 JRST LP3A
	.CALL RHDATS
	 PUSHJ P,DFHDTS		; So the dates are unknown
	SKIPE A,RFDATE		; Except if we are about to set the date
	 HLLM A,HRDATE		; below, then use that.
	.CALL RHLEN
	 SETOM HLEN		; So the length is unknown
LP3A:	MOVE A,[-LHBLK,,HBLK]	;OUTPUT FILE HEADER
	PUSHJ P,MAGWRI
	MOVE A,HBLK+2
	MOVEM A,LISTBF(USRUFD)
	MOVE A,HBLK+3
	MOVEM A,LISTBF+1(USRUFD)
	MOVE A,HBLK+5
	MOVEM A,LISTBF+2(USRUFD)
	ADDI USRUFD,3
	SKIPE LSTWHL
	 PUSHJ P,LOUSY		;GENERATE LISTING LINE
	  JFCL
	SKIPE LNKFLG
	 JRST LP4A
	SKIPN RFDATE
	 JRST LP
	.CALL SRFDAT
	 JFCL
LP:	MOVE A,[-2000,,BUF]	;OUTPUT THE FILE
	.IOT DSKIN,A
	HRLOI B,-BUF-1(A)
	EQVI B,BUF		;AOBJN POINTER TO STUFF ACTUALLY READ
	SKIPGE A
	 .CLOSE DSKIN,
	JUMPGE B,LP1
	EXCH A,B
	PUSHJ P,MAGWRI
	JUMPGE B,LP		;MORE TO DO ?
LP1:	SKIPN CKIDMP
	 JRST LP1A
	SKIPN MICFLG		;DON'T BOTHER CHECKING, SET DUMPCHECK
	 SKIPE EXPERM		;BITS NOW.
	  JRST LP1A
	OPEN DSKIN,TRNI		;RE-OPEN SINCE CLOSED BY EOF
	 JRST LP1A
	.CALL SRFDAT
	 JFCL
	MOVE A,[400000,,DSKIN]
	.DMPCH A,		;SET DUMP CHARACTER SO WONT BE
	.CLOSE DSKIN,		; INCREMENTALLY DUMPED AGAIN.
LP1A:	PUSHJ P,AEOF		;WRITE EOF MARK ON TAPE
	MOVE A,USNM
	MOVEM A,LUSNM		;LAST LOSER DUMPED
	AOS NFTDMP
	POPJ P,			;RETURN FROM ADMP3

LP4A:	MOVE A,[-3,,LNKNM1]	;DUMP A LINK AS A 3 WORD FILE
	PUSHJ P,MAGWRI		;  LKNM1,LKNM2,SNAM
	JRST LP1A

;HERE IF DUMPING A DIRECTORY RATHER THAN A FILE
DIRDMP:	.IOPUSH DSKIN,		;PROTECT FILE ALREADY OPEN MAYBE
	AOSN DMPMFD
	 PUSHJ P,MFDDMP
	AOSN DMPUFD
	 PUSHJ P,UFDDMP
	.IOPOP DSKIN,
	SKIPL FULLDMP
	 JRST LP2A		;NOT A FULL DUMP, GO BACK
	POPJ P,			;RETURN TO ADMP2

MFDDMP:	HRRI A,.BII
	HRLM A,MFO
	.OPEN DSKIN,MFO
	 POPJ P,
	MOVE A,[-2000,,MFDBUF]
	.IOT DSKIN,A
	PUSHJ P,DFHBLK		; Set defaults in HBLK
	MOVE A,USNM
	MOVEM A,HSNM
	MOVE A,MFO+1
	MOVEM A,HFN1
	MOVE A,MFO+2
	MOVEM A,HFN2
	.CALL RQDATE
	 JFCL
	MOVEI A,2000		; MFD is always 2000 words long
	MOVEM A,HLEN
	MOVE A,[-LHBLK,,HBLK]	;OUTPUT FILE HEADER
	PUSHJ P,MAGWRI
	MOVE A,HBLK+2
	MOVEM A,LISTBF(USRUFD)
	MOVE A,HBLK+3
	MOVEM A,LISTBF+1(USRUFD)
	MOVE A,HBLK+5
	MOVEM A,LISTBF+2(USRUFD)
	ADDI USRUFD,3
	SKIPE LSTWHL
	 PUSHJ P,LOUSY
	  JFCL
	AOS ITAPE
	MOVE A,[-2000,,MFDBUF]
	PUSHJ P,MAGWRI
	PUSHJ P,AEOF
	AOS NFTDMP
	POPJ P,

UFDDMP:	HRRI A,.BII
	HRLM A,FNO
	.OPEN DSKIN,FNO
	 POPJ P,
	MOVE A,[-2000,,UFDBUF]
	.IOT DSKIN,A
	PUSHJ P,DFHBLK		; Set defaults in HBLK
	MOVE A,USNM
	MOVEM A,HSNM
	MOVE A,FNO+1
	MOVEM A,HFN1
	MOVE A,FNO+2
	MOVEM A,HFN2
	.CALL RQDATE
	 JFCL
	MOVE A,UDESCP+UFDBUF	; Calculate how many words we're actually
	ADDI A,5		; going to dump out below.
	IDIVI A,6
	ADDI A,UDDESC+2000
	SUB A,UDNAMP+UFDBUF
	MOVEM A,HLEN
	MOVE A,[-LHBLK,,HBLK]	;OUTPUT FILE HEADER
	PUSHJ P,MAGWRI
	MOVE A,HBLK+2
	MOVEM A,LISTBF(USRUFD)
	MOVE A,HBLK+3
	MOVEM A,LISTBF+1(USRUFD)
	MOVE A,HBLK+5
	MOVEM A,LISTBF+2(USRUFD)
	ADDI USRUFD,3
	SKIPE LSTWHL
	 PUSHJ P,LOUSY
	  JFCL
	MOVE A,UDESCP+UFDBUF	;PACK DIRECTORY BY NOT DUMPING FREE AREA
	ADDI A,5
	IDIVI A,6		;ROUND UP TO NEXT HIGHER WORD
	ADDI A,UDDESC		;DUMP HEADER AREA TOO
	MOVNS A
	HRLS A
	HRRI A,UFDBUF		;DUMP OUT DESC AREA
	PUSHJ P,MAGWRI
	MOVE A,UDNAMP+UFDBUF
	SUBI A,2000
	HRLS A
	HRR A,UDNAMP+UFDBUF
	ADDI A,UFDBUF		;DUMP OUT NAME AREA
	PUSHJ P,MAGWRI
	PUSHJ P,AEOF
	AOS NFTDMP
	POPJ P,

;CALL HERE AFTER DUMPING ALL THE FILES IN A SINGLE DIRECTORY
;UPDATE .TAPEn; TAPE nnn FILE (TAPE DIRECTORY)
FILAPP:	SKIPGE APPENF
	 POPJ P,		;NOTHING WAS DUMPED FOR THIS USER
	MOVEI A,.BII
	HRLM A,NSVOP
	.SUSET [.SSNAM,,NPLACE]
	.OPEN SAVET,NSVOP
	 JRST KARILY		;FIRST TIME THROUGH
	PUSHJ P,ACCESS
	MOVEI A,100007		;WRITE-OVER MODE
	HRLM A,NSVOP
FILAP0:	OPEN SAVET,NSVOP
	 JRST [	PUSH P,LPTSW
		SETZM LPTSW
		PRINT [TYPE ANY CHARACTER TO TRY AGAIN]	;MAYBE SOMEONE HAS IT OPEN
		PUSHJ P,TYI
		PUSHJ P,CRR
		POP P,LPTSW
		JRST FILAP0 ]	;KEEP TRYING UNTIL IT WORKS, DON'T PUNT THE WHOLE DUMP
	.ACCESS SAVET,B		;WE'RE ABOUT TO APPEND "USER" UFD" ONTO "TAPE XXX"
FILAP1:	MOVE A,[-1,,[0]]
	.IOT SAVET,A		;CREATE SNAME ENTRY
	HRROI A,USNM
	.IOT SAVET,A
FLY:	MOVNS USRUFD
	HRLS USRUFD
	HRRI USRUFD,LISTBF
	.IOT SAVET,USRUFD
	.CLOSE SAVET,
	POPJ P,

;GOTTA CREATE THE TAPE DIRECTORY
KARILY:	MOVEI A,.BIO
	HRLM A,NSVOP
	OPEN SAVET,NSVOP
	 JRST RET
	MOVE A,[-LTHBLK-1,,LISTBF]	;PUT HEADER
	.IOT SAVET,A
	MOVE A,[-1,,[0]]	;THEN PUT CHANGE-SNAME TO THIS DIR
	.IOT SAVET,A
	HRROI A,USNM
	.IOT SAVET,A
	SUBI USRUFD,LTHBLK+1	;THEN DUMP OUT THIS DIR'S INFO
	MOVNS USRUFD
	HRLS USRUFD
	HRRI USRUFD,LISTBF+LTHBLK+1
	.IOT SAVET,USRUFD
	.CLOSE SAVET,
	POPJ P,

ACCESS:	MOVEI B,0		;ACCUMULATED ACCESS POINTER
MORCRF:	MOVE A,[-2000,,BUF]	;THIS ROUTINE ACCESSES TO THE END OF THE FILE
	.IOT SAVET,A		;THIS READING ONLY TO GET POINTER
	HLRE C,A
	ADDI B,2000(C)		;INCREMENT ACCESS POINTER
	JUMPGE A,MORCRF		;CONTINUE READING
	POPJ P,

;DETERMINE INTELLIGENTLY WHETHER OR NOT TO ASK FOR 
;TAPE AND REEL NUMBER
;AND ASK WHAT IS NECESSARY
TAPEMB:	SKIPL THTPN
	 JRST ADMPK1		;WE ALREADY KNOW WHAT TAPE THIS IS
ADMPK:	PUSHJ P,TAPGET
	MOVEM SYM,NSVTPN
	SKIPGE CDMFL		;DON'T ASK REEL # FOR NOT CDUMP
	 SKIPL NTAPES		;DON'T ASK REEL # IF YOU KNOW IT
	  JRST ADMPK1		;WE ALREADY KNOW WHAT REEL THIS IS
	PUSH P,LPTSW
	SETZM LPTSW
	PRINT REEL =
	POP P,LPTSW
	PUSHJ P,GETSYL	
	 JRST .-1
	HRRM N,THTPN
	MOVEM N,NTAPES
ADMPK1:	POPJ P,


SUBTTL DUMP A FILE TO THE FILECOMPUTER
;THIS IS A SUBROUTINE. PLEASE CALL WITH SNAME SET UP AND NAME IN FN1, FN2

FCDMP:	SKIPE LNKFLG				    ;IF INPUT FILE IS A LINK
	 POPJ P,				    ;DONT BOTHER WITH IT HERE.
	.CALL [	SETZ ? SIXBIT/OPEN/ ? [.UIO,,DSKIN]
		GFRDEV ? FN1 ? FN2 ?  400000,,SNAME]   ;TRY TO OPEN INPUT FILE.
	 POPJ P,				    ;OH,WELL.
FCDMP0:	.CALL [	SETZ ? SIXBIT/OPEN/		    ;PROBE FOR DIRECTORY ON FC:
		[.UAI,,DSKOUT]
		[SIXBIT /FC/]
		[SIXBIT /.FILE./] ? [SIXBIT /(DIR)/]
		400000,,SNAME]
	 JRST [	.CLOSE DSKOUT
		PUSHJ P,CFCDIR			    ;IF MISSING, TRY TO CREATE IT.
		 PUSHJ P,FCDDLS			    ; UMMM, GEE. IT DIDNT WORK?
		JRST FCDMP1]			    ; YOW! NOW WE CAN HAVE FUN!
	.CLOSE DSKOUT
FCDMP1:	.CALL [	SETZ ? SIXBIT/OPEN/		    ;OPEN OUTPUT FILE.
		[.UIO,,DSKOUT]
		[SIXBIT /FC/] ? FN1 ? FN2 ? 400000,,SNAME]
	  JRST FCDLOS
	PUSHJ P,FCDMP4				    ;GET PAGES FOR THE BUFFER.
FCDMPI:	MOVE U,[444400,,BUFFER]			    ;SETUP FOR FULL WORD TRANSFERS.
	MOVEI W,BUFSIZ*PAGSIZ
	.CALL [	SETZ ? SIXBIT/SIOT/ ? %CLIMM,,DSKIN ? U ? 400000,,W]
	 .LOSE %LSFIL
	MOVEI V,BUFSIZ*PAGSIZ
	SUB V,W					    ;HOW MUCH MORE TO GO?
	JUMPE V,FCDMPZ
	MOVE U,[444400,,BUFFER]
	MOVEI W,BUFSIZ*PAGSIZ
	.CALL [	SETZ ? SIXBIT/SIOT/ ? %CLIMM,,DSKIN ? U ? 400000,,V]
	 .LOSE %LSFIL
	JRST FCDMPI
FCDMPZ:	.CLOSE DSKOUT,				    ;CLEAN UP WHEN DONE.
FCDMP3:	.CLOSE DSKIN,
	POPJ P,

FCDMP4:	SKIPE FCDMAP				    ;IF WE ALREADY GOT SOME BUFFER PAGES
	 POPJ P,				    ;DONT GET 'EM TWICE!
	MOVE X,[-BUFSIZ,,<BUFFER+PAGSIZ-1>/PAGSIZ]
	.CALL [	SETZ ? SIXBIT/CORBLK/
		%CLIMM,,%CBNDR\%CBNDW
		%CLIMM,,%JSELF
		X
		400000+%CLIMM,,%JSNEW]
	 .LOSE %LSSYS
	SETOM FCDMAP
	POPJ P,

FCDDLS: PUSH P,LPTSW				    ;WARN OF LOSSAGE VIA THE TTY.
	SETZM LPTSW
	PRINT [FILECOMPUTER DIRECTORY CREATION FAILED - MAYBE FC IS DOWN?]
	POP P,LPTSW
	POPJ P,					    ;AND PUNT OUT.


FCDLOS: PUSH P,LPTSW				    ;WARN OF LOSSAGE VIA THE TTY.
	SETZM LPTSW
	PRTFNS
	PRINT [NOT COPIED TO FILECOMPUTER.]
	POP P,LPTSW
	POPJ P,					    ;AND PUNT OUT.

SUBTTL CREATE A USER DIRECTORY ON THE FC: FILECOMPUTER DEVICE 
;THIS IS A SUBROUTINE. PLEASE CALL WITH SNAME SET UP.
;SKIPS IF SUCCESSFUL.

CFCDIR:	.CALL [	SETZ ? SIXBIT/OPEN/
		[.UIO,,DSKOUT]
		[SIXBIT/FC/]
		[SIXBIT /..NEW./]
		[SIXBIT /(UDIR)/]
		SNAME
		400000+%CLERR,,X ]
	 JFCL
	CAIN X,%ENSFL		;IF WE GOT AN FNF ERROR
	 AOS (P)		;WE WON.
	POPJ P,			;OTHERWISE WE LOSE SOMEHOW

SUBTTL GRIM FILE REAPER

;FIRST, PROCESS OPTIONS LIKE 'LOOP'
AGFR:	SETOM THTPN
	MOVSI A,-NGFRSW
	SKIPGE GFRTB2(A)
	 CLEARM @GFRTB2(A)	;IF INSTRUCTION IS SETOM, CLEAR IT
	AOBJN A,.-2
	SETZM GFRPNM		;START WITH NO PACKS TO REAP OFF OF
	SETZM GFRDEV		;DEFAULT IS TO WRITE TO TAPE
	CAIN TER,15
	 JRST RET		;NO OPTIONS? DO NOTHING.
GFRLP1:	PUSHJ P,TYI
	CAIN A,"?
	 JRST GFRPHL		;GIVE INFO ON OPTIONS AVAILABLE
	PUSHJ P,GETSL1
	 POPJ P,		;OVER-RUBOUT? DO NOTHING.
	PUSHJ P,GFRSPT
	CAIN TER,15
	 JRST GFREXC
	JRST GFRLP1

GFRSPT:	JUMPE SYM,CPOPJ
	MOVSI A,-NGFRSW
	CAMN SYM,GFRTB1(A)
	 JRST GFRSPD
	AOBJN A,.-2
	SUB P,[1,,1]		;BAD OPTION, IGNORE
	PRINT ?
	PSIS SYM
	PUSHJ P,TYOS
	PRINT IGNORED
	PUSHJ P,TYOS
	JRST GFRLP1

GFRSPD:	CAMN SYM,[SIXBIT /FC/]
	 JRST FCNONE
GFRSPX:	XCT GFRTB2(A)		;DO OPTION AS SPECIFIED
	POPJ P,

GFRPHL:	PASC GFRHLP		;GIVE OPTIONS AND DESCRIPTION
	JRST GFRLP1

; COME HERE TO SEE IF THIS MACHINE HAS A FILECOMPUTER.
; THIS IS SORT OF BOGUS, BUT I DIDNT WANT TO CONDITIONALIZE THE SOURCE.
FCNONE:	.CALL [ SETZ ? 'SSTATU ? REPEAT 5,[MOVEM A ? ] SETZM A ]
	 .LOSE %LSSYS
	CAMN A,[SIXBIT \AIKA\]	;IF WE ARE ON THE AI-KA MACHINE
	 JRST GFRSPX		;WE CAN DO FILECOMPUTER THINGS.
	PUSH P,LPTSW		;ELSE COMPLAIN.
	SETZM LPTSW
	PRINT [THIS MACHINE DOESN'T HAVE A FILECOMPUTER - IGNORING FC OPTION.]
	POP P,LPTSW
	POPJ P,


  ;IF YOU UPDATE THIS TABLE, ALSO UPDATE GFRTB2 AND GFRHLP (ALSO ON THIS PAGE)
GFRTB1:	SIXBIT /H/	;HISTOGRAM
	SIXBIT /L/	;LIST
	SIXBIT /DUMP/	;DUMP
	SIXBIT /DELETE/	;DELETE
	SIXBIT /DATE/	;ENTER DATE
	SIXBIT /BLOCKS/	;GET X BLOCKS
	SIXBIT /EVERY/	;ALLOW NO SPECIAL DIRECTORIES
	SIXBIT /CREATE/	;USE CREATION DATE INSTEAD OF REF DATE
	SIXBIT /QUOTA/	;ENFORCE QUOTA
	SIXBIT /ALLOC/	;REAP ALLOCATED DIRS TOO
	SIXBIT /FROM/	;FROM DEVICE
	SIXBIT /TO/	;TO DEVICE
	SIXBIT /ONLY/	;ONLY FROM SPECIFIED DEVICE
	SIXBIT /DISK/	;DUMP TO SECONDARY DISK INSTEAD OF TAPE
	SIXBIT /SECOND/	;REAP SECONDARY DISK ALSO
	SIXBIT /FC/	;REAP TO BOTH FC DEVICE AND TO TAPE
NGFRSW==.-GFRTB1

GFRHLP:	ASCIZ\
H	MAKE HISTOGRAM OF BLOCKS FREED VERSUS DATE
L	LIST HISTOGRAM AND/OR FILES REAPED
DUMP	DUMP REAPED FILES ONTO TAPE
DELETE	DELETE REAPED FILES (AFTER DUMPING)
TO dev	DUMP TO DISK DEVICE dev (E.G. SECOND) INSTEAD OF TAPE
DATE	ENTER DATE OF OLDEST FILE TO RETAIN
BLOCKS	ENTER NUMBER OF BLOCKS TO BE OBTAINED
CREATE	USE CREATION DATE INSTEAD OF REFERENCE DATE
QUOTA	ENFORCE DIRECTORY QUOTAS
ALLOC	REAP ALLOCATED DIRS TOO
EVERY	ALLOW NO SPECIAL DIRECTORIES (DON'T USE THIS, PLEASE!)
FROM dev REAP OFF OF DEVICE dev (E.G. SECOND) AS WELL AS MAIN DISK.
ONLY	REAP ONLY FROM SPECIFIED DEVICE, NOT MAIN DISK.
DISK	DUMP TO SECONDARY DISK INSTEAD OF TAPE
	(THIS IS AN OBSOLETE FORM FOR "TO SECOND")
SECOND	REAP SECONDARY DISK ALSO
	(THIS IS AN OBSOLETE FORM FOR "FROM SECOND")
FC	REAP FILES ONTO BOTH TAPE AND THE FILECOMPUTER.
_GFR \

GFRTB2:	SETOM GFRHSW
	SETOM GFRLST
	SETOM GFRDMS
	SETOM GFRDES
	SETOM GFRDAS
	SETOM GFRBLS
	SETOM GFREVR
	SETOM GFRCRE
	SETOM GFRQUO
	SETOM GFRALO
	PUSHJ P,GFPFRM
	PUSHJ P,GFPTO
	SETOM GFRONL
	PUSHJ P,GFPDSK
	PUSHJ P,GFPSEC
	SETOM FCREAP
IFN .-GFRTB2-NGFRSW, .ERR GFRTB2 DISAGREES WITH GFRTB1

GFRHSW:	0	;HISTOGRAM SWITCH
GFRDMS:	0	;DUMP SWITCH
GFRDES:	0	;DELETE SWITCH
GFRDAS:	0	;DATE SWITCH
GFRBLS:	0	;BLOCKS SWITCH
GFRLST:	0	;LIST SWITCH
GFRNBK:	0	;NUMBER OF BLOCKS DESIRED
GFRNBG:	0	;NUMBER OF BLOCKS GOTTEN
GFREVR:	0	;NO SPECIAL DIR SWITCH (BE CAREFUL WITH THIS!!!!)
GFRCRE:	0	;CREATION DATE SWITCH
GFRQUO:	0	;HACK QUOTA
GFRALO:	0	;REAP ALLOCATED DIRS TOO
GFRDEV:	0	;DEVICE WRITING TO (0 MEANS TAPE)
GFRPNM:	0	;PACK NUMBER MASK (1 MEANS OK TO REAP FROM)
GFRONL:	0	;ONLY FROM SPECIFIED DEVICE, NOT PRIMARY PACKS
GFRJST:	0	;DISCRIMINATE AGAINST CERTAIN DIRECTORIES
FCREAP:	0	;FC DEVICE SWITCH

GFPDSK:	MOVE SYM,['SECOND]
	PUSHJ P,GFPDV1
GFPTO:	 PUSHJ P,GFPDEV
	MOVEM SYM,GFRDEV
	POPJ P,

GFPSEC:	MOVE SYM,['SECOND]
	PUSHJ P,GFPDV1
GFPFRM:	 PUSHJ P,GFPDEV
	IORM B,GFRPNM
	POPJ P,

;RETURN WITH SIXBIT DEVICE IN SYM AND BIT MASK OF PACK NUMBERS IN B
GFPDEV:	PRINT [DEVICE=]
	PUSHJ P,GETSYL
	 JRST RET
	CAIA
GFPDV1:	 AOS (P)
	MOVEI B,0
	MOVSI A,-NQS
GFPDV2:	CAME SYM,QRESRV(A)
	 AOBJN A,.-1
	JUMPGE A,GFPDV3
	MOVEI C,1
	LSH C,@QPKID(A)
	IOR B,C	
	AOBJN A,GFPDV2
GFPDV3:	JUMPN B,CPOPJ
	PASC [ASCIZ/? NO SUCH PACK MOUNTED/]
	JRST RET

;ENTRY FROM MAIN DUMP TO ALSO DO A REAP
INCGFR:	SETOM GFRFLG
	MOVSI A,-NGFRSW
	SKIPGE GFRTB2(A)	;CLEAR ALL ARGUMENTS EXCEPT GFRQUO AND LIST IF WAS SET
	 CLEARM @GFRTB2(A)	;IF INSTRUCTION IS SETOM, CLEAR IT
	AOBJN A,.-2
	MOVSI A,-NFIGS
	CLEARM @FIGTB2(A)
	AOBJN A,.-1
	SETOM GFRQUO
	SETOM GFRDMS	;SET DUMP SWITCH
	SETOM GFRDES	;SET DELETE SWITCH
	SETOM MFDIN
	SKIPE LSTWHL
	 SETOM GFRLST
	JRST GFREX1

;GFR'S VERSION OF 'EXECU' - MASSAGE OPTIONS AND INITIALIZE
GFREXC:	MOVE A,PRIMSK		;ALSO REAP FROM PRIMARY PACKS
	SKIPN GFRONL
	 IORM A,GFRPNM
	SKIPN GFRPNM
 	 DIE WHAT PACKS DO YOU WANT ME TO REAP FROM
	SKIPE GFRDAS
	 CLEARM GFRBLS		;CAN'T DO BOTH DATES AND BLOCKS
	SKIPN GFRDEV		;REAPING TO SECONDARY DISK
	 JRST GFRXC1
	SETZM GFRDES
	SETZM GFRDMS
GFRXC1:	SKIPE GFRDES
	 PUSHJ P,GFRDCK		;DELETE CHECK
	SKIPE GFRBLS
	 PUSHJ P,GFRGNB		;GET NUMBER OF BLOCKS
	SETZM GFRNBG
	SKIPE GFRDAS
	 PUSHJ P,GETDAT		;GET DATES
	SKIPE GFRLST
 	 PUSHJ P,DEVGET		;GET LISTING DEVICE
	.SUSET [.SSNAME,,USNM]
	SKIPE GFRHSW
	 PUSHJ P,GFRPHI		;COMPUTE HISTOGRAM, MAYBE PRINT IT
	SKIPE GFRBLS
	 PUSHJ P,GFRGBD		;GET DATE ASSOCIATED WITH NEEDED NUMBER OF BLOCKS
	SKIPN GFRDAS
	 SKIPE GFRBLS
	  JRST GFREX6
	SKIPN GFRQUO
	 JRST RET		;NO ACTUAL REAPING TO BE DONE, PROBABLY
				; JUST WANTED TO SEE HISTOGRAM
	;*DROPS IN
GFREX6:	SKIPE GFRDMS		;IF DUMPING,
	 PUSHJ P,MBOCF		;GET TO BEGINNING OF CURRENT FILE ON TAPE.
	SETOM GFRFLG
	SETOM MFDIN
	JRST GFREX1

MBOCF:	PUSHJ P,SPRF		;BEGINNING OF CURRENT FILE
	PUSHJ P,SETIT1		;Get tape status
	TRNN A,TF%BOT		;Unless BOT,
	 PUSHJ P,SPFF		; Forward one file
	PUSHJ P,SETIT
	POPJ P,

GETDAT:	PRINT ENTER DATE (YY/MM/DD)
	PUSHJ P,GETDT
	CAIGE N,100.
	 CAIGE N,1.
	  JRST GETDAT		;BAD YEAR
	DPB N,[330700,,DATE]
	PUSHJ P,GETDT
	CAIGE N,13.
	 CAIGE N,1.
	  JRST GETDAT		;BAD MONTH
	DPB N,[270400,,DATE]
	PUSHJ P,GETSYL
	 JRST GETDAT		;OVER RUBOUT ON DAY
	CAIGE N,32.
	 CAIGE N,1.
	  JRST GETDAT		;BAD DAY
	DPB N,[220500,,DATE]
	POPJ P,

GETDT:	SETZM N			;GET SYLLABLE OF DATE
GETDT1:	PUSHJ P,TYI
	CAIN A,40		;SPACE
	 POPJ P,
	CAIN A,177		;CAN'T HACK RUBOUT, START OVER
	 JRST [	SUB P,[1,,1] ? JRST GETDAT ]
	CAIN A,"/
	 POPJ P,		;SLASH TERMINATES DATE SYLLABLES
	SUBI A,"0
	IMULI N,10.
	ADD N,A
	JRST GETDT1

GFRGBD:	SKIPN GFRHSW		;COMPUTE WHAT DATE TO REAP BACK TO
	 PUSHJ P,GFRHIS		; TO GET DESIRED NUMBER OF BLOCKS
	MOVE B,[-LGFRBLK,,GFRBLK]
GFRBD1:	HLRZ A,(B)
	CAML A,GFRNBK
	 JRST GFRBD2
	AOBJN B,GFRBD1
	PRINT YOU ASKED FOR THE WHOLE DISK
	JRST RET

GFRBD2:	HRRZS B
	PUSHJ P,CRR
	PUSHJ P,GFROFI
	MOVEM A,DATE
	PRINT DATE FOR GFR IS
	PUSHJ P,GFRPDT
	PUSHJ P,CRR
	POPJ P,

GFRGNB:	PRINT NUMBER OF BLOCKS DESIRED ?
	PUSHJ P,GETSYL
	 JRST GFRGNB
	JUMPL N,GFRGNB
	MOVEM N,GFRNBK
	POPJ P,

;LOOP OVER ALL FILES
GFREX1:	PUSHJ P,MFDN		;GET NEXT DIRECTORY
	 JRST GFRFIN		;DONE
	PUSHJ P,GFRUCK		;SEE IF SPECIAL DIRECTORY THAT
	 JRST GFREX1		; SHOULDN'T GET REAPED
	.SUSET [.SSNAM,,USNM]
	SETOM GFRFQ
	SETOM FLNI
GFREX2:	SKIPN GFRBLS		;IF USER SAID BLOCKS, STOP WHEN GOT THAT MANY
	 JRST GFRX2A
	MOVE A,GFRNBG
	CAML A,GFRNBK
	 JRST GFRFIN
GFRX2A:	PUSHJ P,FNG		;GET NEXT FILE IN THIS DIRECTORY
	 JRST GFREX3		; SORTED BY DECREASING DESIRE TO REAP.
	SKIPN GFRQUO		;IF ENFORCING QUOTAS,
	 JRST GFREX4
	MOVE A,BLOCKS		;SEE IF OVER QUOTA
	CAMG A,QUOTA
	 JRST GFREX3
	AOSE GFRFQ
	 JRST GFREX5
	SKIPN GFRLST
	 JRST GFREX5
	PUSHJ P,CRR
	PUSHJ P,CRR
	PSIS USNM
	PUSHJ P,TYOS
	PRINT QUOTA =
	PUSHJ P,TYOS
	PDPT QUOTA
	PUSHJ P,TYOS
	PRINT BLOCKS =
	PUSHJ P,TYOS
	PDPT BLOCKS
	PUSHJ P,CRR
	JRST GFREX5

GFREX4:	SKIPN A,RFDATE
	 JRST GFREX2
	CAMLE A,DATE
	 JRST GFREX2
	JRST GFREX5

;END OF DIRECTORY
GFREX3:	SKIPE GFRDMS
	 PUSHJ P,FILAPP		;APPEND USERUFD FILE
	JRST GFREX1

;'DELETE' OPTION GIVEN, SEE IF SHE REALLY MEANS IT
GFRDCK:	PRINT YOU SPECIFIED DELETE,
	PUSHJ P,CHECK
	SKIPE GFRDMS
	 POPJ P,
	PRINT YOU DID NOT SPECIFY DUMP,
	PUSHJ P,CHECK
	PRINT WHAT TAPE DID YOU DUMP THESE FILES ON?
	PUSHJ P,TAPGET
	POPJ P,

;GENERATE LISTING LINE FOR FILE BEING REAPED.
GFRLIS:	PUSHJ P,CRR
	PSIS USNM
	PUSHJ P,TYOS
	PSIS FN1
	PUSHJ P,TYOS
	PSIS FN2
	PUSHJ P,TYOS
	MOVE A,RFDATE
	PUSHJ P,GFRPDT
	PUSHJ P,TYOS
	PDPT FLENTH
	POPJ P,

GFRFIN:	SKIPE GFRDMS		;IF DELETING,
	 PUSHJ P,GESELL		;UPDATE SYSENG;MACRO TAPES.
GFRNUT:	SETZM LPTSW
	PUSHJ P,CRR
	MOVE A,GFRNBG
	PUSHJ P,DPT
	PRINT [ BLOCKS REAPED.]
	JRST RET

;THIS ONE IS GETTING REAPED
GFREX5:	MOVE A,BLOCKS		;COMPUTE BLOCKS SAVED
	SUB A,FLENTH
	MOVEM A,BLOCKS
	SKIPE GFRLST
	 PUSHJ P,GFRLIS		;LIST
	SKIPE GFRDMS
	 PUSHJ P,ADMP3		;DUMP ONTO TAPE
	SKIPE FCREAP		;MAYBE DUMP ONTO FC DEVICE ALSO
	 PUSHJ P,FCDMP
	SKIPE GFRDES
	 PUSHJ P,GFRDEL		; THEN DELETE THE FILE.
	SKIPN GFRDEV
	 JRST GFREX2
	HRLZI A,.BII		;DUMP ONTO SECONDARY DISK
	HLLM A,TRNI
	OPEN DSKIN,TRNI
	 JRST GFREX2		;FILE BEEN DELETED
	.CALL [	SETZ ? SIXBIT/OPEN/ ? [.BIO,,DSKOUT]
		GFRDEV ? [SIXBIT/_DUMP_/] ? SETZ ['OUTPUT]]
	 JRST [	PUSH P,LPTSW
		SETZM LPTSW
		PRINT [CAN'T OUTPUT TO ]
		PSIS GFRDEV
		PRINT [: ]
		.SUSET [.RSNAME,,A]
		PSIS A
		PRINT [; _DUMP_ OUTPUT - ]
		PUSHJ P,OPINFL
		PUSHJ P,CRR
		POP P,LPTSW
		.CLOSE DSKIN,
		JRST GFREX2 ]
	.CALL RDATE
	 JFCL
	.CALL SDATE
	 JFCL
	.CALL RRDATE
	 JFCL
	.CALL SRDT
	 JFCL
	LDB A,[230100,,UNRNDW]
	.CALL [SETZ ? 'SREAPB ? 1000,,DSKOUT ? SETZ A]
	 JFCL
	LDB A,[430100,,UNRNDW]
	.CALL [SETZ ? 'SDMPBT ? 1000,,DSKOUT ? SETZ A]
	 JFCL
	.CALL [SETZ ? SIXBIT/RAUTH/ ? MOVEI DSKIN ? SETZM A]
	JFCL
	.CALL [SETZ ? SIXBIT /SAUTH/ ? 1000,,DSKOUT ? SETZ A]
	JFCL
GFRDS1:	MOVE A,[-2000,,BUF]	;HAVING GOT NEW FILE READY, COPY OVER
	.IOT DSKIN,A
	HRLOI B,-BUF-1(A)
	EQVI B,BUF
	SKIPGE B
	 .IOT DSKOUT,B	
	JUMPGE A,GFRDS1
	.CLOSE DSKIN,
	.CALL [	SETZ ? 'RENMWO ? MOVEI DSKOUT ? FN1 ? SETZ FN2 ]
	 JRST [	PUSH P,LPTSW
		SETZM LPTSW
		PRINT [CAN'T RENMWO ]
		PSIS GFRDEV
		PRINT [: ]
		.SUSET [.RSNAME,,A]
		PSIS A
		PRINT [; ]
		PSIS FN1
		PRINT [ ]
		PSIS FN2
		PRINT [ - ]
		PUSHJ P,OPINFL
		PUSHJ P,CRR
		POP P,LPTSW
		JRST .+1 ]	 
	.CLOSE DSKOUT,
	MOVE A,FLENTH
	ADDM A,GFRNBG
	JRST GFREX2

;DELETE REAPED FILE BY REPLACING IT WITH A LINK TO BACKUP; TAPE nnn
GFRDEL:	MOVE A,FN1
	MOVEM A,GFRLNK+1
	MOVE A,FN2
	MOVEM A,GFRLNK+2
	MOVSI A,.BII
	HLLM A,TRNI
	OPEN DSKIN,TRNI		;OPEN FILE BEING DELETED (TO GET CREATION DATE)
	 POPJ P,
	.CALL RDATE		;FDATE GETS CREATION DATE
	 .LOSE %LSFIL
	.CALL [SETZ ? SIXBIT/RAUTH/ ? MOVEI DSKIN ? SETZM AUTHOR]
	 SETZM AUTHOR
	.CALL [ SETZ ? 'DELEWO ? SETZI DSKIN ]
	 .LOSE %LSFIL
	.CLOSE DSKIN,		;OLD FILE VANISHES
	MOVE A,FLENTH
	ADDM A,GFRNBG
	OPEN DSKOUT,GFRLNK	;MAKE THE LINK
	 POPJ P,		;FOO, SHOULDN'T GET DIR FULL
	MOVSI A,20+.BII		;OPEN UP THE LINK AGAIN
	HLLM A,TRNI
	OPEN DSKOUT,TRNI
	 POPJ P,		;FOO?
	.CALL SDATE		;SET CREATION DATE TO FDATE
	 .LOSE %LSFIL
	.CALL [SETZ ? SIXBIT /SAUTH/ ? 1000,,DSKOUT ? SETZ AUTHOR]
	 JFCL			;ALSO TRY TO PRESERVE AUTHOR
	.CLOSE DSKOUT,
	POPJ P,

GFRLNK:	200000,,(SIXBIT/DSK/)	;OPEN COMMAND 2 = MLINK
	0	;FN1
	0	;FN2
	SIXBIT /TAPE/
	0	;TAPE NUMBER FROM TAPGET
	SIXBIT /BACKUP/	;SNAME FOR LINK

;COMPUTE HISTOGRAM OF DATE VERSUS NUMBER OF BLOCKS SAVED
;IF FILES OLDER THAN THAT ARE REAPED.
GFRPHI:	PUSHJ P,GFRHIS		;COMPUTE IT
	SKIPE GFRLST
	 PUSHJ P,GFRHP		;IF 'LIST' SPECIFIED, PRINT IT OUT
	POPJ P,

GFRHIS:	.RDATE A,
	SETOM MFDIN
	SETOM GFRFLG
	SETZM CURDAT
	LDB B,[000600,,A]	;LOW DIGIT OF DAY
	SUBI B,20
	LDB C,[060600,,A]	;HIGH DIGIT OF DAY
	SUBI C,20
	IMULI C,10.
	ADD C,B
	DPB C,[220500,,CURDAT]	;STORE DAY IN DAY FIELD OF DISK-DATE WORD
	LDB B,[140600,,A]	;SAME WITH MONTH
	SUBI B,20
	LDB C,[220600,,A]
	SUBI C,20
	IMULI C,10.
	ADD C,B
	DPB C,[270400,,CURDAT]
	LDB B,[300600,,A]	;SAME WITH YEAR
	SUBI B,20
	LDB C, [360600,,A]
	SUBI C,20
	IMULI C,10.
	ADD C,B
	DPB C,[330700,,CURDAT]	;NOW HAVE CURRENT TIME IN DISK FORMAT
	MOVE A,CURDAT		;[I DON'T KNOW WHAT'S WRONG WITH *******
	SUBI C,GFRYRS		; THE RQDATE SYSTEM CALL] *******
	DPB C,[330700,,A]
	MOVEM A,OLDDAT		;OLDEST FILE DATE IS GFRYRS YEARS AGO *******
	SETZM GFRBLK
	MOVE A,[GFRBLK,,GFRBLK+1]
	BLT A,GFRBLK+LGFRBLK-1
GFR1:	PUSHJ P,MFDN		;READ A DIRECTORY
	 JRST GFRF
	PUSHJ P,GFRUCK		;SEE IF THIS DIRECTORY SHOULD NOT BE REEPED
	 JRST GFR1
	.SUSET [.SSNAM,,USNM]
	SETOM FLNI
GFR2:	PUSHJ P,FNG		;READ A FILE
	 JRST GFR1
	SKIPE LNKFLG		;DO NOTHING FOR LINKS
	 JRST GFR2
	SKIPN A,RFDATE		;DON'T COUNT FILES WITHOUT REFERENCE DATES
	 JRST GFR2
	CAMG A,OLDDAT		;IF OLDER THAN GFRYRS, USE OLDDAT
	 MOVE A,OLDDAT
	PUSHJ P,GFROFS		;COMPUTE OFFSET
	MOVE B,FLENTH
	ADDM B,GFRBLK(A)	;INCREMENT COUNT OF BLOCKS ON THAT DATE
	JRST GFR2		;NEXT FILE

;HISTOGRAM ALL DONE
GFRF:	SETZM GFRFLG
	SETZM A
	MOVEI B,GFRBLK
GFRTOT:	ADD A,(B)
	HRLM A,(B)		;RH INCREMENT, LH RUNNING SUM
	AOS B
	CAIG B,GFRBLK+LGFRBLK-1
	 JRST GFRTOT
	POPJ P,

;GIVEN A DATE IN A, COMPUTE NUMBER OF DAYS SINCE DATE IN OLDDAT
GFROFS:	SETZM B
	LDB C,[330700,,OLDDAT]	;SUBTRACT YEARS
	LDB D,[330700,,A]
	SUB D,C
	IMULI D,12.*31.		;APPARENTLY THERE ARE 372 DAYS PER YEAR
	MOVE B,D		; AT LEAST IF EACH MONTH HAS 31 DAYS
	LDB C,[270400,,OLDDAT]	;SUBTRACT MONTHS
	LDB D,[270400,,A]
	SUB D,C
	IMULI D,31.
	ADD B,D
	LDB C,[220500,,OLDDAT]	;SUBTRACT DAYS
	LDB D,[220500,,A]
	SUB D,C
	ADD B,D
	MOVE A,B
	CAILE A,LGFRBLK-2	;DON'T GET FAKED OUT BY FILES
 	 MOVEI A,LGFRBLK-2	; BROUGHT BACK FROM THE FUTURE
	POPJ P,

;PRINT GFR HISTOGRAM
GFRHP:	MOVEI B,GFRBLK
GFRHPT:	HRRZ A,(B)
	SKIPN A
	 JRST GFRHP1
	PUSHJ P,CRR
	PUSHJ P,GFROFI		;OFFSET BACK TO DATE
	PUSHJ P,GFRPDT		;PRINT DATE
	PASC [ASCIZ /	/]
	HRRZ A,(B)
	PDPT A			;PRINT INCREMENT IN BLOCKS
	HLRZ A,(B)
	PDPT A			;PRINT TOTAL BLOCKS
GFRHP1:	AOS B
	CAIG B,GFRBLK+LGFRBLK-1
	 JRST GFRHPT
	POPJ P,

;PRINT DATE IN A
GFRPDT:	PUSH P,B
	PUSH P,A
	LDB B,[270400,,A]	;MONTH
	PSIS MONTH(B)
	PUSHJ P,TYOS
	LDB A,[220500,,A]	;DAY
	CAIGE A,10.
	 PUSHJ P,TYOS
	PUSHJ P,DPT
	PASC [ASCIZ /, /]
	POP P,A
	LDB A,[330700,,A]	;YEAR
	ADDI A,1900.
	PUSHJ P,DPT
	POP P,B
	POPJ P,

;CONVERT GFRBLK POINTER IN B BACK FROM OFFSET INTO DATE
;SOMEONE SHOULD DOCUMENT THIS PURE MAGIC
;OK, here is the explanation:
; The date of GFRBLK+0 is stored in OLDDAT.  If we pretend that every
; month has 31. days, then GFRBLK+<n> would have the date C(OLDDAT)+<n>.
; (Where <n> is measured in days, and date arithmetic is done appropriately.)
; Thus, some locations in GFRBLK correspond to impossible dates such as
; February 30.  For some reason, people never create files on those dates...
GFROFI:	LDB C,[330700,,OLDDAT]	; C: old-year
	LDB D,[270400,,OLDDAT]	; D: old-month
	LDB E,[220500,,OLDDAT]	; E: old-day
	PUSH P,B
	SUBI B,GFRBLK
	MOVE A,B
	IDIVI A,12.*31.		; A: years, B: remainder
	ADD C,A
	MOVE A,B
	IDIVI A,31.		; A: months (0 - 11.), B: days (0 - 31.)
	ADD D,A
	ADD E,B
	CAILE E,31.
	 AOS D
	CAILE E,31.
	 SUBI E,31.
	CAILE D,12.
	 AOS C
	CAILE D,12.
	 SUBI D,12.
	CAILE D,12.
	 AOS C
	CAILE D,12.
	 SUBI D,12.
	POP P,B
	SETZM A
	DPB C,[330700,,A]
	DPB D,[270400,,A]
	DPB E,[220500,,A]
	POPJ P,

GFRFLG:	0			;MAGIC ARGUMENT TO FNG
CURDAT:	0			;CURRENT DISK-FORMAT DATE
OLDDAT:	0			;BASE DISK-FORMAT DATE FOR GFRBLK
GFRYRS==:2			; 2 year histogram
LGFRBLK==:<GFRYRS*12.*31.>+1	;1 ENTRY FOR EACH DAY, 1 EXTRA AT END FOR TOTAL
GFRBLK:	BLOCK LGFRBLK

MONTH:	0
	SIXBIT /JAN/
	SIXBIT /FEB/
	SIXBIT /MAR/
	SIXBIT /APR/
	SIXBIT /MAY/
	SIXBIT /JUN/
	SIXBIT /JUL/
	SIXBIT /AUG/
	SIXBIT /SEP/
	SIXBIT /OCT/
	SIXBIT /NOV/
	SIXBIT /DEC/


;GFRUCK - Skip if it's OK to reap this directory

GFRUCK:
	; Very grim procedure.
	SKIPE GFREVR		;Are we reaping all directories?
	 JRST POPJ1		; Yes - reap 'em all.

	; Discriminatory reap procedures.
	SKIPN GFRJST		;If we are not being discriminatory
	 JRST GFRUC2		; follow normal procedures.
	MOVSI A,-NBADDY		;Number of discriminated against dirs.
GFRUC1:	CAMN B,BADDY(A)		;Is this dir a baddy?
	 JRST POPJ1		; Yes - it should be reaped.
	AOBJN A,GFRUC1
	POPJ P,			;No, a normal dir. Don't reap it.

	; Nondiscriminatory reap procedure.
GFRUC2:	HLRZ A,USNM
	CAIE A,(SIXBIT /SYS/)	;Never reap system dirs
	 CAIN A,(SIXBIT /LIB/)	;Never reap libraries.
	  POPJ P,
	MOVE B,USNM		;Don't reap the DUMP database!
	MOVSI A,-NTDIR
GFRUC3:	CAMN B,TDIRTB(A)
	 POPJ P,
	AOBJN A,GFRUC3
	SKIPE WRONG
	 DIE Cannot GFR because this version of DUMP is for the wrong machine
	MOVSI A,-NSDIR		;Check list of specially protected dirs.
GFRUC4:	CAMN B,SDIR(A)		;Is this dir in the list?
	 POPJ P,		; Yes, do not reap it.
	AOBJN A,GFRUC4
	JRST POPJ1		;Not in the list - reap it.



SUBTTL	SPECIALLY PROTECTED DIRS TO BE HAND REAPED ONLY

SDIR:	SIXBIT /./
	SIXBIT /.BULK./
	SIXBIT /.INFO./
	SIXBIT /.MAIL./
	SIXBIT /.TECO./
	SIXBIT /ACOUNT/
	SIXBIT /BACKUP/
	SIXBIT /C/
	SIXBIT /DEVICE/
	SIXBIT /EMACS/
	SIXBIT /EMACS1/
	SIXBIT /FONTS/
	SIXBIT /FONTS1/
	SIXBIT /INFO/
	SIXBIT /INQUIR/
	SIXBIT /LISP/
	SIXBIT /MAINT/

IFE MCOND AI,[
	SIXBIT /COMLAP/
	SIXBIT /DECSYS/
	SIXBIT /KLDCP/
	SIXBIT /KSC/
	SIXBIT /KSHACK/
	SIXBIT /L/
	SIXBIT /LSPMAI/
	SIXBIT /MIDAS/
	SIXBIT /SAIL/
	SIXBIT /UCODE/
;Macsyma-related directories:
;(should be moved to the ML list when it comes up)
;Well, its up now, but perhaps we have decided to leave Macsyma on AI?
	SIXBIT /ALJABR/
	SIXBIT /DEMO/
	SIXBIT /LMMAXQ/
	SIXBIT /MACDOC/
	SIXBIT /MACSYM/
	SIXBIT /MAXDOC/
	SIXBIT /MAXDMP/
	SIXBIT /MAXERR/
	SIXBIT /MAXER1/
	SIXBIT /MAXTUL/
	SIXBIT /MAXOUT/
	SIXBIT /MUNFAS/
	SIXBIT /SHARE/
	SIXBIT /SHARE1/
	SIXBIT /SHARE2/
	SIXBIT /SHAREM/
]

IFE MCOND MC,[			; (The KS)
	SIXBIT /ANBB/
	SIXBIT /DUPSYS/
	SIXBIT /KSC/
	SIXBIT /LSPMAI/
]

IFE MCOND MX,[			; (The KL)
	SIXBIT /.DOVR./
	SIXBIT /.KLFE./
	SIXBIT /KLDCP/
	SIXBIT /KSC/
	SIXBIT /L/
	SIXBIT /MIDAS/
	SIXBIT /UCODE/
;Macsyma-related directories:
	SIXBIT /ALJABR/
	SIXBIT /DEMO/
	SIXBIT /LMMAXQ/
	SIXBIT /MACDOC/
	SIXBIT /MACSYM/
	SIXBIT /MAXDOC/
	SIXBIT /MAXDMP/
	SIXBIT /MAXERR/
	SIXBIT /MAXER1/
	SIXBIT /MAXTUL/
	SIXBIT /MAXOUT/
	SIXBIT /MUNFAS/
	SIXBIT /SHARE/
	SIXBIT /SHARE1/
	SIXBIT /SHARE2/
	SIXBIT /SHAREM/
]

IFE MCOND DM,[
	SIXBIT /%SYS/
	SIXBIT /.BATCH/
	SIXBIT /COMDAT/
	SIXBIT /COMMUD/
	SIXBIT /COMPIL/
	SIXBIT /COMSAV/
	SIXBIT /CPROG/
	SIXBIT /FONTS2/
	SIXBIT /MADMAN/
	SIXBIT /MBPROG/
	SIXBIT /MPROG/
	SIXBIT /MPROG1/
	SIXBIT /MPROG2/
	SIXBIT /MUDBUG/
	SIXBIT /MUDDLE/
	SIXBIT /MUDMAN/
	SIXBIT /MUDSAV/
	SIXBIT /MUDSYS/
	SIXBIT /NCOMPI/
	SIXBIT /NETDOC/
	SIXBIT /R/
	SIXBIT /READER/
	SIXBIT /XFONT/
]

IFE MCOND AIKA,[
	SIXBIT /CNVR/
	SIXBIT /COMLAP/
	SIXBIT /L/
	SIXBIT /LMCONS/
	SIXBIT /LMDOC/
	SIXBIT /MIDAS/
	SIXBIT /PUB/
	SIXBIT /SAIL/
	SIXBIT /VIS/
	SIXBIT /WP/
]

NSDIR==.-SDIR



SUBTTL	DIRS TO BE DISCRIMINATORILY REAPED

BADDY:
	SIXBIT /FOOBAR/
NBADDY==.-BADDY


SUBTTL FILE NAME READER

;THE FOLLOWING ROUTINE GOBBLES INPUT LINES
;FROM THE TTY AND INTERPRETS THEM AS STANDARD MIDAS OR COPY INPUT
;LINES.  EX. TODEV:TOSNM;TOFN1 TOFN2_FMDEV:FMSNM;FMFN1 FMFN2(CR)
;THE ROUTINE KEEPS TYPING FILE= AND WAITS FOR ANOTHER LINE
;UNTIL AN ALTMODE A LONELY CR IS TYPED.  ALL THE TODEV'S  ARE STORED IN A LIST
;CALLED TODEV:.  ALL THE FMFN1'S ARE STORED ON A LIST CALLED FMFN1:
;ETC.  THERE ARE EIGHT LISTS IN ALL.  AN UNSPECIFIED ARGUMENT IN THE
;LINE IS GIVEN THE VALUE OF THE DEFAULT FOR
;THAT SPEC.  A SPECIFIED ARG BECOMES THE DEFAULT FOR THAT SPEC.
;IF THE _ IS OMMITTED, ALL ARGS ARE FM ARGS.
;INITIAL DEFAULT FOR FM NAMES IS DSK:<MSNAME>;* *
;THE ROUTINE EXITS IF THE LAST INPUT LINE OF FM NAMES
;EVALUATES TO *;* *
;TO NAMES UNSPECIFIED IN A LINE ARE SET
;TO FM NAMES OF THE SAME CORRESPONDING TYPE(DEV,SNM,FN1,FN2)

FILGET:	MOVSI D,-LLIST		;NUMBER OF ENTRIES ALLOWED
	SETZM FMDUMP(D)
	AOBJN D,.-1
	MOVSI D,-LLIST
	CAIA
ONEFIL:	 MOVSI D,-1		;ENTRY FOR ONLY ONE SPEC TO BE READ
	MOVSI X,(SIXBIT /DSK/)	;DEFAULT FOR DEV
	MOVE U,MYNAME		;DEFAULT FOR SNAME
	MOVE V,[SIXBIT /*/]	;FIRST FILE NAME DEFAULT
	MOVE W,V		;SECOND FILE NAME DEFAULT
	IRP X,,[TO,FM]
	 IRP Y,,[DEV,SNM,FN1,FN2]
	  SETZM !X!!Y
	  MOVE A,[!X!!Y,,!X!!Y+1]
	  BLT A,!X!!Y+LLIST-1
	  TERMIN
	 TERMIN
TRAGEN:	PRINT FILE=
	SETZM TINDEV
	MOVE A,[TINDEV,,TINSNM]
	BLT A,TINFN2		;SO UNSPECIFIEDS WILL BE 0
	SETOM BARROW		;SAYS NO BACK-ARROW TYPED YET
	PUSHJ P,TYI
	CAIE A,33
	 CAIN A,15
	  JRST TIDONE		;LONELY CR
	PUSHJ P,GETSL1		;READ A SYLLABLE BUT FIRST CHARACTER ALREADY READ
	 JRST TRAGEN		;ENTIRE SYLLABLE RUBBED OUT
	JRST OVER

TGET:	PUSHJ P,GETSYL
	 JRST TRAGEN
OVER:	CAIN TER,":
	 JRST TDEV
	CAIN TER,";
	 JRST TSNM
	CAIN TER,40
	 JUMPE SYM,TGET
	CAIN TER,^F
	 JUMPE SYM,TRRDF	;INDIRECT AND READ FILE TO GET FILE NAMES
	CAIE TER,33
	 CAIN TER,15
	  JUMPE SYM,ENDLIN
	CAIN TER,"_
	 JUMPE SYM,BASET
	SKIPN TINFN1
	 JRST TFN1
	SKIPE TINFN2
	 MOVEI TER,40		;MORE THAN TWO FILE NAMES
	SKIPE TINFN2
	 JRST TOMANY
	MOVEM SYM,TINFN2
	JRST TFNC

TFN1:	MOVEM SYM,TINFN1
	JRST TFNC

TFNC:	CAIN TER,40
	 JRST TGET
	CAIN TER,"_
	 JRST BASET
	CAIN TER,^F
	 JRST TRRDF		;INDIRECT TO READ FILE
ENDLIN:	AOS BARROW		;NO BACKARROW IMPLIES ONLY FM NAMES
	AOS BARROW
	PUSHJ P,DACIT
IRP X,,[DEV,SNM,FN1,FN2]
	SKIPN A,TO!X(D)
	 JRST Z!X
	CAME A,[SIXBIT /*/]
	 JRST NZ!X
Z!X:	MOVE A,FM!X(D)
	MOVEM A,TO!X(D)
NZ!X:
TERMIN
	AOBJN D,.+1
	MOVEI A,0
	CAMN A,TYNSNM
	 CAME A,TYNFN1
	  JRST NOCOM
	CAMN A,TYNFN2
	 JRST TIDONE		;CAN'T ASK FOR MORE THAN THE UNIVERSE !
NOCOM:	CAIN TER,33
	 JRST TIDONE		;ALTMODE MEANS NO MORE LINES TO BE TYPED
	JUMPL D,TRAGEN
	JRST NOMORE		;FILE SPEC BUFFER FULL

TRRDF:	MOVSI A,'DSK
	SKIPN TINDEV
	 MOVEM A,TINDEV
	MOVE A,MYNAME
	SKIPN TINSNM
	 MOVEM A,TINSNM
	AOS TYIPD		;DEPTH IN IOPUSHES ON TYIC
	.IOPUSH TYIC,
	.CALL TRRDFO
	 JRST TRRDFL
	JRST TRAGEN		;CONTINUE PROCESSING FILE SPECS (FROM DISK NOW)

TRRDFL:	PRINT [INDIRECT FILE ERROR; ]
	PUSHJ P,OPINFL
	SOS TYIPD
	.IOPOP TYIC,
	JRST TRAGEN

BASET:	PUSHJ P,DACIT
	AOSE BARROW
	 JRST TOMANY
	SETZM TINDEV
	MOVE A,[TINDEV,,TINSNM]
	SETZM TINDEV
	BLT A,TINFN2
	JRST TGET

NOMORE:	CAIN D,1
	 JRST TIDONE		;DON'T SAY FILE IF ONLY ONE LINE WAS ASKED FOR
	PRINT FILE=
	PUSHJ P,TYI		;PRETEND TO WANT ONE MORE, BUT BARF IF ONE GIVEN
	CAIE A,15
	 JRST TOOMCH
TIDONE:	HRRZM D,LENGTH
	SKIPN LENGTH
	 JRST MLP		;NO ENTRIES
	JRST CRR

;APPLY DEFAULTS TO THE TYPED-IN FILE NAME
DEFINE INITFD AC,DES
	SKIPN E,TYN!DES
	 MOVEM AC,TYN!DES	;SET UNSPECIFIED ARG TO DEFAULT
	CAIE E,0
	 MOVE AC,E		;SET DEFAULT TO SPECIFIED ARG
	CAMN AC,[SIXBIT /*/]
	 SETZM TYN!DES		;ASTERISKS MATCH TO ANYTHING
	CAME AC,[SIXBIT / */]
	 JRST NOAST!AC
	MOVE E,[SIXBIT /*/]
	MOVEM E,TYN!DES		;SPACE * GETS CHANGED TO A REAL ASTERISK
NOAST!AC:
TERMIN

DACIT:	MOVSI B,-4
	MOVE A,[TINDEV,,TYNDEV]
	BLT A,TYNFN2
	SKIPG BARROW
	 JRST ENDLUP
	IRP K,,[X,U,V,W]B,,[DEV,SNM,FN1,FN2]
	 INITFD K,B
	 TERMIN
	MOVSI C,(SIXBIT /DSK/)
	SKIPE A,TYNDEV
	 CAMN A,[SIXBIT /*/]
	  MOVEM C,TYNDEV
ENDLUP:	MOVE A,TYNDEV(B)
	SKIPL BARROW
	 PUSHJ P,FMLST
	SKIPGE BARROW
	 PUSHJ P,TOLST
	AOBJN B,ENDLUP
	POPJ P,

TOOMCH:	PRINT _NO MORE ENTRIES ALLOWED.
QUES:	PRINT SHALL I CONTINUE?
	.RESET TYIC,
	PUSHJ P,TYI
	CAIN A,"Y
	 JRST TIDONE
	CAIN A,"N
	 JRST MLP
	PRINT _TYPE Y FOR YES OR N FOR QUIT._
	JRST QUES

;I HAVE NO IDEA WHETHER THESE DO ANYTHING *******
IRP X,,[TO,FM]
X!LST:	MOVEI C,LLIST
	IMULI C,(B)
	ADDI C,X!DEV(D)
	MOVEM A,(C)
	POPJ P,
TERMIN

IRP X,,[DEV,SNM]
T!X:	SKIPE TIN!X
	 JRST TOMANY
	MOVEM SYM,TIN!X
	JRST TGET
TERMIN

TOMANY:	PRINT UNACCEPTABLE WITH
	CAIN TER,"_
	 JRST NOTWO
	CAIE TER,":
	 CAIN TER,";
	  JRST NOTWO
	PUSHJ P,TYOS
	PRINT THREE FILE NAMES!
	MOVEI TER,0
	CAIA
NOTWO:	 PUSHJ P,TYOS
	CAIE TER,":
	 CAIN TER,";
	  PRINT TWO
	CAIN TER,"_
	 PRINT TWO
	CAIE TER,0
	 PUSHJ P,TYOS
	CAIN TER,";
	 PRINT SNAMES!
	CAIN TER,":
	 PRINT DEVICES!
	CAIN TER,"_
	 PRINT BACKARROWS!
	PUSHJ P,CRR
	JRST TRAGEN
SUBTTL MAGIC ROUTINES TO CALL FROM DDT

;WHO KNOWS WHAT THIS DOES?
TRAN:	SETOM MFDIN
TRAN1:	PUSHJ P,MFDN
	 .VALUE
	SETOM FLNI
	.SUSET [.SSNAM,,USNM]
TRAN2:	PUSHJ P,FNG
	 JRST TRAN1
	.OPEN DSKIN,TRNI
	 JRST TRAN2
	SKIPE LNKFLG
	 JRST TRAN2
	.CALL RDATE
	 JFCL
	SKIPG FDATE
	 JRST TRAN2
	MOVE A,FDATE
	TLO A,110000
	CAML A,TOMDAT
	 SUB A,[2000,,0]
	MOVEM A,FDATE
	.CALL SFDAT1
	 JFCL
	JRST TRAN2

TOMDAT:	0

SFDAT1:	SETZ
	SIXBIT /SFDATE/
	[DSKIN]
	SETZ FDATE

;CONVERT FROM OLD .TAPEn; TAPE nnn FILE FORMAT TO NEW (1975?)
CONV:	MOVE A,TDIRTB
	MOVEM A,USNM
	SETOM FLNI
	.SUSET [.SSNAME,,USNM]
CONV1:	PUSHJ P,FNG
	 .VALUE
	MOVEI A,.BII
	HRLM A,TRNI
	OPEN DSKIN,TRNI
	 .VALUE
	MOVEI B,.BIO
	HRLM B,TRNI
	OPEN DSKOUT,TRNI
	 .VALUE
	HRLM A,TRNI
	.CALL RDATE
	 SETOM FDATE
	.CALL SDATE
	 JFCL
	.CALL SRDT1
	 JFCL
	SETOM USNM
	MOVE A,[-5,,BUF]
	.IOT DSKIN,A
	MOVE A,[-3,,0]
	MOVEM A,BUF+4
	MOVE A,[-5,,BUF]
	.IOT DSKOUT,A
CONV2:	MOVE A,[-5,,BUF]
	.IOT DSKIN,A
	JUMPL A,CONV3
	MOVE A,BUF
	CAME A,USNM
	 PUSHJ P,CONV4
	MOVE A,[-2,,BUF+1]
	.IOT DSKOUT,A
	HRROI A,BUF+4
	.IOT DSKOUT,A
	JRST CONV2

CONV3:	.CLOSE DSKOUT,
	.CLOSE DSKIN,
	JRST CONV1

CONV4:	MOVEM A,USNM
	HRROI A,[0]
	.IOT DSKOUT,A
	HRROI A,USNM
	.IOT DSKOUT,A
	POPJ P,

SRDT1:	SETZ
	SIXBIT /SRDATE/
	[DSKOUT]
	SETZ RFDATE

;ORDMFD$G WILL RUN THRU ALL THE .TAPE. FILES, AND PRODUCE A LIST
;	OF DIRECTORIES WHICH HAVE EVER BEEN DUMPED
;	(THIS IS A FILE OF SIXBIT, UNORDERED)

ORDM1:	-40000,,SBUF	;POINT TO A BUFFER
ORDM2:	-40000,,SBUF	;POINT TO CURRENT END
ORDIR:	0		;NAME OF A TAPE DIR
ORDIRS:	0		;NAME OF SAVED DIR
DIRFLG:	0		;FLAG SAYS THAT NEXT IS A DIR

ORDMFD:	.CORE CORSZB
	 JRST .-1
	MOVE A,[-40000,,SBUF]
	MOVEM A,ORDM1
	MOVEM A,ORDM2
	.SUSET [.RSNAM,,ORDIRS]
	SETOM TDIRN
OM0:	AOS A,TDIRN
	CAIGE A,NTDIR
	 JRST [	MOVE A,TDIRTB(A)
		MOVEM A,ORDIR
		PUSHJ P,OM1
		JRST OM0 ]
	.SUSET [.SSNAM,,ORDIRS]	;RESET SNAM
	OPEN DSKOUT,[SIXBIT /  &DSKDMPMFD>/]
	 .VALUE
	MOVE A,ORDM1
	SUB A,ORDM2	;# WDS IN BUF
	MOVSS A
	HRRI A,ORDM1
	.IOT DSKOUT,A
	.CLOSE DSKOUT,
	.VALUE [ASCIZ /TAPES.SCANNED.FOR.MFD/]

OM1:	SETOM FLNI	;ROUTINE TO SCAN A .TAPE DIR
	.SUSET [.SSNAM,,A]
OM1A:	PUSHJ P,FNG
	 POPJ P,	;END OF DIR
	PUSHJ P,OM2
	JRST OM1A

OM2:	SETOM EOFF	;ROUTINE TO SCAN A .TAPE FILE
	OPEN DSKIN,TRNI
	 .VALUE
	MOVEI B,0
	JSR GWD
	CAME A,[-4,,]	;GOOD HEADER
	 .VALUE
	JSR GWD		;TAPE#
	JSR GWD		;DATE
	JSR GWD		;FLAGS
	JFCL		;JUMPGE A,CPOPJ IF ONLY INCR WANTED
	JSR GWD		;ANOTHER RANDOM
	CAME A,[-3,,]	;MORE GOOD HEADER
	 .VALUE
	JSR GWD		;SHOULD BE FOR A DIR NAME HERE
	CAME A,DIRFLG
	 .VALUE
OM2B:	JSR GWD		;GET DIR NAME		
	PUSHJ P,OMFD	;INSERT NAME IN LIST
OM2C:	JSR GWD		;GET FN1 OR FLAG
	CAMN A,DIRFLG
	 JRST OM2B	;A DIR
	JSR GWD		;WAS FN1, GET FN2
	JSR GWD		;DATE
	JRST OM2C

OMFD:	MOVE C,ORDM2	;PUT A WORD IN LIST (IF UNIQUE)	
	MOVEM A,(C)
	MOVE C,ORDM1	;SEARCH
	CAME A,(C)
	 AOBJN C,.-1
	CAME C,ORDM2	;SKIP IF REACHED END OF LIST
	 POPJ P,	;NOT A NEW NAME
	AOBJP C,[.VALUE] ;REACHED END???
	MOVEM C,ORDM2	;BUMP POINTER NOW
	POPJ P,

;WHO KNOWS WHAT THIS DOES?
ORFIND:	.CORE CORSZB
	 JRST .-1
	SETOM MFDIN
OF1:	PUSHJ P,MFDN
	 .VALUE
	MOVEM A,SCRDIR+2
	.SUSET [.SSNAM,, [SIXBIT /TAPSCR/]]
	OPEN DSKOUT,SCRDIR
	 .VALUE
	SETOM TDIRN
OF1A:	AOS A,TDIRN
	CAIL A,NTDIR
	 JRST OF1	;LOOP FOR ANOTHER NAME
	MOVE A,TDIRTB(A)
	MOVEM A,ORDIR
	PUSHJ P,OF2
	JRST OF1A

SCRDIR:	7,,446353
	SIXBIT /TAPE/
	0

OF2:	SETOM FLNI
	.SUSET [.SSNAM,,A]
OF3:	PUSHJ P,FNG
	 POPJ P,
	SETOM EOFF
	OPEN DSKIN,TRNI
	 .VALUE
	MOVE A,[-5,,BUF]
	.IOT DSKIN,A
	SKIPL BUF+3
	 JRST OF3	;NOT INCREMENTAL
	PUSHJ P,OF4
	JRST OF3

OF4:	MOVEI B,0
	MOVE A,TRNI+2
	MOVEM A,DATA+3
	JSR GWD
OF7:	PUSHJ P,OF5
	 POPJ P,
	JSR GWD
OF6:	MOVEM A,DATA
	JSR GWD
	MOVEM A,DATA+1
	JSR GWD
	MOVEM A,DATA+2
	MOVE A,[-4,,DATA]
	.IOT DSKOUT,A
	JSR GWD
	SKIPN A
	 JRST OF7
	JRST OF6

DATA:	BLOCK 4

OF5:	JSR GWD
	CAMN A,USNM
	 JRST POPJ1
	JRST OF8

OF9:	JSR GWD
	JSR GWD
OF8:	JSR GWD
	SKIPN A
	 JRST OF5
	JRST OF9

;WHO KNOWS WHAT THIS DOES?
OFSORT:	.CORE CORSZB
	 JRST .-1
	SETOM FLNI
	.SUSET [.SSNAM,,[SIXBIT /TAPSCR/]]
OFS1:	PUSHJ P,FNG
	 .VALUE
	MOVE A,[-40000,,SBUF]
	MOVEI B,.BII
	HRLM B,TRNI
	OPEN DSKIN,TRNI
	 .VALUE
	.IOT DSKIN,A
	SKIPL A
	 .VALUE
	MOVEM A,SORTAS
	HRRZ C,A
	HRRZI A,SBUF
	MOVEI D,4
	MOVEI N,0
	SETZM (C)
	PUSHJ P,SORT
	MOVEI A,SBUF
	MOVEI N,1
	MOVE C,A
OFS2:	SKIPN B,(A)
	 JRST OFS4
OFS3:	ADDI C,4
	CAMN B,(C)
	 JRST OFS3
	PUSHJ P,SORT
	JRST OFS2

OFS4:	MOVEI A,100007		;WRITE-OVER BLOCK IMAGE OUTPUT MODE
	HRLM A,TRNI
	.CLOSE DSKIN,
	OPEN DSKOUT,TRNI
	 .VALUE
	.ACCESS DSKOUT,[0]
	MOVE A,[-40000,,SBUF]
	HLLZ B,SORTAS
	SUB A,B
	.IOT DSKOUT,A
	.CLOSE DSKOUT,
	JRST OFS1

OUTNAM:	.CORE CORSZB
	 JRST .-1
	MOVE B,[440600,,A]
	MOVSI C,-6
OUTNM1:	ILDB D,B
	ADDI D,40
	PUSHJ P,OUTASC
	AOBJN C,OUTNM1
	POPJ P,

OUTNUM:	MOVE B,[440600,,A]
	MOVSI C,-3
OUTNU1:	ILDB D,B
	ADDI D,40
	PUSHJ P,OUTASC
	AOBJN C,OUTNM1
	POPJ P,

OUTDAT:	MOVE B,[270400,,A]
	MOVEI D,"0
	LDB C,B
	CAIL C,10.
	 MOVEI D,"1
	PUSHJ P,OUTASC
	CAIL C,10.
	 SUBI C,10.
	ADDI C,"0
	MOVE D,C
	PUSHJ P,OUTASC
	MOVEI D,"/
	PUSHJ P,OUTASC
	MOVE B,[220500,,A]
	LDB B,B
	IDIVI B,10.
	ADDI B,"0
	MOVE D,B
	PUSHJ P,OUTASC
	ADDI C,"0
	MOVE D,C
	PUSHJ P,OUTASC
	MOVEI D,"/
	PUSHJ P,OUTASC
	MOVE B,[330700,,A]
	LDB B,B
	CAIGE B,72.
	 ADDI B,72.
	IDIVI B,10.
	ADDI B,"0
	MOVE D,B
	PUSHJ P,OUTASC
	ADDI C,"0
	MOVE D,C
	PUSHJ P,OUTASC
	POPJ P,

OUTCR:	MOVEI D,15
	PUSHJ P,OUTASC
	MOVEI D,12
	JRST OUTASC

OUTSPC:	MOVEI D," 
	JRST OUTASC

OUT4SP:	MOVEI D," 
	MOVSI B,-4
	PUSHJ P,OUTASC
	AOBJN B,.-1
	POPJ P,

OUTASC:	MOVE U,ASCBP
	CAMN U,[010700,,BUF+2000-1]
	 PUSHJ P,OUTBLK
	IDPB D,ASCBP
	POPJ P,

OUTBLK:	MOVE U,[-2000,,BUF]
	.IOT DSKOUT,U
	MOVE U,[440700,,BUF]
	MOVEM U,ASCBP
	POPJ P,

ASCBP:	440700,,BUF

CONASC:	.CORE CORSZB
	 JRST .-1
	SETOM FLNI
CONAS1:	.SUSET [.SSNAM,,[SIXBIT /TAPSCR/]]
	PUSHJ P,FNG
	 .VALUE
	MOVEI A,.BII
	HRLM A,TRNI
	OPEN DSKIN,TRNI
	 .VALUE
	.SUSET [.SSNAM,,[SIXBIT /TAPASC/]]
	MOVEI A,.BIO
	HRLM A,TRNI
	OPEN DSKOUT,TRNI
	 .VALUE
	MOVE A,[440700,,BUF]
	MOVEM A,ASCBP
	MOVE A,[-40000,,SBUF]
	.IOT DSKIN,A
	MOVEM A,SORTAS
	HRRZS A
	SUBI A,SBUF
	IDIVI A,4
	MOVEM A,NUMENT
	MOVEI X,SBUF
CONAS2:	MOVE A,NUMENT
	ADDI A,3
	IDIVI A,4
	SETZM FUDGE+2
	SETZM FUDGE+3
	CAILE A,57
	 JRST CONAS6
	MOVEI C,4
	CAIN B,0
	 MOVEM C,FUDGE+2
	CAIN B,1
	 MOVEM C,FUDGE+3
	MOVEI C,8
	CAIN B,0
	 MOVEM C,FUDGE+3
CONAS6:	CAIL A,57.
	 MOVEI A,57.
	MOVEM A,LINPAG
CONAS3:	MOVNI V,(A)
	HRLZS V
CONAS4:	MOVSI W,-4
CONAS5:	MOVE E,LINPAG
	IMULI E,4
	IMULI E,(W)
	ADD E,X
	SUB E,FUDGE(W)
	MOVE A,(E)
	PUSHJ P,OUTNAM
	PUSHJ P,OUTSPC
	MOVE A,(E)1
	PUSHJ P,OUTNAM
	PUSHJ P,OUTSPC
	MOVE A,(E)2
	PUSHJ P,OUTDAT
	PUSHJ P,OUTSPC
	MOVE A,(E)3
	PUSHJ P,OUTNUM
	CAME W,[-1,,3]
	 PUSHJ P,OUT4SP
	CAMN W,[-1,,3]
	 PUSHJ P,OUTCR
	SOSN NUMENT
	 JRST ASCEOF
	AOBJN W,CONAS5
	ADDI X,4
	AOBJN V,CONAS4
	MOVEI D,^L
	PUSHJ P,OUTASC
	MOVE D,LINPAG
	IMULI D,12.
	ADD X,D
	JRST CONAS2

FUDGE:	0
	0
	0
	0

ASCEOF:	MOVEI D,3
ASCEF1:	PUSHJ P,OUTASC
	HLRZ A,ASCBP
	CAIE A,10700
	 JRST ASCEF1
	HRRZ A,ASCBP
	ADDI A,1
	SUBI A,BUF
	MOVNS A
	HRLZS A
	HRRI A,BUF
	.IOT DSKOUT,A
	.CLOSE DSKOUT,
	JRST CONAS1

NUMENT:	0
LINPAG:	0

LNKBL:	200000,,446353
	BLOCK 4
	SIXBIT /TAPASC/
LNKSNM:	SIXBIT /.LPTR./

OFMLNK:	SETOM FLNI
	.SUSET [.SSNAM,,[SIXBIT /TAPASC/]]
ML1:	PUSHJ P,FNG
	 .VALUE
	.SUSET [.SSNAM,,LNKSNM]
	MOVE A,FN1
	MOVEM A,LNKBL+1
	MOVEM A,LNKBL+3
	MOVE A,FN2
	MOVEM A,LNKBL+2
	MOVEM A,LNKBL+4
	.OPEN DSKIN,LNKBL
	 .VALUE
	JRST ML1

;CHECK FOR CLOBBERED FILES (CONTAIN 'CLBWRD')
CHECCL:	.CORE CORSZB
	 JRST .-1
	SETOM MFDIN
	PUSHJ P,DEVGET
CHECL1:	PUSHJ P,MFDN
	 JRST RET
	SETOM FLNI
	.SUSET [.SSNAM,,USNM]
CHSNM:	PUSHJ P,FNG
	 JRST CHECL1
	SKIPE LNKFLG
	 JRST CHSNM
	HRRI A,.BII
	HRLM A,TRNI
	OPEN DSKIN,TRNI
	 JRST CHSNM
CHSNM1:	MOVE A,[-40000,,SORTAS]
	.IOT DSKIN,A
	PUSH P,A
	HLLZS A
	MOVE B,[-40000,,0]
	SUB B,A
	HRRI B,SORTAS
	MOVE C,CLBWRD
CHSNM4:	MOVE D,(B)
	TLZ D,770000
	CAME C,D
	 JRST CHSNM2
CHSNM3:	POP P,A
	JUMPL B,CLBFL
	JUMPGE A,CHSNM1
	.CLOSE DSKIN,
	JRST CHSNM

CHSNM2:	ADD B,[1777,,1777]
	AOBJN B,CHSNM4
	JRST CHSNM3

CLBFL:	PSIS USNM
	PSIS FN1
	PSIS FN2
	PDPT PACKN
	.CALL RDATE
	 JFCL
	MOVE A,FDATE
	MOVEM A,DAYTIM
	PASC [ASCIZ /	/]
	PUSHJ P,PFDATE
	.CLOSE DSKIN,
	PUSHJ P,CRR
	JRST CHSNM

CLBWRD:	600,,3			;USUAL WORD FILES GET CLOBBERED WITH

;MORE CHECKING FOR CLOBBERED FILES

DIRSO:	SIXBIT /  &DSKWALL  BIN  /

FBLK:	.CORE CORSZB
	 JRST .-1
	.SUSET [.SSNAM,, [SIXBIT /SEC/]]
	.OPEN 15,DIRSO
	 .VALUE
	PUSHJ P,DEVGET
FBLK1:	PUSHJ P,SFNG
	 .VALUE
FBLK5:	.OPEN UFDCH,FNO
	 .VALUE
	MOVE A,[-2000,,FDIRBF]
	.IOT UFDCH,A
	MOVEI A,.BII
	HRLM A,TRNI
	OPEN DSKIN,TRNI
	 JRST FBLK1
	MOVNI A,3
	MOVEM A,BLKOFS
FBLK2:	MOVE A,[-6000,,SORTAS]
	.IOT DSKIN,A
	AOS BLKOFS
	AOS BLKOFS
	AOS BLKOFS
	PUSH P,A
	HLLZS A
	MOVE B,[-6000,,0]
	SUB B,A
	HRRI B,SORTAS
	MOVE C,CLBWRD
FBLK3:	CAMN C,(B)
	 JRST FBLK4
	ADD B,[1777,,1777]
	AOBJN B,FBLK3
	POP P,A
	JUMPGE A,FBLK2
	.CLOSE DSKIN,
	JRST FBLK1


SFNG:	MOVE A,[-1,,USNM]
	.IOT 15,A
	JUMPL A,CPOPJ
	SKIPN USNM
	 POPJ P,
	.SUSET [.SSNAM,,USNM]
	MOVE A,[-2,,FN1]
	.IOT 15,A
	JRST POPJ1

FBLK4:	POP P,A
	PUSHJ P,CRR
	PSIS USNM
	PSIS FN1
	PSIS FN2
	HRRZS B
	SUBI B,SORTAS
	IDIVI B,2000
	ADD B,BLKOFS
	PUSHJ P,DELBLK
	PUSHJ P,FTRK
	PDPT A
	JRST FBLK5

DELBLK:	PUSH P,B
	IMULI B,2000
	MOVEI C,100007		;WRITE-OVER BLOCK IMAGE OUTPUT
	HRLM C,TRNI
	.OPEN DSKIN,TRNI
	 .VALUE
	.ACCESS DSKIN,B
	SETZM BUF		;CLOBBER WITH ZERO
	MOVE C,[BUF,,BUF+1]
	BLT C,BUF+1777
	MOVE C,[-2000,,BUF]
	.IOT DSKIN,C
	.CLOSE DSKIN,
	POP P,B
	MOVEI C,.BII
	HRLM C,TRNI
	POPJ P,

FTRK:	MOVE A,FDIRBF+1
	MOVEI A,FDIRBF(A)
FTRK1:	MOVE C,(A)
	CAME C,FN1
	 JRST FTRK3
	MOVE C,1(A)
	CAME C,FN2
	 JRST FTRK3
	LDB C,[150500,,2(A)]
	PDPT C
	LDB C,[UNDSCP +2(A)]
	IDIVI C,6
	MOVE D,BTB(D)
	ADDI D,FDIRBF+11.(C)
	SETOM A
FTRK2:	ILDB C,D
	TRZE C,40
	 JRST FTRKL
	CAILE C,12.
	 JRST FTRKS
FTRKN:	AOS A
	SOSGE B
	 POPJ P,
	SOSLE C
	 JRST FTRKN
	JRST FTRK2

FTRKS:	SUBI C,11.
	ADD A,C
	SOSGE B
	 POPJ P,
	JRST FTRK2

FTRKL:	TRZ C,20
	SETZM A
	DPB C,[140600,,A]
	ILDB C,D
	DPB C,[60600,,A]
	ILDB C,D
	DPB C,[600,,A]
	SOSGE B
	 POPJ P,
	JRST FTRK2

BLKOFS:	0
BTB:	440600,,
	360600,,
	300600,,
	220600,,
	140600,,
	060600,,

FTRK3:	ADDI A,5
	CAIGE A,FDIRBF+1777
	 JRST FTRK1
	SETOM A
	POPJ P,

;FIND PROBLEMS WITH CONVERTING TO NEW (1975?) .TAPEn; TAPE nnn FILE FORMAT
FNDCON:	.CORE CORSZB
	 JRST .-1
	MOVSI V,-NTDIR
FNDCO1:	MOVE B,TDIRTB(V)
	SETOM FLNI
	.SUSET [.SSNAM,,B]
FNDCO2:	PUSHJ P,FNG
	 JRST FNDCO3
	MOVEI B,.BII
	HRLM B,TRNI
	OPEN DSKIN,TRNI
	 JRST FNDCO2
	.CALL FILLEN
	 .VALUE
	SKIPN A,LENGTH
	 JRST FNDCO2
	.CALL FILBLK
	 .VALUE
	MOVNS A
	HRLS A
	HRRI A,SBUF
	.IOT DSKIN,A
	MOVSI B,-10.
FNDCOX:	SETZM (A)
	AOS A
	AOBJN B,FNDCOX
	MOVE A,SBUF
	CAME A,[-4,,0]
	 JRST FNDCO2		;NOT A GOOD TAPE
	MOVEI C,5		;C WILL BE A POINTER INTO TAPE
FCLOOP:	CAML C,LENGTH
	 JRST FNDCO4
	MOVE A,SBUF(C)
	CAME A,[-1]
	 JRST FCL1		;REGULAR FILE
	MOVE A,SBUF+4(C)	;DATE OF NEXT FILE IF SNAME CHANGE
	CAMN A,[-1]
	 JRST FCL3
	LSH A,-27.
	CAIG A,2		;OLD DATE
	 JRST FCL3
	CAIL A,71.
	 CAILE A,76.
	  JRST FCL2
FCL3:	SETZM SBUF(C)
	ADDI C,2
	JRST FCLOOP

FCL1:	ADDI C,3
	JRST FCLOOP

FCL2:	MOVE A,SBUF+1(C)
	PSIS A
	JRST FCL1

FNDCO3:	AOBJN V,FNDCO1
	JRST RET

FNDCO4:	.CLOSE DSKIN,
	MOVEI A,100007		;WRITE-OVER BLOCK IMAGE OUTPUT MODE
	HRLM A,TRNI
	OPEN DSKOUT,TRNI
	 .VALUE
	.CALL SDATE
	 .VALUE
	.CALL SRDT
	 .VALUE
	MOVN A,LENGTH
	HRLS A
	HRRI A,SBUF
	.IOT DSKOUT,A
	.CLOSE DSKOUT,
	JRST FNDCO2

;CONVERT OLD SYSENG;MACRO TAPES FORMAT TO NEW

TFCONV:	.SUSET [.SSNAME,,SPLACE]
	MOVEI A,.BII
	HRLM A,STATOP
	OPEN DSKIN,STATOP
	 JRST RET
	MOVEI A,.BIO
	HRLM A,STATOP
	OPEN DSKOUT,STATOP
	 JRST RET
	SKIPE WRONG
	 DIE Cannot access MACRO TAPES file because this version of DUMP is for the wrong machine
	MOVEI B,MAXTAP
TFCNV1:	MOVE A,[-10.,,BUF]	; Currently TPINFL=10. (1/17/86)
	.IOT DSKIN,A
	JUMPL A,TFCNV2
	MOVE A,[-TPINFL,,BUF]
	.IOT DSKOUT,A
	SOJG B,TFCNV1
TFCNV2:	SETZM BUF
TFCNV3:	MOVE A,[-TPINFL,,BUF]
	.IOT DSKOUT,A
	SOJG B,TFCNV3
	.CLOSE DSKIN,
	.CLOSE DSKOUT,
	.BREAK 16,
SUBTTL 'FIND', 'OFIND', and 'DFIND' COMMANDS

;CODE TO FIND FILES BASED ON DSK:.TAPEX; DIRECTORIES REWRITTEN 12/8/77 BY PDL
; TO READ ALL DIRECTORIES AND SORT TAPE FILES BY CREATION DATE BEFORE
; SEARCHING.  MOST RECENTLY DUMPED FILES ARE THEREFORE SEEN FIRST.

; DEDDEV, DDIRTB, NDDIR

DFIND:	PRINT [ _FILES FOR ]
	SIXTYP DEDITS
	PRINT [ WHICH ARE STORED ON ]
	SIXTYP DEDDEV
	PRINT _
	SETZM OFINDF	;SAY WE ARE CHECKING FROM DISK.
	SETOM DFINDF	;SAY THIS IS FOR A DECEASED ITS.
	JRST AFIND1	

OFIND:	SETOM OFINDF	;DO A FIND FROM A TAPE INSTEAD OF .TAPEn
	SKIPA		;THE TAPE CONTAINS .TAPEn; TAPE nnn FILES, 
			; NOT USER FILES!
AFIND:	 SETZM OFINDF	;DOING A REGULAR FIND
	SETZM DFINDF	;FROM A LIVE ITS
AFIND1:	MOVSI A,-NFIGS
	CLEARM @FIGTB2(A)
	AOBJN A,.-1
	PUSHJ P,FILGET		;WHAT SHOULD I FIND?
	PUSHJ P,DEVGET		;WHERE SHOULD I LIST THEM?
	SKIPE OFINDF
	 JRST FLOOP1
;HERE FIND FROM DISK
	.CORE CORSZB
	 JRST .-1
	MOVEI C,SBUF		;HUGE BUFFER AT END OF CORE

	MOVSI V,-NTDIR		;ONCE FOR EACH TAPE DIRECTORY POSSIBLY ON DISK
	SKIPE DFINDF		;IF THIS IS FOR A DECEASED ITS
	 MOVSI V,-NDDIR		;  USE DIFFERENT DIRECTORIES.

FLOOP:	SKIPE DFINDF
	 JRST [	SYSCAL OPEN,[%CLBIT,,.BII ? %CLIMM,,UFDCH
			DEDDEV ? [SIXBIT /.FILE./] ? [SIXBIT /(DIR)/]
			DDIRTB(V)]
		 JRST NEXDIR
		JRST FLSNRF]
	SYSCAL OPEN,[%CLBIT,,.BII ? %CLIMM,,UFDCH
		[SIXBIT /DSK/] ? [SIXBIT /.FILE./] ? [SIXBIT /(DIR)/]
		TDIRTB(V)]
	 JRST NEXDIR	;DIR PROBABLY DOESNT EXIST
FLSNRF:	MOVE A,[-2000,,FDIRBF]
	.IOT UFDCH,A		;SNARF DIR
	.CLOSE A,

	MOVE A,FDIRBF+UDNAMP	;PROCESS THE DIR, MAKING A LIST OF TAPE FILES IN SBUF
	ADDI A,FDIRBF		;A POINTS TO BEGINNING OF NAME AREA
FINDNM:	CAILE A,FDIRBF+1777-4
	 JRST NEXDIR		;END OF NAME AREA
	SKIPE W,(A)		;EMPTY SLOT
	 CAME W,[SIXBIT /TAPE/]	;KEEP ONLY "TAPE XXX" FILES
	  JRST FNDNEX
	MOVE B,UNRNDM(A)
	TLNN B,UNLINK		;IGNORE FILES IN USE AND OTHER CHIMERAS
	 TLNE B,UNIGFL
	  JRST FNDNEX		; FILE IS LINK, OPEN FOR WRITING OR BEING DELETED
	MOVEM W,(C)		;FIRST NAME
	MOVE W,1(A)
	MOVEM W,1(C)		;SECOND NAME
	MOVE W,TDIRTB(V)
	MOVEM W,2(C)		;TAPE DIR NAME (FOR USE IN OPEN LATER)
	MOVE W,3(A)
	MOVEM W,3(C)		;CREATION DATE
	HLRZ W,4(A)		;REFERENCE DATE (NOT REALLY USED IN FIND)
	SKIPN W
	 MOVEI W,177777
	ANDI W,177777
	MOVSM W,4(C)
	ADDI C,LUNBLK		;MOVE TO NEXT NAME ENTRY IN OUTPUT BUFFER
FNDNEX:	ADDI A,5		;MOVE TO NEXT ENTRY IN DIRECTORY
	JRST FINDNM
NEXDIR:	AOBJN V,FLOOP		;MOVE TO NEXT DIR IN .TAPE* LIST
	MOVEM C,LFDIR		;LAST ENTRY ADDED TO LIST

;NOW SORT ACCUMULATED FILE POINTERS BY CREATION DATE
	MOVEI A,SBUF		;SORT BETWEEN SBUF AND C(LFDIR)
	MOVEI N,3		; THIRD ELEMENT IS SORT KEY (CDATE)
	MOVEI D,LUNBLK		; ENTRIES ARE NAME PTRS
	PUSHJ P,SORTDN		; SORT IN DESCENDING ORDER

	MOVEI A,SBUF
	MOVEM A,DIRIDX		;POINTER TO TAPE FILE WE ARE WORKING ON
NEXFL1:	PUSHJ P,NEXTAP		;SET UP FILE OPEN BLOCK
	 JRST CRR		; NO MORE TAPES TO LOOK AT
	PUSHJ P,NEXFL3		;PROCESS TAPE FILE
	JRST NEXFL1

NEXTAP:	MOVE A,DIRIDX		;ROUTINE TO SET UP OPEN BLOCK FOR TAPE FILE SEARCH
	SKIPN B,(A)
	 POPJ P,		;NO MORE FILES
	MOVEM B,FN1
	MOVE B,1(A)
	MOVEM B,FN2
	MOVE B,2(A)
	.SUSET [.SSNAM,,B]
	ADDI A,LUNBLK
	MOVEM A,DIRIDX
	AOS (P)
	POPJ P,

;FIND FROM TAPE FILES DUMPED TO MAG TAPE
; USES SAME SEARCHING CODE ONCE FILE IS "OPEN", BUT IS OTHERWISE
; COMPLETELY SEPARATE FROM REGULAR FIND COMMAND
FLOOP1:	PUSHJ P,MAGOP		;READ TAPE
	 JRST FLOOP2
	MOVE A,HFN1
	MOVEM A,FN1
	MOVE A,HFN2
	MOVEM A,FN2
	PUSHJ P,NEXFL5		;PROCESS THIS FILE NAME
	PUSHJ P,FILSKP		;SKIP FILE
	JRST FLOOP1

FLOOP2:	PUSHJ P,ARWND		;REWIND TAPE AND EXIT
	JRST CRR

;HERE FOR EACH TAPE DIRECTORY ON DISK OR TAPE
NEXFL3:	SKIPE DFINDF
	 JRST [	SYSCAL OPEN,[%CLBIT,,.BII ? %CLIMM,,DSKIN
			DEDDEV ? FN1 ? FN2 ? SNAME]
		 JRST RET
		JRST NEXFL5 ]
	OPEN DSKIN,TRNI		;OPEN TAPE DIRECTORY
	 JRST RET

NEXFL5:	SETOM EOFF
	MOVEI B,0		;SO THAT GWD WILL .IOT IMMEDIATELY THE FIRST TIME THROUGH
	JSR GWDF
	MOVE C,A
	JSR GWDF
	AOBJN C,.-1		;SKIP TAPE HEADER
	MOVE C,A
	SETZM FILN
COMPR:	JSR GWDF
	SKIPN A
	 JRST FNDSSN
	AOS FILN
	MOVEM A,PFF1
	 JSR GWDF
	MOVEM A,PFF2
	ADD C,[2,,2]		;WE JUST READ TWO WORDS
	MOVE W,LENGTH
	IMUL W,[-1,,]
COMCON:	SKIPN D,FMSNM(W)
	 JRST COMFN1		;ZERO MATCHES TO ANYTHING
	CAME D,PSNAM
	 JRST NEXCOM		;NO MATCH
COMFN1:	SKIPN D,FMFN1(W)
	 JRST COMFN2
	CAME D,PFF1
	 JRST NEXCOM
COMFN2:	SKIPE D,FMFN2(W)
	 CAMN D,PFF2
	  JRST MATCH
NEXCOM:	AOBJN W,COMCON
NEXNAM:	JUMPGE C,INITC		;ALREADY CORRECT PLACE
	JSR GWDF
	AOBJN C,.-1		;GET TO BEGINNING OF NEXT ENTRY
INITC:	IMUL C,[-1,,]
	JRST COMPR

FNDSSN:	JSR GWDF
	MOVEM A,PSNAM
	JRST COMPR

;HERE WHEN THE FILE NAME MATCHES, LIST THIS ONE.
MATCH:	JSR GWDF		;READ DATE AND TIME
	PUSH P,B
	MOVEM A,DAYTIM
	ADD C,[1,,1]
	PUSHJ P,CRR
	PSIS FN1
	PSIS FN2
	PSIS PSNAM
	PSIS PFF1
	PSIS PFF2
	PDPT FILN
	PASC [ASCIZ / /]
	PUSHJ P,PFDATE
	POP P,B
	JRST NEXNAM

PFDATE:	MOVE A,DAYTIM		;PRINTS CONTENTS OF DAYTIM AS FILE CREATION DATE AND TIME
	AOJE A,NODATE
	CAMN A,[SETZ]
	 JRST LDATE
	LDB A,[270400,,DAYTIM]	;CREATION DATE AND TIME
	PUSHJ P,DPT		;PRINT MONTH
	PASC [ASCIZ \/\]
	LDB A,[220500,,DAYTIM]
	PUSHJ P,DPT		;PRINT DAY
	PASC [ASCIZ \/\]
	LDB A,[330700,,DAYTIM]
	PUSHJ P,DPT
	HRRZ A,DAYTIM	; TIME
	PASC [ASCIZ / /]
	IDIVI A,60.*60.*2	;HALF SECONDS IN AN HOUR
	PUSHJ P,DDPA		;PRINT HOURS
	PRINT :
	MOVE A,B
	IDIVI A,60.*2		;HALF SECONDS IN A MINUTE
	PUSHJ P,DDPA		;PRINT MINUTES
	PRINT :
	MOVE A,B
	IDIVI A,2		;HALF SECONDS IN A SECOND
	PUSHJ P,DDPA		;PRINT SECONDS
	CAIE B,0		;RG MEMORIAL (?) HALF SECOND OF SILENCE
	 PRINT .5
	POPJ P,

NODATE:	PRINT -
	POPJ P,

LDATE:	PRINT L
	POPJ P,

DDPA:	CAIGE A,10.		;SHOULD WE PRINT A '0' AS IN 4:07?
	 PRINT 0
	PUSH P,B
	PUSHJ P,DPT
	POP P,B
	POPJ P,

GWD:	0
GWD1:	MOVE A,(B)		;THIS ROUTINE READS ONE WORD, BUT ASSUMES BLOCK INPUT
	AOBJN B,[JRST @GWD]	;NO NEED TO READ FROM DISK YET(MORE IN BUFFER)
	SKIPL EOFF
	 JRST CPOPJ		;END OF FILE, RETURN FROM CALLER!!!!
	MOVE B,[-2000,,BUF]
	.IOT DSKIN,B
	SUBI B,BUF-1		;SO ONE WORD BUFFER WILL WIN
	MOVNS B
	HRLS B
	HRRI B,BUF
	CAME B,[-2000-1,,BUF]	;FULL BUFFER?
	 AOS EOFF		;NO, MUST BE LAST BUFFER IN FILE
	JRST GWD1		;NOW GET THE WORD

GWDF:	0			;FOR FIND, GWD FROM DISK OR TAPE
	SKIPN OFINDF
	 JRST GWDFD
GWDFM:	JSR MGWD
	JRST @GWDF

GWDFD:	JSR GWD
	JRST @GWDF

MGWD:	0
MGWD1:	MOVE A,(B)		;THIS ROUTINE READS ONE WORD, BUT ASSUMES BLOCK INPUT
	AOBJN B,[JRST @MGWD]	;NO NEED TO READ FROM DISK YET(MORE IN BUFFER)
	SKIPL EOFF
	 JRST CPOPJ		;END OF FILE
	MOVE A,[-2000,,BUF]
	PUSHJ P,MAGREAD
	 JRST FILSKP		;ERROR, SKIP TO END OF FILE AND CONTINUE
	MOVE B,A
	SUBI B,BUF-1		;SO ONE WORD BUFFER WILL WIN
	MOVNS B
	HRLS B
	HRRI B,BUF
	CAME B,[-2000-1,,BUF]	;FULL BUFFER?
	 AOS EOFF		;NO, MUST BE LAST BUFFER IN FILE
	JRST MGWD1		;NOW GET THE WORD
SUBTTL MISCELLANEOUS MAGTAPE OPERATIONS

;CLOSE MAGOUT, WRITE LOGICAL EOT ON TAPE
CLSOUT:	SKIPL TAPTYP
	 JRST [	.CLOSE MAGOUT,	;CLOSE TAPE OUTPUT
		POPJ P, ]
	PUSHJ P,RMTEOF		;Write a second EOF mark
	SETOM CTRLG		;Defer ^G
	PUSHJ P,RTAPE"FINISH	;Make sure all output was completed
	 JRST RMTWER		;Tape error
	JRST CTRLGX		;Don't close RTAPE server yet

;WRITE EOF,MAGOUT ASUMED OPEN
AEOF:	SKIPGE TAPTYP
	 JRST RMTEOF
	MOVEI A,5
	MOVEM A,MTCMD
	MOVE A,[MAGOUT,,MTCMD]
	.MTAPE A,
	 JRST NAUGHT
	POPJ P,

RMTEOF:	SETOM CTRLG
	PUSHJ P,RTAPE"WRTFM	;Write file mark
	JRST CTRLGX

;SPACE TO LOGICAL END OF TAPE
AEOT:	MOVEI A,10
	PUSHJ P,TAPOPR
	SETOM EOTFLG
	SETOM UFDDAT
	SETOM MFDDAT
	CLEARM ITAPE
	POPJ P,

;SPACE REVERSE FILE
SPRF:	MOVE A,[-1,,7]
	JRST TAPOPR

;SPACE FORWARD FILE
SPFF:	MOVEI A,7
	JRST TAPOPR

;REWIND
ARWND:	SKIPA B,[1]		;SKIPS THROUGH

;REWIND THEN UNLOAD
AUNLD:	 MOVEI B,2
	SETOM ITAPE
	SETOM UFDDAT
	SETOM MFDDAT
	SKIPL A,THTPN
	 MOVEM A,LTHTPN
	SETOM THTPN
	MOVE A,B
	PUSHJ P,TAPOPR
	CLEARM EOTFLG
	POPJ P,

;PERFORM A TAPE OPERATION, COMMAND CODE IN A
TAPOPR:	SKIPGE TAPTYP
	 JRST RMTOPR
LCLOPR:	OPEN MAGIN,MAGI
	 JRST RET
	MOVEM A,MTCMD
	MOVE A,[MAGIN,,MTCMD]
	.MTAPE A,
	 JRST NAUGHT
	.CLOSE MAGIN,
	POPJ P,

;This just initiates the operation
;Call SETIT1 if you want to know if it worked
RMTOPR:	PUSH P,B
	PUSH P,C
	PUSH P,D
	PUSH P,A
	PUSHJ P,SETIT1		;Terminate any pending read-ahead
	POP P,A
	SETOM CTRLG
	XCT RMTDIS(A)
	POP P,D
	POP P,C
	POP P,B
	JRST CTRLGX

RMTDIS:	.VALUE
	PUSHJ P,RTAPE"REWIND
	PUSHJ P,RTAPE"UNLOAD
REPEAT 4,.VALUE
	PUSHJ P,[ HLRE B,A	;7 space file
		  JRST RTAPE"SKPFL0 ]
	PUSHJ P,[ MOVSI B,20000	;10 space to eot
		  JRST RTAPE"SKPFL0 ]

;ROUTINE TO DETERMINE WHETHER USER IS SURE
CHECK:	PUSH P,LPTSW
	SETZM LPTSW
	PUSHJ P,CRR
	PRINT  ARE YOU SURE ? 
CHECK2:	PUSHJ P,TYI
	CAIE A,"Y
	 JRST ERR
	PUSHJ P,CRR
	POP P,LPTSW
	POPJ P,

;Show who used tape drive last.  Put this on .TAPE0.  That's ok,
;since FIND ignores files that aren't "TAPE XXX."
SETITN:	.suset [.runame,,a]
	.rdate d,
	.call [setz
		sixbit /MLINK/
		[sixbit /DSK/]
		[sixbit /LAST/]
		[sixbit /USE/]
		[sixbit /.TAPE0/]
		COMT(B)		;which command
		D		;when
		SETZ A]		;who
	  jfcl
;Drops in.		
;SET ITAPE ROUTINE
;Call here first time tape is used
SETIT:	SKIPE TAPTYP		;Do we know what type of drive to use?
	 JRST SETIT0		;Yes
	.OPEN MAGIN,MAGI	;No, see if there is a local drive
	 JRST [	.SUSET [.RIOS+MAGIN,,A]
		LDB A,[220600,,A]
		CAIE A,%ENSDV
		 JRST .+1
		SETOM TAPTYP	;Use remote drive
		JRST SETIT0 ]
	AOS TAPTYP		;Default is local drive if it exists
SETIT0:	PUSHJ P,SETIT1		;Get tape status in A and in TAPEF
	TRNN A,TF%BOT		;Check for BOT
	 POPJ P,		;No
	SETOM ITAPE		;Yes, at BOT
	SETOM UFDDAT
	SETOM MFDDAT
	POPJ P,

SETIT1:	SKIPGE A,TAPTYP		;Remote tape?
	 JRST SETIT2		;Yes
SETIT4:	OPEN MAGIN,MAGI		;WAIT FOR ALL TAPE ACTIVITY TO STOP
	 JRST RET		;BARF
IFN NEWCOD, .STATUS MAGIN,TAPEF	
	.CLOSE MAGIN,
IFE NEWCOD, CONI 344,TAPEF	;READ MAG TAPE STATUS
	MOVE A,TAPEF
	POPJ P,

;Mount remote tape if not already mounted
SETIT2:	PUSHJ P,RTAPE"RDRST	;Reset read and write buffers, stop readahead
	AOJL A,RMTSTS		;Jump if already mounted
	PUSH P,B
	PUSH P,C
	PUSH P,D
	PUSH P,E
	PUSH P,N
	PUSH P,SYM
	PUSH P,TER
	SKIPE TAPHST		;Host known yet?
	 JRST SETIT3
	PRINT TAPE SERVER HOST=
	PUSHJ P,GETSYL
	 JRST ERR
	PUSH P,SYM
	PRINT DRIVE=
	PUSHJ P,GETSYL
	 JRST ERR
	MOVE B,[440700,,TAPDRV]
	PUSHJ P,SIXTO7
	POP P,SYM
	MOVE B,[440700,,TAPHST]
	PUSHJ P,SIXTO7
	PRINT [READ-ONLY? ]	;HT server insists
	PUSHJ P,TYI
	MOVE SYM,[ASCII/BOTH/]
	CAIN A,"Y
	 MOVE SYM,[ASCII/READ/]
	MOVEM SYM,TAPDIR
	PUSHJ P,CRR
SETIT3:	MOVEI A,TAPHST
	MOVEI B,CORSZB_10.
	MOVEI C,TAPDRV
	MOVEI D,TAPDIR
	SETOM CTRLG
	PUSHJ P,RTAPE"OPEN
	 JRST [ SETZM LPTSW
		PRINT [Remote mount failed: ]
		PASC RTAPE"STATUS	;Just the string is enough
		SETZM TAPHST	;Don't save host if failed to connect
		JRST MLP ]
;Develop tape status in A and TAPEF
RMTST1:	MOVE B,RTAPE"STSFLG
	MOVEI A,TF%RDY
	TRNE B,RTAPE"F%BOT
	 TRO A,TF%BOT
	TRNE B,RTAPE"F%EOT
	 TRO A,TF%EOT
	TRNE B,RTAPE"F%EOF
	 TRO A,TF%EOF
	TRNN B,RTAPE"F%OFFL
	 TRNN B,RTAPE"F%MNT
	  TRZ A,TF%RDY
	MOVEM A,TAPEF
	SETOM TAPTYP		;If not mounted, forget about this server
	TRNE A,TF%RDY
	 SOS TAPTYP		;Mounted
	TRNE B,RTAPE"F%STRG
	 JRST [	PUSH P,LPTSW
		SETZM LPTSW		
		PRINT Remote tape status=
		PASC RTAPE"STATUS
		PUSHJ P,CRR
		POP P,LPTSW
		JRST .+1 ]
	POP P,TER
	POP P,SYM
	POP P,N
	POP P,E
	POP P,D
	POP P,C
	POP P,B
	JRST CTRLGX

;Tape already mounted, check status
;Develop tape status in A and TAPEF
RMTSTS:	PUSH P,B
	PUSH P,C
	PUSH P,D
	PUSH P,E
	PUSH P,N
	PUSH P,SYM
	PUSH P,TER
	SETOM CTRLG
	PUSHJ P,RTAPE"PROBE
	JRST RMTST1

;Remote login routine
RMTLGN:	SKIPN RMTUSR		;First try own name and no password
	 JRST [	.SUSET [.RXUNAME,,SYM]
		MOVE B,[440700,,RMTUSR]
		PUSHJ P,SIXTO7
		JRST .+1 ]
RMTLG1:	MOVEI A,RMTUSR
	MOVEI B,RMTPSW
	PUSHJ P,RTAPE"LOGIN
	 CAIA
	  POPJ P,
	PRINT [_REMOTE LOGIN AS ]
	PASC RMTUSR
	PRINT [ FAILED: ]
	PASC RTAPE"STATUS
	PUSHJ P,CRR
	PASC TAPHST
	PRINT [ USER ID=]
	PUSHJ P,GETSYL
	 JRST MLP
	MOVE B,[440700,,RMTUSR]
	SKIPE SYM		;DON'T CHANGE USER ID IF BLANK INPUT
	 PUSHJ P,SIXTO7
	MOVE A,TTYST1		;TURN ECHOING OFF
	ANDCM A,[<%TGPIE+%TGMPE>*010101010101]
	MOVE B,TTYST2
	ANDCM B,[<%TGPIE+%TGMPE>*010101010101]
	.CALL [ SETZ ? 'TTYSET ? MOVEI TYIC ? A ? B ? SETZ TTYSTS ]
	 JFCL
	PRINT PASSWORD=
	PUSHJ P,GETSYL
	 JRST MLP
	.CALL TTYSET		;TURN ECHOING BACK ON
	 JFCL
	MOVE B,[440700,,RMTPSW]
	PUSHJ P,SIXTO7
	JRST RMTLG1

SIXTO7: MOVEI N,0		;Sixbit in SYM to ASCIZ, BP in B
	LSHC N,6
	ADDI N,40
	IDPB N,B
	JUMPN SYM,SIXTO7
	IDPB SYM,B
	POPJ P,

;Commands to specify tape drive to use
AREMOTE:SKIPA A,[-1]
ALOCAL:	 MOVEI A,1
	MOVEM A,TAPTYP
	.CLOSE RTAPE"RSICH,	;Dispose of possible remote server
	.CLOSE RTAPE"RSOCH,
	SETZM TAPHST		;Force ask for host again
	PUSHJ P,SETIT1		;Get tape status in A and in TAPEF
	SKIPGE TAPTYP
	 PRINT [REMOTE ]
	SKIPLE TAPTYP
	 PRINT [LOCAL ]
	PRINT TAPE
	TRNE A,TF%BOT		;Check for BOT
	 JRST ALOCL1
	PRINT [ NOT REWOUND]
	TRNN A,TF%RDY		;Check for offline
	 JRST ALOCL2		;If offline, leave ITAPE alone so quit works
	SETZM ITAPE
	POPJ P,

ALOCL1:	PRINT [ REWOUND]
	SETOM ITAPE
	SETOM UFDDAT
	SETOM MFDDAT
	POPJ P,

ALOCL2:	PRINT [ AND NOT ON-LINE]
	POPJ P,

;COMMAND TO SPACE TAPE, LISTING FILES, AND WAITING FOR A SPACE
; AFTER EACH
ALSPACE:PUSHJ P,CRR
	PUSHJ P,TYOS
ASPAC2:	PUSHJ P,LAST
	 POPJ P,
	PUSHJ P,TYI
	CAIN A,177
	 POPJ P,
	JRST ASPAC2

;COMMAND TO SPACE TAPE FORWARD OR BACKWARD 'N' FILES
ASPACE:	SETZM N
	CAIN TER,15
	 JRST ASPAC1
	PUSHJ P,GETSYL
	 POPJ P,
ASPAC1:	MOVEI A,7
	ADDM N,ITAPE
	SKIPGE ITAPE
	 SETOM ITAPE
	SKIPGE N
	 SOS N			;SPACE REVERSE
	HRL A,N
	PUSHJ P,TAPOPR
	PUSHJ P,SETIT1		;Await completion and get tape status
	TRNN A,TF%BOT		;Unless BOT,
	 SKIPL N		;SPACING BACKWARD?
	  POPJ P,
	JRST SPFF		;NOW SPACE FILE FORWARD
SUBTTL GET TAPE NUMBER, LISTING DEVICE

TAPGET:	PUSH P,LPTSW
TAPGT1:	SETZM LPTSW
	PRINT TAPE NO=
	PUSHJ P,GETSYL
	 JRST TAPGT1
	JUMPL N,TAPGT1
	SKIPE WRONG
	 DIE Cannot access MACRO TAPES file because this version of DUMP is for the wrong machine
	CAIL N,MAXTAP
	 JRST TAPGT1
	POP P,LPTSW
	HRLM N,THTPN
	SETZM NPLACE
	MOVEM SYM,NSVTPN
	MOVEM SYM,GFRLNK+4
	SKIPN LPTSW
	 JRST SNPLAC
	PRINT TAPE NO =
	PDPT N
	PASC [ASCIZ /	/]
	.RDATE A,
	MOVEM A,THDATE
	PRINT CREATION DATE
	PSIS THDATE
	PASC [ASCIZ /	/]
	PRINT DUMPED BY 
	.SUSET [.RXUNAME,,A]
	PSIS A
	JRST SNPLAC		;DECIDE WHERE TO PUT .TAPEn FILE

ATPLA:	HRRZ A,LPTO
	CAIN A,(SIXBIT /TPL/)
	 JRST NAUGHT
	PRINT  CHANGED TO TPL_
	MOVEI SYM,(SIXBIT /TPL/)
	JRST SETOU1

DEVGET:	PRINT  LIST DEV =
SETOUT:	PUSHJ P,GETSYL	;READ DEVICE TO BE USED FOR LISTING STUFF ON
	 JRST DEVGET
	HLRZS SYM
	SKIPN SYM
	 MOVEI SYM,'TTY		;RESPONSE OF CR MEANS TTY
	CAIN SYM,'TTY
	 POPJ P,
SETOU1:	HRRM SYM,LPTO
	.SUSET [.SSNAM,,MYNAME]	;WRITE ON USER'S WORKING DIR
	OPEN LPTCH,LPTO		;LIST FILES ON TAPE
	 JRST ATPLA
	SETOM LPTSW		;SET LPT SWITCH ON
	POPJ P,
SUBTTL DECIDE WHERE TO PUT .TAPEn; TAPE nnn FILE

;THIS IS A TABLE OF THE NAMES OF ALL THE TAPE DIRECTORIES
TDIRTB:	REPEAT 10., <SIXBIT/.TAPE0/>+.RPCNT
	REPEAT 26., <SIXBIT/.TAPEA/>+.RPCNT	
NTDIR==.-TDIRTB


;HERE IS A SORT OF KLUDGE TO EXAMINE THE TAPE DIRECTORIES OF A
;DECEASED ITS (IN THIS CASE, AI.)  RESTORE ALL THE TAPE
;DIRECTORIES TO SOME MACHINE, UNDER THE NAMES %TAPEn;.

DFINDF:	0		;-1 => LOOKING ON DECEASED MACHINE'S TAPE DIRS.
DEDDEV:	SIXBIT /DM/	;MACHINE WHERE %TAPEn DIRS ARE STORED.
DEDITS:	SIXBIT /AI/	;WHICH MACHINE'S TAPE DIRS THEY WERE.

DDIRTB:	REPEAT 10., <SIXBIT/%TAPE0/>+.RPCNT
	REPEAT 26., <SIXBIT/%TAPEA/>+.RPCNT	
NDDIR==.-TDIRTB



SNPLAC:	SKIPN NPLACE		;IF ALREADY KNOW, DON'T MAKE INFINITE SYSTEM CALLS
	 JRST SNPL0
	.SUSET [.SSNAME,,NPLACE]
	POPJ P,

SNPL0:	PUSH P,A
	PUSH P,B
	PUSH P,C
	PUSH P,D
	PUSH P,E
	HLRZ A,THTPN
	MOVE D,NSVTPN
	CAIE A,-1
	 JRST SNPL00
	HLRZ A,LTHTPN
	MOVE C,[440600,,D]
	MOVEI D,0
	PUSHJ P,SIXNUM
SNPL00:	MOVEM D,SNTRYN
	SETOB B,C		;B NAME OF LEAST FULL DIR, C SPACE LEFT IN IT
	MOVSI A,-NTDIR
SNPL1:	.CALL SNTRY		;IS TAPE IN THIS DIR?
	 JRST [	CAIN E,4
		 JRST SNPL3	;NO
		CAIN E,20
		 JRST SNPL2	;NON-EXISTENT DIRECTORY
		PRINT ERROR ACCESSING TAPE DIR - 
		PUSHJ P,OPINFL
		JRST SNPL3 ]	
	MOVE B,TDIRTB(A)
	JRST SNPL4		;YES, LEAVE IN SAME DIR	

SNPL3:	MOVE E,TDIRTB(A)	;READ DIR TO SEE HOW FULL IT IS
	.SUSET [.SSNAME,,E]
	.OPEN SNPLCH,FNO
	 .LOSE %LSFIL
	MOVE D,[-UDNAMP-1,,SNBUF]
	.IOT SNPLCH,D
	CAML C,SNBUF+UDNAMP
	 JRST SNPL3A
	MOVE C,SNBUF+UDNAMP	;THIS DIR LESS FULL
	MOVE B,TDIRTB(A)
SNPL3A:	AOBJN A,SNPL1		;TRY NEXT DIR
SNPL2:	CAIL C,460
	 JRST SNPL4		;THIS ONE HAS ENOUGH SPACE
	JUMPL A,SNPL2A
	SETZM LPTSW
	DIE ALL TAPE DIRECTORIES FULL

SNPL2A:	MOVE E,TDIRTB(A)
	.SUSET [.SSNAME,,E]
	.OPEN SNPLCH,CRUFD	;BEST DIR IS GROSSLY FULL, CREATE A NEW ONE
	 JFCL
	.SUSET [.RIOS+SNPLCH,,C]
	LDB C,[220600,,C]
	CAIE C,4		;ERROR CODE BETTER BE FILE NOT FOUND!
	  JRST [ SETZM LPTSW
		 DIE [NO FREE UFD SLOTS, CANNOT CREATE ANOTHER TAPE DIRECTORY, GET HELP]
	       ]
	MOVE B,TDIRTB(A)
SNPL4:	MOVEM B,NPLACE		;USE THIS DIR
	.SUSET [.SSNAME,,NPLACE]
	.CLOSE SNPLCH,
	POP P,E
	POP P,D
	POP P,C
	POP P,B
	POP P,A
	POPJ P,
SUBTTL TAPE LISTING COMMANDS

;QUIT COMMAND
AQUIT:	.BREAK 16,160000

;LIST CONTENTS OF A TAPE BY USING .TAPEn FILE
ATLIST:	PUSHJ P,DEVGET
	PUSHJ P,TAPGET
	PUSHJ P,SNPLAC		;FIND WHICH TAPE DIR TO USE
	MOVEI A,.BII
	HRLM A,NSVOP
	.OPEN SAVET,NSVOP
	 CAIA
	  JRST ATLST4
	PRINT NOT FOUND
	JRST RET

ATLST4:	SETZM ITAPE
	MOVE A,[-1,,B]
	.IOT SAVET,A
	ADD B,[1,,THBLK+1]
	.IOT SAVET,B
	PUSHJ P,PTHEAD
	MOVE A,[-1,,GARBAG]
	.IOT SAVET,A
ATLST1:	HRROI A,B
	.IOT SAVET,A
	JUMPL A,ATLST2
	SKIPN B
	 JRST ATLST3
	MOVEM B,HBLK+2
	HRROI A,HBLK+3
	.IOT SAVET,A
	JUMPL A,ATLST2
	HRROI A,HBLK+5
	.IOT SAVET,A
	JUMPL A,ATLST2
	PUSHJ P,LOUSY
	 JFCL
	AOS ITAPE
	JRST ATLST1

ATLST2:	SETOM ITAPE
	SETOM MFDDAT
	SETOM UFDDAT
	.CLOSE SAVET,
	POPJ P,

ATLST3:	HRROI A,HBLK+1
	.IOT SAVET,A
	JRST ATLST1

APTDIR:	SETOM PDIRSW	;PRINT DIRECTORIES FROM TAPE.
	PUSHJ P,DEVGET
	PUSHJ P,APTD1
	 POPJ P,
	JRST .-2

APTD1:	PUSHJ P,MAGOP
	 POPJ P,
	PUSHJ P,FILSKP
	AOS (P)
	POPJ P,

ALIST:	PUSHJ P,DEVGET	;LIST FILES ON MACRO-TAPE
	PUSHJ P,LAST
	 POPJ P,
	JRST .-2

LAST:	PUSHJ P,LOUSE
	 POPJ P,
	PUSHJ P,FILSKP	;FLUSH REST OF FILE (PITY WE HAVE TO READ ALL THIS CRUFT)
	AOS (P)
	POPJ P,

;SAVE STUFF ABOUT THIS TAPE IN SYSENG; MACRO TAPES FILE

SINFO:	IRPS X,,[THTPN THTYPE FUSNM LUSNM]Y,,[STAPEN STYPE SFUSNM SLUSNM]
	MOVE A,X
	MOVEM A,Y
TERMIN
	MOVE A,THTPN
	CAME A,[-1]
	 JRST SINFO5
	MOVE A,LTHTPN
	MOVEM A,STAPEN
SINFO5:	.RDATE A,
	MOVEM A,STDATE
SINFO1:	.SUSET [.RUNAME,,SUSER]
	.SUSET [.SSNAM,,SPLACE]
SINFO4:	MOVEI A,100007		;WRITE-OVER BLOCK IMAGE OUTPUT MODE
	HRLM A,STATOP
	.OPEN STATC,STATOP
	 JRST SINFO2
	.CALL CLBIT		;ZERO DUMPCHECK BIT
	 JFCL
	HLRZ A,STAPEN
	SKIPE WRONG
	 DIE Cannot access MACRO TAPES file because this version of DUMP is for the wrong machine
	CAIL A,MAXTAP
	 DIE [TAPE NUMBER TOO LARGE, YOU LOSE]
	IMULI A,TPINFL		;ACCESS TAPE INFO BLOCK
	.ACCESS STATC,A
	MOVE A,[-TPINFL,,STAPST]
	.IOT STATC,A
	.CLOSE STATC,
	.SUSET [.SSNAM,,USNM]
	POPJ P,

SINFO2:	MOVEI A,.BIO		;MACRO TAPES DOESN'T EXIST, CREATE IT
	HRLM A,STATOP
	OPEN STATC,STATOP
	 JRST RET
	SETZM BUF
	MOVE A,[BUF,,BUF+1]
	BLT A,BUF+TPINFL-1
	SKIPE WRONG
	 DIE Cannot access MACRO TAPES file because this version of DUMP is for the wrong machine
	MOVEI B,MAXTAP
SINFO3:	MOVE A,[-TPINFL,,BUF]
	.IOT STATC,A
	SOJG B,SINFO3
	.CLOSE STATC,
	JRST SINFO4

;GET INFO ON A TAPE OUT OF SYSENG; MACRO TAPES FILE
GINFO:	MOVEI B,.BII
	HRLM B,STATOP
	.SUSET [.SSNAM,,SPLACE]
	.OPEN STATC,STATOP
	 JRST GINFO1
	SKIPE WRONG
	 DIE Cannot access MACRO TAPES file because this version of DUMP is for the wrong machine
	CAIL N,MAXTAP
	 DIE [TAPE NUMBER TOO LARGE, YOU LOSE]
	IMULI N,TPINFL
	.ACCESS STATC,N
	MOVE A,[-TPINFL,,STAPST]
	.IOT STATC,A
	.CLOSE STATC,
GINFO2:	.SUSET [.SSNAM,,USNM]
	POPJ P,

GINFO1:	SETZM STAPST
	MOVE A,[STAPST,,STAPST+1]
	BLT A,STAPST+TPINFL-1
	JRST GINFO2

;COMMAND TO LIST ALL KNOWN TAPES
ATAPES:	PUSHJ P,DEVGET
	.SUSET [.SSNAM,,SPLACE]
	MOVEI A,.BII
	HRLM A,STATOP
	OPEN STATC,STATOP
	 JRST RET
	MOVEI U,0
TAPES1:	MOVE A,[-TPINFL,,STAPST]
	.IOT STATC,A
	SKIPE STAPEN
	 PUSHJ P,LINFO
	ADDI U,1
	SKIPE WRONG
	 DIE Cannot access MACRO TAPES file because this version of DUMP is for the wrong machine
	CAIGE U,MAXTAP
	 JRST TAPES1
	.CLOSE STATC,
	JRST CRR

;COMMAND TO LIST A SINGLE TAPE
ATAPE:	PUSHJ P,TAPGET
	PUSHJ P,GINFO
	PUSHJ P,LINFO
	JRST CRR

;LIST OUT MACRO TAPES INFO
LINFO:	HLRZ A,STAPEN
	JUMPE A,NOINFO
	PDPT A
	PSIS STDATE
	SKIPN STYPE
	 PRINT   NORM
	SKIPGE STYPE
	 PRINT 	INCR
	SKIPLE STYPE
	 PRINT 	FULL
	PSIS SUSER
	SKIPN SDONE
	 PRINT 	ABRT
	SKIPLE SDONE
	 PRINT 	ARCH
	SKIPGE SDONE
	 PRINT 	DUMP
	HRRZ A,STAPEN
	PDPT A
	PRINT 	
	PSIS SFUSNM
	PSIS SLUSNM
	JRST CRR

NOINFO:	PRINT NO INFORMATION
	JRST CRR

;CREATE TAPE DIRECTORY ON DISK FROM MOUNTED TAPE
ATAPED:	PUSHJ P,ARWND
	PUSHJ P,MAGOP
	 POPJ P,
	MOVE A,THTPN
	MOVEM A,LTHTPN
	SETOM THTPN		;KNOWN NUMERICALLY, NOT SYMBOLICALLY
	SETZM NPLACE
	PUSHJ P,SNPLAC		;FIND TAPE DIRECTORY IF ON-LINE ALREADY
	MOVEI A,.BII		;OTHERWISE DECIDE WHERE TO PUT IT
	HRLM A,NSVOP
	.OPEN SAVET,NSVOP
	 JRST ATAPD3
	PRINT _DIRECTORY ALREADY EXISTS._
	PUSHJ P,CHECK
ATAPD3:	MOVEI A,.BIO
	HRLM A,NSVOP
	OPEN SAVET,NSVOP
	 JRST RET
	MOVE A,[-LTHBLK,,THBLK]	;STORE TAPE HEADER
	.IOT SAVET,A
	HRROI A,[-3,,0]
	.IOT SAVET,A
	SETOM USNM
DLUP:	PUSHJ P,FILSKP		;SKIP THIS TAPE FILE
	PUSHJ P,MAGOP		;GET NEXT
	 POPJ P,		;EOT
	MOVE B,USNM
	CAME B,HBLK+1		;NEW S NAME?
	 PUSHJ P,DLUPSN		;YES.
	MOVE A,[-2,,HBLK+2]	;FILE NAMES
	.IOT SAVET,A
	MOVE A,[-1,,HBLK+5]	;DATE
	.IOT SAVET,A
	JRST DLUP

DLUPSN:	MOVE A,HBLK+1		;SWITCH S NAMES
	MOVEM A,USNM
	HRROI A,[0]		;0 FN FLAGS SNAME CHANGE
	.IOT SAVET,A
	HRROI A,USNM
	.IOT SAVET,A
	POPJ P,

;COMMAND TO CHANGE STORED INFO ABOUT A TAPE
TAPSET:	PUSHJ P,TAPGET		;GET TAPE NUMBER
	MOVE U,N
	PUSHJ P,GINFO
	PUSHJ P,LINFO
	HRLM U,STAPEN
LWREQ:	PRINT LAST WRITTEN=
	PUSHJ P,GETSYL
	 JRST LWREQ
	CAIN A,33
	 JRST TAPST1
	SKIPE SYM
	 MOVEM SYM,STDATE
	PRINT TYPE=
	PUSHJ P,TYI
	MOVEI C,1
	CAIN A,33
	 JRST TAPST1
	CAIN A,"F
	 MOVEM C,STYPE
	CAIN A,"R
	 SETZM STYPE
	CAIN A,"I
	 SETOM STYPE
	PRINT _ARCHIV?
	PUSHJ P,TYI
	CAIN A,"Y
	 MOVEM C,SDONE
	CAIN A,"N
	 SETOM SDONE
	SKIPN STYPE
	 JRST TAPST1
RNFULU:	PRINT _REEL NO FIRST USER LAST USER 
BACK:	PUSHJ P,GETSYL
	 JRST RNFULU
	CAIN A,33
	 JRST TAPST1
	MOVEM SYM,W
	SKIPE SYM
	 HRRM N,STAPEN
BACK1:	PUSHJ P,GETSYL
	 JRST UNDO1
	CAIN A,33
	 JRST TAPST1
	SKIPE SYM
	 MOVEM SYM,SFUSNM
	PUSHJ P,GETSYL
	 JRST UNDO2
	SKIPE SYM
	 MOVEM SYM,SLUSNM
TAPST1:	PUSHJ P,CHECK
	JRST SINFO1

UNDO1:	PSIS W
	PUSHJ P,TYOS
	JRST BACK

UNDO2:	PSIS SYM
	PUSHJ P,TYOS
	JRST BACK1

;MORE LISTING COMMANDS AND SUBROUTINES

LOUSE:	PUSHJ P,MAGOP	;OPEN TAPE AND READ HEADER
	 JRST ENDMAG	;END OF TAPE
LOUSY:	PUSHJ P,CRR
	PUSHJ P,TAPN
	PSIS HSNM
	PSIS HFN1	;OUTPUT FILE NAME
	PSIS HFN2
	SKIPE LNKFLG
	 PUSHJ P,LDMUT5
	SKIPE LNKFLG
	 JRST NOPP
	SKIPL HPKN
	 PDPT HPKN	;OUTPUT PACK NUMBER
NOPP:	SIXTYP [SIXBIT/ /]
	MOVE A,HDATE
	MOVEM A,DAYTIM
	SKIPN LNKFLG
	 PUSHJ P,PFDATE
	AOS (P)
	POPJ P,

ENDMAG:	PRINT _ REEL = 
	HRRZ A,THTPN
	PDPT A		;OUTPUT REEL NUMBER
	JRST CRR

;COMMAND TO LIST THE MFD
AMFD:	PUSHJ P,DEVGET
	SETOM MFDIN
AMFD1:	PUSHJ P,MFDN
	 POPJ P,
	PSIS USNM
	PUSHJ P,CRR
	JRST AMFD1

;COMMAND TO LIST A DIRECTORY
ALISTF:	SETOM FLNI
	CLEARM MICFLG
	MOVEI A,(SIXBIT /DSK/)
	HRRM A,FNO
GETDIR:	PRINT DIRECTORY=
	PUSHJ P,GETSYL
	 JRST GETDIR
	CAIN TER,15
	 PUSHJ P,CRR
	CAIN TER,":
	 HLRM SYM,FNO
	MOVEM SYM,USNM
	CAIE TER,":
	 .SUSET [.SSNAM,,USNM]
	PUSHJ P,DEVGET		;WHERE TO LIST IT TO
ALISTK:	PUSHJ P,FNG
	 JRST CRR
	PUSHJ P,CRR
	PSIS FN1
	PSIS FN2
	SKIPN MICFLG
	 PDPT PACKN
	JRST ALISTK

;LISTING ROUTINES

;LIST LINK INFO
LDMUT5:	PSIS [SIXBIT /L/]
	PSIS PACKN	; SYSNM
	PSIS LNKNM1
	PSIS LNKNM2
	POPJ P,

;WHEN LOADING, LIST SNAMES AS ENCOUNTERED
LDMUT4:	MOVE A,HSNM
	CAMN A,CUSN
	 POPJ P,		;SAME NAME 
	PUSHJ P,TAPN
	MOVEM A,CUSN		;NEW NAME
	PSIS CUSN
	JRST CRR

;LIST A FILE THAT'S ACTUALLY BEING LOADED
LDMUT3:	PUSHJ P,TAPN
	PSIS HFN1
	PSIS HFN2
	SKIPE LNKFLG
	 PUSHJ P,LDMUT5
	SKIPN LNKFLG
	 PDPT HPKN
	JRST CRR
SUBTTL RETRIEVAL ROUTINES (LOAD, RELOAD)

RETRV0:	SKIPL LDPACK
	 SKIPE LOSRSW
	  JRST RETRV
	PRINT LDPACK FEATURE ISN'T GOING TO WORK UNLESS YOU RELOAD IN SORRY MODE
	JRST ERR

SFRETR:	PUSHJ P,FILSKP		;FLUSH CURRENT FILE, THEN DROP INTO RETRV

;ENTER HERE FROM EXECU FOR LOAD AND RELOAD COMMANDS
RETRV:	PUSHJ P,MAGOP		;OPEN TAPE
	 POPJ P,		;END OF TAPE
	SKIPL A,LDPACK
	 JRST [	CAME A,HPKN	;ON SINGLE PACK BEING RELOADED?
		 JRST SFRETR	;NO, SKIP IT
		JRST .+1 ]
	SKIPL A,BBPACK		
	 JRST [	CAME A,HPKN	;ON SINGLE PACK BEING BROUGHT BACK?
		 JRST SFRETR	;NO, SKIP IT.
		JRST .+1 ]
	SKIPE LSTWHL		;LIST?
	 PUSHJ P,LDMUT4
	MOVN W,LENGTH		;SEE IF THIS IS ONE OF THE FILES
	HRLZS W			;THAT WE WERE ASKED TO LOAD.
COMCN2:	SKIPN D,FMSNM(W)
	 JRST CM2FN1
	CAME D,HSNM
	 JRST NEXCM2
CM2FN1:	SKIPN D,FMFN1(W)
	 JRST CM2FN2
	CAME D,HFN1
	 JRST NEXCM2
CM2FN2:	SKIPE D,FMFN2(W)
	 CAMN D,HFN2
	  JRST RETRVF
NEXCM2:	AOBJN W,COMCN2
	JRST SFRETR		;IT'S NOT, FLUSH IT

;CURRENT TAPE FILE MATCHES SPECS OF FILES TO BE LOADED
RETRVF:	IRP X,,[FN1,FN2]	;STORE FILE NAMES INTO 'CPYO' OPEN BLOCK
	SKIPE A,TO!X(W)
	 MOVEM A,L!X
	MOVE A,H!X
	SKIPN TO!X(W)
	 MOVEM A,L!X
TERMIN
	MOVEI A,(SIXBIT /DSK/)
	SKIPN TODEV(W)
	 HRRM A,CPYO		;UNSPECIFIED DESTINATION FOR LOADS IS DISK
	SKIPE A,TODEV(W)
	 HLRM A,CPYO		;SPECIFIED DESTINATION
	SKIPN A,TOSNM(W)
	 MOVE A,HSNM		;UNSPECIFIED SNAME IS THE ONE READ FROM TAPE
	.SUSET [.SSNAM,,A]	;SET SNAME FOR MERGE TEST
	MOVEI B,36		;BLOCK IMAGE INPUT, DON'T TOUCH REFDATE,
	HRLM B,CPYO		; AND DON'T CHASE LINKS
	SKIPGE DEADPK		;If DEADPK being restored
	 JRST CHMRG
	MOVE B,LFN1		; SNAME still in A...
	MOVE C,LFN2
	PUSHJ P,DKLOOK		; Look up file on disk
	 JRST SFRETR		; No longer around, skip it
	MOVEM A,DKBLK		; Save this for later...
	MOVE B,UNRNDM(A)
	LDB C,[UNPKN B]
	TLNN B,UNLINK
	 CAME C,DEADPK
	  JRST SFRETR		; Link, or wrong pack, skip it
	MOVEI D,[ASCIZ\file on tape is a link.\]
	SKIPE LNKFLG
	 JRST NORETR		; What kind of a tape is he using?
	MOVE B,UNDATE(A)
	CAMN B,HDATE
	 JRST OKRETR		; Dates match, go read it!
	MOVEI D,[ASCIZ\file on disk has a different creation date.\]
	JRST NORETR

;CHECK FOR MERGE MODE
CHMRG:	SKIPL MRGSW
	 JRST CHCARE
	.OPEN DSKOUT,CPYO	;MERGE.  DON'T LOAD IF FILE EXISTS.
	 JRST OKRETR		;FILE DOESNT EXIST
	MOVEI D,[ASCIZ\file already exists on disk.\]
	JRST NORETR		;FILE EXISTS, DON'T FILE ON TOP OF.

;IF NOT IN MERGE MODE, SEE IF FILE EXISTS ON DISK AND
; ISN'T DUMPED YET AND WE'RE BEING CAREFUL.  IF SO, DON'T CLOBBER IT.
CHCARE:	SKIPE CAREF
	 SKIPE MICFLG
	  JRST CHRECN		;IF NOT BEING CAREFUL, LOAD OVER
	.OPEN DSKOUT,CPYO
	 JRST OKRETR		;IF DOESNT EXIST, LOAD OVER
	MOVEI A,DSKOUT
	.DMPCH A,		;OTHERWISE, SEE IF DUMPED
	JUMPN A,CHRECN		;YES WAS DUMPED, OK TO LOAD OVER
	MOVEI D,[ASCIZ\file exists on disk and has not been backed up.\]
	JRST NORETR

;CHECK FOR OVER-WRITING MORE RECENT FILE
CHRECN:	SKIPE LOSRSW
	 JRST OKRETR		;DON'T CHECK IF SORRY MODE
	MOVEI A,36		;BLOCK IMAGE INPUT, DON'T SET REF DATE,
	HRLM A,CPYO		; AND DON'T CHASE LINKS
	.OPEN DSKOUT,CPYO
	 JRST OKRETR		;FILE DOES NOT EXIST, NO OVERWRITE PROBLEMS
	.CALL [ SETZ ? 'FILBLK ? MOVEI DSKOUT	;GET FILE INFO
		MOVEM D ? MOVEM D ? MOVEM D	;D GETS UNRNDM BITS
		SETZM A ]			;A GETS CREATION DATE
	 .LOSE %LSFIL
	TLNN D,UNLINK		;DON'T WORRY ABOUT LINKS, OR FILES
	 CAMG A,HDATE		;WITH OLDER CREATION DATE THAN THAT ON TAPE
	  JRST OKRETR
	MOVEI D,[ASCIZ\a newer file with same name exists on disk.\]
	JRST NORETR

;FILE SPECS SAY TO RETRIEVE THIS FILE, BUT OTHER OPTIONS SUCH
;AS MERGE SAY NOT TO.  D -> ASCIZ STRING FOR WHY THIS SHOULDN'T
;BE RETRIEVED.  IF 'NOASK' WAS NOT SPECIFIED, CONSULT
;USER, OTHERWISE SKIP IT.
;W -> CURRENT RETRIEVAL FILE, CPYO (LFN1, LFN2) HAS ACTUAL FILE WRITING TO.
NORETR:	SKIPE NOASK
	 JRST SFRETR		;YES, JUST FLUSH IT QUIETLY
	PUSH P,LPTSW
	SETZM LPTSW
	PRINT _File
	.SUSET [.RSNAME,,A]
	PSIS A
	PRINT [;]
	PSIS LFN1
	PSIS LFN2
	PRINT [ not getting retrieved because ]
	PASC (D)
	PRINT [_Do you want to retrieve it anyway? ]
NORET1:	PUSHJ P,TYI
	MOVE D,A
	PUSHJ P,CRR
	CAIE D,"N
	 CAIN D,"Y
	  JRST NORET2
	PRINT [(Y or N) ]
	JRST NORET1

NORET2:	POP P,LPTSW
	CAIE D,"Y
	 JRST SFRETR		;NO, FLUSH IT
	JRST OKRETR		;YES, LOAD IT

;SKIP AN INPUT FILE
FILSKP:	SKIPGE TAPTYP
	 JRST [	SETOM CTRLG
		PUSHJ P,RTAPE"SKPFIL
		JRST CTRLGX ]
	PUSH P,A
	PUSH P,B
	MOVEI A,7
	MOVE B,[MAGIN,,A]
	.MTAPE B,	; SKIP TO EOF
	 JFCL
	.CLOSE MAGIN,
	POP P,B
	POP P,A
	POPJ P,

;OK, WE'VE DECIDED TO RELOAD IT.
OKRETR:	SKIPE LNKFLG
	 JRST RETRLK		;GO RELOAD LINK
	MOVE A,HSNM		;DIR LOADING ONTO
	CAMN A,[SIXBIT/.KLFE./]
	 JRST [	PRINT [ATTEMPT TO CLOBBER KL10 FRONT END DIRECTORY, FILE BEING SKIPPED_]
		JRST SFRETR ]
	MOVE B,HFN1
	CAMN A,[SIXBIT /./]
	 CAME B,[SIXBIT /.FEFS./]
	  SKIPA
	   JRST [ PRINT [ATTEMPT TO CLOBBER KS10 FRONT END FILESYSTEM, FILE BEING SKIPPED_]
		  JRST SFRETR ]
	SKIPE A,TODEV(W)	;GET DEVICE TO WRITE TO
	 JRST OKRET0		;EXPLICITLY SPECIFIED USE IT, OTHERWISE CHOOSE
	MOVE B,HPKN		;IF RELOADING, AND FILE WAS FROM SECONDARY
	MOVSI A,-NQS		; DISK, PUT IT BACK THERE
	CAME B,QPKID(A)
	 AOBJN A,.-1
	JUMPGE A,OKRET9	
	SKIPE A,QRESRV(A)
	 CAMN A,[-1]
	  JRST OKRET9
	SKIPL RELOSW
OKRET9:	 MOVSI A,'DSK
OKRET0:	SKIPE CRDIR
	 .OPEN CRUFD		;CREATE DIRECTORY IF NON-EXISTENT
	  JFCL
	.CALL [SETZ ? SIXBIT/OPEN/ ? [.BIO,,DSKOUT]
	       A ? [SIXBIT/_DUMP_/] ? SETZ [SIXBIT/OUTPUT/]]
	 .LOSE 1400		;MIGHT AS WELL LET DDT HANDLE IT
	SKIPE LSTWHL
	 PUSHJ P,LDMUT3		;LIST THIS FILE
	SETZM HFNL
	HLRZ A,HSNM
	CAIN A,'LCF
	 PUSHJ P,ISLCF
	MOVE A,HDATE
	SKIPGE RELOSW		;IF NOT RELOADING,
	 JRST OKRET1
	SKIPE A
	 CAMN A,[-1]	
	  PUSHJ P,ALD5		;MAKE CREATION DATE FROM TAPE DATE
OKRET1:	MOVEM A,FDATE
	.CALL SDATE
	 JFCL			;IT DOESN'T MATTER WEATHER YOU WIN OR LOSE, ITS HOW YOU PLAY THE GAME.
OKRET2:	MOVE A,[-2000,,BUF]
	PUSHJ P,MAGRDL		;READ A BUFFER LOAD FULL
	 JRST RETRFN		;ERROR
	HRLOI B,-BUF-1(A)
	EQVI B,BUF
	SKIPE HFNL
	 PUSHJ P,HFNLX
	SKIPGE B
 	 .IOT DSKOUT,B		;OUTPUT IT TO DISK
	JUMPGE A,OKRET2		;JUMP UNLESS EOF
	PUSHJ P,FILSKP		;EOF, BE SURE.
	SKIPN THTYPE
	 JRST OKRET3		;RANDOM TAPE, DON'T CLEAR NOT-DUMPED INDIC.
	.CALL [SETZ ? 'SDMPBT ? 1000,,DSKOUT ? SETZI 1]
	 .LOSE 1000
OKRET3:	SKIPGE RELOSW
	 PUSHJ P,RELOAF		;IF WE ARE RELOADING, SET DUMPBIT,REAPBIT ,AUTHOR, REF DATE
	SKIPL DEADPK
	 PUSHJ P,DKBLKF		; Restore attributes from saved file block
	.CALL [SETZ ? 'RENMWO ? MOVEI DSKOUT ? LFN1 ? SETZ LFN2]
	 .LOSE 1000
;FILE HAS BEEN LOADED, REMOVED FROM LOAD SPECS
RETRFN:	.CLOSE DSKOUT,
	SKIPE FMSNM(W)
	 SKIPN FMFN1(W)
	  JRST RETRV		;WAS "*"=> DON'T FLUSH ENTRY
	SKIPN FMFN2(W)
	 JRST RETRV
	PUSHJ P,FLUSH
	 POPJ P,		;NOTHING MORE TO DO
	JRST RETRV

ISLCF:	HLRZ A,HFN1
	CAIE A,'ACT
	 CAIN A,'DUN
	  SETOM HFNL
	POPJ P,

HFNLX:	PUSH P,B		;DONT COMPROMISE, RANDOMIZE!
	PUSH P,A
HFNLXL:	MOVE A,(B)
	TSC A,1(B)
	MOVEM A,(B)
	AOBJN B,HFNLXL
	POP P,A
	POP P,B
	POPJ P,	

;FLUSH ENTRY OF FILE THAT WAS JUST DUMPED, OR LOADED
;SKIP RETURN IF ANY MORE FILES TO BE DONE
FLUSH:	SOSN B,LENGTH
	 POPJ P,		;NOTHING MORE TO DO
	SUBI B,1
	HRLI A,FMDUMP+1(W)	;BLT DOWN ENTRIES ABOVE IT
	HRRI A,FMDUMP(W)
	BLT A,FMDUMP(B)
	IRP X,,[FM,TO]
	 IRP Y,,[DEV,SNM,FN1,FN2]
	  HRLI A,!X!!Y+1(W)
	  HRRI A,!X!!Y(W)
	  BLT A,!X!!Y(B)
	  TERMIN
	 TERMIN
	JRST POPJ1

; Restoring dead pack:  set author, reference date, and reap bit from disk
; copy of UFD.
DKBLKF:	MOVE C,DKBLK
	LDB A,[UNAUTH UNREF(C)]
	PUSHJ P,DKAUTH
	.CALL [	SETZ ? SIXBIT /SAUTH/ ? MOVEI DSKOUT ? SETZ A ]
	 JFCL
	HLLZ A,UNREF(C)
	.CALL [	SETZ ? SIXBIT /SRDATE/ ? MOVEI DSKOUT ? SETZ A ]
	 JFCL
	MOVE A,UNRNDM(C)
	TLNE A,UNREAP
	 .CALL [ SETZ ? SIXBIT /SREAPB/ ? MOVEI DSKOUT ? SETZI 1 ]
	 JFCL
	POPJ P,

;RELOADING, SET MISCELLANEOUS FILE ATTRIBUTES FROM TAPE COPY OF UFD
RELOAF:	SKIPGE UFDDAT
	 POPJ P,		;NO UFD IN CORE
	MOVE A,HSNM
	CAME A,UFDBUF+UDNAME
	 POPJ P,		;WRONG NAME
	MOVE C,UDNAMP+UFDBUF
	ADDI C,UFDBUF
	MOVE A,HFN1
	SKIPA B,HFN2
RELOF1:	 ADDI C,LUNBLK
	CAIL C,UFDBUF+2000
	 POPJ P,		;NOT FOUND
	CAMN A,UNFN1(C)
	 CAME B,UNFN2(C)
	 JRST RELOF1
	MOVE A,HDATE
	CAME A,UNDATE(C)
	 POPJ P,		;SAME NAMES, DIFFERENT CREATION DATE
RELOF2:	LDB A,[.BP (UNREAP),UNRNDM(C)]
	.CALL [SETZ ? 'SREAPB ? 1000,,DSKOUT ? SETZ A]
	 JFCL
	LDB A,[.BP (UNDUMP),UNRNDM(C)]
	.CALL [SETZ ? 'SDMPBT ? 1000,,DSKOUT ? SETZ A]
	 JFCL
	HLLZ A,UNREF(C)
	.CALL [SETZ ? 'SRDATE ? 1000,,DSKOUT ? SETZ A]
	 JFCL
	LDB A,[UNAUTH+UNREF(C)]
	PUSHJ P,GEAUTH
	 POPJ P,
	.CALL [SETZ ? SIXBIT /SAUTH/ ? 1000,,DSKOUT ? SETZ A]
	 JFCL
	POPJ P,

;MAKE A A CREATION DATE FROM TAPE DATE
ALD5:	SETZM A
	PUSH P,B
	PUSH P,C
	LDB B,[300400,,THDATE]
	LDB C,[360400,,THDATE]
	IMULI C,10.
	ADD B,C
	DPB B,[330700,,A]
	LDB B,[140400,,THDATE]
	LDB C,[220400,,THDATE]
	IMULI C,10.
	ADD B,C
	DPB B,[270400,,A]
	LDB B,[000400,,THDATE]
	LDB C,[060400,,THDATE]
	IMULI C,10.
	ADD B,C
	DPB B,[220500,,A]
	POP P,C
	POP P,B
	POPJ P,

;RELOAD A LINK
RETRLK:	SKIPE LSTWHL
	 PUSHJ P,LDMUT3
	MOVE A,LFN1
	MOVEM A,LNKBLK+1
	MOVE A,LFN2
	MOVEM A,LNKBLK+2
	.OPEN DSKOUT,LNKBLK
	 .LOSE 1400		;SHOULD SUCCEED, LET DDT HANDLE IT.
	PUSHJ P,FILSKP		;FLUSH TO EOF
	SKIPL RELOSW		;IF RELOADING,
	 JRST RETRFN		; WILL HAVE TO RESTORE MISC CRUFT
	MOVEI A,36		;DON'T CHASE LINKS, DON'T SET REFD,
	HRLM A,CPYO		; BLOCK IMAGE INPUT (REOPEN THE LINK)
	.OPEN DSKOUT,CPYO
	 .LOSE 1400		;WE JUST PUT IT THERE!!
	PUSHJ P,RELOAF
	JRST RETRFN
SUBTTL 'OPEN' A MAGTAPE FILE FOR INPUT

; DFHBLK: Set all defaults in HBLK
; DFHDTS: Default dates in HBLK
DFHBLK:	SETZM HBLK+1
	MOVE A,[HBLK+1,,HBLK+2]
	BLT A,HBLK+LHBLK-1
	SETOM HLEN		; Unknown length
DFHDTS:	SETOM HDATE		; Unknown creation date
	HRROI A,777000		; Unknown reference date
	MOVEM A,HRDATE		; Unknown author, 36. bit bytes
	POPJ P,

MAGOT:	PSIS CHNTAB+MAGIN	;LOST
	PUSHJ P,OPINFL
	PUSHJ P,CRR
	MOVEI A,150.		;WAIT FOR SOMEONE TO FIX TAPE DRIVE
	.SLEEP A,		;DROP THROUGH
;ENTER HERE, NON-SKIP IF EOT.
MAGOP:	PUSHJ P,DFHBLK		; Set defaults in HBLK
	SKIPGE TAPTYP		;SKIP IF USING LOCAL DRIVE
	 JRST MAGOP0		;REMOTE DRIVE STAYS OPEN I GUESS
	.OPEN MAGIN,MAGI	;OPEN MAG TAPE INPUT (READ HEADERS)
	 JRST MAGOT		;WAIT FOR HIM TO MOUNT TAPE OR REWIND
MAGOP0:	CLEARM ERRCNT		;RESET ERR COUNT FOR THIS FILE
	AOSE ITAPE		;SKIP IF BEGINNING OF TAPE
	 JRST ART2		; ALSO INCREMENTS FILE SEQUENCE NUMBER
	PUSH P,A
	SKIPGE TAPTYP
	 PUSHJ P,RMTSTS		;DRAIN QUEUED STATUS
	POP P,A
	SETZM THTYPE
	SETOM THDATE
	HRROI A,B
	PUSHJ P,MAGREAD		;READ AOBJN WORD INTO B
	 JRST MAGOP		;ERROR, TRY NEXT FILE
	TRNE B,-1
	 JSP D,BDHD		;BAD TAPE-HEADER - AOBJN WORD HAS NON-ZERO RIGHT HALF
	CAMGE B,[-LTHBLK,,]
	 JSP D,BDHD		;BAD TAPE-HEADER - FIRST RECORD TOO LONG
	ADD B,[1,,THBLK+1]
	MOVE A,B
	PUSHJ P,MAGREAD		;READ TAPE HEADER
	 JRST MAGOP		;ERROR, TRY NEXT FILE
	HLRZ A,THTPN		;CHECK TAPE NUMBER
	JUMPN A,ART3		;IF NON-ZERO THEN IT IS VALID
	PRINT [TAPE NUMBER ON TAPE IS 0, REAL TAPE NUMBER/NAME=]
	PUSHJ P,GETSYL
	  JRST .-2		;SOME SORT OF ERROR, REPROMPT
	MOVEM SYM,NSVTPN
	HRLM N,THTPN
ART3:	PUSHJ P,PTHEAD		;TELL USER WHAT TAPE THIS CLAIMS TO BE
;HERE IF THIS WASN'T THE BEGINNING OF THE TAPE
ART2:	HRROI A,B
	PUSHJ P,MAGREAD		;READ ANOTHER WORD, SHOULD BE FILE HEADER AOBJN WD
	 JRST MAGOP
	JUMPL A,EOTISH		;EOT
	TRNE B,-1
	 JSP D,BDHD		;BAD FILE-HEADER - AOBJN WORD NON-ZERO RIGHT HALF
	CAMGE B,[-LHBLK,,]
	 JSP D,BDHD		;BAD FILE-HEADER - RECORD TOO LONG
	CAMLE B,[-LHBLKZ,,]
	 JSP D,BDHD		;BAD FILE-HEADER - RECORD TOO SHORT
	ADD B,[1,,HBLK+1]
	MOVE A,B
	PUSHJ P,MAGREAD		;READ USER NAME, FILE NAMES AND PACK NUMBER
	 JRST MAGOP
	SKIPGE A
	 JSP D,BDHD1		;BAD FILE-HEADER - NOT ALL THERE
	SETZM LNKFLG
	HLRZ B,HPKN
	SKIPN B			;LINK? (BITS ON IN LH OF PACK NUMBER)
	 JRST MAGOP1
	MOVE A,[-3,,LNKNM1]	;YES, READ NAMES LINKED TO
	PUSHJ P,MAGRDL
	 JRST MAGOP
	SKIPGE A
	 JSP D,BDHD1		;BAD FILE-HEADER - LINK NOT ALL THERE
	SETOM LNKFLG
	AOS (P)			;TAKE SUCCESS RETURN
	POPJ P,

EOTISH:	PRINT  E-O-T 
	SETOM EOTFLG
	SKIPL TAPTYP		;SKIP IF REMOTE TAPE
	 .CLOSE MAGIN,
	POPJ P,

.SCALAR MGRDLF			; Flag for MAGRDL

; Like MAGREAD, but respect length in HLEN.
MAGRDL:	SKIPGE HLEN
	 JRST MAGREAD		; Length is implicit on old tapes
	PUSH P,A
	SETZM MGRDLF
	PUSHJ P,MAGREAD
	 SETOM MGRDLF
	EXCH B,(P)
	MOVEI B,(B)
	SUBI B,(A)		; B: minus # words read
	ADDB B,HLEN		; Adjust HLEN
	JUMPLE B,MAGRDJ		; HLEN exhausted
	JUMPL A,MAGRDN		; EOF but HLEN promises more...
MAGRDX:	POP P,B
	SKIPN MGRDLF
	 AOS (P)
	POPJ P,

.VECTOR MGARB(LMGARB==:40)

MAGRDJ:	JUMPL A,MAGRDK		; Already at EOF?
	PUSH P,A
MAGRDH:	SKIPE MGRDLF		; Errors?
	 JRST MAGRDE		; Yes: Nothing to do
	MOVE A,[-LMGARB,,MGARB]	; No: Read extra garbage
	PUSHJ P,MAGREAD
	 SETOM MGRDLF
	JUMPGE A,MAGRDH		; No EOF yet?  Keep reading.
MAGRDE:	POP P,A
MAGRDK:	SETZM HLEN		; Nothing left
	MOVN B,B		; Adjust caller's ptr
	HRLI B,(B)
	SUB A,B
	JRST MAGRDX

MAGRDN:	SETOM MGRDLF
	SETOM RDERR
	SETOM ERRALL
	AOS ERRCNT
	PUSH P,LPTSW
	SETZM LPTSW
	PRINT _DATA ON TAPE TOO SHORT_
	PUSHJ P,TAPN
	PSIS HSNM
	PSIS HFN1
	PSIS HFN2
	PRINT LENGTH ERROR TAPE IN ..FILE BEING SKIPPED.._
	POP P,LPTSW
	JRST MAGRDX

;DO .IOT MAGIN,A AND SKIP IF NO DATA ERROR
;FILE MARK SIGNALLED BY NOT COUNTING OUT THE AOBJN POINTER
MAGREA:	SETZM RDERR
	SETZM PHYEOT
	SKIPGE TAPTYP
	 JRST RMTREA
	.IOT MAGIN,A
	SKIPN RDERR
	 AOS (P)
	POPJ P,

RMTREA:	PUSH P,B
	CAMN A,[-1,,B]
	 HRROI A,(P)
	TRNN A,-20
	 DIE Program error--RMTREAD can't read into AC's
	SETOM CTRLG
	PUSHJ P,RTAPE"READ
	 JRST RMTRER		;Tape error
	POP P,B
	AOS (P)
	JRST CTRLGX

;Remote read error, code similar to INT1 and INT2
RMTRER:	PUSHJ P,CTRLGX
	PUSH P,A
	PUSH P,D
	PUSH P,LPTSW		;Error messages on TTY
	SETZM LPTSW
	PRINT _TAPE READ ERROR_
	PUSHJ P,RTAPE"PRSTS
	MOVE A,RTAPE"STSFLG	;Classify error
	TRNE A,RTAPE"F%NLI+RTAPE"F%OFFL+RTAPE"F%EOT
	 JRST ERR		;Non-data error
	AOS ERRCNT		;Non-recoverable data error
	SETOM ERRALL
	PUSHJ P,TAPN
	PSIS HSNM
	PSIS HFN1
	PSIS HFN2
	PRINT DATA ERROR TAPE IN ..FILE BEING SKIPPED.._
	TRNN A,RTAPE"F%EOF
	 PUSHJ P,FILSKP		;If not already at EOF, skip file
	SETOM RDERR
	POP P,LPTSW
	POP P,D
	POP P,B
	POP P,A
	POPJ P,

;WRITE BLOCK (NOT RECORD) TO TAPE, AOBJN POINTER IN A
MAGWRI:	SKIPGE TAPTYP
	 JRST [	SETOM CTRLG	;Remote drive
		PUSHJ P,RTAPE"WRITE
		JRST CTRLGX ]
	.IOT MAGOUT,A		;Local drive
	POPJ P,

;Come here if write error on remote drive
;during RTAPE"WRITE, RTAPE"FORCE, or RTAPE"WRTFM
;Stack level unpredictable, but not at interrupt level
;All writes pass through ADMP4, which saves state so we can restore it
RMTWER:	PUSHJ P,CTRLGX
	PUSH P,LPTSW		;Error messages on TTY
	SETZM LPTSW
	MOVE A,RTAPE"STSFLG
	TRNE A,RTAPE"F%EOT
	 JRST RMTEOT
	PRINT _TAPE WRITE ERROR_
	PUSHJ P,RTAPE"PRSTS
	PRINT _SIMULATING E-O-T ..
RMTEOT:	MOVEI A,FOOB	;AH ! I KNOW HOW TO HANDLE END OF TAPE !
	SKIPGE FULLDMP
	 JRST INTX1	;CAUSE PROGRAM TO RESTART AT FOOB
	DIE _PHYSICAL END OF TAPE

;BAD HEADER, SKIP FILE
BDHD:	MOVE A,[-3,,HSNM]
	PUSHJ P,MAGREAD
	 JRST MAGOP	;ERROR
BDHD1:	PRINT _BAD HEADER 
	PSIS HSNM	;TRY TO TYPE STUFF PAST LOSING HEADER
	PSIS HFN1
	PSIS HFN2
	PUSHJ P,CRR
	PUSHJ P,FILSKP	;FLUSH CURRENT FILE
	JRST MAGOP

;MAGOP, NOT A LINK
MAGOP1:	MOVE A,HFN1
	MOVE B,HFN2
	CAMN A,[SIXBIT /M.F.D./]
	 CAME B,[SIXBIT /(FILE)/]
	  SKIPA
	   JRST MAGOP2		;READ IN COPY OF MFD
	CAMN A,[SIXBIT /.FILE./]
	 CAME B,[SIXBIT /(DIR)/]
	  JRST POPJ1		;AN ORDINARY FILE, TAKE SUCCESS RETURN
;READ IN UFD FROM TAPE
	SETZM UFDBUF
	MOVE A,[UFDBUF,,UFDBUF+1]
	BLT A,UFDBUF+1777
	MOVE A,[-UDDESC,,UFDBUF]	;GET HEADER AREA
	PUSHJ P,MAGRDL
	 JRST MAGOP		;ERROR, FLUSH
	MOVE A,UFDBUF+UDESCP	;COMPUTE SIZE OF DESCRIPTOR AREA
	ADDI A,5
	IDIVI A,6
	MOVNS A
	HRLS A
	HRRI A,UFDBUF+UDDESC
	PUSHJ P,MAGRDL		;READ IN DESCRIPTOR AREA
	 JRST MAGOP		;ERROR, FLUSH
	MOVE A,UDNAMP+UFDBUF	;COMPUTE SIZE OF NAME AREA
	SUBI A,2000
	HRLS A
	HRR A,UDNAMP+UFDBUF
	ADDI A,UFDBUF
	PUSHJ P,MAGRDL		;READ IN NAME AREA
	 JRST MAGOP		;ERROR, FLUSH
	MOVE A,HDATE
	MOVEM A,UFDDAT
	SKIPGE RELOSW		;IF RELOADING, 
	 PUSHJ P,MAGOP3		; UPDATE DISK DIRECTORY FROM TAPE
	SKIPGE PDIRSW
	 PUSHJ P,PTUFD		;PRINT UFD FROM TAPE
	HRRZ A,(P)
	CAIN A,RLDRD0+1		;RELOAD RDATES FROM THIS DIR
	 PUSHJ P,RLDRD1
	PUSHJ P,FILSKP		;DONE WITH THIS FILE
	JRST MAGOP		;TRY TO OPEN A REAL FILE

PTUFD:	PUSH P,C
	PUSH P,B
	PUSH P,A
	PUSH P,W
	PUSH P,N
	MOVE C,UFDBUF+UDNAMP
	ADDI C,UFDBUF
PTUFD1: CAIL C,UFDBUF+2000
	 JRST [	POP P,N
		POP P,W
		POP P,A
		POP P,B
		POP P,C
		POPJ P,]
	SKIPE (C)
	SKIPN 1(C)
	JRST PTUFD2
	PUSHJ P,CRR
	MOVE B,UNRNDM(C)
	TLNE B,UNLINK
	 PASC [ASCIZ /L /]
	PSIS (C)
	PSIS 1(C)
	TLNE B,UNLINK
	 JRST [	PASC [ASCIZ /=>/]
		LDB B,[UNDSCP+UNRNDM(C)] ; GET FIRST BYTE INDEX
		PUSH P,B+1
		IDIVI B,UFDBYT
		ADDI B,UFDBUF+UDDESC
		MOVNI N,-6(B+1)
		IMULI N,6
		HRLI N,60200		;ASSUMING B=2 !!!
		ROT N,30.
		POP P,B+1
		PUSHJ P,GETLSL
		PSIS W			;SNAME
		PASC [ASCIZ /;/]
		PUSHJ P,GETLSL
		PSIS W			;LINK FN1
		PUSHJ P,GETLSL
		PSIS W
		JRST .+1]
PTUFD2:	ADDI C,LUNBLK
	JRST PTUFD1


;"RELOAD" A DIRECTORY IF IT MATCHES AGAINST THE FILE SPEC LIST
MAGOP3:	MOVN A,LENGTH
	HRLZS A
MAGOP4:	SKIPE B,FMSNM(A)
	 CAMN B,HSNM
	  JRST DIRUPD
	AOBJN A,MAGOP4
	POPJ P,

;READ IN MFD FROM TAPE
MAGOP2:	MOVE A,[-2000,,MFDBUF]
	PUSHJ P,MAGRDL
	 JRST MAGOP		;ERROR, FLUSH
	MOVE A,HDATE
	MOVEM A,MFDDAT
	PUSHJ P,FILSKP		;DONE WITH THIS FILE
;GO THROUGH ALL DIRECTORIES IN DISK MFD BUT NOT IN TAPE MFD.
;FOR EACH, SEE IF IT CONTAINS NO 'NEW' FILES.  IF SO, OFFER
;TO DELETE IT.  ONLY DO THIS WHEN RELOADING, OF COURSE.
	SKIPL RELOSW
	 JRST MAGOP
	.CALL [SETZ ? SIXBIT/OPEN/ ? [.BII,,UFDCH]
	       [SIXBIT/DSK/] ? [SIXBIT/M.F.D./] ? SETZ [SIXBIT/(FILE)/]]
	 .LOSE 1400
	MOVE A,[-2000,,BUF]
	.IOT UFDCH,A
	.CLOSE UFDCH,
	SKIPA E,BUF+MDNAMP	;POINTS AT DISK MFD
MFDUP3:	 ADDI E,LMNBLK
	CAIL E,2000
	 JRST MAGOP		;DONE ALL OF DISK MFD
	SKIPN A,BUF(E)		;NAME OF A DISK DIR
	 JRST MFDUP3
	MOVE D,MFDBUF+MDNAMP	;POINTS AT TAPE MFD
MFDUP2:	CAIL D,2000
	 JRST MFDUP4		;DIR EXISTS ON DISK BUT NOT ON TAPE
	CAMN A,MFDBUF(D)
	 JRST MFDUP3		;OK, DIR EXISTS ON BOTH
	ADDI D,LMNBLK
	JRST MFDUP2

MFDUP4:	.SUSET [.SSNAME,,A]	;THIS DIR IS CANDIDATE FOR DELETION
	MOVEI A,.BII
	HRLM A,FNO
	.OPEN UFDCH,FNO
	 .LOSE 1400
	MOVE A,[-2000,,BIF]
	.IOT UFDCH,A
	.CLOSE UFDCH,
	MOVE B,BIF+UDNAMP
	CAIL B,2000
	 JRST MFDUP3		;Directory already empty, ignore
	CAIA
MFDUP5:	 ADDI B,LUNBLK
	CAIL B,2000
	 JRST MFDUP6
	MOVE C,UNDATE+BIF(B)
	CAMLE C,MFDDAT
	 JRST MFDUP3		;NEW FILE, PRESERVE THE DIR
	HLLZ C,UNREF+BIF(B)
	CAMLE C,MFDDAT
	 JRST MFDUP3		;OLD FILE, BUT NEWLY REFERENCED
	JRST MFDUP5

MFDUP6:	PUSH P,LPTSW
	SETZM LPTSW
	PRINT _Directory
	PSIS BIF+UDNAME
	PRINT [ exists on disk but not tape and contains only old files.]
	PRINT [_Shall I delete it? ]
	PUSHJ P,GETSYL
	PUSHJ P,CRR
	POP P,LPTSW
	CAMN SYM,[SIXBIT/NO/]
	 JRST MFDUP3
	CAME SYM,[SIXBIT/YES/]
	 JRST MFDUP6
	SKIPA B,BIF+UDNAMP
MFDUP7:	 ADDI B,LUNBLK
	CAIL B,2000
	 JRST MFDUP3
	.CALL [SETZ ? 'DELETE ? [SIXBIT/DSK/] 
	       BIF+UNFN1(B) ? SETZ BIF+UNFN2(B)]
	 .LOSE 1400
	JRST MFDUP7
SUBTTL UPDATE DISK DIRECTORY FROM TAPE (RELOAD)

DIRUPD:	.SUSET [.SSNAM,,UFDBUF+UDNAME]
	MOVEI A,.BII
	HRLM A,FNO
	.OPEN UFDCH,FNO
	 CAIA
	  JRST DIRU0
	.SUSET [.RIOS+UFDCH,,A]	;DIR SEEMS NOT TO EXIST
	LDB A,[220600,,A]
	CAIE A,20		;NO SUCH DIRECTORY ERROR CODE
	 .LOSE			;HMM, NEED HUMAN ASSISTANCE
	SKIPE CRDIR
	 JRST DIRUCR
	PUSH P,LPTSW
	SETZM LPTSW
	PRINT _DIRECTORY
	PSIS UFDBUF+UDNAME
	PRINT [ DOES NOT EXIST ON DISK, SHALL I CREATE IT? ]
	PUSHJ P,TYI
	MOVE D,A
	PUSHJ P,CRR
	POP P,LPTSW
	CAIE D,"Y
	 POPJ P,		;NOT CREATING IT, GIVE UP
DIRUCR:	.OPEN UFDCH,CRUFD
	 JFCL			;SHOULD GET FNF
	JRST DIRUPD		;NOW TRY AGAIN

DIRU0:	MOVE A,[-2000,,BIF]	;READ DISK COPY INTO COMPARE BUFFER
	.IOT UFDCH,A
	.CLOSE UFDCH,
	MOVE B,BIF+UDNAMP
	ADDI B,BIF		;B POINTS TO NAME AREA ON DISK COPY
	MOVEI A,.BII+30		;DON'T CHASE LINKS BIT, DON'T SET RDATE BIT.
	HRLM A,TRNI		;DROPS THROUGH

;HERE WE LOOP OVER ALL FILES ON DISK ON THIS DIRECTORY.  FOR EACH ONE,
;IF IT IS NOT ON THE TAPE THEN (UNLESS IT IS NEW) WE DELETE IT.
;IF IT IS ON THE TAPE, AND THE TAPE COPY IS NEWER, WE DELETE THE
;DISK FILE TO TRY AND AVOID GETTING DEVICE/DIRECTORY FULL WHEN WE
;TRY AND LOAD IT LATER ON.  IF IT SEEMS TO BE THE SAME VERSION
;ON TAPE AND ON DISK, WE UPDATE THE MISCELLANEOUS ATTRIBUTES.
;NOTE THAT THIS LOOP APPLIES TO LINKS AS WELL AS FILES.
DIRUPL:	CAIL B,BIF+2000
	 JRST DIRU5		;PROCESSED WHOLE DIRECTORY
	MOVE D,(B)
	MOVE E,1(B)
	MOVEM D,FN1
	MOVEM E,FN2
	MOVE A,UNDATE(B)
	CAMLE A,UFDDAT		;DISK FILE NEWER THAN TAPE, LEAVE IT ALONE
	 JRST DIRUPN
	HLLZ A,UNREF(B)
	CAMLE A,UFDDAT		;OLD FILE, BUT RECENTLY REFERENCED,
	 JRST DIRU8		; SO LEAVE IT ALONE
	MOVE C,UFDBUF+UDNAMP
	ADDI C,UFDBUF		;C POINTS TO NAME AREA ON TAPE COPY
DIRU1:	CAIL C,UFDBUF+2000	;FIND TAPE COPY IF IT EXISTS
	 JRST DIRU4
	CAMN D,(C)
	 CAME E,1(C)
	  JRST DIRU2
	SKIPL LDPACK		;DON'T MESS OVER NOW, IF WILL BE RELOADING
	 JRST DIRU8		;TAPE COPY IN SORRY MODE ANYWAY.
	MOVE A,UNDATE(B)
	CAME A,UNDATE(C)
	 JRST DIRU4A		;SAME NAMES, DIFFERENT CREATION DATE, DELETE IT
	JRST DIRU3

DIRU2:	ADDI C,LUNBLK
	JRST DIRU1

;FILE DOES NOT EXIST ON TAPE, OR WILL BE LOADED OVER.
;DELETE IT EITHER BECAUSE BEING FLUSHED OR TO MAKE ENOUGH ROOM
;ON DISK AND IN DIR TO ALLOW IT TO BE RELOADED.
DIRU4:	SKIPN LSTWHL
	 JRST DIRU4A
	PRINT [DELETE]		;MAKE LISTING LINE FOR FILE REALLY BEING
	PSIS UFDBUF+UDNAME	;DELETED (I.E. NOT JUST BEING LOADED OVER)
	PSIS FN1
	PSIS FN2
	PUSHJ P,CRR
DIRU4A:	.FDELE TRNI		;DELETE IT FROM DISK
	 JFCL
	JRST DIRU8

;SAME NAMES, SAME CREATION DATE.  RESTORE OTHER CRUFT.
;WORKS EVEN FOR LINKS SINCE DON'T CHASE LINKS BITS IS SET
DIRU3:	SETO E,			;FLAG NOT OPENED YET
	HLLZ A,UNREF(B)
	HLLZ D,UNREF(C)
	CAME A,D
	 PUSHJ P,DIRURF		;UPDATE REF DATE
	LDB A,[UNAUTH+UNREF(B)]
	LDB D,[UNAUTH+UNREF(C)]
	CAME A,D
	 PUSHJ P,DIRUAU		;UPDATE AUTHOR
	LDB A,[430100,,UNRNDM(B)]
	LDB D,[430100,,UNRNDM(C)]
	CAME A,D
	 PUSHJ P,DIRUDB		;UPDATE REAPBIT
	LDB A,[230100,,UNRNDM(B)]
	LDB D,[230100,,UNRNDM(C)]
	CAME A,D
	 PUSHJ P,DIRURB		;UPDATE REAP BIT
	.CLOSE DSKIN,
DIRU8:	ADDI B,LUNBLK
	JRST DIRUPL

;FOUND FILE ON DISK NEWER THAN TAPE.
DIRUPN:	LDB A,[UNPKN+UNRNDM(B)]
	CAME A,LDPACK
	 JRST DIRU8		;LEAVE IT
	LDB A,[UNLNKB+UNRNDM(B)]
	JUMPN A,DIRU8		;LINK IS OK
	JRST DIRU4		;REALLY GONE, DELETE IT

;GET AUTHOR SIXBIT GIVEN MAGIC NUMBER IN DIRECTORY
GEAUTH:	SKIPGE MFDDAT		;INDEX IN A, RETURN MFD ENTRY IN A
	 POPJ P,		;MFD NOT IN CORE, CAN'T LOOK IT UP
	PUSH P,B
	MOVE B,MDNUDS+MFDBUF
	SUB A,B
	LSH A,1
	MOVE A,MFDBUF+2000(A)
	POP P,B
	AOS (P)
	POPJ P,

;FILE NOT ALREADY OPEN, OPEN SO CAN UPDATE STUFF
DIROPF:	OPEN DSKIN,TRNI
	 JRST POP1J
	POPJ P,

POP1J:	SUB P,[1,,1]
	POPJ P,

;UPDATE DUMPCHECK BIT
DIRUDB:	AOSN E
	 PUSHJ P,DIROPF
	.CALL DIRSDB
	 JFCL
	POPJ P,

DIRURB:	AOSN E
	 PUSHJ P,DIROPF
	.CALL DIRSRB
	 JFCL
	POPJ P,

DIRURF:	AOSN E
	 PUSHJ P,DIROPF
	.CALL DIRSRF
	 JFCL
	POPJ P,

DIRUAU:	MOVE A,D
	PUSHJ P,GEAUTH
	 POPJ P,
	AOSN E
	 PUSHJ P,DIROPF
	.CALL DIRSAU
	 JFCL
	POPJ P,

DIRSAU:	SETZ
	SIXBIT /SAUTH/
	1000,,DSKIN
	SETZ A

DIRSDB:	SETZ
	SIXBIT /SDMPBT/
	1000,,DSKIN
	SETZ D

DIRSRB:	SETZ
	SIXBIT /SREAPB/
	1000,,DSKIN
	SETZ D

DIRSRF:	SETZ
	SIXBIT /SRDATE/
	1000,,DSKIN
	SETZ D

;SCAN ALL FILES IN TAPE UFD AND MAKE ANY REQUIRED LINKS.
;THE REASON THIS HAS TO BE DONE IS THAT LINKS ARE NOT
;PUT ON INCREMENTAL DUMPS.
;NOTE THAT IF ANY FILE WITH THE SAME NAME EXISTS, DON'T MAKE
; THE LINK SINCE THE FILE WAS LESS WORTHY IT WOULD
; HAVE BEEN DELETED AT DIRU4.
DIRU5:	MOVE C,UFDBUF+UDNAMP	;SCAN NAME AREA OF TAPE DIRECTORY
	CAIL C,2000
	 JRST DIRU7		;EMPTY
	ADDI C,UFDBUF
DIRU6:	MOVE V,UNRNDM(C)
	TLNE V,UNLINK
	 PUSHJ P,DIRMLK		;MAKE A LINK
	ADDI C,LUNBLK
	CAIGE C,UFDBUF+2000
	 JRST DIRU6
DIRU7:	MOVEI A,.BII		;TURN OFF RANDOM BITS IN TRNI
	HRLM A,TRNI
	.CLOSE DSKOUT,
	POPJ P,			;DIRUPD ALL DONE

DIRMLK:	MOVE W,UNFN1(C)
	MOVEM W,LNKBLK+1	;FIRST NAME
	MOVEM W,FN1
	MOVE W,UNFN2(C)
	MOVEM W,LNKBLK+2
	MOVEM W,FN2
	MOVEI A,30+.BII		;DON'T CHASE LINKS, DON'T SET REF DATE
	HRLM A,TRNI
	.OPEN DSKIN,TRNI	;SEE IF IT EXISTS (EVEN A LINK)
	 CAIA
	  POPJ P,		;YES, DON'T CLOBBER IT
	LDB B,[UNDSCP+UNRNDM(C)] ; GET FIRST BYTE INDEX
	PUSH P,B+1
	IDIVI B,UFDBYT
	ADDI B,UFDBUF+UDDESC
	MOVNI N,-6(B+1)
	IMULI N,6
	HRLI N,60200		;ASSUMING B=2 !!!
	ROT N,30.
	POP P,B+1
	PUSHJ P,GETLSL
	SKIPN W
	 SETOM W		;IN CASE OF ZERO SNAME (?)
	MOVEM W,LNKBLK+5	; SNAME
	PUSHJ P,GETLSL
	MOVEM W,LNKBLK+3	; LINK FN1
	PUSHJ P,GETLSL
	MOVEM W,LNKBLK+4
	;; POP P,B	Good joke flushed by Alan 12/22/87
	.OPEN DSKOUT,LNKBLK	;MAKE THE LINK
	 .LOSE 1400		;HMM, NOT SUPPOSED TO HAVE TROUBLE
	.CALL [SETZ ? 'SFDATE ? MOVEI DSKOUT ? SETZ UNDATE(C)]
	 JFCL
	JRST RELOF2		;UPDATE MISC ATTRIBUTES
SUBTTL PRINT TAPE HEADER

PTHEAD:	PRINT TAPE NO 
	HLRZ A,THTPN
	PDPT A
	SKIPE A			;DON'T CONVERT IF TAPE NUMBER IS ZERO
	 MOVE C,[440600,,NSVTPN]
	PUSHJ P,SIXNUM
	PRINT  CREATION DATE 
	PSIS THDATE
	PUSHJ P,CRR
	SKIPN THTYPE
	 POPJ P,
	PRINT REEL NO 
	HRRZ B,THTPN
	PDPT B
	SKIPGE THTYPE
	 PRINT  OF INCREMENTAL DUMP
	SETZM NPLACE
	PUSHJ P,SNPLAC
	SKIPLE THTYPE
	 PRINT  OF FULL DUMP
	JRST CRR

SIXNUM:	IDIVI A,12		;CREATES SIXBIT FILE NAME FROM CONTENTS OF A
	PUSH P,B		;C INITIALLY SHOULD CONTAIN 440600,,LOC
	CAIE A,0
	 PUSHJ P,SIXNUM
	POP P,A
	ADDI A,20
	IDPB A,C
	POPJ P,
SUBTTL CHECKING OF DUMP TAPES, SETTING HAS-BEEN-DUMPED BITS

;ENTER HERE FROM END OF TAPE DURING AN INCREMENTAL DUMP
ICHECK:	PUSHJ P,MAGOP
	 JRST ICKEOT
	.SUSET [.SSNAM,,HSNM]
	MOVE A,HSNM
	CAMN A,LUSNM
	 JRST ICKEOT	;DON'T CHECK LAST USER (SO I DUMP CONTINUES ON NEXT TAPE WITH FULL USER)
	MOVE A,HFN1
	MOVEM A,FN1
	MOVE A,HFN2
	MOVEM A,FN2
	MOVEI A,10+.BII		;DON'T SET RDATE BIT
	HRLM A,TRNI
	.OPEN DSKIN,TRNI
	 JRST ICK1
	.CALL RDATE
	 JFCL
	MOVE A,FDATE
	CAME A,HDATE
	 JRST ICK1		;BEEN CHANGED SINCE
	MOVE A,[ICKLP,,D]	;RUN LOOP IN ACS IF NOT KL10
	BLT A,D+ICKLPL-1
	SETZ A,
	BLT A,0
	JUMPN A,ICK2		;JUMP IF KL10
	HRRI TER,D		;CLOSE LOOP
ICK2:	MOVE A,[-2000,,BUF]
	.IOT DSKIN,A
	PUSH P,A
	MOVE A,[-2000,,BIF]
	PUSHJ P,MAGRDL
	 JRST ICKER2		;ERROR
	MOVE B,A
	POP P,A
	SUBI B,BIF-BUF
	CAME A,B
	 JRST ICKERR
	CAMN A,[-2000,,BUF]
	 JRST ICK4
	PUSH P,A
	HLLZ B,A
	MOVE A,[-2000,,BUF]
	SUB A,B
	JRST (TER)		;TO CHECKING LOOP IN ACS OR CACHE

ICK3:	POP P,A
	SKIPL A
	 JRST ICK2		;GET ANOTHER BLOCK
ICK4:	MOVE A,[400000,,DSKIN]
	.DMPCH A,
	MOVE A,HSNM
	CAME A,[SIXBIT /VANISH/]
	 JRST ICK1
	.FDELE TRNI
	 JFCL
ICK1:	.CLOSE DSKIN,
	PUSHJ P,FILSKP
	JRST ICHECK

ICKLP:	MOVE B,(A)	;D
	MOVE C,BIF-BUF(A)	;E
	CAME B,C	;N
	 JRST ICKER1	;SYM
	AOBJN A,ICKLP	;TER (RH MODIFIED TO D IF PUT INTO ACS)
	JRST ICK3	;U
ICKLPL==.-ICKLP

ICKER1:	POP P,A
ICKERR:	JRST ICK1

ICKER2:	POP P,A
	.CLOSE DSKIN,
	JRST ICHECK

ICKEOT:	POPJ P,

;LCHECK COMMAND
ALCHEC:	SETOM PNTALL
	JRST ACHEK1

;ICHECK COMMAND
AICHEC:	PUSHJ P,ICHECK
	JRST RET

;CHECK COMMAND
ACHECK:	CLEARM PNTALL
ACHEK1:	SETOM SUPERC		;SUPPRESS DATA ERROR COMMENTS
	CLEARM MICFLG
	SETOM CHKFLG
	.CORE CORSIZ+1
	 JRST .-1
	PUSHJ P,DEVGET		;CRUDE FILE CHECKER
	CLEARM ALLWRD		;RESET TOTAL NUMBER OF WORDS FOR THIS REEL
	SKIPN MICFLG
	 MOVEI A,(SIXBIT /DSK/)
	HRRM A,TRNI
ACHUCK:	PUSHJ P,MAGOP		;OPEN NEXT TAPE FILE
	 JRST ACHIND		;END-OF-TAPE
	.SUSET [.SSNAME,,HSNM]
	MOVE A,HFN1
	MOVEM A,FN1
	MOVE A,HFN2
	MOVEM A,FN2
	CLEARM WRDCNT
	CLEARM LNTCNT
	CLEARM WRDONG
	CLEARM ERRALL
	CLEARM ERRCNT	;RESET # OF TAPE IOCS
	CLEARM ERRDSK	;RESET # OF DISK IOCS
	SKIPE LNKFLG
	 JRST ACHUF3
	MOVEI A,10+.BII		;DON'T SET RDATE BIT
	HRLM A,TRNI
	.OPEN DSKIN,TRNI
	 JRST DSKOPL
	SETOM NEWCHR
	SKIPE MICFLG
	 JRST ACHUF1
	MOVEI A,DSKIN
	.DMPCH A,
	MOVEM A,NEWCHR

ACHUF1:	MOVE A,[-2000,,BUF]
	.IOT DSKIN,A
	HRLOI B,-BUF-1(A)
	EQVI B,BUF	;AOBJN POINTER 1
	SKIPGE A
	 .CLOSE DSKIN,
	PUSH P,A
	MOVE A,[-2000,,BIF]
	PUSHJ P,MAGRDL
	 JRST ACHUF4
	MOVE C,A
	POP P,A
	HRLOI D,-BIF-1(C)
	EQVI D,BIF		;AOBJN POINTER 2
	SKIPL A
	 SKIPGE C
	  PUSHJ P,FILSKP
	PUSHJ P,COMPAR		;COMPARE THE TWO BUFFERS
	HRRZI D,-BIF(C)
	ADDM D,WRDCNT
	SKIPL A
	 JUMPGE C,ACHUF1	;MORE TO COME
	JRST ACHUF2

;LOSSAGE
ACHUF2:	SKIPN PNTALL
	 SKIPE ERRALL
	  SKIPA
	   JRST CHKT5
	PUSHJ P,LOUSZ
CHKT6:	PDPT WRDCNT
	PRINT  WORD
	SOSE WRDCNT
	 PRINT S
	SKIPN WRDCNT
	 PRINT  
CHKT5:	SKIPN WRDONG
	 JRST CHKT4
	PDPT WRDONG
	PRINT  BAD WORD
	SOSE WRDONG
	 PRINT S
	SKIPN WRDONG
	 PRINT  
	PRINT  AT
	PDPT SAVAOB
	.CLOSE DSKIN,
CHKT4:	MOVE A,WRDCNT
	ADDM A,ALLWRD
	SKIPN V,LNTCNT
	 JRST CHKT7
	MOVM W,V
	PDPT W
	SKIPL V
	 PRINT  LONGER 
	SKIPG V
	 PRINT  SHORTER
	PRINT  ON DISK
CHKT7:	SKIPN ERRCNT
	 JRST CHKTA
	PDPT ERRCNT
	PRINT  *TAPE IOC
	SOSE ERRCNT
	 PRINT S
	SKIPN ERRCNT
	 PRINT  
	PRINT *
CHKTA:	SKIPN ERRDSK
	 JRST CHKTB
	PDPT ERRDSK
	PRINT  *DISK IOC
	SOSE ERRDSK
	 PRINT S
	SKIPN ERRDSK
	 PRINT  
	PRINT *
CHKTB:	SKIPN PNTALL
	 SKIPE ERRALL
	  PRINT  ! 
	JRST ACHUCK

ACHUF3:	PUSHJ P,FILSKP
	JRST ACHUF2

ACHUF4:	POP P,A
	JRST ACHUF2

LOUSZ:	PUSHJ P,LOUSY
	 JFCL
	SKIPE MICFLG
	 POPJ P,
	SKIPN NEWCHR
	 PRINT  NEW 
	SKIPE NEWCHR
	 PRINT      
	POPJ P,

DSKOPL:	PUSHJ P,LOUSY
	 JFCL
	PUSHJ P,OPINFL
	SETOM ERRALL
	PUSHJ P,CHKT3	;FLUSH TAPE FILE
	JRST CHKT6

CHKT3:	PUSH P,A
	MOVE A,[-2000,,BIF]
	PUSHJ P,MAGRDL
	 JRST POPAJ
	MOVE C,A
	POP P,A
	HRRZI D,-BIF(C)
	ADDM D,WRDCNT
	JUMPGE C,CHKT3
	PUSHJ P,FILSKP
	POPJ P,

ACHIND:	.CORE CORSIZ
	 JRST .-1
	.CLOSE DSKIN,
	.CLOSE MAGIN,
	PRINT _ REEL =
	HRRZ A,THTPN
	PDPT A
	PRINT  HAS 
	PDPT ALLWRD
	PRINT  WORDS__
	POPJ P,

COMPAR:	MOVE U,B
	MOVE V,D
	MOVE W,U
	XOR W,V
	TLNE W,-1
	 JRST DSKUNC
COMPA0:	JUMPGE U,CPOPJ
	JUMPGE V,CPOPJ
COMPA1:	MOVE W,(U)
	CAME W,(V)
	 JRST WRNWRD
COMPA2:	AOBJN U,.+2
	 POPJ P,
	AOBJN V,COMPA1
	POPJ P,

WRNWRD:	SKIPN WRDONG	;FIRST LOSSAGE ?
	 PUSHJ P,WRNWR1
	AOS WRDONG
	JRST COMPA2

WRNWR1:	HRRZ W,U
	SUBI W,BUF
	ADD W,WRDCNT
	MOVEM W,SAVAOB
	POPJ P,

DSKUNC:	HLRES U
	HLRES V
	SUB V,U
	ADDM V,LNTCNT
	SETOM ERRALL
	MOVE U,B
	MOVE V,D
	JRST COMPA0

SUBTTL RESTORE REFERENCE DATES

;START NORMALLY, THEN ^Z AND START AGAIN HERE
;DON'T TRY TO USE THIS DUMP JOB FOR ANYTHING ELSE!
RLDRDT:	PRINT RESTORE REFERENCE DATES FROM TAPE WHEN CURRENT RDATE IS - 
	PUSHJ P,GETDAT
	HLLZS DATE
	MOVEI A,%DONRF+%DONLK+.UAI
	HRLM A,TRNI
RLDRD0:	PUSHJ P,MAGOP		;OPEN TAPE
	 JRST MLP		;END OF TAPE
	PUSHJ P,FILSKP		;ADVANCE TO NEXT FILE
	JRST RLDRD0

;CALLED BY MAGOP IF DIRECTORY SEEN
RLDRD1:	.SUSET [.SSNAME,,UFDBUF+UDNAME]
	PUSHJ P,CRR
	PSIS UFDBUF+UDNAME
	SKIPA U,UFDBUF+UDNAMP
RLDRD2:	 ADDI U,LUNBLK
	CAILE U,1777-4
	 POPJ P,		;END OF NAME AREA
	MOVE A,UFDBUF+UNFN1(U)
	MOVEM A,FN1
	MOVE A,UFDBUF+UNFN2(U)
	MOVEM A,FN2
	OPEN DSKIN,TRNI		;OPEN DISK INPUT
	 JRST RLDRD2		;FILE DOESN'T SEEM TO EXIST ANY MORE
	.CALL RRDATE
	 .LOSE %LSFIL
	HLLZ A,RFDATE
	CAME A,DATE
	 JRST RLDRD3
	.CALL [ SETZ ? 'SRDATE ? MOVEI DSKIN ? SETZ UFDBUF+UNREF(U)]
	 .LOSE %LSFIL
RLDRD3:	.CLOSE DSKIN,
	JRST RLDRD2

SUBTTL LOCAL TO REMOTE TAPE COPY

;START NORMALLY, GIVE REMOTE COMMAND, THEN ^Z AND START AGAIN HERE
TCOPY:	MOVE A,TAPTYP
	AOJL A,.+2
	 DIE You must use the REMOTE command to specify tape server host first
	PRINT _Mount input tape on local drive and blank output tape on remote drive.
	SETZM DMPMOD
	SETOM TCOPYF
	SETOM OTAPE		;Start of output tape
TCOPY0:	PRINT [_Type OK when ready.  ]
	PUSHJ P,GETSYL
	 JRST .-1
TCOPY1:	SETOM ITAPE		;Start of input tape
	PUSHJ P,RMTSTS		;Make sure it's mounted (this also
	TRNN A,TF%RDY		; drains queued status)
	 DIE OUTPUT TAPE NOT MOUNTED
	PUSHJ P,SETIT4		;Get status of local drive
	TRNE A,TF%BOT
	 JRST TCOPY3
	PRINT [_Rewind input tape? ]
	PUSHJ P,YESNO
	 JRST TCOPY3
	MOVEI A,1
	PUSHJ P,LCLOPR
TCOPY3:	PUSHJ P,DFHBLK		; Set defaults in HBLK
	;; Start copying a file
	SETOM EOFF
	OPEN MAGIN,MAGI
	 JRST NAUGHT
TCOPY4:	SETZM RDERR
	SETZM PHYEOT
	MOVE C,[-2000,,BUF]	;Copy next block of file
	.IOT MAGIN,C
	SKIPE RDERR
	 JRST TCOPY9		;File cannot be read
	PUSH P,C		;Save post-input aobjn pointer
	MOVEI B,BUF		;Pointer to next header input
	HRLOI A,-BUF-1(C)
	EQVI A,BUF		;Aobjn pointer for output
	AOSE EOFF		;See if first record in file
	 JRST TCOPY6		;No, this is the middle of a file
	CAMN C,[-2000,,BUF]
	 JRST TCOPY7		;Logical end of tape
	AOSE ITAPE		;See if first file on tape
	 JRST TCOPY5
	MOVE D,(B)		;First word on tape
	TRNN D,-1		;Skip if bad header
	 CAMGE D,[-LTHBLK,,]	;Skip if good header
	  JRST TCOPY5
	MOVSI C,1(B)		;Save tape header
	HRRI C,THBLK+1
	BLT C,THBLK+LTHBLK-1
	HLRO C,D
	MOVN C,C		;Number of words in tape header
	ADDI B,(C)		;Advance over tape header
	HRL C,C
	AOSE OTAPE		;See if first file on output tape
	 ADD A,C		;No, skip over tape header on output
TCOPY5:	MOVE D,(B)		;File header
	TRNN D,-1		;Skip if bad header
	 CAMGE D,[-LHBLK,,]	;Skip if good header
	  JRST TCOPY6
	CAMLE D,[-LHBLKZ,,]	;Skip if good header
	 JRST TCOPY6
	MOVSI B,1(B)		;Save file header for error messages
	HRRI B,HBLK+1
	BLT B,HBLK+LHBLK-1
TCOPY6:	JUMPGE A,TCOP6A		;Jump if empty record
	PUSHJ P,MAGWRI
	AOS OTAPE		;Something has been written
TCOP6A:	POP P,C			;Recover post-input aobjn pointer
	JUMPGE C,TCOPY4		;Jump unless EOF
	PUSHJ P,AEOF		;Write EOF mark on tape
	JRST TCOPY3		;Copy next file

;Physical end of tape reached
TCOP7A:	AOSE EOFF		;See if first record in file
	 PUSHJ P,AEOF		;No, close off that partial file
TCOPY7:	PRINT _End of tape._
	MOVEI A,2		;Rewind and unload the input tape
	PUSHJ P,LCLOPR
	PRINT [Copy another tape onto same output tape? ]
	PUSHJ P,YESNO
	 JRST TCOPY8
	PRINT _Mount next input tape on local drive.
	JRST TCOPY0

TCOPY8:	PUSHJ P,CLSOUT		;Write logical EOT
	PUSHJ P,AUNLD		;Then unload the output tape
	JRST TCOPY

;File cannot be read -- system won't let us see the bad data either
TCOPY9:	SKIPE PHYEOT
	 JRST TCOP7A
	AOSE EOFF		;See if first record in file
	 JRST TCOP9A		;No
	AOS ITAPE		;For file header that could not be read
	AOSE OTAPE		;See if first file on output tape
	 JRST TCOPY3		;No, don't copy this file at all
	SETZM THTPN		;Write dummy header since real header
	SETZM THDATE		;could not be read
	SETZM THTYPE
	MOVE A,[-LTHBLK,,THBLK]
	PUSHJ P,MAGWRI
	JRST TCOPY3		;Don't copy file, just tape header

TCOP9A:	SETZM BUF		;Substitute one block of nulls for rest of file
	MOVE A,[BUF,,BUF+1]
	BLT A,BUF+1777
	MOVE A,[-2000,,BUF]
	PUSHJ P,MAGWRI
	PUSHJ P,AEOF		;Write EOF mark on tape
	JRST TCOPY3		;Copy next file

;Skip if YES
	PRINT [ Please type YES or NO: ]
YESNO:	PUSHJ P,GETSYL
	 JRST YESNO-1
	CAMN SYM,[SIXBIT/YES/]
	 AOSA (P)
	CAMN SYM,[SIXBIT/NO/]
	 POPJ P,
	JRST YESNO-1
SUBTTL REMOTE TAPE SUPPORT

$$CHAOS==1
$$HOSTNM==1
$$SYMLOOK==1
$$HSTMAP==1
$$CONNECT==1
.INSRT SYSNET;NETWRK >

NETWRK"DEBUG:	0		;NETWRK wants this for some reason

	.BEGIN RTAPE		;Remote Tape Package

comment \  --- stuff remaining to do

Problems convincing old server to disconnect from drive sometimes.
Attempts to create new server say drive is still busy (using HT).

Unix (Hermes) appears to have a wonderful bug where if you write
a tape, rewind it, read a bunch, and then lose the network connection,
it writes two eof marks wherever the tape happened to be positioned.
Thanks a lot.

Hermes drive tries really hard to screw you by setting the density
to 6250, even though I tell it in the mount command to use 1600.
When you mount the tape the drive's 1600 light is lit, but then
when you walk away it switches to 6250.  Try making sure the
"sys sel" light is not on.

VMS (Pygmalion) doesn't allow writing short records and also gives
an error status at logical end of tape.

CORE DUMP MODE IN ITS SERVER DUE TO BLOCK SIZE PROBLEMS ??
DUMP never seems to want to call CLOSE

Should fix ILDB/IDPB loop in SIOKT to use KLH unaligned byte move
which I think can be found in SYSENG;FSCOPY
Perhaps this can be finessed by knowing what the alignment of the
system's buffers probably is and aligning my own buffer correspondingly.
Or just do my own packetizing, this will never run over TCP
The old code certainly spent essentially all its time at SIOKS3
So I put in my own packetizing for output and the speed is slow but
no longer pitifull.  I fixed my byte copying routine, the next
culprit is data reformatting in the Chaosnet interrupt routines.

WRTFM should not need to force a packet out to the network,
but that's how my modularity is right now.
\

DEFINE PUSHAE AC,LIST
IRP LOC,,[LIST]
PUSH AC,LOC
TERMIN
TERMIN

DEFINE POPAE AC,LIST
IRP LOC,,[LIST]
POP AC,LOC
TERMIN
TERMIN

DEFINE PRTERR REASON
	DIE [Remote-Tape protocol error--REASON]
TERMIN

;Remote Tape Protocol Definitions

;User to Server Opcodes

RT%LGI==1	;Login username password
RT%MNT==2	;Mount direction reelid drive blocksize density norewind
RT%PRB==3	;Probe uid (2 bytes)
RT%RD==4	;Read n-records (ascii decimal); no arg means read continuous
RT%WRT==5	;Record
RT%RWD==6	;Rewind
RT%SYN==7	;Rewind-sync
RT%UNL==8	;Rewind-unload
RT%SPF==9	;Space-file n-files (ascii decimal)
RT%SPR==10.	;Space-record n-records (ascii decimal)
RT%WFM==12.	;Write-file-mark
RT%CLS==13.	;Close

;Server to User Opcodes

RT%LGR==33.	;Login-response code message-string
RT%DTA==34.	;Read-data
RT%RFM==35.	;Read-file-mark
RT%STS==36.	;Status 

;Storage for decoded status, second word of each is byte length
STSVER:	1 ? 1			;Protocol version number
STSUID:	0 ? 2			;Probe unique ID, 0 if unsolicited
STSNRD:	0 ? 3			;Number of records read
STSNSK:	0 ? 3			;Number of objects skipped (?)
STSNWD:	0 ? 3			;Number of writes discarded
STSLOP:	0 ? 1			;Last non-probe opcode received
STSDEN:	0 ? 2			;Density in bits per inch
STSRTR:	0 ? 2			;Retries (?)
STSDRV:	BLOCK 4			;Asciz drive name
STSFLG:	0			;Word of flag bits
F%SOL==1			;Solicited flag
F%BOT==2			;Beginning of tape
F%EOT==4			;Past end of tape
F%EOF==10			;EOF encountered in read
F%NLI==20			;Not logged in error
F%MNT==40			;Mounted
F%STRG==100			;Explanatory string follows status
F%HER==200			;Hard error encountered
F%SER==400			;Soft error encountered
F%OFFL==1000			;Offline
F%NREC==2000			;Non-record-oriented device

STATUS:	BLOCK 20		;Most recent explanatory string, asciz

UIDG:	0			;Unique ID generator

RDAHD:	0			;0 idle, 1 reading, -1 stopped with exception,
				; -2 stopped at file mark

MXRECW==2000			;Maximum record length in words
MXRECB==MXRECW*5		;Maximum record length in bytes
BUFFER:	BLOCK <MXRECB+19.+3>/4	;Can hold biggest record (32-bit words)
BUFCNT:	0			;Number of 32-bit words sitting in buffer
BUFPNT:	0			;Number of words already taken out

RESBUF:	BLOCK 4			;Residue of record (36-bit words)
RESBFC:	0			;Number of 36-bit words in RESBUF
RESBFP:	0			;Number of words already taken out

MXSTSB==200
STSBUF:	BLOCK MXSTSB/4		;Buffer for status records

;Probe for status of remote drive
;Clobbers all registers, returns flags in D
PROBE:	PUSHJ P,SPROBE		;Send probe command
PROBE7:	PUSHJ P,LISTEN		;Read a response, waiting if necessary
	 PUSHJ P,PROBE0
	MOVE T,UIDG		;Verify that it isn't stale
	CAME T,STSUID
	 JRST PROBE7		;Try again
	POPJ P,			;OK

SPROBE:	AOS D,UIDG		;Get a unique ID
	DPB D,[341000,,STSBUF]	;Send it LSB first
	LSH D,-8
	DPB D,[241000,,STSBUF]
	MOVEI A,RT%PRB
	MOVE B,[440800,,STSBUF]
	MOVEI C,2
	JRST RSXMTF

;Listen for status, read it and skip return if there is any
LISTEN:	.CALL [ SETZ ? 'WHYINT ? MOVEI RSICH ? MOVEM T ? MOVEM T ? SETZM T ]
	 .LOSE %LSFIL
	TLNN T,-1		;Network input available?
	 POPJ P,		;No, exit
	MOVE B,[440800,,STSBUF]
	MOVEI C,MXSTSB
	PUSHJ P,RSRCV		;Yes, read it into status buffer
	CAIE A,RT%STS
	 JRST LISTEN		;Ignore any input other than Status
	AOS (P)			;Skip return
	JRST PROBE1

;Read a status record
PROBE0:	MOVE B,[440800,,STSBUF]
	MOVEI C,MXSTSB
	PUSHJ P,RSRCV		;Should be status, response or unsolicited
	CAIE A,RT%STS
	 JRST PROBE0		;Something else, discard it
;Process a status record already received
PROBE1:	MOVEI A,STSVER		;Read status into here
PROBE2:	MOVE T,1(A)		;Number of bytes in this field
	SETZB D,(A)		;Accumulate field here, least significant first
PROBE3:	ILDB TT,B
	LSH TT,(D)
	ADDI D,8
	IORM TT,(A)
	SOJG T,PROBE3
	ADDI A,2
	CAIE A,STSDRV
	 JRST PROBE2
	ILDB T,B		;Number of valid characters in drive name
	MOVEI D,16.		;Number of allocated characters in drive name
	HRLI A,440700
PROBE4:	ILDB TT,B
	SOSGE T
	 MOVEI A,0
	IDPB TT,A
	SOJG D,PROBE4
	IDPB D,A		;Ensure asciz termination
	ILDB D,B		;First byte of flags
	ILDB T,B		;Second byte of flags
	LSH T,8
	IOR D,TT		;Leave flags in D for caller
	MOVEM D,STSFLG
	SUBI C,36.		;Number of bytes of status
	SKIPGE C
	 PRTERR status record too short
	TRNN D,F%STRG		;Explanatory string follows?
	 JRST PROBE6
	MOVE A,[440700,,STATUS]	;Yes, swallow it
PROBE5:	ILDB T,B
PROB5A:	CAME A,[100700,,STATUS+20]
	 IDPB T,A
	CAIN T,215
	 JRST [	MOVEI T,12 ? JRST PROB5A ]
	SOJG C,PROBE5
	IDPB C,A
IFN 0,[		;temporary code not needed any more I think
	PUSH P,LPTSW
	SETZM LPTSW
	PRINT _REMOTE TAPE STATUS=
	PASC STATUS
	PRINT _
	POP P,LPTSW
];IFN 0
PROBE6:	MOVE A,STSVER
	CAIE A,1
	 PRTERR wrong protocol version number
	POPJ P,			;Done reading status, flags in D

;Print remote tape status most recently read
PRSTS:	PUSH P,A
	PRINT Remote tape status=
	PASC STATUS
	SKIPE STATUS
	 PUSHJ P,CRR
	MOVE A,STSFLG
	TRNE A,F%BOT
	 PRINT [BOT ]
	TRNE A,F%EOT
	 PRINT [EOT ]
	TRNE A,F%EOF
	 PRINT [EOF ]
	TRNE A,F%NLI
	 PRINT [Not-logged-in ]
	TRNN A,F%MNT
	 PRINT [Not-mounted ]
	TRNE A,F%HER
	 PRINT [Hard-error ]
	TRNE A,F%SER
	 PRINT [Soft-error ]
	TRNE A,F%OFFL
	 PRINT [Offline ]
	POP P,A
	POPJ P,

;Random tape operations, none wait for completion
UNLOAD:	SKIPA A,[RT%UNL]
REWIND:	 MOVEI A,RT%RWD
RSXMT0:	MOVEI C,0
	MOVE B,[440800,,BUFFER]	;SIOT checks bp even though count is 0
	JRST RSXMTF

CLOSE:	SKIPA A,[RT%CLS]
WRTFM:	 MOVEI A,RT%WFM		;write file mark
	PUSHJ P,FORCE		;first force buffered output
	JRST RSXMT0

SKPREC:	SKIPA A,[RT%SPR]	;B has signed number of records/files to skip
SKPFL0:	 MOVEI A,RT%SPF
	MOVE T,B
	MOVE B,[440800,,BUFFER]
	MOVEI C,0
	PUSHJ P,CMDN0
	MOVE B,[440800,,BUFFER]
	PUSHJ P,RSXMTF
	POPJ P,

CMDN0:	JUMPGE T,CMDN1
	MOVNS T
	MOVEI TT,"-
	IDPB TT,B
	ADDI C,1
CMDN1:	IDIVI T,10.
	PUSH P,TT
	SKIPE T
	 PUSHJ P,CMDN1
	POP P,TT
	ADDI TT,"0
	IDPB TT,B
	AOJA C,CPOPJ

;wait for completion of pending I/O
;skip return unless tape error
FINISH:	PUSHAE P,[A,B,C,D,E]
	PUSHJ P,PROBE		;By the time this answers, should be done
	TRNN D,F%EOT+F%NLI+F%HER+F%OFFL	;Serious error?
	 AOS -5(P)		;No, take skip return
	POPAE P,[E,D,C,B,A]
	POPJ P,

;Read data in core-dump mode into buffer addressed by aobjn pointer in A
;A is advanced
;Skip return unless tape error
;File mark signalled by not fully counting-out A
;Record boundaries are invisible at this level
READ:	PUSHAE P,[B,C,D,E,T,TT]
READ0:	SKIPN RESBFC		;Collect residue if any is present
	 JRST READ1
	AOS B,RESBFP
	MOVE T,RESBUF-1(B)
	MOVEM T,(A)
	CAML B,RESBFC
	 SETZM RESBFC		;Residue exhausted
	AOBJN A,READ0
	JRST READ8		;No more data required

READ1:	SKIPN C,BUFCNT		;Have a buffered record?
	 JRST READ6		;No, get one
	SUB C,BUFPNT		;Number of words not yet read
	IDIVI C,5		;Number of 4-word blocks available
	MOVE B,BUFPNT
	HLRE T,A
	MOVN T,T
	LSH T,-2		;Number of complete 4-word blocks wanted
	CAMLE C,T
	 MOVE C,T		;Number of 4-word blocks to do
	JUMPE C,READ2		;Jump if no bulk conversion possible
	PUSHJ P,RDCNV		;Copy data, advance A and B
	JUMPGE A,READ8		;Destination buffer exhausted
	JRST READ1		;Get more data

READ2:	PUSH P,A		;Fill residue buffer
	MOVEI A,RESBUF
	SETZM RESBFP
	MOVE C,BUFCNT
	SUB C,BUFPNT
	LSH C,2			;Number of bytes available
	IDIVI C,5		;Convert to words
	CAILE C,4		;At most 4 words residue
	 MOVEI C,4
	MOVEM C,RESBFC
	MOVEI C,1		;Translate one 4-word block
	PUSHJ P,RDCNV
	POP P,A
	JRST READ0		;Collect residue

READ6:	SKIPGE T,RDAHD		;Read-ahead stopped due to exception?
	 JRST [	AOJL T,READ8	;EOF simply terminates the data
		JRST READ9 ]	;Anything else takes failure return
	PUSH P,A
	JUMPG T,READ7		;Jump if read-ahead already in progress
	MOVEI A,RT%RD		;Initiate read-ahead
	PUSHJ P,RSXMT0
	AOS RDAHD
READ7:	SETZM BUFPNT
	PUSHJ P,RSRCVB		;Receive next record from server
	MOVE T,A		;Opcode of record received
	POP P,A			;Recover aobjn pointer
	CAIN T,RT%DTA
	 JRST [	ADDI C,3
		LSH C,-2	;Number of words, rounded up
		MOVEM C,BUFCNT	;Buffer now contains data
		JRST READ1 ]
	CAIN T,RT%STS
	 JRST [	SETZM RDAHD	;Read-ahead has terminated
		PUSH P,A
		PUSHJ P,PROBE1	;Swallow the status record B points to
		POP P,A
		TRNE D,F%NLI+F%HER+F%OFFL	;Serious error?
		 SETOM RDAHD	;Yes, note exception has occurred
		JRST READ6 ]	;Consider current status again
	CAIE T,RT%RFM
	 PRTERR [record type other than data, read-file-mark, or status]
	SETCMM RDAHD		;Filemark read, set RDAHD to -2
READ8:	AOS -6(P)		;Success return
READ9:	POPAE P,[TT,T,E,D,C,B]
	POPJ P,

;Translate from 32-bit words to 36-bit words
;A - destination aobjn pointer
;B - source index in BUFFER
;C - number of 4-word blocks
;Arguments get advanced, T,TT are clobbered
RDCNV:	DMOVE T,BUFFER(B)	;First two 32-bit words
	LSH T,-4		;Right-align first four bytes
	LSH TT,4		;Flush 4 bits out of fifth byte
	LSHC T,4		;First 36-bit word
	MOVEM T,(A)
	LSH TT,-12.		;Right-align bytes 6-8
	MOVE T,BUFFER+2(B)	;Third 32-bit word
	ROTC T,8		;TT has bytes 6-9 right-aligned
	LSH T,4			;Flush 4 bits out of 10th byte
	ROTC T,4		;Second 36-bit word in TT
	MOVEM TT,1(A)
	ROT T,16.		;Right align bytes 11-12
	MOVE TT,BUFFER+3(B)	;Fourth 32-bit word
	LSHC T,16.		;T has bytes 11-14 right aligned
	LSH TT,4		;Flush 4 bits out of 15th byte
	ROTC T,4		;Third 36-bit word in T
	MOVEM T,2(A)
	LSHC T,8		;Right align byte 16
	MOVE TT,BUFFER+4(B)	;Bytes 17-20
	ROTC T,-12.		;Right align bytes 17-19 in TT
	LSH T,4			;Flush 4 bits out of 20th byte
	ROTC T,4		;Fourth 36-bit word in TT
	MOVEM TT,3(A)
	ADD A,[4,,4]
	ADDI B,5
	SOJG C,RDCNV
	MOVEM B,BUFPNT
	CAML B,BUFCNT
	 SETZM BUFCNT		;Source buffer exhausted
	POPJ P,

;Terminate read-ahead
;--- Doesn't try to count records/files read ahead
;--- Unclear who is supposed to call this in that case
STOP:	SKIPLE RDAHD
	 PUSHJ P,PROBE		;This should stop it
	SETZM RDAHD
	POPJ P,

;Skip rest of file, interacting properly with read-ahead
SKPFIL:	PUSHAE P,[A,B,C,D,T,TT]
	SKIPGE B,RDAHD
	 AOJL B,SKPFL9		;Pass by file mark already read
	JUMPLE B,SKPFL8		;Send space-file command to drive
;Readahead in progress.  Server may have already read up to file mark,
;but not past it.  Send a probe so server shuts down, then swallow
;remaining readahead.
	PUSHJ P,RDSTOP
	 JRST SKPFL9		;File-mark seen
SKPFL8:	MOVEI B,1		;Space one file
	PUSHJ P,SKPFL0		;File mark not seen in readahead, so space-file
SKPFL9:	SETZM RDAHD		;No matter what path we take, read-ahead is off
	POPAE P,[TT,T,D,C,B,A]
	POPJ P,

RDRST:	PUSHAE P,[A,B,C,D,T,TT]
	SKIPLE RDAHD
	 PUSHJ P,RDSTOP
	  SETZM RDAHD
	PUSHJ P,BUFRST
	JRST SKPFL9

;Reset buffers
BUFRST:	SETZM BUFCNT
	SETZM RESBFC
	POPJ P,

;Send a probe so server shuts down, then swallow remaining readahead.
;Skip return unless file mark seen during swallowed readahead.
RDSTOP:	PUSHJ P,SPROBE		;Tell server to stop
	PUSHJ P,BUFRST		;Flush partially read input record
	PUSH P,[0]		;Initialize file-mark-seen flag
RDSTP1:	PUSHJ P,RSRCVB		;Receive next record from server
	CAIN A,RT%DTA
	 JRST RDSTP1		;Ignore data records
	CAIN A,RT%RFM
	 JRST [	SETOM (P)	;File mark seen
		JRST RDSTP1 ]
	CAIE A,RT%STS
	 PRTERR [record type other than data, read-file-mark, or status]
	PUSHJ P,PROBE1		;Swallow status record
	MOVE T,UIDG		;Verify that it isn't stale
	CAME T,STSUID
	 JRST RDSTP1		;Another status should be incoming
	SKIPN (P)
	 AOS -1(P)		;No file-mark seen
	SETZM RDAHD		;Read-ahead has been terminated
	JRST POP1J

;WRITE -- write core-dump mode data, AOBJN pointer in A
;Record boundaries are invisible at this level
;Aobjn pointer in A is advanced
;Clobbers no registers
;Abnormal exit: tape error jumps to RMTWER
WRITE:	PUSHAE P,[B,C,D,E,T,TT]
	SKIPN C,RESBFC		;If there is residue, append to it
	 JRST WRITE2
WRITE1:	MOVE T,(A)		;Copy into RESBUF until it is full or
	MOVEM T,RESBUF(C)	; aobjn pointer counts out
	AOS C,RESBFC
	CAIGE C,4
	 AOBJN A,WRITE1
	JUMPGE A,WRITE9		;Did not fill up residue buffer
	AOBJN A,.+1		;Filled residue buffer, adjust aobjn pointer
	PUSH P,A
	MOVEI A,RESBUF		;Send off the residue
	MOVEI C,1
	PUSHJ P,WRICNV
	SETZM RESBFC
	CAIL B,MXRECB/4		;If buffer is now full,
	 PUSHJ P,FORCE1		; send off that record
	POP P,A			;Recover aobjn pointer
WRITE2:	HLRE C,A		;Minus count of words remaining
	MOVN C,C		;Positive count
	TRZ C,3			;Round down to multiple of 4 words
	JUMPE C,WRITE7		;Jump if only a residue remains
	MOVE T,BUFCNT
	IDIVI T,5		;Number of 4-word blocks already in buffer
	LSH T,2
	ADD T,C
	CAILE T,MXRECW
	 SUBI C,-MXRECW(T)	;Whole transfer cannot be accomodated
	HRL C,C			;Number of words to do in both halves
	PUSH P,A		;Save and advance aobjn pointer
	ADDM C,(P)
	HRRZ C,C		;Compute number of 4-word blocks to do
	LSH C,-2
	PUSHJ P,WRICNV		;Convert that much
	CAIL B,MXRECB/4		;If buffer is now full,
	 PUSHJ P,FORCE1		; send off that record
	POP P,A			;Recover aobjn pointer
	JUMPL A,WRITE2		;Jump if there is more to do
WRITE7:	JUMPGE A,WRITE9		;Not even a residue remains
WRITE8:	MOVE T,(A)		;Copy residue into buffer
	MOVEM T,RESBUF(C)
	AOS C,RESBFC
	AOBJN A,WRITE8
WRITE9:	POPAE P,[TT,T,E,D,C,B]
	POPJ P,


;FORCE -- force buffered output, if any, as a short record
;Clobbers no registers
;Abnormal exit: tape error jumps to RMTWER
FORCE:	PUSHAE P,[A,B,C,D,E,T,TT]
	SKIPN BUFCNT
	 SKIPE RESBFC
	  PUSHJ P,FORCE1
	POPAE P,[TT,T,E,D,C,B,A]
	POPJ P,

FORCE1:	PUSHJ P,LISTEN		;Any status incoming?
	 JRST FORCE2		;No
	TRNE D,F%EOT+F%NLI+F%HER+F%OFFL	;Serious error?
	 JRST RMTWER		;Yes, exit
FORCE2:	MOVE C,BUFCNT
	LSH C,2			;Convert word count to byte count
	SKIPN E,RESBFC
	 JRST FORCE3		;Jump if no residue
	PUSH P,C
	MOVE A,[.BYTE 7 ? 3 ? 3 ? 3 ? 3 ? 3]	
	CAIGE E,2		;Pad residue with ^Cs
	 MOVEM A,RESBUF+1
	CAIGE E,3
	 MOVEM A,RESBUF+2
	CAIGE E,4
	 MOVEM A,RESBUF+3
	MOVEI A,RESBUF		;Include the residue
	MOVEI C,1
	PUSHJ P,WRICNV
	POP P,C			;Residue doesn't count as 4 full words
	IMULI E,5		;5 bytes for each word of residue
	ADD C,E
	SETZM RESBFC
FORCE3:	MOVEI A,RT%WRT
	MOVE B,[440800,,BUFFER]
;If the tape server on PYG (VMS) worked, you would need
;this in order to be able to use it
IFN 0,[
	CAIGE C,16		;God damn bag chomping VMS barfs if record
	 MOVEI C,16		; is shorter than this
];IFN 0
	PUSHJ P,RSXMT		;Send off this record
	SETZM BUFCNT
	POPJ P,


;Convert from 36-bit form to 32-bit form
;A - address of 36-bit data
;C - number of 4-word blocks to do
;Returns new value of BUFCNT in C
;Bashes A,B,C,D,T,TT
WRICNV:	MOVE B,BUFCNT		;Append 32-bit words to buffer
WRICN1:	DMOVE T,(A)		;First two 36-bit words
	MOVEM T,BUFFER(B)	;First 4 bytes
	ROTC T,-8		;5th byte to high end of TT
	TLZ TT,600000		;Book says these bits are zero
	MOVEM TT,BUFFER+1(B)	;Second four bytes
	EXCH T,TT
	LSHC T,4		;9th byte to low end of T
	LSH TT,-4		;10th byte to high end of TT
	MOVE D,T		;Copy bits 30-31 of second 36-bit word
	ANDI D,3
	ROT D,-4
	IOR TT,D
	LSHC T,8		;9th and 10 bytes in T
	MOVE TT,2(A)		;Third 36-bit word
	LSHC T,20.		;9th-12th bytes left-aligned in T
	MOVEM T,BUFFER+2(B)
	LSHC T,12.		;13th, 14th bytes to low end of T
	LSH TT,-4		;15th byte to high end of TT
	MOVE D,T		;Copy bits 30-31 of third 36-bit word
	ANDI D,3
	ROT D,-4
	IOR TT,D
	LSHC T,8		;13th-15th bytes in T
	MOVE TT,3(A)		;Fourth 36-bit word
	LSHC T,12.		;13th-16th bytes left-aligned in T
	MOVEM T,BUFFER+3(B)
	LSHC T,20.		;17th-19th bytes to low end of T
	LSH TT,-4		;20th byte to high end of TT
	MOVE D,T		;Copy bits 30-31 of fourth 36-bit word
	ANDI D,3
	ROT D,-4
	IOR TT,D
	LSHC T,12.		;17th-20th bytes left-aligned in T
	MOVEM T,BUFFER+4(B)
	ADDI A,4		;Advance to next block of words
	ADDI B,5
	SOJG C,WRICN1
	MOVEM B,BUFCNT
	POPJ P,

;Open remote tape connection and mount tape
;A - asciz host name (0 to listen)
;B - address at which to map host table
;C - remote drive name in asciz
;D - direction in asciz (READ, WRITE, or BOTH)
;reel name assumed not to matter, I'll always use "ITS" as the reel ID
;Skip return if successful, otherwise tape is not mounted and status
;buffer contains the details.  OZ sets F%HER but HT just returns a string.
OPEN:	PUSH P,C
	PUSH P,D
	SETZM STSFLG
	SETZM STATUS
	MOVEI C,[ASCIZ/RTAPE/]
	PUSHJ P,RSOPEN
	 JRST OPEN7		;Failed
OPEN1:	MOVE B,[440800,,BUFFER]	;Build mount command
	MOVNI C,1		;Remove final space by starting with -1
	MOVE A,(P)		;Direction
	PUSHJ P,SOUT
	MOVEI A,[ASCIZ/ITS/]	;Reel
	PUSHJ P,SOUT
	MOVE A,-1(P)		;Drive
	PUSHJ P,SOUT
	MOVEI A,RECLEN		;Maximum record length (decimal)
	PUSHJ P,SOUT
	MOVEI A,[ASCIZ/1600/]	;Density
	PUSHJ P,SOUT
	MOVEI A,[ASCIZ/NOREWIND/]	;Don't be gratuitous
	PUSHJ P,SOUT
	MOVEI A,RT%MNT		;Send mount command
	MOVE B,[440800,,BUFFER]
	PUSHJ P,RSXMTF
	PUSHJ P,PROBE		;Did it work?
	TRNE D,F%MNT
	 JRST POP2J1		;Yes
	TRNE D,F%NLI
	 JRST [	PUSHJ P,RMTLGN	;Login please
		JRST OPEN1 ]	;And try again
	JRST POP2J		;Failed

OPEN7:	MOVSI B,-17		;Copy reason for failure into STATUS string
OPEN8:	MOVE T,(A)
	ADDI A,1
	MOVEM T,STATUS(B)
	TRNE T,177_1
	 AOBJN B,OPEN8
	JRST POP2J

DEFINE FOO A
	ASCIZ/A/
TERMIN
RADIX 10.
RECLEN:	FOO \MXRECB
RADIX 8
	EXPUNGE FOO

;A - ASCIZ user name
;B - ASCIZ password
;Skip return if success, otherwise STATUS has the string
LOGIN:	PUSHAE P,[A,B,C]
	MOVE B,[440800,,BUFFER]	;Build login command
	MOVNI C,1		;Remove final space by starting with -1
	MOVE A,-2(P)		;User name
	PUSHJ P,SOUT
	MOVE A,-1(P)		;Password
	SKIPE (A)
	 PUSHJ P,SOUT
	MOVEI A,RT%LGI		;Send login command
	MOVE B,[440800,,BUFFER]
	PUSHJ P,RSXMTF
	MOVE B,[440800,,STATUS]	;Receive response
	MOVEI C,100
	PUSHJ P,RSRCV
	CAIE A,RT%LGR
	 PRTERR wrong record type in response to login
	JUMPE C,LOGIN9		;Success return if count is zero
	MOVE A,[440700,,STATUS]	;Convert 8 bit to asciz
LOGIN2:	ILDB T,B
	IDPB T,A
	SOJG C,LOGIN2
	IDPB C,A
	SOS -3(P)
LOGIN9:	AOS -3(P)
	POPAE P,[C,B,A]
	POPJ P,

POP2J1:	AOS -2(P)
POP2J:	SUB P,[2,,2]
CPOPJ:	POPJ P,

SOUT:	TLNN A,-1
	 HRLI A,440700
SOUT1:	ILDB T,A
	JUMPE T,SOUT2
	IDPB T,B
	AOJA C,SOUT1

SOUT2:	MOVEI T,40
	IDPB T,B
	AOJA C,CPOPJ


;Record-Stream support

;Open a record stream to a Chaosnet host, and initialize it
;RSICH, RSOCH - input and output channels
;A - asciz host name (0 to listen)
;B - address at which to map host table
;C - asciz contact name
;Clobbers all ACs
;If successful, skip return
;If failure, A has asciz failure reason
RSOPEN:	PUSH P,C
	JUMPE A,RSOPN1
	PUSH P,A
	LDB A,[121000,,B]	;Page number
	MOVEI B,RSICH
	PUSHJ P,NETWRK"HSTMAP	;--- Someday use DQ device instead?
	 JRST [	MOVEI A,[ASCIZ/Cannot map network host table/]
		JRST POP2J ]
	POP P,A			;Host name
	PUSHJ P,NETWRK"HSTLOOK
	 JRST [	MOVEI A,[ASCIZ/Host not found in host table/]
		JRST POP1J ]
	PUSHJ P,NETWRK"HSTUNMAP
	 JFCL
RSOPN1:	POP P,C			;Contact name
	MOVEI D,15.		;Window size
	MOVE B,A		;Host number or 0
	MOVEI A,RSICH		;Channel pair
	JUMPE B,RSOPN2		;Jump if listen
	PUSHJ P,NETWRK"CHACON
	 JRST [	MOVEI A,[ASCIZ/Cannot connect to remote tape server/]
		POPJ P, ]
	JRST RSOPN3

RSOPN2:	PUSHJ P,NETWRK"CHALSN
	 .LOGOUT 1,		;Nobody home
RSOPN3:	MOVE T,[440700,,[ASCII/RECORD STREAM VERSION 1/]]
	MOVEI TT,.LENGTH/RECORD STREAM VERSION 1/
	.CALL [ SETZ ? SIXBIT/SIOT/ ? MOVEI RSOCH ? T ? SETZ TT ]
	 .LOSE %LSFIL
	.IOT RSOCH,[215]
	.NETS RSOCH,
	MOVE A,[440700,,[ASCII/RECORD STREAM VERSION 1/]]
	MOVEI B,.LENGTH/RECORD STREAM VERSION 1/
	SETZM PKTRBC
RSINI1:	PUSHJ P,RSRBTI
	ILDB TT,A
	SKIPN TT
	 MOVEI TT,215
	CAME T,TT
	 PRTERR wrong record-stream identification text
	SOJGE B,RSINI1
	SETZM PKTXBC
	MOVE T,[440800,,PKTXBF+NETWRK"%CPKDT]
	MOVEM T,PKTXBP
	JRST POPJ1		;Success return

;--- Experiment to avoid hideously slow SIOKS3
PKTXBF:	BLOCK NETWRK"%CPMXW	;Packet transmit buffer 
PKTXBP:	0			;Byte pointer to PKTXBF
PKTXBC:	0			;Byte count (valid bytes in packet)
PKTRBF:	BLOCK NETWRK"%CPMXW	;Packet receive buffer
PKTRBP:	0			;Byte pointer to PKTRBF
PKTRBC:	0			;Byte count

;Transmit record and force output
RSXMTF:	PUSHJ P,RSXMT
RSXSND:	PUSH P,A
	MOVE A,PKTXBC
	LSH A,4
	TLO A,(SETZ)
	MOVEM A,PKTXBF
	.CALL [ SETZ ? 'PKTIOT ? MOVEI RSOCH ? SETZI PKTXBF ]
	 .LOSE %LSSYS
	SETZM PKTXBC
	MOVE A,[440800,,PKTXBF+NETWRK"%CPKDT]
	MOVEM A,PKTXBP
	POP P,A
	POPJ P,

;Output byte from T, low volume
RSXBTO:	AOS TT,PKTXBC
	CAIG TT,NETWRK"%CPMXC
	 JRST [	IDPB T,PKTXBP
		POPJ P, ]
	SOS PKTXBC
	PUSHJ P,RSXSND
	JRST RSXBTO

;Input byte to T, low volume
	PUSHJ P,RSRRCV
RSRBTI:	SOSGE PKTRBC
	 JRST .-2
	ILDB T,PKTRBP
	POPJ P,

;Receive next packet into PKTRBF
RSRRCV:	.CALL [ SETZ ? 'PKTIOT ? MOVEI RSICH ? SETZI PKTRBF ]
	 .LOSE %LSSYS
	MOVE T,[440800,,PKTRBF+NETWRK"%CPKDT]
	MOVEM T,PKTRBP
	LDB T,[NETWRK"$CPKNB+PKTRBF]
	MOVEM T,PKTRBC
	SKIPGE PKTRBF		;Skip if non-data packet
	 POPJ P,
	LDB T,[NETWRK"$CPKOP+PKTRBF]
	; CAIN T,NETWRK"%COEOF	; Ignore EOFs fucking Unix sends...
	;  JRST RSRRCV
	; Doesn't do any good if it also closes the channel...  $%!$#^%!$%!!
;A little bit of useful non-modularity (knows we're inside DUMP)
	SETZM LPTSW
	PRINT _Non-data packet received:
	POCT T
	PRINT [ ]
	CAIN T,NETWRK"%COCLS
	 PRINT [(CLS) ]
	CAIN T,NETWRK"%COLOS
	 PRINT [(LOS) ]
RSRRC1:	SOSGE PKTRBC
	 JRST ERR
	ILDB T,PKTRBP
	.IOT TYOC,T
	JRST RSRRC1

;Transmit a record
;RSOCH - network output channel
;A - opcode
;B - 8-bit byte pointer to buffer containing record
;C - number of bytes in record
;Bashes A,B,C,T,TT
RSXMT:	MOVE T,A		;Send opcode byte
	PUSHJ P,RSXBTO
	CAIGE C,1_15.		;Long count?
	 JRST RSXMT1
	MOVEI T,200
	PUSHJ P,RSXBTO
	LDB T,[301000,,C]
	PUSHJ P,RSXBTO
	LDB T,[201000,,C]
	PUSHJ P,RSXBTO
RSXMT1:	LDB T,[101000,,C]	;Send high byte of count
	PUSHJ P,RSXBTO
	MOVE T,C		;Send low byte of count
	PUSHJ P,RSXBTO
RSXMT2:	JUMPLE C,CPOPJ
	MOVEI T,NETWRK"%CPMXC
	SUB T,PKTXBC		;Space remaining in buffer
	CAMLE T,C
	 MOVE T,C
	JUMPLE T,[ PUSHJ P,RSXSND	;Make space and try again
		   JRST RSXMT2 ]
	ADDM T,PKTXBC		;Send this many
	SUB C,T
	PUSH P,C
	MOVE A,PKTXBP
	MOVE C,T
	PUSHJ P,SCOPY		;Copy into buffer
	MOVEM A,PKTXBP
	POP P,C
	JRST RSXMT2

;Copy string of 8-bit bytes
;Byte instructions are hideously slow on KS10
;A - destination byte pointer
;B - source byte pointer
;C - number of bytes
;Bashes T,TT; advances arguments
SCOPY:	JUMPLE C,CPOPJ		;Return if nothing left to do
	TLNN A,300000		;Skip if destination not word-aligned
	 CAIGE C,8		;If fewer than two words, use slow loop
	  JRST SCOPY1		;Copy one byte and try again
	IBP A			;Point to first actual byte
	IBP B
	MOVE T,C
	LSH T,-2		;Number of words to do
	ANDI C,3		;Number of bytes left over
	CAMGE B,[341000,,0]	;Skip if source is word-aligned
	 JRST SCOPY2
	HRLZ TT,B		;Both aligned, use BLT
	HRR TT,A
	ADD A,T
	ADD B,T
	BLT TT,-1(A)
	JRST SCOPY4		;Take care of residue, if any

SCOPY1:	ILDB T,B
	IDPB T,A
	SOJA C,SCOPY

SCOPY2:	PUSHAE P,[D,E]
	LDB D,[360600,,B]	;Byte position of source
	MOVEI TT,34		;Compute left shift required to align it
	SUB TT,D
SCOPY3:	DMOVE D,(B)
	LSH D,-4		;Squeeze out extra bits
	LSHC D,4(TT)		;Align source to destination
	MOVEM D,(A)
	ADDI A,1
	ADDI B,1
	SOJG T,SCOPY3
	POPAE P,[E,D]
SCOPY4:	ADD A,[100000,,]	;Undo IBP
	ADD B,[100000,,]	;..
	JRST SCOPY		;Take care of residue, if any

IFN 0,[
;Transmit record and force output
RSXMTF:	PUSHJ P,RSXMT
	.NETS RSOCH,
	POPJ P,

;Transmit a record
;RSOCH - network output channel
;A - opcode
;B - 8-bit byte pointer to buffer containing record
;C - number of bytes in record
RSXMT:	.IOT RSOCH,A		;Send opcode byte
	CAIGE C,1_15.		;Long count?
	 JRST RSXMT1
	.IOT RSOCH,[200]
	LDB T,[301000,,C]
	.IOT RSOCH,T
	LDB T,[201000,,C]
	.IOT RSOCH,T
RSXMT1:	LDB T,[101000,,C]	;Send high byte of count
	.IOT RSOCH,T
	.IOT RSOCH,C		;Send low byte of count
	.CALL [ SETZ ? SIXBIT/SIOT/ ? MOVEI RSOCH ? B ? SETZ C ]
	 .LOSE %LSFIL
	POPJ P,
];IFN 0

;Receive a record into buffer
RSRCVB:	MOVE B,[440800,,BUFFER]
	MOVEI C,MXRECB		;fall into RSRCV

;Receive a record
;RSICH - network input channel
;A - opcode is returned here
;B - 8-bit byte pointer to buffer in which record is returned
;C - input: number of bytes in buffer, output: number of bytes in record
RSRCV:	PUSHJ P,RSRBTI		;Await record and receive the opcode
	PUSH P,T		;Save opcode
	PUSH P,C		;Save buffer size
	PUSHJ P,RSRBTI		;High byte of count
	MOVE C,T
	MOVEI TT,1		;Normally one additional byte
	TRNE C,200
	 JRST [	MOVEI TT,4	;Long count
		MOVEI C,0
		JRST .+1 ]
RSRCV0:	LSH C,8
	PUSHJ P,RSRBTI
	IOR C,T
	SOJG TT,RSRCV0
	CAMLE C,(P)
	 PRTERR Record-stream input buffer overflow--record too long
	MOVEM B,(P)		;Save buffer pointer
	PUSH P,C		;Save record length
	SKIPA A,B		;Destination
RSRCV1:	 PUSHJ P,RSRRCV		;Get another packet
	MOVE B,PKTRBP		;Source
	PUSH P,C		;Save remaining record length
	CAMLE C,PKTRBC
	 MOVE C,PKTRBC		;Only part of record is in this packet
	MOVN T,C
	ADDM T,PKTRBC		;Use up source and destination buffers
	ADDM T,(P)
	PUSHJ P,SCOPY		;Copy into caller's buffer
	MOVEM B,PKTRBP
	POP P,C			;Number of bytes still needed
	JUMPG C,RSRCV1
	POP P,C			;Overall record length
	POP P,B			;Original buffer pointer
	POP P,A			;Opcode
	POPJ P,

IFN 0,[
RSRCV:	.IOT RSICH,A		;Await record and receive the opcode
	PUSH P,C		;Save buffer size
	.IOT RSICH,C		;High byte of count
	MOVEI TT,1		;Normally one additional byte
	TRNE C,200
	 JRST [	MOVEI TT,4	;Long count
		MOVEI C,0
		JRST .+1 ]
RSRCV0:	LSH C,8
	.IOT RSICH,T
	IOR C,T
	SOJG TT,RSRCV0
	CAMLE C,(P)
	 PRTERR Record-stream input buffer overflow--record too long
	MOVEM B,(P)		;Save buffer pointer
	MOVE T,C
	.CALL [ SETZ ? SIXBIT/SIOT/ ? MOVEI RSICH ? B ? SETZ T]
	 .LOSE %LSFIL
	POP P,B
	POPJ P,
];IFN 0

	.END RTAPE

SUBTTL DKAUTH, DKLOOK

; Call with magic number in A, returns with SIXBIT of author in A.  Author
; is looked up in the -local- MFD, so that better be what you want.
DKAUTH:	PUSH P,B
	SKIPN DKMFDP
	 JRST DKAUT1
DKAUT2:	MOVE B,MDNUDS+DSKMFD
	SUB A,B
	LSH A,1
	SKIPGE A
	 SKIPA A,DSKMFD+2000(A)
	  SETZI A,		; 0 if no author
	POP P,B
	POPJ P,

DKAUT1:	.IOPUSH DSKIN,
	.CALL [	SETZ ? SIXBIT /OPEN/
		[.BII,,DSKIN]
		[SIXBIT /DSK/]
		[SIXBIT /M.F.D./]
		SETZ [SIXBIT /(FILE)/]]
	 .LOSE %LSFIL
	MOVE B,[-2000,,DSKMFD]
	.IOT DSKIN,B
	SKIPGE B
	 .LOSE
	SETOM DKMFDP
	.IOPOP DSKIN,
	JRST DKAUT2

; Call with directory name in A, first name in B, second name in C, returns
; with pointer to name block in A.  Fails to skip if file or directory not
; found.  Uses the local filesystem, so that better be what you want.
DKLOOK:	PUSH P,D
	CAMN A,DKUFDP
	 JRST DKLOK1
	.IOPUSH DSKIN,
	.CALL [	SETZ ? SIXBIT /OPEN/
		[.BII,,DSKIN]
		[SIXBIT /DSK/]
		[SIXBIT /.FILE./]
		[SIXBIT /(DIR)/]
		SETZ A ]
	 JRST [	.IOPOP DSKIN, ? JRST POPDJ ]
	MOVE D,[-2000,,DSKUFD]
	.IOT DSKIN,D
	SKIPGE D
	 .LOSE
	MOVEM A,DKUFDP
	.IOPOP DSKIN,
DKLOK1:	MOVE A,DSKUFD+UDNAMP
	ADDI A,DSKUFD-LUNBLK
DKLOK2:	ADDI A,LUNBLK
	CAIL A,DSKUFD+2000
	 JRST POPDJ
	CAMN B,UNFN1(A)
	 CAME C,UNFN2(A)
	  JRST DKLOK2
	MOVE D,UNRNDM(A)
	TLNE D,UNIGFL
	 JRST DKLOK2
POPDJ1:	AOS -1(P)
POPDJ:	POP P,D
	POPJ P,

SUBTTL BUFFERS

CONSTANTS
VARIABLES

PATCH:
PAT:	BLOCK LPAT

PDL:	BLOCK LPDL

CLOADF:			;SAVE SWITCHES FOR 'CLOAD' COMMAND
	-1		;SAVE DMPMOD HERE
	0		;SAVE RELOSW HERE
	0		;SAVE LENGTH HERE
	BLOCK NFIGS	;SAVE @FIGTB2(n) HERE

MFDLST:	BLOCK 1000	;MUST BE IN THIS ORDER
BUF:	BLOCK 2000	;NORMAL BUFFER
DSKUFD:	BLOCK 2000	.SEE DKLOOK	;UFD ON DISK
DSKMFD:	BLOCK 2000	.SEE DKAUTH	;MFD ON DISK
UFDBUF:	BLOCK 2000	;STORAGE FOR INCOMING AND OUTGOING UFDS
MFDBUF:	BLOCK 2000	;STORAGE FOR TAPES COPY OF MFD
FDIRBF:	BLOCK 2000+10	;FOR FNG+POSSIBLE OVERFLOW
LISTBF:	BLOCK 600.	;3 WORDS MAX 190. FILES, LISTING BUFFER
BIF:	BLOCK 2000	;COMPARE BUFFER
CORSIZ==<.+1777>_-10.
SORTAS:	0
SBUF:			;FOR ORDMFD (SCOTT CUTLER MEMORIAL BUFFER)
CORSZB==<.+40000+1777>_-10.
BUFFER:	0		.SEE FCDMP

	END START
