Google
 

Trailing-Edge - PDP-10 Archives - bb-d868c-bm_tops20_v4_2020_distr - 4-sources/dumper.mac
There are 42 other files named dumper.mac in the archive. Click here to see a list.
;<4.UTILITIES>DUMPER.MAC.247,  3-Jan-80 15:25:42, EDIT BY R.ACE
;UPDATE COPYRIGHT DATE
; UPD ID= 129, SNARK:<4.UTILITIES>DUMPER.MAC.246,  12-Dec-79 17:03:24 by R.ACE
;TCO 4.2593 - FIX FOR RESTORING ARCHIVED FILES, FIX FOR CLEARING AR%RAR
;<4.UTILITIES>DUMPER.MAC.245, 19-Oct-79 06:26:28, EDIT BY R.ACE
;CHANGE TAG OF "PRINT" COMMAND HANDLER FROM "$DIR" TO "PRINT"
;BECAUSE OF CONFLICT WITH $DIR MACRO IN GLXMAC
;<4.UTILITIES>DUMPER.MAC.244, 19-Oct-79 05:57:30, EDIT BY R.ACE
;FIX RESTORE OF INVISIBLE BIT FOR BBN TAPES
;<4.UTILITIES>DUMPER.MAC.243, 25-Sep-79 09:36:52, EDIT BY R.ACE
;TCO 4.2484 - LABELED-TAPE SKIP - DON'T STOP AT END OF VOLUME
;<4.UTILITIES>DUMPER.MAC.242, 20-Sep-79 06:56:44, EDIT BY R.ACE
;TCO 4.2477 - CLEAN UP "UNABLE TO SET TAPE DATA MODE" A BIT
;<4.UTILITIES>DUMPER.MAC.241, 12-Sep-79 06:59:08, EDIT BY R.ACE
;TCO 4.2458 - DON'T CLEAR TNSF IN TAPE, REWIND COMMANDS
;<4.UTILITIES>DUMPER.MAC.240, 10-Sep-79 14:26:44, EDIT BY DBELL
;TCO 4.2450 - PREVENT "INVALID WILDCARD" ERROR IN INTERCHANGE MODE (AGAIN)
;<4.UTILITIES>DUMPER.MAC.239,  7-Sep-79 07:42:10, EDIT BY R.ACE
;FOR BBN - DON'T DO ARCF'S IN OLDAFX IF NOT ENABLED
;<4.UTILITIES>DUMPER.MAC.238, 23-Aug-79 08:55:33, EDIT BY R.ACE
;TCO 4.2390 - INCREMENTAL SAVES... CALL PASS2 FOR ALL FILESPECS
;PROSCRIBE "AS" FILESPEC FOR ARCHIVE/MIGRATION/INCREMENTAL SAVES
;<4.UTILITIES>DUMPER.MAC.237, 27-Jul-79 05:50:32, EDIT BY R.ACE
;TCO 4.2352 - DON'T UNLOAD AFTER SAVE WITH WILDCARDED DIR SPECIFICATION
;<4.UTILITIES>DUMPER.MAC.236, 12-Jul-79 06:07:50, EDIT BY R.ACE
;TCO 4.2323 - PERMIT USE OF ANSI LABELED TAPES
;<4.UTILITIES>DUMPER.MAC.235, 21-Jun-79 15:24:34, EDIT BY R.ACE
;TCO 4.2306 - FIX LOSING PAGE IF CONTINUED AFTER OVER-QUOTA FAILURE
;<4.UTILITIES>DUMPER.MAC.234, 17-Jun-79 19:18:07, EDIT BY R.ACE
;FIX UNLABELED BACKSPACE BUGS WHEN BOT IS ENCOUNTERED
;ARCFIX... DON'T DO ARCF'S IF NOT PRIVILEGED
;<4.UTILITIES>DUMPER.MAC.233,  7-Jun-79 09:11:55, EDIT BY R.ACE
;FIX SO DEFAULT FILESPEC FOR RETRIEVE USES DSK*:
;<4.UTILITIES>DUMPER.MAC.232,  7-Jun-79 06:06:50, EDIT BY R.ACE
;FIX ALL ERROR MESSAGES TO HAVE NO SPACE AFTER ? OR %
;DON'T SET DATA MODE WHEN OPENING TAPE JUST FOR REWIND
;(ON LABELED TAPES, THIS CAN CAUSE MOVEMENT AND POSSIBLE MTOPR FAILURE)
;<4.UTILITIES>DUMPER.MAC.231, 22-May-79 11:00:36, EDIT BY R.ACE
;MISCELLANEOUS FIXES
;<4.UTILITIES>DUMPER.MAC.230, 21-May-79 21:38:13, EDIT BY DBELL
;TCO 4.2255 - CHANGE DEFAULTS (AGAIN) FOR SAVE AND RESTORE TO BE
;YOUR CONNECTED STRUCTURE AND DIRECTORY.
;<4.UTILITIES>DUMPER.MAC.229,  4-May-79 16:08:30, EDIT BY R.ACE
;GET RID OF REDEOT FLAG - USE PAGNO INSTEAD
;PUT ERJMP AFTER MSTR TO ALLOW RUNNING R4 DUMPER ON TOPS-20 R3A
;<4.UTILITIES>DUMPER.MAC.228,  3-May-79 05:36:49, EDIT BY R.ACE
;MAKE PRINT COMMAND DO ALL VOLUMES IN THE SET
;<4.UTILITIES>DUMPER.MAC.227,  3-May-79 04:49:11, EDIT BY R.ACE
;PERMIT USE OF TOPS-20 LABELED TAPES
;FIX LABELED TAPE BUGS IN RECORD SEQUENCE BOOKKEEPING
;<4.UTILITIES>DUMPER.MAC.226, 26-Apr-79 22:51:41, EDIT BY DBELL
;HAVE SETGJB ALWAYS SET UP DEFAULT POINTERS FOR DEVICE AND DIRECTORY
;<4.UTILITIES>DUMPER.MAC.225, 23-Apr-79 08:16:29, EDIT BY R.ACE
;ADD BOX-TYPE COMMENTS DESCRIBING TAPE FORMATS
;<4.UTILITIES>DUMPER.MAC.224, 21-Apr-79 09:00:29, EDIT BY R.ACE
;FIX PROBLEM OF TAPE# GETTING RESET TO 1
;LAY MORE GROUNDWORK FOR LABELED TAPE SUPPORT
;ADD CODE TO WASHOU TO SET AR%RFL BIT IN FDB
;<4.UTILITIES>DUMPER.MAC.223, 17-Apr-79 13:20:59, EDIT BY R.ACE
;CLEAR RETSW ON CHECK AND RESTORE COMMANDS
;DON'T ACCEPT SWITCHES ON RETRIEVE COMMAND
;<4.UTILITIES>DUMPER.MAC.222, 13-Apr-79 04:52:43, EDIT BY R.ACE
;REMOVE /COLLECT SWITCH FROM SAVE COMMAND
;<4.UTILITIES>DUMPER.MAC.221, 12-Apr-79 15:32:10, Edit by R.ACE
;FIX RETRIEVAL TO REQUEUE REQUEST IF LOSING BECAUSE NO DISK SPACE
;ADD PRIVATE-QUASAR CODE
;CHANGE OCCURRENCES OF T1,T2,T3,T4 TO A,B,C,D RESPECTIVELY
;<4.UTILITIES>DUMPER.MAC.220, 11-Apr-79 16:55:10, Edit by KONEN
;CORRECT 7-BIT TO 6-BIT CONVERSION
;<4.UTILITIES>DUMPER.MAC.219,  6-Apr-79 14:59:46, Edit by KONEN
;MAKE USAGE STRUCTURE ENTRIES SIXBIT
;<4.UTILITIES>DUMPER.MAC.218,  1-Apr-79 19:11:59, EDIT BY DBELL
;MAKE DEFAULTS FOR SAVING AND RESTORING BE AS FOLLOWS:
;  SAVE (FROM) CONN-STR:<CONN-DIR> (TO) SAME-AS-INPUT-SPEC
;  RESTORE (FROM) DSK*:<CONN-DIR> (TO) SAME-AS-INPUT-SPEC
;<4.UTILITIES>DUMPER.MAC.217, 30-Mar-79 12:30:12, EDIT BY R.ACE
;TAKE OUT PROLOG MACRO REFERENCE
;DEFINE LOGICAL NAME RETRVL: FOR RETRIEVAL TAPES
;REARRANGE MREQ ROUTINE
;ADD NTAPER ENTRY TO NTAPE TO REWIND AFTER TAPE IS GOTTEN
;DON'T DISPLAY TAPE # FOR VIRTUAL DISK TAPES
;<HURLEY.CALVIN>DUMPER.MAC.2, 21-Mar-79 12:41:18, EDIT BY HURLEY.CALVIN
; Define BBN 101B FDB offsets and use them properly in OLDAFX
;<4.UTILITIES>DUMPER.MAC.216, 21-Mar-79 05:08:48, EDIT BY R.ACE
;IGNORE ERRORS FROM CHFDB SETTING FILE INVISIBLE TO PERMIT REL4
;DUMPER TO RUN ERROR-FREE ON REL3A
;<4.UTILITIES>DUMPER.MAC.215, 17-Mar-79 08:01:38, EDIT BY R.ACE
;FIX BUG WHEN RETRIEVING INVISIBLE FILES THAN SPAN VOLUMES
;THIS FIX HAS THE SIDE EFFECT OF MAKING ALL RETRIEVED FILES VISIBLE
;<4.UTILITIES>DUMPER.MAC.214, 16-Mar-79 13:17:28, EDIT BY R.ACE
;ADD ERJMP AFTER RCDIR IN LODUSR
;<4.UTILITIES>DUMPER.MAC.213, 15-Mar-79 22:44:59, EDIT BY DBELL
;ADD A CRLF IN THE "NOT DUMPED" MESSAGE AT NDMESS+7
;<4.UTILITIES>DUMPER.MAC.212, 15-Mar-79 09:23:37, EDIT BY R.ACE
;FIX HANDLING OF ERRORS FROM GTJFN ON OFFLINE FILE POINTER
;BYPASS STRUCTURE REGULATIONS IF WHEEL OR OPERATOR ENABLED
;<4.UTILITIES>DUMPER.MAC.211, 10-Mar-79 13:50:17, EDIT BY KONEN
;UPDATE COPYRIGHT FOR RELEASE 4
;<4.UTILITIES>DUMPER.MAC.210,  8-Mar-79 13:53:58, EDIT BY R.ACE
;DUPLICATE USE OF PDB WAS CAUSING RETRIEVAL MOUNTS TO HANG
;SO CREATE MPDB FOR MOUNTING TAPES
;<4.UTILITIES>DUMPER.MAC.209,  5-Mar-79 14:41:02, EDIT BY HURLEY.CALVIN
; add time-stamp in retrieved message
;<4.UTILITIES>DUMPER.MAC.208, 28-Feb-79 15:30:58, EDIT BY DBELL
;AT OFNAM2 FIX "INVALID WILDCARD" ERROR ON RESTORING INTERCHANGE MODE FILES.
;<4.UTILITIES>DUMPER.MAC.207, 26-Feb-79 08:59:47, EDIT BY R.ACE
;NUMEROUS EDITS TO IMPLEMENT FOLLOWING FEATURES:
; MAKE DUMPER CONSCIOUS OF UNLABELED MT DEVICES, VOLIDS, ETC.
; REMOVE ARCHIVING TAPE NUMBERING SCHEME
;<R.ACE.LT>D.MAC.44, 18-Feb-79 15:19:07, EDIT BY DBELL
;TCO 4.2192 - MAKE THE DEVICE DSK*: WORK PROPERLY IN SAVE AND RESTORE
;<ARC-DEC>DUMPR4.MAC.16, 15-Dec-78 08:23:13, EDIT BY CALVIN
; Change to release 4 style QUASAR
;<ARC-DEC>DUMPR.MAC.30, 30-Nov-78 14:38:17, EDIT BY CALVIN
; Fix host output code & subroutinize it (code was in 3 places)
;<ARC-DEC>DUMPR.MAC.20,  9-Nov-78 09:31:23, EDIT BY CALVIN
; REPEAT 0 out expiration code in DUMPER
;<RETURN>DUMPX4.MAC.1, 12-Oct-78 20:38:00, Edit by CALVIN
; BEGIN INSTALLING IPCF STUFF FOR COMMUNICATION WITH QUASAR
;<ARC-DEC>DUMPN4.MAC.29,  2-Oct-78 09:11:03, EDIT BY CALVIN
; Install code to handle old style archive tapes
;<ARC-DEC>DUMPER.MAC.195, 18-Sep-78 08:25:11, EDIT BY CALVIN
; Merge in ARCHIVE/VIRTUAL disk code
;<4.UTILITIES>DUMPER.MAC.206, 27-Nov-78 10:41:51, Edit by LCAMPBELL
;<4.UTILITIES>DUMPER.MAC.205, 27-Nov-78 10:34:47, Edit by LCAMPBELL
; Add QUIT as synonym for EXIT
;<4.UTILITIES>DUMPER.MAC.204, 20-Nov-78 14:42:12, EDIT BY DBELL
;REMOVE CHKWLD ROUTINE FINALLY, AND USE WILD% JSYS INSTEAD
;<4.UTILITIES>DUMPER.MAC.203, 23-Oct-78 17:54:48, EDIT BY DBELL
;TCO 4.2061 - FIX EXTRANEOUS "TAPE HAS FILES MISSING" MESSAGES WHEN A
; RESTORE IS NOT STARTED ON THE FIRST TAPE.
;<4.UTILITIES>DUMPER.MAC.202, 12-Oct-78 20:34:04, EDIT BY DBELL
;TCO 4.2043 - FIX INFINITE LOOP WHEN SAVING FILE WHICH IS MULTIPLE OF 512 PAGES
;<4.UTILITIES>DUMPER.MAC.201,  3-Oct-78 00:23:04, EDIT BY DBELL
;TCO 4.2029 - FIX "JFN NOT ASSIGNED" ERROR DURING INCREMENTAL SAVE AT FIXBCK
;<4.UTILITIES>DUMPER.MAC.200, 25-Sep-78 22:50:14, EDIT BY DBELL
;TCO 4.2020 MAKE MULTI-REEL CHECK COMMAND WORK PROPERLY.
;<4.UTILITIES>DUMPER.MAC.199, 14-Sep-78 15:10:17, EDIT BY DBELL
;FIX ONCE AGAIN THE PROBLEM OF RESTORED FILE IN INTERCHANGE MODE
;HAVING THEIR PROTECTION SET TO 0.
;<4.UTILITIES>DUMPER.MAC.198, 22-Aug-78 17:11:44, EDIT BY DBELL
;TCO 4.1990 - ALLOW OPENING OF LIST DEVICES SUCH AS MTA0: AND PLPT0:
;<4.UTILITIES>DUMPER.MAC.197, 17-Aug-78 15:56:08, EDIT BY DBELL
;CHANGE "?" TO "%" IN "NO FILES DUMPED" MESSAGE
;<4.UTILITIES>DUMPER.MAC.196, 11-Aug-78 10:34:34, Edit by PORCHER
;<4.UTILITIES>DUMPER.MAC.195, 10-Aug-78 15:43:52, Edit by PORCHER
;FIX FILE NUMBER CHECKING ACROSS TAPE BOUNDARIES
;UPDATE TO VERSION 4(174)
;<4.UTILITIES>DUMPER.MAC.193, 12-Jul-78 10:45:28, Edit by PORCHER
;TCO # 1944 - ADD FILE NUMBER CHECKING
;TCO # 1943 - REMOVE RPACS FOR EXISTING PAGES ON SAVE
;TCO # 1942 - INDICATE MISSING PAGES ON RESTORE
;<4.UTILITIES>DUMPER.MAC.192,  2-Jun-78 09:34:00, Edit by FORTMILLER
;<4.UTILITIES>DUMPER.MAC.191,  1-Jun-78 13:17:23, Edit by FORTMILLER
;TCO 1891 ADD 6250 BPI
;<4.UTILITIES>DUMPER.MAC.190, 19-May-78 17:30:03, Edit by PORCHER
;TCO # 1914 - REMOVE DUMPER VERSION HERALD
;TCO # 1913 - INCREASE FILESPEC DEFAULT AREAS TO 20 WORDS
;<4.UTILITIES>DUMPER.MAC.189, 16-May-78 16:22:51, Edit by PORCHER
;TCO # 1910 -- HANDLE ZERO BYTE SIZE CORRECTLY IN INTERCHANGE MODE
;<4.UTILITIES>DUMPER.MAC.188, 10-May-78 16:33:53, Edit by PORCHER
;<4.UTILITIES>DUMPER.MAC.187, 10-May-78 14:39:14, Edit by PORCHER
;TCO # 1909 -- USE SYSTEM DEFAULT ACCOUNT IF TAPE ACCOUNT INVALID ON RESTORE
;MAKE BACKSPACE TO BEGINNING OF TAPE ONLY WARNING ERROR
;<4.UTILITIES>DUMPER.MAC.186, 27-Apr-78 16:58:35, Edit by PORCHER
;FIX BUGS IN /INCREMENTAL: ...
;<4.UTILITIES>DUMPER.MAC.185, 18-Apr-78 11:28:28, Edit by PORCHER
;TCO # 1903 - Add /FULL-INCREMENTAL, /INCREMENTAL:n, no restore of backup words
;<4.UTILITIES>DUMPER.MAC.184, 13-Apr-78 16:06:07, Edit by PORCHER
;MAKE CHECKSUM ERRORS INTERRUPTIBLE
;ALLOW FOR "DUMPX3" - BUFFER SIZE TOO BIG
;<4.UTILITIES>DUMPER.MAC.183, 12-Apr-78 13:16:14, Edit by PORCHER
;FIX EXPRESSION FOR MTBUF2 DUE TO MACRO BUG
;<4.UTILITIES>DUMPER.MAC.182,  6-Apr-78 17:33:33, Edit by PORCHER
;MAKE ALL ERRORS TYPE <CR> ONLY IF NOT AT LEFT MARGIN ALREADY
;<4.UTILITIES>DUMPER.MAC.181,  6-Apr-78 17:08:11, Edit by PORCHER
;PUT MTBUF1 AND MTBUF2 ON PAGE BOUNDARY FOR BLOCKING-FACTOR OF 15
;<4.UTILITIES>DUMPER.MAC.180,  6-Apr-78 16:31:25, Edit by PORCHER
;<4.UTILITIES>DUMPER.MAC.179,  3-Apr-78 12:22:13, Edit by PORCHER
;<4.UTILITIES>DUMPER.MAC.178,  3-Apr-78 08:55:45, Edit by PORCHER
;<4.UTILITIES>DUMPER.MAC.177, 31-Mar-78 13:31:15, Edit by PORCHER
;MAKE BEGUSR COPY ENTIRE DIRECTORY NAME STRING
;USE DIRECTORY STRING (WITH WILD CARDS) FROM USER FOR RCDIR ON SAVE
;ALLOW TTY OUTPUT AFTER INTERRUPTED "PRINT TTY:"
;<4.UTILITIES>DUMPER.MAC.176, 31-Mar-78 10:49:14, Edit by PORCHER
;<4.UTILITIES>DUMPER.MAC.175, 31-Mar-78 10:42:24, Edit by PORCHER
;<4.UTILITIES>DUMPER.MAC.174, 31-Mar-78 10:21:55, Edit by PORCHER
;TCO # 1986 - PRINT FILENAME PROPERLY ON RESTORE ERRORS
;<4.UTILITIES>DUMPER.MAC.173, 30-Mar-78 16:27:11, Edit by PORCHER
;<4.UTILITIES>DUMPER.MAC.172, 30-Mar-78 16:19:35, Edit by PORCHER
;UPDATE TO VERSION 4(166)
;MISCELLANEOUS BUG FIXES AND ...
;TCO # 1895 - COPY PROTECTION/ACCOUNT FROM OUTPUT SPEC IN SAVE/RESTORE
;TCO # 1894 - ALLOW JUST DATE IN BEFORE/SINCE COMMANDS
;TCO # 1893 - DON'T ABORT COMMAND IF "FILE NOT FOUND" IN SAVE COMMAND
;TCO # 1892 - AUTO-UNLOAD FOR MULTI-REEL SAVESETS, UNLOAD COMMAND
;<4.UTILITIES>DUMPER.MAC.170, 21-Mar-78 13:26:50, Edit by DBELL
;ALLOW /INCREMENTAL SWITCH IF NOT WHEEL, BUT THEN COMPLAIN
;<4.UTILITIES>DUMPER.MAC.169, 17-Mar-78 16:02:47, Edit by DBELL
;DON'T SET PROTECTION FROM TAPE IF RESTORING IN INTERCHANGE MODE
;<PORCHER>DUMPER.MAC.170, 16-Mar-78 16:25:07, Edit by PORCHER
;TCO # 1891 - CHANGES FOR MULTIPLE RECORD BLOCKING
;<4.UTILITIES>DUMPER.MAC.168, 17-Feb-78 18:05:26, Edit by DBELL
;HANDLE FULL WILDCARDS IN RESTORE COMMAND BY CALLING CHKWLD ROUTINE
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
;  OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;
;COPYRIGHT (C) 1976,1977,1978,1979,1980 BY DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.

	IFNDEF DSKDMP,<DSKDMP==0> ; Build tape version

	SEARCH MONSYM,MACSYM,QSRMAC,GLXMAC,ACTSYM
IFN DSKDMP,<SEARCH SPSYM>
	TITLE DUMPER
	SALL

	.REQUIRE SYS:MACREL
	.REQUIRE ARMAIL		; Need mailing routines
	.DIRECT FLBLST

	EXTERN MLTOWN,MLTLST,MLDONE,MLINIT
	EXTERN .JBOPS		;135 NON-ZERO = USE PRIVATE QUASAR

; VERSION NUMBER DEFINITIONS

VMAJOR==4		;MAJOR VERSION OF DUMPER
VMINOR==0		;MINOR VERSION NUMBER
VEDIT==303		;EDIT NUMBER
VWHO==0			;GROUP WHO LAST EDITED PROGRAM (0=DEC DEVELOPMENT)
			; 1=BBN

VDUMPR== <VWHO>B2+<VMAJOR>B11+<VMINOR>B17+VEDIT
COMMENT ^

	F O R M A T   O F   D U M P E R   T A P E S
	===========================================


EACH PHYSICAL RECORD WRITTEN BY DUMPER CONTAINS ONE OR MORE
LOGICAL RECORDS, EACH OF WHICH IS 518 (1006 OCTAL) WORDS LONG.

EACH LOGICAL RECORD HAS THE FOLLOWING FORMAT:

	!=======================================================!
CHKSUM	!          CHECKSUM OF ENTIRE 518-WORD RECORD           !
	!-------------------------------------------------------!
ACCESS	!         PAGE ACCESS BITS (CURRENTLY NOT USED)         !
	!-------------------------------------------------------!
TAPNO	!SCD!    SAVESET NUMBER     !        TAPE NUMBER        !
	!-------------------------------------------------------!
PAGNO	!F1!F2!    FILE # IN SET    !      PAGE # IN FILE       !
	!-------------------------------------------------------!
TYP	!              RECORD TYPE CODE (NEGATED)               !
	!-------------------------------------------------------!
SEQ	!        RECORD SEQUENCE NUMBER (INCREASES BY 1)        !
	!=======================================================!
	!                                                       !
	!         CONTENTS OF FILE PAGE IF DATA RECORD          !
	!        OTHER TYPES HAVE OTHER INFORMATION HERE        !
	!                                                       !
	!=======================================================!


TYPE	VALUE	MEANING
----	-----	-------
DATA	  0	CONTENTS OF FILE PAGE
TPHD	  1	NON-CONTINUED SAVESET HEADER
FLHD	  2	FILE HEADER (CONTAINS FILESPEC, FDB)
FLTR	  3	FILE TRAILER
TPTR	  4	TAPE TRAILER (OCCURS ONLY AFTER LAST SAVESET)
USR	  5	USER DIRECTORY INFORMATION
CTPH	  6	CONTINUED SAVESET HEADER
FILL	  7	NO MEANING, USED FOR PADDING


SCD (3 BITS) - 0=NORMAL SAVE, 1=COLLECTION, 2=ARCHIVE, 3=MIGRATION

F1 F2	MEANING
-- --	-------
 0  0	OLD-FORMAT TAPE (NO FILE # IN PAGNO BITS 2-17)
 1  1	OLD-FORMAT TAPE, CONTINUED FILE
 0  1	NEW-FORMAT TAPE (FILE # IN PAGNO BITS 2-17)
 1  0	NEW-FORMAT TAPE, CONTINUED FILE
A DUMPER TAPE IS A COLLECTION OF RECORDS ORGANIZED IN THE
FOLLOWING FASHION:


!=======================================================!
!            HEADER FOR FIRST SAVESET (TPHD)            !
!-------------------------------------------------------!
!          USER INFO (USR) OR FILE (SEE BELOW)          !
!-------------------------------------------------------!
!                   USER INFO OR FILE                   !
!-------------------------------------------------------!
!                           .                           !
!                           .                           !
!                           .                           !
!=======================================================!
!            HEADER FOR SECOND SAVESET (TPHD)           !
!-------------------------------------------------------!
!          USER INFO (USR) OR FILE (SEE BELOW)          !
!-------------------------------------------------------!
!                   USER INFO OR FILE                   !
!-------------------------------------------------------!
!                           .                           !
!                           .                           !
!                           .                           !
!=======================================================!
!                                                       !
!                  SUBSEQUENT SAVESETS                  !
!                                                       !
!=======================================================!
!                                                       !
!                     LAST SAVESET                      !
!                                                       !
!=======================================================!
!                  TAPE TRAILER (TPTR)                  !
!=======================================================!


NOTES:

1.  ON LABELED TAPES, THE TPTR RECORD APPEARS ONLY IF
    THE SAVESET IS CONTINUED ON ANOTHER TAPE.

2.  SOLITARY TAPE MARKS (EOF'S) ARE IGNORED ON INPUT.
    TWO CONSECUTIVE TAPE MARKS ARE INTERPRETED AS TPTR.

3.  ON LABELED TAPES, EACH SAVESET OCCUPIES EXACTLY ONE FILE.

4.  THE FIRST RECORD OF A CONTINUED SAVESET IS CTPH
    INSTEAD OF TPHD.
A DISK FILE SAVED ON A DUMPER TAPE ALWAYS HAS THIS
SEQUENCE OF RECORDS:

!=======================================================!
!                  FILE HEADER (FLHD)                   !
!-------------------------------------------------------!
!          DATA RECORD: 1 PAGE OF FILE (DATA)           !
!-------------------------------------------------------!
!          DATA RECORD: 1 PAGE OF FILE (DATA)           !
!-------------------------------------------------------!
!                           .                           !
!                           .                           !
!                           .                           !
!-------------------------------------------------------!
!                  FILE TRAILER (FLTR)                  !
!=======================================================!


^
	SUBTTL STORAGE AND DEFINITIONS

FMTV0==0		;BBN (TENEX) DUMPER FORMAT
FMTV1==1
FMTV2==2
FMTV3==3		;RELEASE 2 (FDB CHANGES, STRUCTURES, ETC.)
FMTV4==4		;RELEASE 3 (NEW GTDIR BLOCKS)
CURFMT==FMTV4			;DATA FORMAT TO WRITE

USRLH==500000			;THIS IS TO IDENTIFY A USER
				;NUMBER. IF THE MONITOR 
				;CHANGES THE DEFINITION, IT 
				;MUST CHANGE HERE

F=0
A=1
B=2
C=3
D=4
T1=1		;DO NOT USE T1-T4.  IN CASE SOMEONE SLIPS AND DOES
T2=2		;USE THEM, THESE DEFS OVERRIDE THOSE IN GLXMAC.
T3=3
T4=4
Q1=5
Q2=6
Q3=7
P1=10
P2=11
P3=12
P4=13
P5=14
P6=15
CX=16
P=17
PGSIZ==1000			;PAGE SIZE

; Definitions for old BBN style archive tapes (FDB offsets for 101B system)

.BBNBT==17			; Old FBBBT
.BBNTF==20			; TFN1,,TFN2
.BBNTS==21			; TSN1,,TSN2
.BBNTP==22			; TAPE1,,TAPE2
.BBNDT==23			; Archive date & time


;FLAGS IN F

NOFLG==1B0			;'NO' PRECEDED COMMAND
USRDAT==1B1			;DUMP/LOAD USER DATA
T36MOD==1B2			;36-BIT TAPE MODE
DIRCHG==1B3			;OUTPUT DIRECTORY NOT SAME AS
				;INPUT DIRECTORY
TNSF==1B4			;TAPE NUMBER SET FLAG
LRERR==1B5			;LAST RECORD HAD AN UNRECOVERABLE ERROR
SAVUSF==1B6			;WE SHOULD SAVE USER DATA IF SET
DMPFLF==1B7			;(SAVE) WE HAVE FOUND A VALID JFN TO DUMP

TF1==1B9			;TEMP FLAGS FOR LOCAL USE
TF2==1B10			;FILE CONTINUED ON NEXT REEL			

LFDSK==1B11			;LOG FILE NOT DISK
ICMT1==1B12			;INTERCHANGE MODE - REPEAT LAST RECORD
ICMODF==1B13			;USE INTERCHANGE MODE TAPE FORMAT
LDIRF==1B14			;LIST DIRECTORIES WHILE RUNNING
LFILF==1B15			;LIST FILES WHILE RUNNING
LTTYF==1B16			;LOG FILE IS TTY
LREOF==1B17			;LAST RECORD READ WAS EOF

SSA==1B18			;SUPERSEDE ALWAYS
SSN==1B19			;SUPERSEDE NEVER
RESPRO==1B20			;RESTORE PROTECTION FROM TAPE
RESACC==1B21			;RESTORE ACCOUNT FROM TAPE
CHKSM==1B23			;CHECKSUMMING
CS%SEQ==1B24			;SEQUENTIAL CHECKSUMMING

%ATF==1B32			; "@" seen (GETOWN)
%VERBA==1B33			; Take input "as is" (GETOWN)
COMMAF==1B34			; Comma flag (For PRTTAP)
FST%PN==1B35			; First ";" seen in FIXFMM (TENEX tape)
;FORMAT OF HEADER PORTION OF RECORD

XCKSUM==0			;CHECKSUM
XACC==1				;ACCESS
XTAPNO==2			;TAPE NUMBER
XPAGNO==3			;PAGE NUMBER
XTYP==4				;RECORD TYPE
XSEQ==5				;RECORD SEQUENCE
NHEAD==6			;HEADER SIZE

NIHEAD==^D32			;HEADER SIZE, INTERCHANGE FORMAT

MXHEAD==NHEAD			;SET MAX (NHEAD, NIHEAD)
 IFG NIHEAD-MXHEAD,<MXHEAD==NIHEAD>

MAXBKF==^D15			;MAXIMUM BLOCKING FACTOR
DEFBKF==^D1			;DEFAULT BLOCKING FACTOR

MTBFSZ==<<NHEAD+PGSIZ>*MAXBKF>+1 ;SIZE OF PHYSICAL RECORD BUFFERS
 IFG <MXHEAD+PGSIZ+1>-MTBFSZ,<MTBFSZ==MXHEAD+PGSIZ+1>
				;(THE EXTRA 1 IS TO FORCE RECORD LENGTH ERROR
				; ON READING TO DETERMINE BLOCKING FACTOR)


;LOCATIONS IN UPPER ADR SPACE

N.JFN==2*PGSIZ			;DOUBLE LENGTH BUFFER (JFNSTK)
CBFSIZ==2*PGSIZ			;2 PAGES (CBFR)
NJFNL==PGSIZ			;(JFNLST & JF2LST)
NQSRML==PGSIZ			; Page for communication with QUASAR
NSNDBD==PGSIZ*3			; Amount of space allocated for message body

JFNLST=500000			;LIST OF JFNS FOR CURRENT COMMAND
JF2LST=501000			;LIST OF DEST JFNS, PARALLEL TO JFNLST
JFNSTK=502000			;JFN STACK FOR REPARSE (2 PAGES)
CBFR=504000			;2 PAGE LINE BUFFER FOR COMMAND

MBUF=506000			;IPCF BUFFER USED DURING TAPE MOUNT
MTBUF1=MBUF+NQSRML		;ALTERNATING BUFFERS FOR MAGTAPE I/O
MTBUF2=<MTBUF1+MTBFSZ+777>&<^-777> ; . .
QSRMSR=<MTBUF2+MTBFSZ+777>&<^-777> ; Page for QUASAR communication
QSRMSS=QSRMSR+NQSRML		; FOR SENDING TO QUASAR
SNDBDY=QSRMSS+NQSRML		; Body of messages sent

IFL <577772-<SNDBDY+NSNDBD>>,<PRINTX SNDBDY and XBUFF overlap - Readjust upper core storage>


BUFF=600000
BUFPAG==<BUFF>B44
 IFL BUFF-<<MTBUF2+MTBFSZ+777>&<^-777>>,<PRINTX ? MTBUF2 OVERLAPS BUFF>

BUFF2=601000
BF2PAG==<BUFF2>B44

BUF0==602000		;FILE WINDOW
BUF0PG==<BUF0>B44	;PAGE NUMBER OF SAME

XBUFF=BUFF-NHEAD		;BUFFER ORIGIN
CHKSUM=XBUFF+XCKSUM
ACCESS=XBUFF+XACC
TAPNO=XBUFF+XTAPNO
PAGNO=XBUFF+XPAGNO
TYP=XBUFF+XTYP
SEQ=XBUFF+XSEQ

;BITS IN LH OF PAGNO WORD

PGNCFL==1B0			;CONTINUED TAPE FILE (SET IN FILE TRAILER,
				; TAPE TRAILER, FILE HEADER)
PGNNFL==1B1			;FILE NUMBER IS VALID (IF COMPLEMENT OF PGNCFL)
PGNFLN==177777B17		;FILE NUMBER

;STRUCTURE OF RECORD HEADER FOR ARCHIVE/COL./MIG. TAPES

DEFSTR SSCOD,XTAPNO,2,3		;SAVESET TYPE CODE:
	SSCOL==1		;COLLECTION RUN SAVESET
	SSARC==2		;ARCHIVE RUN SAVESET
	SSMIG==3		;MIGRATION RUN SAVESET
DEFSTR SSNO,XTAPNO,17,15	;SAVESET NUMBER
DEFSTR TPNO,XTAPNO,35,18	;TAPE NUMBER
DEFSTR TFNO,XPAGNO,17,16	;TAPE FILE NUMBER
DEFSTR PGNO,XPAGNO,35,18	;PAGE NO. IN FILE
;RECORD TYPE CODES

DATAX==0			;DATA RECORD
TPHDX==1			;TAPE HEADER
FLHDX==2			;FILE HEADER
FLTRX==3			;FILE TRAILER
TPTRX==4			;TAPE TRAILER
USRX==5				;USER BLOCK
CTPHX==6			;CONTINUED SAVE
FILLX==7			;FILLER RECORD

;NUMBER OF ERROR RETRIES FOR MTA

NRETRY==^D40

;LISTING FORMAT PARAMETERS

FLCOL==^D5			;COLUMN FOR FILE NAME
WTCOL==^D60			;COLUMN FOR WRITE DATE
SIZCOL==^D80			;COLUMN FOR SIZE
CSCOL==^D100			;COLUMN FOR CHECKSUM
PAGLEN==^D57			;LINES PER LISTING PAGE

;FORMAT OF RECORDS ON TAPE
;TAPE HEADER

BFMSGP==1			;PTR TO SAVE SET NAME
BFTAD==2			;TAD OF SAVE
BFMSG==3			;SAVE SET NAME

;FILE HEADER

FHNAM==0			;FILE NAME
FHFDB==200			;FDB

;DIRECTORY INFORMATION BLOCK

UHNAM==40			;NAME STRING
UHPSW==60			;PASSWORD STRING
UHACT==100			;ACCOUNT STRING
UGLEN==200			;USER/DIRECTORY GROUP LENGTH
CDUG==200			;USER GROUPS
CDDG==400			;DIRECTORY GROUPS
CDSG==600			;SUBDIRECTORY GROUPS

;FILE NAME PUNCTUATION

DEVPCT==":"			;DEVICE
DIRBP=="<"			;DIRECTORY BEGIN
DIREP==">"			;DIRECTORY END
EXTPCT=="."			;EXTENSION
GENPCT=="."			;GENERATION
ATTPCT==";"			;ATTRIBUTE
	SUBTTL INTERCHANGE FORMAT DEFINITIONS

BKFMT==1			;FORMAT VERSION NUMBER (CONSTANT)

;RECORD TYPES

T$LBL==1			;LABEL IDENTIFICATION RECORD
T$BEG==2			;SAVE START
T$END==3			;SAVE END
T$FIL==4			;DISK FILE DATA
T$UFD==5			;UFD RIB
T$EOV==6			;END OF VOLUME
T$COM==7			;COMMENT
T$CON==10			;CONTINUE (SAME DATA AS T$BEG-T$END)
T$MAX==T$CON			;MAXIMUM RECORD TYPE

;STANDARD RECORD

G$TYPE==0			;RECORD TYPE
G$SEQ==1			;SEQUENCE NUMBER
G$RTNM==2			;RELATIVE TAPE NUMBER
G$FLAG==3			;RECORD DEPENDENT BITS
 GF$EOF==1B0			;LAST RECORD OF FILE
 GF$RPT==1B1			;REPEAT OF LAST RECORD WRITE ERROR
 GF$NCH==1B2			;IGNORE CHECKSUM
 GF$SOF==1B3			;START OF FILE
G$CHK==4			;CHECKSUM
G$SIZ==5			;NUMBER OF DATA WORDS
G$LND==6			;TOTAL LENGTH OF NON-DATA SECTION
G$CUSW==13			;RESERVED FOR CUSTOMER USE

;O$FILE/A$FLGS

B$PERM==1B0			;PERMANENT
B$TEMP==1B1			;TEMPORARY
B$DELE==1B2			;ALREADY DELETED
B$DLRA==1B3			;DON'T DELETE FOR LACK OF RECENT ACCESS
B$NQCF==1B4			;NOT QUOTA CHECKED
B$NOCS==1B5			;DOES NOT HAVE VALID CHECKSUMS
B$CSER==1B6			;HAS CHECKSUM ERROR
B$WRER==1B7			;HAS DISK WRITE ERROR
B$MRER==1B8			;HAD <BACKUP READ ERROR ON RESTORE
B$DAER==1B9			;DECLARED BAD BY DAMAGE ASSESMENT

;O$FILE BLOCK

A$FHLN==0			;HEADER LENGTH WORD
A$FLGS==1			;FLAGS
A$WRIT==2			;CREATION DATE/TIME
A$ALLS==3			;ALLOCATED SIZE
A$MODE==4			;MODE
A$LENG==5			;LENGTH
A$BSIZ==6			;BYTE SIZE
A$VERS==7			;VERSION
A$PROT==10			;PROTECTION
A$ACCT==11			;BYTE POINTER ACCOUNT STRING
A$NOTE==12			;BYTE POINTER TO ANONOTATION STRING
A$CRET==13			;CREATION DATE/TIME OF THIS GENERATION
A$REDT==14			;LAST READ DATE/TIME OF THIS GENERATION
A$MODT==15			;MONITOR SET LAST WRITE DATE/TIME
A$ESTS==16			;ESTIMATED SIZE IN WORDS
A$RADR==17			;REQUESTED DISK ADDRESS
A$FSIZ==20			;MAXIMUM FILE SIZE IN WORDS
A$MUSR==21			;BYTE POINTER TO ID OF LAST MODIFIER
A$CUSR==22			;BYTE POINTER TO ID OF CREATOR
A$BKID==23			;BYTE POINTER TO SAVE SET OF PREVIOUS <BACKUP
A$BKDT==24			;DATE/TIME OF LAST BACKUP
A$NGRT==25			;NUMBER OF GENERATIONS TO RETAIN
A$NRDS==26			;NBR OPENS FOR READ THIS GENERATION
A$NWRT==27			;NBR OPENS FOR WRITE THIS GENERATION
A$USRW==30			;USER WORD
A$PCAW==31			;PRIVILEGED CUSTOMER WORD
LN$AFH==32			;LENGTH OF FIXED HEADER

;PROTECTION FIELDS

AC$OWN==377B19			;OWNER ACCESS FIELD
AC$GRP==377B27			;AFFINITY GROUP ACCESS FIELD
AC$WLD==377B35			;WORLD ACCESS FIELD
PR$ATR==7B31			;ATTRIBUTE PROTECTION SUBFIELD
PR$WRT==3B33			;WRITE PROTECTION SUBFIELD
PR$RED==3B35			;READ PROTECTION SUBFIELD

;O$DIRT/D$FLGS

DF$FOD==1B0			;FILES ONLY DIRECTORY
DF$AAL==1B1			;ALPHA ACCOUNTS ARE LEGAL
DF$RLM==1B2			;REPEAT LOGIN MESSAGES

;O$DIRT BLOCK

D$FHLN==0			;FIXED HEADER LENGTH WORD
D$FLGS==1			;DIRECTORY FLAGS
D$ACCT==2			;ACCOUNT NUMBER
D$PROT==3			;DIRECTORY PROTECTION
D$FPRT==4			;DEFAULT FILE PROTECTION
D$LOGT==5			;LOGIN DATE/TIME
D$GENR==6			;NUMBER GENERATIONS TO KEEP
D$QTF==7			;LOGGED-IN QUOTA
D$QTO==10			;LOGGED-OUT QUOTA
D$ACSL==11			;ACCESS LIST
D$USRL==12			;USER LIST
D$PRVL==13			;PRIVILEGE LIST
D$PSWD==14			;PASSWORD
LN$DFH==15			;LENGTH OF DIRECTORY FIXED HEADER

;NON-DATA BLOCK TYPES

O$NAME==1			;FULL PATH NAME BLOCK
O$FILE==2			;FILE ATTRIBUTE BLOCK
O$DIRT==3			;DIRECTORY ATTRIBUTE BLOCK
O$SYSN==4			;SYSTEM HEADER BLOCK
O$SSNM==5			;SAVE SET NAME BLOCK

;T$LBL RECORD

L$DATE==14			;DATE/TIME OF LABELING
L$FMT==15			;BACKUP FORMAT
L$BVER==16			;BACKUP VERSION
L$MON==17			;MONITOR TYPE
L$SVER==20			;SYSTEM VERSION
L$APR==21			;APR SERIAL NUMBER WRITING LABEL
L$DEV==22			;DEVICE ID WRITING LABEL
L$MTCH==23			;TAPE WRITE PAREMETERS
L$RLNM==24			;SIXBIT TAPE REEL NAME
L$DSTR==25			;DATE/TIME FOR DESTRUCTION
L$CUSW==37			;RESERVED CUSTOMER WORD

;T$BEG, T$END, T$CON RECORDS

S$DATE==14			;DATE/TIME OF START/END OF SAVE
S$FMT==15			;RETRIEVAL VERSION
S$BVER==16			;BACKUP VERSION
S$MON==17			;MONITOR TYPE
S$SVER==20			;SYSTEM VERSION
S$APR==21			;APR SERIAL NUMBER
S$DEV==22			;DEVICE ID WRITING SAVE SET
S$MTCH==23			;TAPE WRITE PARAMETERS
S$RLNM==24			;REELID
S$CUSW==37			;CUSTOMER WORD

;T$UFD RECORD

D$PCHK==14			;PATH CHECKSUM
D$LVL==15			;UFD LEVEL (UFD=0, SFD1=1, ETC.)
D$STR==16			;STRUCTURE OF UFD ( MAX OF 12(10) WORDS )
D$CUSW==37			;CUSTOMER WORD

;T$FIL RECORD

F$PCHK==14			;PATH CHECKSUM
F$RDW==15			;RELATIVE DATA WORD OF FILE
F$PTH==16			;START OF PATH BLOCK
LN$PTH==14			;LENGTH OF F$PTH BLOCK
F$CUSW==37			;RESERVED CUSTOMER WORD

F$NND==400			;LENGTH OF NON-DATA PORTION OF FIRST RECORD

;T$FIL/O$NAME SUB-BLOCK TYPES

.FCDEV==1			;DEVICE
.FCNAM==2			;FILE NAME
.FCEXT==3			;EXTENSION
.FCVER==4			;VERSION
.FCGEN==5			;GENERATION
.FCDIR==40			;DIRECTORY
.FCSF1==41			;FIRST SFD
.FCSF2==42			;SECOND SFD
; Defn's for retrievals & QUASAR interface

DEFSTR TPNM1,.ARTP1,35,36	; Tape 1 ID
DEFSTR TSN1,.ARSF1,17,18	; Tape 1 saveset #
DEFSTR TFN1,.ARSF1,35,18	; Tape 1 tape file #
DEFSTR TPNM2,.ARTP2,35,36	; Tape 2 ID
DEFSTR TSN2,.ARSF2,17,18	; Tape 2 saveset #
DEFSTR TFN2,.ARSF2,35,18	; Tape 2 tape file #

FILNM=.ARPSZ+1			; Where file name will start
	SUBTTL STORAGE

;BUFFERS NOT CLEARED AT STARTUP

ICOBUF:	BLOCK PGSIZ+NHEAD	;CONVERSION OUTPUT BUFFER

;STORAGE CLEARED AT STARTUP

STGBGN:				;BEGINNING OF STORAGE CLEARED AT STARTUP

; Do not seperate the following block

TPTSK:	BLOCK 1			; Internal task name on ret blk
TPRQUS:	BLOCK 1			; User who requested the retrieve
ABTFLG:	BLOCK 1			; Abort recieved from QUASAR
TPBLK:!
TPOFL:	BLOCK 1			; Flags
TAP1ID:	BLOCK 1			; Tape 1 ID
SSF1ID:	BLOCK 1			; Tape 1 saveset & tape file #
TAP2ID:	BLOCK 1			; Tape 2 ID
SSF2ID:	BLOCK 1			; Tape 2 saveset & tape file #
TPODT:	BLOCK 1			; Tape write date
TPPSZ:	BLOCK 1			; # pages in file
TAPNAM:	BLOCK <6+1+1+^D39*2+1+^D39*2+1+^D39*2+1+6+1>/5 ; Space for file name (^V's incl)
TPACT:	BLOCK <2*^D39>/5	; Account of request

MYPID:	BLOCK 1			; My PID (for talking to QUASAR)
QSRPID:	BLOCK 1			; QUASAR's PID
PDB:	BLOCK .IPCAS+11		; Space for MUTILing around
MPDB:	BLOCK 10		;PDB FOR MOUNTING TAPES
NUSABL==27
USABLK:	BLOCK NUSABL		; Block for USAGE
USADIR:	BLOCK 20		; Directory string for USAGE
USASTR:	BLOCK ^D12		; Structure name for USAGE
USASSI:	BLOCK 2			;SIXBIT STRUCTURE ID FOR USAGE
USAACT:	BLOCK ^D39/5		; Account string for USAGE
LHOSTN:	BLOCK 1			; Local host # (ARPAnet)
RFSPEC:	BLOCK 11		; Space for type in restart file
CURBUF:	BLOCK 1			;CURRENT OUTPUT BUFFER
FORMAT:	BLOCK 1			;DATA FORMAT
MTBUFF:	BLOCK 1			;BUFFER SWITCH
MTBPTR:	BLOCK 1			;ADDRESS OF CURRENT LOGICAL RECORD WITHIN
				; MTBUF1 OR MTBUF2
MTRACT:	BLOCK 1			;READ-AHEAD REQUEST ISSUED
SETBKF:	BLOCK 1			;LAST BLOCKING-FACTOR SET
TAPBKF:	BLOCK 1			;BLOCKING-FACTOR OF CURRENT TAPE
BLKCNT:	BLOCK 1			;DOWN-COUNTER FOR LOGICAL RECORDS BLOCKED
				; WITHIN EACH PHYSICAL RECORD
NAMBUF:	BLOCK 100		;FULL FILESPEC FOR FILE BEING DUMPED
ONMBUF: BLOCK 100		;FULL SPEC FOR FILE NAME GOING ON TAPE
IPDLP:	BLOCK 1			;PDL POINTER AT INTERUPT TIME
TPDLP:	BLOCK 1			;TEMP PDL POINTER
PDLP:	BLOCK 1			;STACK PTR AT TOP OF COMMAND
NPDL==100
PDL:	BLOCK NPDL		;MAIN FORK STACK
INIPTR:	BLOCK 1			;INITIAL JFN STACK POINTER
CMDPTR:	BLOCK 1			;TOP OF COMMAND POINTER
RPSPTR:	BLOCK 1			;REPARSE JFN STACK POINTER
CURPTR:	BLOCK 1			;CURRENT JFN STACK POINTER
NLINB==40
LINBUF:	BLOCK NLINB		;RDTTY LINE BUFFER
TEMPS:	BLOCK 100		; Temp storage for FIXFMM

;COMND STORAGE

ACBSIZ==^D200/5			;SIZE OF ATOM BUFFER
ACBFR:	BLOCK ACBSIZ
CBLK:	BLOCK .CMGJB+1		;COMMAND STATE BLOCK
GJBLK:	BLOCK .GJBFP+1		;GTJFN ARG BLOCK

;COMMAND TYPE INFORMATION.  

CMDTYP:	BLOCK 1			;CURRENT COMMAND TYPE HERE
TY%NOC==1B0		;NO-CONTINUE COMMAND
TY%RPO==1B1		;STACK JFNS FOR REPARSE ONLY
TY%MAP==1B2		;COMMAND MAPS BUFPAG
TY%DBL==1B3		;COMMAND USES JFNLST


;STORAGE FOR GTJFN DEFAULT STRINGS

DEFDEV:	BLOCK 20		;DEFAULT DEVICE
DEFDIR:	BLOCK 20		;DEFAULT DIRECTORY
DEFNAM:	BLOCK 20		;DEFAULT NAME
DEFEXT:	BLOCK 20		;DEFAULT EXTENSION
DEFVER:	BLOCK 20		;DEFAULT VERSION
DEFPRO:	BLOCK 20		;DEFAULT PROTECTION
DEFACC:	BLOCK 20		;DEFAULT ACCOUNT
NIJFN:	BLOCK 1			;SAVED JFNLST PTR IN CASE OF INTERRUPT
NJFN:	BLOCK 1			;NUMBER OF JFNS IN JFNLST IN USE
NJFN1:	BLOCK 1			;NUMBER ACTIVE JFNS STILL IN LIST
NSSNBF==^D140/5			;SIZE OF SAVE SET NAME BUFFER
SSNBUF:	BLOCK NSSNBF		;SAVE SET NAME BUFFER
MNTDSG:	BLOCK 1			;DESIGNATOR OF MT ASSIGNED BY QUASAR
MTDSG:	BLOCK 1			;DESIGNATOR FOR SPECIFIED MAGTAPE
MTTYP:	BLOCK 1			;TYPE OF MAGTAPE DEVICE
				;-1 = MTA
				; 0 = UNLABELED MT
				;+1 = LABELED (TOPS-20) MT
NAMPTR:	BLOCK 1			;POINTER TO NAME FIELD OF NAMBUF
ONMPTR: BLOCK 1			;POINTER TO NAME FIELD OF ONMBUF
OGNPTR:	BLOCK 1			;POINTER TO GENERATION NUMBER IN ONMBUF
OACPTR:	BLOCK 1			;POINTER TO ACCOUNT FIELD IN ONMBUF
NOFILS:	BLOCK 1			;NUMBER FILES DUMPED THIS DIRECTORY
TOTFIL:	BLOCK 1			;NUMBER FILES DUMPED ALL DIRECTORIES
WHEEL:	BLOCK 1			;NON-0 IF BEING RUN WITH WHEEL STATUS
DIRNUM:	BLOCK 1			;DIRECTORY NUMBER CURRENT DUMP DIRECTORY
RCDNUM:	BLOCK 1			;DIRECTORY NUMBER FOR RCDIR STEPPING
RCDSTR:	BLOCK 12		;STR:<*> STRING FOR RCDIR
SCNJFN:	BLOCK 1			;CURRENT JFN FOR DUMP SCAN
MTDEV:	BLOCK 2			;NAME STRING FOR SPECIFIED MTA
VOLID:	BLOCK 2			;CURRENT VOLUME IDENTIFIER (ASCIZ)
VOLID6:	BLOCK 1			;CURRENT VOLUME IDENTIFIER (SIXBIT)
DENSIT:	BLOCK 1			;SPECIFIED MTA DENSITY
PARITY:	BLOCK 1			;SPECIFIED MTA PARITY
LASTID:	BLOCK 1			;ID OF CURRENT DUMP PAGE FOR ERROR PSI
LSTERO:	BLOCK 1			;LAST ID REPORTED BY PSI

INT1AC:	BLOCK 20		;INT LEVEL 1 ACS
INT2AC:	BLOCK 20		;INT LEVEL 2 ACS
INT3AC:	BLOCK 20		;INT LEVEL 3 ACS
NINTPD==30			;SIZE OF INT STACKS
INT1PD:	BLOCK NINTPD		;INT LEVEL 1 STACK
INT2PD:	BLOCK NINTPD		;INT LEVEL 2 STACK
INT3PD:	BLOCK NINTPD		;INT LEVEL 3 STACK
LPC1:	BLOCK 1			;PSI PC'S
LPC2:	BLOCK 1
LPC3:	BLOCK 1
EINT1:	BLOCK 2			;JSR ENTRY
INTRQ:	BLOCK 1			;INTERRUPT REQUEST FLAG
INTPC:	BLOCK 1			;INTERRUPT PC
ICMDTY: BLOCK 1			;INTERRUPTED COMMAND TYPE
CEXFLG:	BLOCK 1			;COMMAND IN EXECUTION FLAG
TRAPJ:	BLOCK 1			;TRAP RECOVERY JUMP ADDRESS
TRAPSP:	BLOCK 1			;TRAP RECOVERY STACK FENCE
ITRAPJ: BLOCK 1			;INTERRUPTED TRAP RECOVERY
ITRAPS: BLOCK 1			;...
RTAPNO:	BLOCK 1			;EXPECTED TAPE NUMBER OF READ
RSEQ:	BLOCK 1			;EXPECTED SEQ NUMBER ON READ
TAPLFT:	BLOCK 1			;SET TO 0 WHEN EOT MARK ENCOUNTERED
CNTR:	BLOCK 1			;PAGES THIS FILE REMAINING TO BE DUMPED
USRCNT:	BLOCK 1			;COUNT OF PAGES THIS DIR
TOTCNT:	BLOCK 1			;COUNT OF PAGES ALL DIRS
CDIRN:	BLOCK 1			;CONNECTED DIRECTORY NUMBER
CHECK:	BLOCK 1			;NON-0 IF CHECKING, 0 IF LOADING
LPTJFN:	BLOCK 1			;JFN FOR LISTING FILE
LSTFIL:	BLOCK 40		;FILESPEC FOR LOG FILE
INCRSW:	BLOCK 1			;-1 FOR FULL-INCREMENTAL, ELSE INCREMENTAL COUNT OR 0
TFNAME:	BLOCK 100		;SAVE FILE NAME HERE
DIRNAM:	BLOCK 20		;NAME STRING OF CURRENT DIRECTORY
ODRNAM:	BLOCK 20		;NAME STRING OF OUTPUT DIRECTORY
LSTDIR:	BLOCK 20		;NAME STRING OF LAST DIRECTORY
CONBUF:	BLOCK	20		;STORAGE OF CONNECTED STRUCTURE AND DIRECTORY
CONSTR:	BLOCK	1		;POINTER TO CONNECTED STRUCTURE STRING
CONDIR:	BLOCK	1		;POINTER TO CONNECTED STRUCTURE STRING
JFN:	BLOCK 1			;JFN FOR CURRENT DUMP OR LOAD FILE
MTJFN:	BLOCK 1			;JFN OF MAG TAPE
MTCOMS:	BLOCK 2			;MTA DUMPI/DUMPO COMMAND LIST
LPTPOS:	BLOCK 1			;LPT LINE POSITION
BGNTAD:	BLOCK 1			;TAD AT START OF SAVE
INIJFN:	BLOCK 1			;INITIAL JFN FOR SAVE
INIPGN:	BLOCK 1			;INITIAL PAGE NUMBER FOR SAVE
INICNT:	BLOCK 1			;SAVED COUNTER IF IN MIDDLE OF FILE
ININUM:	BLOCK 1			;FLAG FOR INITIAL DDB
FDB:	BLOCK .FBLN0		;FDB FOR CURRENT FILE
FDBAUT:	BLOCK 10		;STORE AUTHER OF FILE
FDBLWR:	BLOCK 10		;STORE LAST WRITER NAME
FDBARC:	BLOCK .ARPSZ+1		; Tape info for arc/col/mig
ICFDB:	BLOCK .FBLN0		;SAVED FDB FOR INTERCHANGE FORMAT
WBTAD:	BLOCK 1			;WRITTEN-BEFORE TAD
WSTAD:	BLOCK 1			;WRITTEN-SINCE TAD
ABTAD:	BLOCK 1			;ACCESSED-BEFORE TAD
ASTAD:	BLOCK 1			;ACCESSED-SINCE TAD
MBTAD:	BLOCK 1			;MOVED-BEFORE TAD
MSTAD:	BLOCK 1			;MOVED-SINCE TAD
DEVNAM:	BLOCK 14		;DEVICE NAME FOR INCREMENTAL SAVE
FBUF1:	BLOCK 11		;BUFFERS FOR FILESPEC STRING COMPARE
FBUF2:	BLOCK 11
LPTBUF:	BLOCK 40		;BUFFER FOR LPT TEXT
LSTHDR:	BLOCK ^D200/5		;HEADING FOR EACH LISTING PAGE
LPTLIN:	BLOCK 1			;LISTING LINE NUMBER
LPTPAG:	BLOCK 1			;LISTING PAGE
TMODE:	BLOCK 1			;BIT 0 - LOCAL FLAG FOR MTOPN INDICATING
				;	 TAPE DATA MODE MUST BE SET
				;OF%RD - SET IF TAPE OPEN FOR READ
				;OF%WR - SET IF TAPE OPEN FOR WRITE
NWTBIT:	BLOCK 1			;OVERLAP BIT
ICOLEN:	BLOCK 1			;LENGTH OF FILE FOR INTERCHANGE SAVE
;CHECKSUM INFORMATION
CHKCN0:	BLOCK 1			;CHECKSUM FOR FILE
LSTPGE: BLOCK 1			;LAST PAGE CHECKSUMMED
FPGCNT: BLOCK 1			;# OF COMPLETE PAGES BEFORE EOF
RMRPGE: BLOCK 1			;PARTIAL PAGE BEFORE EOF
P2JFN:	BLOCK 1			;JFN FOR PASS2, INCREMENTAL & ARCHIVAL
UNLTAP:	BLOCK 1			;NON-0 FOR UNLOAD TAPE AFTER SAVE
ARCSW:	BLOCK 1			;NON-0 FOR ARCHIVE RUN
COLSW:	BLOCK 1			; 1=> COL; -1=>MIG
ARSETS:	BLOCK 1			;#SETS ARCHIVE INFO. IN FDB
ARCTSN:	BLOCK 1			;ARCHIVE SAVESET NO.
SSTYP:	BLOCK 1			;SAVESET TYPE (ARCHIVE, COLL., OR MIG.)
ARSSTB:	BLOCK 5			;ARG BLOCK FOR .ARSST
SPSEQ:	BLOCK 1			;SPEC. SEQ. NO. FOR RESTART OF ARCH. RUN
IDIR:	BLOCK 12		;INITIAL STR:DIRECTORY ON TAPE
CDIR:	BLOCK 12		;CURRENT STR:DIRECTORY FOR PASS 2
XDIR:	BLOCK 12		;STR:DIRECTORY AT END OF TAPE (PASS2)
FNDDIR:	BLOCK 1			;FLAG FOR FOUND XDIR (PASS2)
ISPEC:	BLOCK 200		;INITIAL FILESPEC ON TAPE
CSPEC:	BLOCK 200		;CURRENT FILESPEC (PASS2)
XSPEC:	BLOCK 200		;FILESPEC AT TAPE SWITCH
LODARC:	BLOCK 1			;FLAG LOAD ARCHIVE INFO
NXTRTP:	BLOCK 1			; Pointer to current retrieval blk
SNDFRK:	BLOCK 1			; SNDMSG fork handle
RETSW:	BLOCK 1			; Non 0 => doing retrievals
TPJFN:	BLOCK 1			; Temp JFN storage - used by SND & LSTMSG
; Do not separate the following SNDMSG blk
SNDTO:	BLOCK 1
SNDSUB:	BLOCK 1
SNDTXT:	BLOCK 1
TOLST:	BLOCK 40
BMBFLG:	0
CURSNP:	0			; Text body ptr for ARMSUS routine
LTARDR:	BLOCK 11		; Current dir name for arc'd msgs
FKRTBK:	BLOCK FILNM		; Fake retrieval block
TEMP:	BLOCK 40		; For file name in fake retrieval blk
STGEND:				;END OF STORAGE CLEARED AT STARTUP
; Block used for ACKing msgs with ACK request on

ACKBLK:	MSHSIZ,,.QOHEL		; Size & hello
	MF.NOM			; No message, just an ACK
	.-.			; ACK code to be filled in

;FLAG USED IN DUMPI/DUMPO TO REQUEST OVERLAPPED OPERATION

NWTBT0:	DM%NWT			;SET TO 0 FOR NON-OVERLAPPED

NBUF:	10			;SIZE OF FILE WINDOW AT BUF0

INIPDL:	IOWD NPDL,PDL		;INITIAL PUSH DOWN LIST

;STANDARD RETURNS

RSKP:	AOS 0(P)
R:	RET


;GTJFN BLOCK USED ONLY FOR REFERENCING FILES WHICH CAN BE INVISIBLE.
;***WARNING***  THE ONLY WORD OF THIS BLOCK WHICH SHOULD BE CHANGED
;IS THE FLAG WORD .GJGEN.

RETBLK:	0			;FLAGS, FILLED IN AT RUNTIME
	.NULIO,,.NULIO		;NO EXTRA INPUT OR OUTPUT
	0			; No device default
	0			; No directory
	0			; No name
	0			; No type
	0			; No protection
	0			; No account
	0			; No special JFN
	G1%IIN			; Find invisible files

CRLF:	ASCIZ/
/

DEFINE SAVPQ <
	JSP CX,.SAV8##>

DEFINE SAVEQ <
	JSP CX,.SAV3##>

DEFINE JSERR<
	JSP CX,JSERR0>

DEFINE ERROR (TAG,MSG)<
	JRST [	TMSGC <MSG
>
		JRST TAG]>

DEFINE ERRORJ (TAG,MSG)<
	JRST [	TMSGC <MSG, >
		CALL JSERRM
		JRST TAG]>

DEFINE FATAL (TXT) <
	JRST [PUSH P,A
		HRROI A,[ASCIZ \TXT\]
		PSOUT
		POP P,A
		HALTF]>

DEFINE TMSG(S)<
	HRROI B,[ASCIZ \S\]
	CALL TMSGQ>

DEFINE LPMSG(S)<
	HRROI B,[ASCIZ \S\]
	CALL LPMSGQ>

DEFINE BTMSG(S)<
	HRROI B,[ASCIZ \S\]
	CALL BTMSGQ>

DEFINE TMSGC(S)<
	HRROI B,[ASCIZ \S\]
	CALL TMSGQC>

DEFINE BTMSGC(S)<
	HRROI B,[ASCIZ \S\]
	CALL BTMSQC>

DEFINE TXTPTR (MSG)<POINT 7,[ASCIZ \MSG\]>

DEFINE TB (DAT,TXT)<
	XWD [ASCIZ \TXT\],DAT>
	SUBTTL MAIN LOOP
;PROGRAM ENTRY VECTOR

ENTVEC:	JRST START		;STARTING LOCATION
	JRST CLRST		;REENTER LOCATION
	VDUMPR			;VERSION NUMBER

START:	RESET
	MOVE A,[STGBGN,,STGBGN+1]
	SETZM -1(1)
	BLT A,STGEND-1		;CLEAR ALL VARIABLES
	MOVE P,INIPDL
	MOVEM P,PDLP		;SET COMMAND STACK FENCE
	MOVE A,[SIXBIT /LHOSTN/]
	SYSGT			; Look up local ARPAnet site #
	SKIPE B			; Table exist?
	MOVEM A,LHOSTN		; Stash away local site #
	MOVE A,[IOWD N.JFN,JFNSTK]
	MOVEM A,INIPTR		;INITIALIZE JFN STACK POINTER
	MOVEM A,RPSPTR		;REPARSE POINTER
	MOVEM A,CURPTR		;AND CURRENT POINTER
	MOVEM A,CMDPTR		;AND COMMAND POINTER
	MOVE A,[JRST EINT1A]
	MOVEM A,EINT1+1		;SETUP JSR DISPATCH
	MOVX F,LDIRF+RESPRO+RESACC ;DEFAULTS
	SETZM LSTFIL		;NO LIST IS DEFAULT
	SETO A,
	MOVE B,[-2,,Q1]
	MOVEI C,.JIDEN
	GETJI			;GET JOB DEFAULT DENSITY AND PARITY
	 JSERR
	MOVEM Q1,DENSIT		;SAVE THEM
	MOVEM Q2,PARITY
	MOVEI A,CURFMT		;DEFAULT IS CURRENT FORMAT
	MOVEM A,FORMAT
	MOVX A,DEFBKF		;GET DEFAULT BLOCKING-FACTOR
	MOVEM A,SETBKF		; AS LAST BLOCKING-FACTOR SET
	CALL MTBOT		;SET UP AS IF AT BEGINNING OF TAPE
	HRROI A,[ASCIZ/RETRVL/]
	STDEV			;RETRIEVAL TAPE FROM PREVIOUS RUN?
	 SKIPA			;NO
	JRST [	LOAD A,DV%TYP,B
		CAIE A,.DVMTA	;JUST MAKE SURE IT'S A TAPE
		JRST .+1
		MOVEM B,MNTDSG	;IS A TAPE
		SETZ A,
		CALL SETMNT	;RELEASE TAPE AND DELETE LOGICAL NAME
		JRST .+1]

	MOVEI A,.FHSLF
	MOVE B,[LEVTAB,,CHNTAB]
	SIR			;DECLARE INTERRUPT TABLES
	EIR			;ENABLE INTERRUPTS
	MOVE B,CHNMSK
	AIC			;ACTIVATE CHANNELS
	MOVE A,[.TICCE,,CECHN]
	ATI			;ACTIVATE ^E INTERRUPT
	CALL UNMAPB		;RESET BUFFERS
	MOVEI A,.FHSLF
	RPCAP
	TXNE C,SC%WHL+SC%OPR	;WHEEL OR OPERATOR?
	JRST [	SETOM WHEEL	;YES
		MOVEI A,.MSIIC
		MSTR		;OVERRIDE STRUCTURE REGULATION
		 ERCAL R	;POSSIBLY RUNNING ON TOPS-20 REL 3A
		JRST .+1]
	HRLOI A,377777		;INIT 'BEFORE' DATE TO PLUS INFINITY
	MOVEM A,ABTAD
	MOVEM A,WBTAD
	MOVEM A,MBTAD
	MOVX A,1B0		;INIT 'SINCE' DATE TO MINUS INFINITY
	MOVEM A,ASTAD
	MOVEM A,WSTAD
	MOVEM A,MSTAD
	MOVE A,[ICBLK,,CBLK]	;INIT COMMAND STATE BLOCK
	BLT A,CBLK+.CMGJB

;RESET AND START COMMAND

CLRST:	MOVE P,PDLP		;RESTORE PDL NOW
	CALL MTCLS		;CLOSE MAGTAPE IF OPEN
	SETZM TRAPJ		;CLEAR TRAP FENCE
	SETZM INTPC		;NO ^E
	MOVE P,INIPDL		;RESET PUSH DOWN LIST
	CALL INIRST		;RESET JFN STACK TO INIPTR
;	JRST RESTRT		;AND START OVER
	; ..
;TOP OF COMMAND

RESTRT:	MOVEM P,PDLP		;SAVE PDL POINTER
	SETZM CMDTYP		;ZERO COMMAND TYPE FLAG
	SETZM TRAPSP
	SETZM TRAPJ		;ZERO TRAP STUFF
	SETZM CEXFLG
	SETZM INTRQ
	MOVE A,CURPTR
	CAME A,CMDPTR		;ERROR IF NOT SAME
	ERROR BMBCM1,<?CMDPTR SHOULD EQUAL CURPTR>
	TXZ F,NOFLG
	MOVE A,CMDPTR		;GET COMMAND POINTER
	MOVEM A,RPSPTR		;RESET REPARSE POINTER
	MOVEM A,CURPTR		;AND CURRENT POINTER
	MOVEI A,REPAR0		;GET REPARSE ADDRESS
	HRROI B,[ASCIZ /DUMPER>/] ;GET POINTER TO PROMPT
	CALL CMDINI		;INIT FOR COMND JSYS
REPAR1:	TXZ F,NOFLG		;FORGET STUFF FROM PARTIAL COMMAND
	MOVEI A,CBLK
	MOVEI B,[FLDDB. (.CMKEY,,CTBL,<command name>)]
	COMND			;GET COMMAND NAME
NO1:	TXNE A,CM%NOP
	ERROR RESTRT,<?NOT A DEFINED COMMAND>
	HRRZ B,0(B)		;GET POINTER TO  COMMAND WORD
	MOVE B,(B)		;FLAGS,,DISPATCH ADDRESS
	MOVEM B,CMDTYP		;STORE AS CURRENT TYPE
	JRST 0(B)		;DISPATCH TO IT

;HERE WHEN REPARSE NEEDED

REPAR0:	MOVE P,PDLP		;RESTORE PDL PNTR
	CALL REPRST		;RESET JFN STACK
	JRST REPAR1		;CONTINUE PARSE

REPRST:	MOVE D,RPSPTR		;REPARSE POINTER
	CALL RSTSTK		;RESET STACK TO REPARSE POINTER
	RET			;RETURN

;HERE WHEN COMMAND COMPLETED

CDONE:	SKIPN ARCSW		; Doing an archive run?
	SKIPE COLSW		; Collection/migration?
	JRST [	SKIPE ICMDTY	; One of those, Under ^E?
		JRST .+1	; Yes, don't clean up
		SETZM ARCSW
		SETZM COLSW
		CALL MLDONE	; Finished with SNDMSG stuff
		JRST .+1]
	SKIPE RETSW		; Doing a retrieval?
	JRST [	SKIPE ICMDTY	; Yes, under ^E?
		JRST .+1	; Yes, don't clean up now
		CALL RETCLN	; Do clean up actions
		CALL MLDONE	; We're done with SNDMSG fork
		SETZM RETSW	; Flag no longer retrieving
		CALL RELPID	; Relase PID used for QSR comm.
		JRST .+1]
	SETZM CEXFLG
	SKIPN ICMDTY		;SKIP IF UNDER ^E
	JRST [	TXZ F,TF2	;NOT IN MIDDLE OF FILE
		MOVE D,CMDPTR   ;GET COMMAND POINTER
		CAMN D,INIPTR	;COMPARE TO INITIAL POINTER
		JRST .+1	;SAME, OK
		TMSGC <%CMDPTR SHOULD EQUAL INIPTR>
		CALL INIRST	;RESET STUFF
		JRST RESTRT]	;RESTART COMMAND
	MOVE D,CMDPTR		;FINAL POINTER
	CALL RSTSTK		;RESET STACK TO COMMAND POINTER
	MOVEM D,RPSPTR		;SET BACK TO COMMAND POINTER
	JRST RESTRT

;HERE TO BOMB THE CURRENT COMMAND
;IF COMMAND IS CONFIRMED, ENTER AT BMBCMD
;IF COMMAND IS NOT CONFIRMED, ENTER AT BMBCM1

BMBCMD:	MOVE D,CMDTYP		;GET COMMAND TYPE
	TXNE D,TY%MAP		;NOSKIP IF COMMAND MAPS BUFPAG
	CALL UNMAPB		;RESET BUFFERS
BMBCM1:	MOVE P,PDLP		;RESET PDL TO TOP OF COMMAND
	MOVE D,CMDPTR		;RESET TO TOP OF COMMAND
	CALL RSTSTK		;RESET STACK TO TOP OF COMMAND
	MOVEM D,RPSPTR		;REPARSE POINTER RESET
	MOVEI A,.PRIIN		;PRIMARY INPUT DEVICE
	CFIBF			;CLEAR BUFFER
	SKIPE RETSW		; In a retrieval?
	JRST [	SKIPN MYPID	; Have a PID?
		JRST .+1	; No, forget this
		CALL GDBYE	; Tell QUASAR goodbye
		 JFCL
		CALL RELPID	; And release the PID
		JRST .+1]
	JRST RESTRT		;TOP OF NEW COMMAND

;CONFIRM

CONFRM:	PUSH P,A
	PUSH P,B
	PUSH P,C		;BE TRANSPARENT
	MOVEI A,CBLK
	MOVEI B,[FLDDB. .CMCFM]
	COMND			;CONFIRM
	TXNE A,CM%NOP
	ERROR BMBCM1,<?NOT CONFIRMED>
	CALL JFNCFM	;WORK OVER JFN STACK
	POP P,C
	POP P,B
	POP P,A
	RET
; COMNDX - EXECUTE COMND JSYS AND HANDLE NO-PARSE ERRORS
;  B/ ADDRESS OF FUNCTION DESCRIPTOR BLOCK (FDB)
; RETURNS +1: PARSE SUCCESSFUL; A,B,C/ AS RETURNED BY COMND
;	  TO BMBCM1 AFTER TYPING ERROR MESSAGE IF CM%NOP IS RETURNED

COMNDX:	MOVEI A,CBLK		;GET STATE BLOCK ADDRESS
	COMND			;ISSUE COMND
	TXNN A,CM%NOP		;PARSE OK?
	RET			;YES
	TMSGC <?>
	CALL JSERRM		;TYPE REASON FOR FAILURE
	JRST BMBCM1

; COMNDN - SAME AS COMNDX, BUT TAKES +1 ON NO-PARSE, +2 ON SUCCESS

COMNDN:	MOVEI A,CBLK
	COMND
	TXNN A,CM%NOP		;OK?
	RETSKP			;YES
	TMSGC <?>
	CALLRET JSERRM		;TYPE REASON AND RETURN TO CALLER


; NOISE - PARSE NOISE PHRASE
;  A/ STRING POINTER TO NOISE PHRASE
; RETURNS +1: NOISE PARSED SUCCESSFULLY

NOISE:	STKVAR <<NOIFDB,2>>
	MOVEM A,.CMDAT+NOIFDB	;STUFF POINTER IN FDB
	MOVX A,FLD(.CMNOI,CM%FNC)
	MOVEM A,.CMFNP+NOIFDB
	MOVEI B,NOIFDB		;GET FDB ADDR	
	CALLRET COMNDX		;ISSUE COMND JSYS AND RETURN


; KEYWD - PARSE A KEYWORD
;  A/ LH: ADDRESS OF ASCIZ HELP TEXT (0 IF NONE)
;     RH: ADDRESS OF KEYWORD TABLE
; RETURNS +1: KEYWORD PARSED, B/ ADDRESS OF KEYWORD TABLE ENTRY

KEYWD:	SAVEQ			;BUILD FDB IN Q1-Q3
	MOVX Q1,FLD(.CMKEY,CM%FNC) ;.CMFNP WORD OF FDB
	HRRZ Q2,A		;.CMDAT WORD OF FDB
	HLRO Q3,A		;.CMHLP WORD OF FDB
	TRNE Q3,-1		;HELP MESSAGE SPECIFIED?
	TXO Q1,CM%HPP		;YES, TELL COMND
	MOVEI B,Q1		;GET FDB ADDRESS FOR COMND
	CALLRET COMNDX		;GO PARSE AND RETURN TO CALLER
; CMDINI - INITIALIZE FOR COMND JSYS
;  A/ FLAGS,,REPARSE ADDRESS
;  B/ STRING POINTER TO PROMPT
; RETURNS +1: ALWAYS

CMDINI:	MOVEM A,CBLK+.CMFLG	;STORE FLAGS AND REPARSE ADDRESS
	MOVEM B,CBLK+.CMRTY	;STORE POINTER TO PROMPT STRING
	MOVEI B,[FLDDB. .CMINI]	;GET ADDRESS OF INIT FDB
	CALLRET COMNDX		;ISSUE COMND JSYS AND RETURN +1


;COMMAND HAS JUST BEEN CONFIRMED. CHECK FOR UNDER ^E
;AND SET JFNSTK POINTERS CORRECTLY FOR CIRCUMSTANCES
;ROUTINE ASSUMES IT MAY USE  AC'S A,B,C.

JFNCFM:	SKIPE ICMDTY		;UNDER ^E?
	JRST JFNCF1		;YES, SEE IF THIS IS A CONTINUE CMD.
	TXZ F,LTTYF
	MOVE A,CMDTYP		;GET TYPE
	TXNE A,TY%RPO		;SKIP IF NOT REPARSE ONLY
	JRST [	MOVE A,RPSPTR	;GET REPARSE POINTER
		MOVEM A,CURPTR 	;STORE AS CURRENT POINTER
		RET]
	MOVE A,CURPTR		;CURRENT POINTER
	MOVEM A,RPSPTR		;BECOMES REPARSE POINTER
	RET
;THE USER HAS TYPED A COMMAND UNDER ^E. CHECK IF IT IS
;A CONTINUE OR NO-CONTINUE COMMAND. IF IT IS NO-CONTINUE,
;INFORM THE USER AND GIVE HER/HIM THE CHOICE BETWEEN THE
;OLD COMMAND AND THE CURRENT COMMAND.
;CALLED WITH A,B,C ON THE STACK AND WITH THE
;CURRENT COMMAND TYPE IN CMDTYP.

JFNCF1:	MOVE A,CMDTYP		;GET COMMAND INFORMATION
	TXNE A,TY%NOC		;SKIP IF CONTINUE-ABLE
	JRST JFNCF2		;NOT CONTINUE-ABLE
	TXNN A,TY%RPO		;SKIP IF REPARSE ONLY
	JRST [	MOVE B,RPSPTR	;GET REPARSE POINTER
		MOVEM B,CMDPTR	;USE AS COMMAND POINTER
		MOVE B,CURPTR	;CURRENT POINTER
		MOVEM B,RPSPTR	;ALSO REPARSE POINTER
		RET ]		;RETURN
	MOVE B,RPSPTR		;GET REPARSE POINTER
	MOVEM B,CURPTR		;RESET CURRENT POINTER
	RET			;RETURN


;HERE IF UNDER ^E AND NOT CONTINUEABLE

JFNCF2:	HRROI A,[ASCIZ\%Do you really want to abort your interrupted command? \]
	CALL YESNO		;GET YES OR NO
	JUMPE A,DLTNEW		;NO-- DELETE NEW COMMAND
;	JRST DLTOLD		;YES-- DELETE OLD COMMAND
;HERE TO DELETE OLD COMMAND

DLTOLD:	SAVPQ			;SAVE PERM REGS
	TXZ F,LTTYF
	SKIPE MTJFN		;TAPE OPEN?
	JRST [	MOVX B,OF%RD	;YES
		TDNE B,TMODE	;OPEN FOR READING
		SKIPG MTTYP	; AND LABELED?
		JRST .+1	;NOT BOTH
		CALL XGDSTS	;CLEAR ERRORS
		CALL REWCV	;PROBABLY IN THE MIDDLE OF SOME SAVESET
		JRST .+1]
	CALL MTCLS		;CLOSE TAPE IF OPEN
	SETZ A,
	CALL SETMNT		;RELEASE MOUNTED MT IF ANY
	TXZ F,TF2		;NOT IN MIDDLE OF FILE
	MOVE D,CMDPTR		;COMMAND POINTER
	CAMN D,INIPTR		;SKIP IF JFNS TO DELETE
	JRST DLTOL2		;NONE
	CALL UNMAPB		;RESET BUFFERS
DLTOL1:	POP D,A			;GET OLD JFN
	CALL RLSJFN		;THROW AWAY
	CAME D,INIPTR		;SKIP IF DONE
	JRST DLTOL1		;LOOP
	MOVE A,INIPTR		;INITIAL POINTER
	MOVE B,CURPTR		;CURRENT POINTER
	SUB B,CMDPTR		;NEW SIZE
	HRLS B			;SIZE,,SIZE
	ADD A,B			;NEW POINTER
	MOVEM A,CURPTR  	;STORE
	HRLZ B,CMDPTR		;START BLT FROM
	HRR B,INIPTR		;BLT TO
	ADD B,[1,,1]
	BLT B,0(A)		;MOVE IT
	
	MOVE A,INIPTR
	MOVEM A,CMDPTR
DLTOL2:	MOVE A,CURPTR
	MOVEM A,RPSPTR		;UPDATE REPARSE POINTER
	MOVE A,LPTJFN		;LIST FILE JFN
	CALL RLSJFN		;RELEASE IT
	SETZM INTPC
	SETZM ICMDTY		;NO LONGER UNDER ^E
	MOVE A,INIPDL		;
	MOVE B,P		;
	SUB B,IPDLP		;# ITEMS TO GET RID OF
	HRLS B			;IN BOTH SIDES
	ADD A,B			;CONSTRUCT NEW POINTER
	MOVE P,A		;AND STORE
	HRLZ B,IPDLP		;BLT FROM
	HRR B,INIPDL		;BLT TO
	ADD B,[1,,1]
	BLT B,0(A)		;MOVE IT
	MOVE A,INIPDL
	MOVEM A,PDLP		;RESET PDLP
	HRRZS A,Q1		;OFFSET ONLY
	HRRZ B,NIJFN		;PICK UP INTERRUPTED OFFSET
	SUB Q1,B		;NEW OFF SET
	HRLS Q1			;NEW OFFSET IN BOTH SIDES
	HRLZ B,NIJFN		;BLT START OFFSET
	MOVE C,[JFNLST,,JFNLST]	;BASE FOR FIRST BLT
	ADD C,B			;FIGURE BLT START ADDRESSES
	BLT C,JFNLST(Q1)		
	ADD B,[JF2LST,,JF2LST]	;BLT START ADDRESSES
	BLT B,JF2LST(Q1)		
	MOVSI B,-NJFNL+1	;SET UP Q1
	ADD Q1,B		;...
	RET

;HERE TO FORGET NEW COMMAND

DLTNEW:	CALL REPRST		;RESET JFN STACK 
	MOVE P,PDLP		;SET PDL BACK
	SETZM CMDTYP		;NO COMMAND 
	JRST RESTRT		;GO ON
;COMMAND NAME TABLE

DEFINE CTB (DAT,FLGS,TXT)<
	XWD [ASCIZ \TXT\],[FLGS+DAT]>

CTBL:	NCTBL,,NCTBL
	CTB $AB4,,<ABEFORE>
	CTB $ACC,,<ACCOUNT>
	CTB $ASI,,<ASINCE>
	CTB $B4,,<BEFORE>
	CTB CHCK,TY%NOC+TY%MAP,<CHECK>
	CTB $CSUM,,<CHECKSUM>
	CTB $CONT,,<CONTINUE>
	CTB $CREAT,,<CREATE>
	CTB $DEN,,<DENSITY>
	CTB $LDIR,,<DIRECTORIES>
	CTB $EOT,TY%NOC+TY%MAP,<EOT>
	CTB $EXIT,TY%NOC,<EXIT>
	CTB $LFIL,,<FILES>
	CTB $FMT,,<FORMAT>
	CTB TYPHLP,,<HELP>
	CTB $INDMD,,<INDUSTRY>
	CTB $INISP,TY%RPO,<INITIAL>
	CTB $ICMOD,TY%NOC,<INTERCHANGE>
	CTB $LIST,TY%RPO,<LIST>
	CTB $MB4,,<MBEFORE>
	CTB $MSI,,<MSINCE>
	CTB $NO,,<NO>
	CTB $PAR,,<PARITY>
	CTB PRINT,TY%NOC+TY%MAP,<PRINT>
	CTB $PRO,,<PROTECTION>
	CTB $EXIT,TY%NOC,<QUIT>		;synonym for EXIT
	CTB $LOAD,TY%NOC+TY%MAP+TY%DBL,<RESTORE>
	CTB $RETRI,TY%NOC+TY%MAP+TY%DBL,<RETRIEVE>
	CTB $REW,TY%NOC,<REWIND>
	CTB DUMP,TY%NOC+TY%MAP+TY%DBL,<SAVE>
	CTB $$SET,,<SET>
	CTB $SIL,,<SILENCE>
	CTB $SINCE,,<SINCE>
	CTB $SKIP,TY%NOC+TY%MAP,<SKIP>
	CTB $SSNAM,,<SSNAME>
	CTB $SUP,,<SUPERSEDE>
	CTB $TAPE,TY%RPO,<TAPE>
	CTB $UNL,TY%NOC,<UNLOAD>
NCTBL==.-CTBL-1

;INITIAL COMMAND STATE BLOCK

ICBLK:	REPAR0			;REPARSE DISPATCH
	.PRIIN,,.PRIOU
	POINT 7,[ASCIZ /DUMPER>/] ;PROMPT
	POINT 7,CBFR
	POINT 7,CBFR
	CBFSIZ*5
	0
	POINT 7,ACBFR
	ACBSIZ*5
	GJBLK
	SUBTTL COMMANDS

;DATE SETTING COMMANDS

;ACCESSED-BEFORE

$AB4:	CALL GETTAD
	MOVEM A,ABTAD
	JRST CDONE

;ACCESSED-SINCE

$ASI:	CALL GETTAD
	MOVEM A,ASTAD
	JRST CDONE

;WRITTEN-BEFORE

$B4:	CALL GETTAD
	MOVEM A,WBTAD
	JRST CDONE

;WRITTEN-SINCE

$SINCE:	CALL GETTAD
	MOVEM A,WSTAD
	JRST CDONE

;MOVED-BEFORE

$MB4:	CALL GETTAD
	MOVEM A,MBTAD
	JRST CDONE

;MOVED-SINCE

$MSI:	CALL GETTAD
	MOVEM A,MSTAD
	JRST CDONE
;GET TIME AND DATE AS NEXT FIELD

GETTAD:	HRROI A,[ASCIZ/DATE AND TIME/]
	CALL NOISE
	MOVEI B,[FLDDB. (.CMTAD,,CM%IDA+CM%ITM,,,[FLDDB. (.CMTAD,,CM%IDA)])]
	CALL COMNDX		;PARSE DATE WITH OPTIONAL TIME
	MOVE A,B
	CALLRET CONFRM		;CONFIRM IT

;INTERCHANGE MODE

$ICMOD:	HRROI A,[ASCIZ/FORMAT/]
	CALL NOISE
	CALL CONFRM
	TXNE F,NOFLG
	TXZA F,ICMODF		;NO INTERCHANGE
	TXO F,ICMODF		;INTERCHANGE 
	JRST CDONE

;(NO)CREATE DIRECTORIES FROM TAPE DATA ON RESTORE

$CREAT:	HRROI A,[ASCIZ/DIRECTORIES FROM TAPE DATA/]
	CALL NOISE
	CALL CONFRM
	TXNE F,NOFLG
	TXZA F,USRDAT		;MEANS IGNORE USER DATA
	TXO F,USRDAT
	JRST CDONE

;(NO)INDUSTRY COMPATIBLE 36-BIT MODE, I.E. LIKE MULTICS AND BBN

$INDMD:	HRROI A,[ASCIZ/COMPATIBLE 36-BIT MODE/]
	CALL NOISE
	CALL CONFRM
	TXNE F,NOFLG
	TXZA F,T36MOD		;NORMAL DEC 'CORE DUMP' MODE
	TXO F,T36MOD		;ELSE 2 36-BIT WORDS IN 9 FRAMES
	JRST CDONE
;INITIAL FILE SPECIFICATION FOR SAVE/RESTORE.  MUST BE FILE WITHIN
;GROUP SPECIFIED IN SAVE OR RESTORE COMMAND.  OPERATIONS 
;BEGINS WITH THIS FILE.

$INISP:	HRROI A,[ASCIZ/FILESPEC/]
	CALL NOISE
	SETZ B,			;PREPARE B IN CASE OF NEGATION
	JXN F,NOFLG,$INIS1	;JUMP IF NEGATED
	MOVEI A,[EXP CSCD,CSWD,CSCD,CSCD]	;POINT TO ROUTINES
	CALL FILDFI		;SETUP DEFAULT STRING
	MOVX A,GJ%OLD+GJ%IFG
	HLLM A,GJBLK+.GJGEN	;ALLOW STARS
	MOVEI A,CBLK
	MOVEI B,[FLDDB. .CMFIL]
	COMND
	TXNE A,CM%NOP
	ERRORJ RESTRT,<?INVALID FILESPEC>
	CALL ADFILE	;ADD JFN TO JFN STACK
$INIS1:	CALL CONFRM		;CONFIRM
	EXCH B,INIJFN		;SAVE NEW JFN, GET OLD JFN
	HRRZ A,B		;GET OLD JFN ALONE IN A
	SKIPE A			;DID I HAVE A JFN BEFORE?
	RLJFN			;YES, DUMP IT
	 JFCL
	SETZM ININUM		;CLEAR DDB FLAG
	JRST CDONE

;SAVESET NAME

$SSNAM:	MOVE Q1,CBLK+.CMPTR	;SAVE CURRENT LINE POINTER
	MOVEI B,[FLDDB. (.CMTXT,CM%SDH,,<arbitrary save set name text>)]
	CALL COMNDX		;PARSE TO EOL
	HRROI A,SSNBUF		;DESTINATION POINTER
	MOVE B,CBLK+.CMABP	;POINT TO ATOM BUFFER WHERE TEXT IS NOW
	SETZ C,			;ASCIZ
	SOUT			;COPY NAME
	JRST CDONE		;ALL DONE WITH $SSNAM
;SUPERSEDE ALWAYS/NEVER/OLDER

$SUP:	MOVEI A,STBL
	CALL KEYWD		;PARSE KEYWORD
	CALL CONFRM
	HRRZ B,0(B)		;GET FLAGS
	TXZ F,SSA+SSN		;MOVE THEM TO F
	IOR F,B
	JRST CDONE

STBL:	NSTBL,,NSTBL
	TB SSA,<ALWAYS>
	TB SSN,<NEVER>
	TB 0,<OLDER>
NSTBL==.-STBL-1

;PROTECTION TO BE RESTORED FROM TAPE OR SYSTEM DEFAULT

$PRO:	HRROI A,[ASCIZ/OF RESTORED FILES FROM/]
	CALL NOISE
	MOVEI A,ACCTB
	CALL KEYWD		;PARSE KEYWORD
	CALL CONFRM
	HRRZ B,0(B)
	SKIPN B			;SET FLAG PER ARGUMENT
	TXZA F,RESPRO
	TXO F,RESPRO
	JRST CDONE
;ACCOUNT OF RESTORED FILES TO BE SET FROM TAPE OR SYSTEM DEFAULT

$ACC:	HRROI A,[ASCIZ/OF RESTORED FILES FROM/]
	CALL NOISE
	MOVEI A,ACCTB
	CALL KEYWD		;PARSE KEYWORD
	CALL CONFRM
	HRRZ B,0(B)
	SKIPN B			;SET FLAG PER ARG
	TXZA F,RESACC
	TXO F,RESACC
	JRST CDONE

;ARGUMENT KEYWORD TABLE FOR PROTECTION AND ACCOUNT

ACCTB:	NACCTB,,NACCTB
	TB 0,<SYSTEM-DEFAULT>
	TB 1,<TAPE>
NACCTB==.-ACCTB-1
;TAPE - SETS MTA UNIT SPECIFICATION

$TAPE:	HRROI A,[ASCIZ/DEVICE/]
	CALL NOISE
	CALL PRSTAP		;PARSE MAGTAPE DESIGNATOR, GET JFN IN B
	 JRST RESTRT		;USER BLEW IT
	CALL ADLIST		;ADD JFN TO JFN STACK
	CALL CONFRM		;CONFIRM IT
	MOVE A,B		;PASS JFN
	CALL CHKMTJ		;CHECK OUT JFN
	 JRST RESTRT		;FAILED
	JRST CDONE

;NTAPE - GET TAPE SPEC FOR SECOND AND SUBSEQUENT TAPES
;NTAPER ENTRY REWINDS TAPE BEFORE RETURNING
;RETURNS +1: ERROR SWITCHING VOLUMES
;	 +2: SUCCESS

NTAPE:	TDZA A,A		;NO REWIND
NTAPER:	MOVEI A,1		;REWIND
	SAVEQ
	MOVE Q2,A		;SAVE REWIND FLAG
	MOVEM P,TPDLP		;TEMPORARY PLACE TO SAVE P
NTAPE1:	SETZM VOLID6		;CLEAR VOLID
	CALL TSTINT		;CHECK FOR INTERRUPT REQUEST
	SKIPE MTDSG		;SKIP IF NO TAPE DEVICE YET
	JRST [	SKIPGE A,MTTYP	;WHAT KIND OF TAPE?
		JRST .+1	;MTA, HAVE TO TALK TO USER
		JUMPE A,NTUMT	;UNLABELED MT, DO VOLSWITCH
		RETSKP]		;LABELED MT, NO ACTION NECESSARY
	MOVEI A,NTAPEC		;REPARSE ADDRESS
	HRROI B,[ASCIZ /$ Tape filespec /]
	CALL CMDINI		;INIT FOR COMND JSYS
NTAPE2:	CALL PRSTAP		;PARSE TAPE FILESPEC
	 JRST NTAPE1		;ERROR
	CALL ADLIST		;ADD JFN TO JFN STACK
	MOVE Q1,B		;SAVE JFN
	MOVEI B,[FLDDB. .CMCFM]
	CALL COMNDN		;GET CONFIRMATION
	 JRST [	CALL REPRST	;ERROR, CLEAN UP DEAD JFNS
		JRST NTAPE1]	;TRY AGAIN
	MOVE A,RPSPTR		;REPARSE POINTER
	MOVEM A,CURPTR		;RESET TO REPARSE POINTER
	MOVE A,Q1		;GET JFN IN A FOR CHKMTJ
	CALL CHKMTJ		;SETUP FOR OPEN
	 JRST NTAPE1		;FAILED
	JUMPE Q2,RSKP		;RETURN NOW IF NO REWIND REQUESTED
	CALL MTOPNX		;GET IT OPEN
	CALL REWCV		;REWIND IT
	CALL MTCLS		;CLOSE IT
	RETSKP

;REPARSE HERE

NTAPEC:	MOVE P,TPDLP		;RESTORE PNTR
	CALL REPRST		;RESET JFN STACK
	JRST NTAPE2		;CONTINUE

; SWITCH TO NEXT VOLUME ON UNLABELED MT DEVICE

NTUMT:	TMSGC <[Mounting next tape volume]
>
	CALL MTOPNX		;OPEN JFN
	MOVE A,MTJFN		;GET JFN
	MOVEI B,.MOVLS		;VOLUME-SWITCH MTOPR FUNCTION CODE
	MOVEI C,[EXP 3,.VSMRV,1] ;ARG LIST TO GET TO NEXT VOLUME
	MTOPR
	 ERJMP [TMSG <?Cannot switch to next tape volume
?>
		CALL JSERRM	;SAY WHY
		CALLRET MTCLS]	;CLOSE JFN
	MOVE A,MTJFN
	CALL GMTINF		;UPDATE VOLID
	CALL REWCV		;AT NEXT VOLUME, SO REWIND IT
	CALL MTCLS
	RETSKP

; PRSTAP - PARSE MAGTAPE FILESPEC
; RETURNS +1: ERROR ON PARSE, MESSAGE TYPED
;	  +2: SUCCESSFUL PARSE, B/ JFN

PRSTAP:	MOVE A,[GJBLK,,GJBLK+1]
	SETZM GJBLK
	BLT A,GJBLK+.GJBFP	;CLEAR COMND GTJFN BLOCK
	MOVEI A,CBLK
	MOVEI B,[FLDDB. (.CMFIL,CM%SDH,,<magtape designator>)]
	COMND			;READ MAGTAPE FILESPEC
	TXNE A,CM%NOP
	ERRORJ R,<?Invalid magtape designator>
	RETSKP			;GOOD RETURN, B/ JFN
; CHKMTJ - GIVEN A JFN, CHECK IF IT IS A REASONABLE MAGTAPE JFN
;	   AND SET UP MTTYP, MTDSG, AND MTDEV
;  A/ JFN (RELEASED BY CHKMTJ)
; RETURNS +1: NON-MAGTAPE OR ILLEGAL LABEL TYPE, ERROR MESSAGE TYPED
;	  +2: SUCCESS, MTDSG/ DESIGNATOR, MTDEV/ ASCIZ NAME
;	      MTTYP/ -1=MTA, 0=UNLABELED MT, +1=LABELED MT

CHKMTJ:	SAVEQ
	MOVE Q1,A		;SAVE JFN
	DVCHR			;GET DEVICE CHARACTERISTICS
	LOAD D,DV%TYP,B		;GET DEVICE TYPE
IFN DSKDMP,<MOVEI D,.DVMTA>	;For disk version, accept non-magtape
	CAIE D,.DVMTA		;IS IT A MAGTAPE?
	JRST [	JSP D,NTAP4	;NO, GO GIVE ERROR MESSAGE
		ASCIZ/ is not a magtape/]
	MOVEM A,MTDSG		;SAVE DESIGNATOR
	SETZM VOLID6		;CLEAR VOLID IN CASE OF MTA
	SETO B,			;ASSUME MTA
	TRNN A,DV%PSD		;CORRECT?
	JRST NTAP3		;YES, SKIP MT CODE
	MOVE A,Q1		;GET JFN
	CALL GMTINF		;GET LABEL TYPE IN A
	MOVEI B,1		;GET CODE FOR LABELED-MT
	CAIE A,.LTANS		;ANSI?
	CAIN A,.LTT20		;OR TOPS-20?
	JRST NTAP3		;YES, LABELED MT
	SETZ B,			;GET CODE FOR UNLABELED-MT
	CAIN A,.LTUNL
	JRST NTAP3		;UNLABELED MT
	MOVEI D,[ASCIZ/ illegal label type - must be UNLABELED or TOPS-20/]
NTAP4:	MOVEI A,.PRIOU		;REPORT NAME
	HRRZ B,Q1
	MOVX C,2B2+2B5+2B8+2B11+1B35
	JFNS
	HRRO A,D		;GET STRING POINTER TO TEXT
	PSOUT			;TYPE MESSAGE
	MOVE A,Q1
	RLJFN			;DUMP THE JFN
	 JFCL
	SETZM MTDSG		;CLEAR DESIGNATOR
	HRROI B,CRLF
	CALLRET TMSGQ		;TYPE CRLF AND RETURN +1

NTAP3:	MOVEM B,MTTYP		;STORE TYPE OF TAPE DEVICE
	HRROI A,MTDEV		;GET DESTINATION STRING POINTER
	HRRZ B,Q1		;GET JFN
	MOVE C,[1B2+1B35]	;DEVICE FIELD, PUNCTUATION
IFN DSKDMP,<MOVX C,1B8+1B11+1B14+1B35>
	JFNS
	MOVE A,Q1		;RELEASE TEMP JFN
	RLJFN
	 JFCL
	RETSKP
;SET COMMAND

$$SET:	MOVEI A,SETTBL
	CALL KEYWD		;PARSE KEYWORD
	HRRZ B,0(B)
	MOVE B,(B)
	MOVEM B,CMDTYP		;STORE AS CURRENT COMMAND TYPE
	JRST 0(B)		;AND GO ON

SETTBL: NSETTB,,NSETTB
	CTB SETBLK,,<BLOCKING-FACTOR>
	CTB TAPNUM,,<TAPE-NUMBER>
NSETTB==.-SETTBL-1

;SET TAPE NUMBER --SETS REEL #

TAPNUM:	HRROI A,[ASCIZ/DECIMAL NUMBER/]
	CALL NOISE
	MOVEI B,[FLDDB. (.CMNUM,,^D10)]
	CALL COMNDX		;PARSE DECIMAL NUMBER
	CALL CONFRM
	MOVEM B,TAPNO
	MOVEM B,RTAPNO		;IN CASE USER IS READING
	TXO F,TNSF		;USER SET TAPE NUMBER
	JRST CDONE


;SET BLOCKING-FACTOR

SETBLK:	HRROI A,[ASCIZ/TO/]
	CALL NOISE
	MOVEI B,[FLDDB. (.CMNUM,,^D10,<number of records,>)]
	CALL COMNDX		;PARSE DECIMAL NUMBER
	PUSH P,B
	HRROI A,[ASCIZ/RECORDS/]
	CALL NOISE
	CALL CONFRM
	POP P,B
	CAIGE B,1		;MUST BE 1 OR GREATER
	ERROR RESTRT,<?BLOCKING-FACTOR MUST BE GREATER THAN 0>
	CAILE B,MAXBKF		;MUST BE WITHIN LIMIT
	ERROR RESTRT,<?BLOCKING-FACTOR TOO LARGE>
	MOVEM B,SETBKF		;REMEMBER BLOCKING-FACTOR
	JRST CDONE
;TAPE PARAMETERS

;DENSITY

$DEN:	HRROI A,[ASCIZ/OF MAGTAPE/]
	CALL NOISE
	MOVEI A,DENTAB
	CALL KEYWD		;PARSE DENSITY KEYWORD
	CALL CONFRM
	HRRZ B,0(B)		;GET DENSITY CODE
	MOVEM B,DENSIT		;SAVE FOR OPEN
	JRST CDONE

DENTAB:	NDENTB,,NDENTB
	TB .SJD16,<1600-BPI>
	TB .SJDN2,<200-BPI>
	TB .SJDN5,<556-BPI>
	TB .SJD62,<6250-BPI>
	TB .SJDN8,<800-BPI>
	TB .SJDDN,<JOB-DEFAULT>
NDENTB==.-DENTAB-1

;PARITY

$PAR:	HRROI A,[ASCIZ/OF MAGTAPE/]
	CALL NOISE
	MOVEI A,PARTAB
	CALL KEYWD		;PARSE PARITY KEYWORD
	CALL CONFRM
	HRRZ B,0(B)		;GET PARITY CODE

	MOVEM B,PARITY		;SAVE FOR OPEN
	JRST CDONE

PARTAB:	NPARTB,,NPARTB
	TB .SJPRE,<EVEN>
	TB .SJPRO,<ODD>
NPARTB==.-PARTAB-1

;FORMAT SPECIFICATION - USEFUL IF STARTING IN MIDDLE OF TAPE

$FMT:	HRROI A,[ASCIZ/VERSION NUMBER IS/]
	CALL NOISE
	MOVEI B,[FLDDB. (.CMNUM,,^D10)]
	COMND
	TXNE A,CM%NOP
	ERROR RESTRT,<?NOT A DECIMAL NUMBER>
	CALL CONFRM
	MOVEM B,FORMAT		;SAVE SPECIFIED NUMBER
	JRST CDONE
;'NO' - INVERTS MEANING OF FOLLOWING COMMAND

$NO:	TXO F,NOFLG		;NOTE INVERSION
	MOVEI B,[FLDDB. (.CMKEY,,NOTBL,<command name>)]
	COMND			;ONLY CERTAIN COMMANDS AFTER NO
	JRST NO1		;JOIN NORMAL CASE

NOTBL:	NNOTB,,NNOTB
	CTB $CSUM,,<CHECKSUM>
	CTB $CREAT,,<CREATE>
	CTB $LDIR,,<DIRECTORIES>
	CTB $LFIL,,<FILES>
	CTB $INDMD,,<INDUSTRY>
	CTB $INISP,,<INITIAL>
	CTB $ICMOD,,<INTERCHANGE>
	CTB $LIST,,<LIST>
	CTB $SIL,,<SILENCE>
NNOTB==.-NOTBL-1

;'HELP'

TYPHLP:	CALL CONFRM
	MOVX A,GJ%OLD+GJ%SHT
	HRROI B,[ASCIZ /SYS:DUMPER.HLP/]
	GTJFN			;GET HELP FILE
	 JRST [	TMSG <?DUMPER help file not available, use "?" for list of commands.
>
		JRST BMBCMD]
	MOVEM A,JFN
	MOVX B,<FLD(7,OF%BSZ)+OF%RD>
	OPENF
	 JRST [	MOVE A,JFN
		RLJFN
		 JFCL
		CALL JSERR1
		SETZM JFN
		JRST BMBCMD]
TYPHL1:	MOVE A,JFN		;COPY FILE TO TERMINAL
	BIN
	JUMPN B,[MOVEI A,.PRIOU
		BOUT
		JRST TYPHL1]
	CLOSF			;NULL, ASSUME EOF
	 JFCL
	SETZM JFN
	JRST RESTRT

;EXIT

$EXIT:	CALL CONFRM
	HALTF
	CALL MTCLS		;CLOSE MAGTAPE IF OPEN
	JRST RESTRT		;IF CONTINUED
;TAPE POSITION COMMANDS

;REWIND

$REW:	MOVEI B,[FLDDB. .CMKEY,,RWTB,,CURRENT-VOLUME]
	CALL COMNDX		;PARSE KEYWORD
	HRRZ B,(B)		;GET DISPATCH ADDRESS
	JRST (B)		;OFF TO KEYWORD HANDLER

RWTB:	RWTBL,,RWTBL
	TB REWC,CURRENT-VOLUME
	TB REWS,SWITCHING
RWTBL==.-RWTB-1

REWC:	CALL CONFRM
	CALL MTOPNX
	CALL REWCV		;REWIND TO BEGINNING OF CURRENT VOLUME
	JRST REW2

REWS:	SAVEQ
	HRROI A,[ASCIZ/TO VOLUME NUMBER/]
	CALL NOISE
	MOVEI B,[FLDDB. .CMNUM,CM%SDH,12,decimal sequence number of volume within set,1]
	CALL COMNDX		;PARSE VOLUME #
	CALL CONFRM
	SKIPG Q3,B
	ERROR RESTRT,<?VOLUME NUMBER MUST BE POSITIVE>
	CALL MTOPNX		;OPEN MAGTAPE
	SKIPGE A,MTTYP		;MTA DEVICE?
	ERROR REW2,<?USE "TAPE" COMMAND TO SWITCH MTA DEVICES>
	JUMPG A,[CAIE Q3,1	;LABELED TAPE, CHECK VOLUME #
		ERROR REW2,<?LABELED TAPES CAN BE SWITCHED ONLY TO VOLUME 1>
		CALL REWVS	;REWIND TO FIRST VOLUME OF SET
		JRST REW1]
	MOVE A,MTJFN		;UNLABELED MT, GET JFN
	MOVEI B,.MOVLS		;VOLUME-SWITCH FUNCTION
	MOVEI C,Q1		;ARG BLOCK ADDRESS
	MOVEI Q1,3		;PUT SIZE IN ARG BLOCK
	MOVEI Q2,.VSMNV		;MOUNT ABSOULTE VOLUME # (IN Q3)
	MTOPR
	 ERJMP [TMSG <
?>
		CALL JSERRM	;TELL ABOUT ERROR
		JRST REW1]
	CALL REWCV		;REWIND TAPE, RESET COUNTERS
REW1:	SETZM VOLID6		;CLEAR VOLID
REW2:	CALL MTCLS		;CLOSE MT
	JRST CDONE

;UNLOAD

$UNL:	CALL CONFRM		;CONFIRM
	SKIPN MTDSG		;HAVE A TAPE YET?
	ERROR BMBCMD,<?NO TAPE DEVICE SPECIFIED YET> ;NO
	SKIPL MTTYP		;MT DEVICE?
	ERROR CDONE,<%Use the DISMOUNT TAPE command to unload MOUNTed tapes> ;YES
	CALL MTOPNX		;MTA DEVICE
	CALL UNLOAD		;UNLOAD IT
	JRST REW1		;CLEAR VOLID, CLOSE TAPE, EXIT

;SKIP TO END OF TAPE, I.E. TO JUST BEFORE TAPE TRAILER RECORD

$EOT:	CALL CONFRM		;CONFIRM
	SETOM CEXFLG		;ALLOW INTERRUPT
	CALL MTOPNR		;OPEN TAPE FOR READ
EOT1:	CALL MTRED		;READ NEXT RECORD
	 JRST [	TMSG <, record ignored
>
		JRST EOT1]
	MOVN A,TYP		;CHECK TYPE
	CAIE A,CTPHX
	CAIN A,TPHDX		;TAPE HEADER?
	JRST [	CALL TYHEDR	;YES, TYPE INFO
		JRST EOT1]
	CAIE A,TPTRX		;TAPE TRAILER?
	JRST EOT1		;NO, KEEP SCANNING
	SKIPLE MTTYP		;YES, LABELED TAPE?
	JRST [	JXE F,LREOF,EOT1 ;YES, LOOP IF NOT AT END OF LAST S/S
		JRST EOT2]	;AT END OF ALL SAVESETS
	CALL BACKSP		;BACK UP OVER TAPE TRAILER
	CALL BACKSP		; and back over another
	CALL FWRSP		; Then advance one to be going in
				;  proper direction
EOT2:	CALL MTCLS		;CLOSE AND DONE
	TMSGC <Tape positioned after last saveset
>
	TXO F,TNSF		;SET TAPE # KNOWN
	JRST CDONE

$CSUM:	JXN F,NOFLG,CSUM1	;JUMP IF USER WANTS NO CHECKSUM
	HRROI A,[ASCIZ/FILES/]
	CALL NOISE
	MOVEI A,CSMTAB
	CALL KEYWD		;PARSE KEYWORD
CSUM1:	CALL CONFRM
	HRRZ B,0(B)
	TXZ F,CHKSM+CS%SEQ	;TURN OFF FLAGS
	TXNN F,NOFLG		;SKIP IF 'NO CHECKSUM'
	IOR F,B
	JRST CDONE
CSMTAB:	NCKTBL,,NCKTBL
	TB CHKSM,<BY-PAGES>
	TB CHKSM+CS%SEQ,<SEQUENTIAL>
NCKTBL==.-CSMTAB-1
;SKIP n SAVESETS

$SKIP:	HRROI A,[ASCIZ/NUMBER OF SAVESETS/]
	CALL NOISE
	MOVEI B,[FLDDB. .CMNUM,,12] ;BASE 10 NUMBER
	CALL COMNDX		;PARSE NUMBER OF SAVESETS TO SKIP
	MOVE Q1,B		;SAVE IT
	CALL CONFRM		;CONFIRM
	SETOM CEXFLG		;ALLOW INTERRUPT
	JUMPLE Q1,SKIPR		;SCAN REVERSE IF 0 OR NEG

;SKIPPING FORWARD

	CALL MTOPNR		;OPEN TAPE FOR READ
	CALL MTRED		;READ FIRST RECORD
	 JRST SKIPF1		;BAD, IGNORE
	MOVN A,TYP
	CAIE A,CTPHX
	CAIN A,TPHDX		;SAVESET HEADER?
	AOJA Q1,SKIPF3		;YES, SKIP ONE MORE THAN SPEC
	JRST SKIPF2

SKIPF1:	CALL MTRED		;SCAN FORWARD
	 JRST [	TMSG <, record ignored
>
		JRST SKIPF1]
SKIPF2:	MOVN A,TYP		;CHECK TYPE
	CAIN A,TPTRX		;END OF TAPE?
	JRST [	SKIPLE MTTYP	;YES, LABELED?
		JRST SKIPF1	;YES, IGNORE END-OF-VOLUME
		CALL BACKSP	;UNLABELED, BACKSPACE OVER TAPE TRAILER
		CALL MTCLS
		TXO F,TNSF	;SET TAPE # KNOWN
		ERROR (BMBCMD,<%End of tape encountered>)]
	CAIE A,TPHDX		;TAPE HEADER?
	JRST SKIPF1		;NO, KEEP SCANNING
SKIPF3:	CALL TYHEDR		;YES, TYPE INFO
	SOJG Q1,SKIPF1		;LOOP IF MORE SAVESETS TO SKIP
	CALL BKTPHD		;BACKUP OVER TAPE HEADER & CLOSE TAPE
	TXO F,TNSF		;SET TAPE # KNOWN
	JRST CDONE

;SKIPPING REVERSE

SKIPR:	SKIPLE MTTYP		;LABELED TAPE?
	ERROR BMBCMD,<?Cannot backspace on labeled tape> ;YES, ERROR
	CALL MTOPNR		;UNLABELED, OPEN IT
	SETZM NWTBIT		;PREVENT OVERLAP READS
	JRST SKIPR1

SKIPR2:	CALL BACKSP		;BACKSPACE ONE RECORD NET
SKIPR1:	CALL BACKSP
	MOVE A,MTJFN		;GET TAPE JFN
	GDSTS			;GET STATUS
	TRNE B,MT%BOT		;AT BOT?
	JRST SKIPR3		;YES, IT HAS BEEN REPORTED, GO WRAP UP
	CALL MTRED
	 JRST [	TMSG <, record ignored
>
		JRST SKIPR2]
	MOVN A,TYP		;CHECK TYPE
	CAIE A,TPHDX		;TAPE HEADER?
	CAIN A,CTPHX
	SKIPA
	JRST SKIPR2		;NO, KEEP SCANNING
	CALL TYHEDR		;YES, TYPE INFO
	AOJLE Q1,SKIPR2		;COUNT HEADERS SEEN
	CALL BACKSP		;NO, BACK OVER LAST HEADER SEEN
SKIPR3:	CALL MTCLS		;DONE WITH TAPE
	TXO F,TNSF		;SET TAPE # KNOWN
	JRST CDONE
;LISTING CONTROL COMMANDS

;(NO)DIRECTORIES

$LDIR:	CALL CONFRM
	TXNE F,NOFLG		;NEGATED?
	TXZA F,LDIRF		;YES, NO DIRECTORIES
	TXO F,LDIRF		;DIRECTORIES
	JRST CDONE

;(NO)FILES

$LFIL:	CALL CONFRM
	TXNE F,NOFLG		;NEGATED?
	TXZA F,LFILF		;YES, "NO FILES"
	TXO F,LFILF		;"FILES"
	JRST CDONE

;(NO)SILENCE

$SIL:	CALL CONFRM
	TXNE F,NOFLG		;NEGATED?
	TXOA F,LFILF+LDIRF	;"NO SILENCE"
	TXZ F,LFILF+LDIRF	;"SILENCE"
	JRST CDONE

;SPECIFY LOG FILE

$LIST:	JXN F,NOFLG,[CALL CONFRM ;IF NEGATED, NO FURTHER ARGS
		SETZM LSTFIL	;NO LOG FILE
		TXZ F,LTTYF+LFDSK ;NOT LOGGING TO ANYTHING
		JRST CDONE]
	HRROI A,[ASCIZ/LOG INFORMATION ON FILE/]
	CALL NOISE
	MOVEI B,[FLDDB. (.CMOFI,,,,<LPT:DUMPER.LOG>)]
	COMND
	TXNE A,CM%NOP
	ERRORJ RESTRT,<?OUTPUT FILESPEC INVALID>
	CALL ADLIST		;ADD JFN TO JFN STACK
	CALL CONFRM
	HRROI A,LSTFIL		;PUT FILESPEC INTO BUFFER
	MOVX C,2B2+1B5+1B8+1B11+1B14+1B35
	JFNS
	MOVE A,B
	RLJFN
	 JFCL
	JRST CDONE
	SUBTTL DIRECTORY LISTING

PRINT:	HRROI A,[ASCIZ/DIRECTORY OF TAPE ONTO FILE/]
	CALL NOISE
	MOVEI B,[FLDDB. (.CMOFI,,,,<TTY:>)]
	COMND
	TXNE A,CM%NOP
	ERRORJ RESTRT,<?OUTPUT FILESPEC INVALID>
	CALL ADLIST		;ADD JFN TO JFN STACK
	CALL CONFRM
	MOVE A,B		;PICK UP JFN
	CALL LPTOP0		;OPEN DEVICE TO RECEIVE DIRECTORY
	CALL DIRS		;DO IT VIA SUBROUTINE
	TXO F,TNSF		;SET TAPE # KNOWN
	JRST CDONE

DIRS:	SETZM LSTHDR		;NO HEADER YET
	CALL MTOPNR
	SETOM CEXFLG		;ALLOW INTERRUPT
DIR1:	CALL MTRED		;READ NEXT RECORD, DISPATCH ON TYPE
	 JRST [	TMSG <, record ignored
>
		JRST DIR1]
	MOVN B,TYP
	CAIN B,FLHDX
	JRST DIRF		;FILE HEADER
	CAIN B,USRX
	JRST DIRU		;USER INFO
	CAIN B,TPTRX
	JRST DIRE		;END OF TAPE
	CAIE B,CTPHX
	CAIN B,TPHDX
	JRST DIRB		;BEGINNING OF TAPE
	CAIN B,FLTRX
	JRST DIRFDB		;FDB INFO
	CALL PGECSM		;CHECKSUM DATA PAGE
	JRST DIR1		
;BEGINNING OF TAPE

DIRB:	MOVE A,[POINT 7,LPTBUF]
	CALL PRHEDR		;COMPOSE HEADER IN LPTBUF
	HRROI B,LPTBUF
	CALL BTMSGQ		;TYPE AND PRINT IT
	BTMSG <
>
	HRROI A,LSTHDR		;SAVE HEADER FOR LISTING
	HRROI B,LPTBUF
	SETZ C,
	SOUT
	CALL PRTHDR
	BTMSG <

>
	JRST DIR1

;END OF TAPE

DIRE:	SKIPL PAGNO		;CONTINUED SAVE?
	JRST DIRE01		;NO-- GO ON
	BTMSG <
End of tape, saveset continued on next reel.
>
	SKIPLE MTTYP		;LABELED TAPE?
	JRST DIR1		;YES, CONTINUE SCANNING
	CALL UNLOAD		;UNLABELED, UNLOAD IF MTA
	CALL MTCLS		;CLOSE TAPE JFN
	CALL NTAPER		;GET NEXT VOLUME UP
	 JRST [	BTMSG <
?Cannot switch to next volume.
>
		JRST DIRE02]	;LOSE
	CALL MTOPNR		;OPEN IT
	JRST DIR1		;CONTINUE LISTING

DIRE01:	BTMSG <
End of tape.
>
DIRE02:	SKIPN A,LPTJFN		;SEE IF LISTING?
	JRST DIRE1		;NO
	MOVEI B,.CHFFD
	BOUT
	CLOSF
	 JFCL
	SETZM LPTJFN
DIRE1:	SKIPG MTTYP		;LABELED?
	CALL BACKSP		;NO, BACKSPACE OVER TAPE TRAILER
	CALLRET MTCLS

;USER INFO

DIRU:	BTMSG <
DDB for >
	HRROI B,BUFF+UHNAM
	CALL BTMSGQ
	BTMSG <
>
	JRST DIR1
;BEGINNING OF FILE

DIRF:	MOVEI B,FLCOL
	CALL TAB		;TAB TO NAME COLUMN
	SKIPN FORMAT		;BBN FORMAT?
	CALL FIXFMM		;YES, FIX SEMICOLON
	MOVE B,[POINT 7,BUFF]
DIRF1:	ILDB A,B		;SCAN FILESPEC
	CAIN A,";"		;END OF GENERATION?
	SETZ A,			;YES, USE NULL
	JUMPN A,DIRF1		;JUMP IF NOT END OF STRING
	DPB A,B			;TIE OFF STRING
	HRROI B,BUFF
	CALL LPMSGQ		;OUTPUT FILESPEC
	SKIPL PAGNO		;SKIP IF FILE CONTINUED
	JRST DIRF4		;GO ON
	LPMSG <
(File continued from previous reel)
>
	JRST DIR1		;DON'T RESET CHECKSUM
DIRF4:	TXNN F,CHKSM		;SKIP IF CHECKSUMMING
	JRST DIR1		;REST WILL BE PRINTED FROM TRAILER
	SETZM CHKCN0		;INITIALIZE CHECKSUM
	SETZM LSTPGE		;AND LAST PAGE #
	TXNN F,CS%SEQ		;SKIP IF SEQUENTIAL
	JRST DIR1		;GO ON
	CALL FILSZE		;FIGURE FILE SIZE
	JRST DIR1		;GO ON

;END OF FILE, FDB INFO

DIRFDB:	SKIPL PAGNO		;SKIP IF FILE CONTINUED
	JRST DIRF3		;GO ON
	LPMSG <
(File continued on next reel)
>
	JRST DIR1		;FDB PRINTER TO BE ADDED
DIRF3:	MOVEI B,WTCOL
	CALL TAB		;TAB TO WRITE COLUMN
	HRROI A,LPTBUF		;CONSTRUCT DATE STRING IN LPT BUFFER
	SKIPN B,BUFF+.FBWRT	;HAVE WRITE DATE?
	JRST [	LPMSG <(NEVER)>	;NO
		JRST DIRF2]
	MOVX C,1B10+1B12+1B17
	ODTIM			;YES, PRINT IT
	HRROI B,LPTBUF
	CALL LPMSGQ
DIRF2:	MOVEI B,SIZCOL
	CALL TAB		;TAB TO SIZE COLUMN
	LOAD B,FB%PGC,BUFF+.FBBYV ;GET PAGE COUNT
	MOVEI C,^D10
	CALL LPNOUT		;OUTPUT SIZE
	TXNE F,CHKSM		;SKIP IF CHECKSUMMING
	CALL PRTCSM		;PRINT CHECKSUM
	LPMSG <
>
	JRST DIR1		;GO ON
	SUBTTL DUMP ROUTINES

DUMP:	CALL DUMPS
	TXO F,TNSF		;SET TAPE # KNOWN
	JRST CDONE

DUMPS:	HRROI A,[ASCIZ/DISK FILES/]
	CALL NOISE
	CALL GETCON		;OBTAIN CURRENT CONNECTED DIRECTORY
	SETZM INCRSW		;DEFAULT NO INCREMENTAL
	SETZM ARCSW		; Default not archive run
	SETZM COLSW		; Default not collection/migration run
	SKIPE ICMDTY		;SKIP IF NOT UNDER ^E
	SKIPN Q1,NIJFN		;PICK UP POINTER, IF ANY
	MOVSI Q1,-NJFNL+1	;INIT PTR TO JFN LIST
	SKIPA Q2,[[FLDDB. .CMSWI,,DSWTB,,,FILCDB]] ;ALLOW SWITCHES
DUMP1:	MOVEI Q2,FILCDB		;GET FDB FOR FILESPEC ONLY
	MOVEI A,[EXP CSCD,CSWD,CSCD,CSCD]	;POINT TO ROUTINES
	CALL FILDFI		;SETUP DEFAULT FILE SPEC
	MOVX A,GJ%OLD+GJ%IFG+GJ%XTN ;ALLOW STARS, CK EXTENDED BLOCK
	HLLM A,GJBLK+.GJGEN
	MOVEI A,CBLK
	MOVE B,Q2		;GET FDB ADDRESS
	SETZ Q2,		;INDICATE FILE SPEC OK (WILL BE ERROR CODE IF NOT)
	COMND			;GET FILESPEC OR SWITCH
	JXN A,CM%NOP,DUMP2	;IF NO PARSE, CHECK GTJFN ERROR
	LOAD C,CM%FNC,0(C)	;GET CODE OF BLOCK USED
	CAIE C,.CMSWI		;SWITCH?
	JRST DUMP4		;NO, MUST BE FILENAME
	HRRZ B,0(B)		;GET DISPATCH
	JRST 0(B)
;SWITCH TABLE

DSWTB:	NDSWTB,,NDSWTB
	TB $ARC,<ARCHIVE>
;	TB $COL,<COLLECT>	;COLLECTION NOT SUPPORTED FOR RELEASE 4
	TB $FINC,<FULL-INCREMENTAL>
	TB $INC,<INCREMENTAL:>
	TB $MIG,<MIGRATE>
	TB $NINC,<NOINCREMENTAL>
NDSWTB==.-DSWTB-1

$ARC:	SKIPN INCRSW		; Some kind of incremental?
	SKIPE COLSW		; Or collection run?
	ERROR BMBCM1,<?Switch combination invalid>
	SETOM ARCSW
	JRST DUMP1

$MIG:	SKIPA A,[-1]		;FLAG AS MIGRATION
$COL:	MOVEI A,1		;FLAG AS COLLECTION
	SKIPN INCRSW
	SKIPE ARCSW
	ERROR BMBCM1,<?Switch combination invalid>
	MOVEM A,COLSW
	JRST DUMP1

$FINC:	SETO B,			;-1 MEANS FULL-INCREMENTAL
	JRST $INC5

$INC:	MOVEI B,1		;ASSUME 1 TAPE FOR /INC:
	JXE A,CM%SWT,$INC5	;IF NO SWITCH TERMINATOR, USE 1
	MOVEI B,[FLDDB. (.CMNUM,,^D10,<number of tapes each file must be on,>,<1>)]
	CALL COMNDX		;PARSE # OF TAPES
	CAIGE B,1		;VALID NUMBER?
	ERROR BMBCM1,<?TAPE COUNT MUST BE GREATER THAN 0>
$INC5:	SKIPN ARCSW		; /ARCHIVE been specified?
	SKIPE COLSW		; Or /COL or /MIGRATE ?
	ERROR BMBCM1,<?Switch combination invalid>
	MOVEM B,INCRSW		;SAVE INCREMENTAL STATE
	JRST DUMP1

$NINC:	SETZM INCRSW		;NO INCREMENTAL
	JRST DUMP1

;COMMAND BLOCK FOR SOURCE FILE

FILCDB:	FLDDB. (.CMFIL,CM%SDH,,<file group descriptor>)

;LIST OF GTJFN ERRORS WHICH ALL MEAN "FILE NOT FOUND"

OKGJXL:	BYTE (18)GJFX16,GJFX17,GJFX18,GJFX19,GJFX20,GJFX24,GJFX32,GJFX35,GJFX36,GJFX38
OKGJXZ==<.-OKGJXL>*2
;HERE WHEN FIRST FILSPEC TYPED, BUT WAS IN ERROR.
;CHECK FOR "OK" GTJFN ERROR:  ALL POSSIBLE "FILE NOT FOUND" CODES.
;ERROR CODE IN B, COMND FLAGS IN A

DUMP2:	JXN A,CM%ESC,DUMP22	;GIVE ERROR NOW IF RECOGNITION ATTEMPTED
	MOVE C,[POINT 18,OKGJXL] ;GET POINTER TO LIST OF OK CODES
	MOVEI D,OKGJXZ		;GET SIZE OF LIST
DUMP21:	ILDB A,C		;GET A CODE FROM TABLE
	CAME A,B		;MATCH ERROR GIVEN?
	SOJG D,DUMP21		;NO-- LOOP FOR ALL POSSIBLE OK ERRORS
	JUMPLE D,DUMP22		;NOT AN OK ERROR-- TYPE ERROR MESSAGE
	MOVE Q2,B		;ERROR IS FILE NOT FOUND-- REMEMBER CODE TO BE
				; PUT IN JF2LST AND CHECKED WHILE SCANNING
	MOVX A,GJ%OFG		;SET UP TO PARSE-ONLY THE NOT-FOUND FILESPEC
	HLLM A,GJBLK+.GJGEN	; . .
	MOVEI A,CBLK		;GET COMMAND STATE BLOCK ADDRESS
	MOVEI B,[FLDDB. .CMFIL]	;ONLY PARSE FILE-SPEC
	COMND			; . .
	TXNE A,CM%NOP		;THIS SHOULD ALWAYS SUCCEED!!
DUMP22:	ERRORJ BMBCM1,<?NOT A SWITCH OR FILESPEC>

;HERE WHEN FIRST FILESPEC HAS BEEN TYPED
;JFN OF FILE IN B

DUMP4:	CALL ADLIST		;ADD FILE TO JFNSTACK
	SKIPN Q2		;DON'T CHECK DEVICE IF FILE-NOT-FOUND
	CALL CHKDVC		;DO A DVCHR FOR LEGAL DEVICE
	JUMPGE Q1,[ERROR (BMBCM1,<?TOO MANY ITEMS IN FILESPEC LIST>)]
	MOVEM B,JFNLST(Q1)	;SAVE JFN
	MOVEM Q2,JF2LST(Q1)	;SET NO DESTINATION YET, ZERO OR ERROR CODE IF FILE-NOT-FOUND
	AOBJN Q1,.+1
	SKIPN ARCSW		; No user info on archive or migration tapes
	SKIPE COLSW
	JRST DUMP41
	TXNN F,USRDAT		;"CREATE" SPECIFIED?
	TXNE B,GJ%DIR		;* FOR DIRECTORY?
	TXO F,SAVUSF		;YES, IMPLIES USER INFO ALSO
DUMP41:	SKIPN ARCSW		; Auto unload on archive or migration
	SKIPE COLSW
	SETOM UNLTAP		;REQUEST AUTO-UNLOAD

;SET UP TO GET JFN ON "AS" FILESPEC

	MOVX B,GJ%OFG
	HLLM B,GJBLK+.GJGEN	;PARSE ONLY
	CALL OFNAME		;MAKE UP OUTPUT NAME DEFAULT

;CHECK IF "AS" FILESPEC IS PROSCRIBED

	SKIPN INCRSW		;INCREMENTAL?
	SKIPE ARCSW		;OR ARCHIVE?
	SKIPA
	SKIPE COLSW		;OR COLLECT/MIGRATE?
	JRST [	MOVE A,[.NULIO,,.NULIO] ;ONE OF THE ABOVE
		MOVEM A,GJBLK+.GJSRC ;SET SOURCE, DEST TO NULL
		MOVEI A,GJBLK	;GET ADDRESS OF GTJGN BLOCK
		SETZ B,		;NO STRING
		GTJFN		;SYNTHESIZE "AS" JFN
		 ERRORJ BMBCM1,<?INVALID FILE GROUP DESCRIPTOR>
		MOVE B,A	;GET JFN IN B
		JRST DUMP42]	;GO STUFF IT IN JF2LST

;PARSE "AS" FILESPEC

	HRROI A,[ASCIZ/AS/]
	CALL NOISE
	MOVEI B,LIT1		;PARSE FILESPEC OR COMMA OR CRLF
	MOVEI A,CBLK
	COMND
	TXNE A,CM%NOP
	ERRORJ BMBCM1,<?INVALID FILE GROUP DESCRIPTOR>

;CHECK WHAT WAS PARSED.  THE FDB CHAIN CONTAINS FILESPEC,COMMA,CONFIRM.
;HOWEVER, IF COMMA OR CONFIRM IS TYPED, IT WILL PARSE AS A FILESPEC.
;THE NEXT 3 LINES ARE A CHECK FOR THAT, JUST IN CASE COMND GETS CHANGED.

	LOAD C,CM%FNC,(C)	;GET CODE USED
	CAIE C,.CMFIL		;DID I PARSE A FILESPEC?
	ERROR BMBCM1,<?PARSE ERROR> ;NO, STRANGENESS IN COMND JSYS
DUMP42:	CALL ADLIST		;OUTPUT FILE SPEC
	SKIPN JF2LST-1(Q1)	;FIRST SPEC NOT FOUND?
	MOVEM B,JF2LST-1(Q1)	;NO, SAVE THIS JFN AS DESTINATION
DUMP5:	SKIPN ARCSW
	SKIPE COLSW
	JRST [	MOVEI A,CBLK	; Either archive or migration, need conf
		MOVEI B,[FLDDB. .CMCFM]
		COMND
		TXNE A,CM%NOP
		ERROR BMBCM1,<?Carriage return required.
Only one filespec allowed for archive or migration runs>
		JRST DUMP6]
	MOVEI A,CBLK		
	MOVEI B,[FLDDB. (.CMCFM,,,,,[FLDDB. (.CMCMA)])]
	COMND
	TXNE A,CM%NOP
	ERROR BMBCM1,<?COMMA OR CARRIAGE RETURN REQUIRED>
	LOAD C,CM%FNC,0(C)	;GET CODE USED
	CAIE C,.CMCFM		;TERMINATOR?
	JRST DUMP1		;NO, ASSUME COMMA. TRY AGAIN
DUMP6:	CALL [	SKIPE WHEEL	;WHEEL OR OPERATOR?
		RETSKP		;YES, NO FURTHER CHECKS REQUIRED
		SKIPN ARCSW	;NOT PRIVILEGED
		SKIPE COLSW
		RET		;CAN'T ARCHIVE/COLLECT/MIGRATE
		SKIPE INCRSW
		RET		;CAN'T DO INCREMENTAL SAVE
		RETSKP]		;OK, NOT TRYING ANYTHING SPECIAL
	 ERROR BMBCM1,<?WHEEL or OPERATOR capability required>
	CALL JFNCFM		;FIX UP JFN STACK
	SETOM CEXFLG		;INDICATE INTERRUPTIBLE COMMAND
	MOVEM Q1,NIJFN		;SAVE IN CASE OF ^E 
	MOVNI Q1,0(Q1)		;SAVE NUMBER OF JFNS SETUP
	MOVEM Q1,NJFN
	GTAD			;GET NOW
	MOVEM A,BGNTAD		;KEEP TIME AT START OF SAVE
	SETZM TOTFIL		;INIT DUMP COUNTS
	SETZM TOTCNT
	SETZM LSTDIR		;RESET LAST DIRECTORY NAME
	SETZM INIPGN		;RESET CONTINUED FILE PAGE
	TXNN F,TNSF		;SKIP IF TAPE # SET
	SETZM TAPNO		; START AFTER TAPE 0
	SKIPN ARCSW		; Archive
	SKIPE COLSW		; Or collection/migration run?
	CALL ARCINI		; Yes, set up for that
	MOVX A,PA%RD!PA%WT!PA%EX!PA%PEX ;GET ALL ACCESS
	MOVEM A,ACCESS		;SET UP ACCESS WORD FOR COMPATABILITY
	SETZM JFN		; Make sure is 0 initially

;LOOP THROUGH JFNLST FOR ALL FILESPECS TYPED

	TXZ F,DMPFLF		;INDICATE NO VALID JFNS FOUND YET
	HRLZ P5,NJFN		;SET TO SCAN JFN LIST

;IF THIS JFN HAD A "FILE-NOT-FOUND", THEN PRINT WARNING

DUMPL1:	MOVE B,JF2LST(P5)	;GET ERROR CODE OR OUTPUT JFN
	TRNN B,1B18		;ERROR CODE (6XXXXX) OR JFN?
	JRST DUMPL2		;JFN, IT'S OK
	TMSGC <%>
	MOVEI A,.PRIOU		;SET TTY
	MOVE B,JF2LST(P5)	;GET ERROR CODE BACK
	HRLI B,.FHSLF		;MYSELF, ERROR CODE NOW IN B
	SETZ C,			;NO LIMIT
	ERSTR			;TYPE ERROR MESSAGE
	 JFCL
	 JFCL
	TMSG < - >
	MOVEI A,.PRIOU		;OUTPUT FILESPEC THAT FAILED
	MOVE B,JFNLST(P5)	;GET JFN FOR IT
	SETZ C,			;DEFAULT OUTPUT
	JFNS			;TYPE FILE SPEC
	TMSG <
>
	JRST DUMPL5		;IGNORE THE FILE

;VALID JFN-- SEE IF OUTPUT DIRECTORY HAS CHANGED

DUMPL2:	TXNE B,GJ%DIR		;SKIP IF OUTPUT DIRECTORY NOT WILD
	JRST DUMPL3
	HRROI A,ODRNAM		;OUTPUT DIR NAME
	MOVX C,<FLD(.JSAOF,JS%DEV)+FLD(.JSAOF,JS%DIR)+JS%PAF>
	JFNS
	HRROI A,DIRNAM		;OUTPUT DIR NAME
	MOVE B,JFNLST(P5)	;INPUT JFN
	JFNS
	HRROI A,ODRNAM		;OUTPUT DIR NAME
	HRROI B,DIRNAM		;INPUT DIRECTORY NAME
	STCMP
	SKIPN A			;SKIP IF STRINGS ARE DIFFERENT
DUMPL3:	TXZA F,DIRCHG		;OUTPUT DIR SAME AS INPUT DIRECTORY
	TXO F,DIRCHG		;DIRECTORY IS DIFFERENT

;SCAN THIS JFN FILE GROUP FOR ALL ITS FILES

	TXON F,DMPFLF		;INDICATE A VALID JFN FOUND, FIRST ONE?
	CALL DNEWV		;YES, START NEW TAPE
	HRROI B,[ASCIZ/%Using INTERCHANGE mode with labeled tape
/]
	TXNE F,ICMODF		;INTERCHANGE MODE
	SKIPG MTTYP		; AND LABELED TAPE?
	CAIA			;NOT BOTH
	CALL TMSGQC		;YOU PROBABLY DON'T WANT TO DO THIS
	MOVE A,JFNLST(P5)	;PICK UP JFN
	SKIPE INIJFN		;SKIP IF NO INITIAL JFN
	JRST [	HRR A,INIJFN	;GET INITIAL JFN
		SETZM INIJFN	;USED UP NOW
		SETOM ININUM	;FLAG BEGUSR CODE
		JRST .+1]
	CALL SCNJFG		;SCAN THIS GROUP
DUMPL5:	AOBJN P5,DUMPL1		;LOOP FOR ALL GROUPS

;ALL DONE WITH ALL FILESPECS

	TXNN F,DMPFLF		;ANY VALID JFN'S FOUND?
	ERROR DUMPL9,<%No files dumped>
	CALL ENDTAP		; TERMINATE TAPE
	SKIPE UNLTAP		; Want auto unload?
	CALL UNLOAD		; Yes
	CALL MTCLS		;CLOSE MAGTAPE
	SKIPN COLSW		; Did we do collection/migration?
	SKIPE ARCSW		;  or an archive run?
	JRST [	CALL ARDELF	; One of the two
		TMSG <
 Pass 1 completed.
 Saveset complete. Tape ready for storage.
>
		CALL PASS2	; Do fixup pass
		SETZM TAPNO	;GET RID OF ARCHIVE MODIFICATIONS
		SETZM PAGNO	;IN RECORD HEADER
		SETZM MTDSG	;REQUIRE RESPEC OF TAPE UNIT
		SETZM SSNBUF	;CLEANUP SAVESET NAME BUFFER
		JRST .+1]
	SKIPN INCRSW		;INCREMENTAL?
	JRST DUMPL8		;NO, SKIP THIS STUFF

;INCREMENTAL SAVE - CALL PASS2 FOR ALL FILESPECS BEING SAVED

	HRLZ P5,NJFN		;GET -(# OF FILESPECS),,0
DUMPL6:	MOVE B,JF2LST(P5)	;GET JFN
	TRNN B,1B18		;JFN VALID?
	JRST [	HRROI A,DEVNAM	;YES, GET DESTINATION
		MOVE C,[111110,,1] ;DEV,DIR,NAME,EXT,GEN
		JFNS		;GET FILESPEC IN DEVNAM FOR PASS2
		CALL PASS2	;FIX FDB'S
		JRST .+1]
	AOBJN P5,DUMPL6		;LOOP THRU ALL FILESPECS IN LIST
DUMPL8:

;TYPE STATISTICS

	BTMSG <

Total files dumped = >
	MOVE B,TOTFIL
	MOVEI C,12
	CALL BTNOUT
	BTMSG <
Total pages dumped = >
	MOVE B,TOTCNT
	MOVEI C,12
	CALL BTNOUT
	BTMSG <
>
DUMPL9:	SKIPN A,LPTJFN
	RET			;DONE IF NO LISTING
	CLOSF
	 JFCL
	SETZM LPTJFN		; No JFN any more
	RET
;SCAN FILE GROUP DESCRIPTOR
; A/ JFN

SCNJFG:	TXO A,GN%DIR+GN%NAM+GN%EXT ;NOTE ALL FIELDS CHANGED
	MOVEM A,SCNJFN		;SAVE JFN AND FLAGS
	HRROI A,DEVNAM		;GET CURRENT FULL FILE-SPEC,
	MOVE B,SCNJFN		; INCLUDING WILDCARDS, FOR FIXBCK
	MOVX C,<FLD(.JSAOF,JS%DEV)+FLD(.JSAOF,JS%DIR)+FLD(.JSAOF,JS%NAM)+FLD(.JSAOF,JS%TYP)+FLD(.JSAOF,JS%GEN)+JS%PAF>
	JFNS
	HRROI A,RCDSTR		;SET TO BUILD STR:<*>, FOR RCDIR
	MOVX C,<FLD(.JSAOF,JS%DEV)+FLD(.JSAOF,JS%DIR)+JS%PAF>
	MOVE B,SCNJFN
	JFNS			;GET STRUCTURE NAME
	SETZM RCDNUM		;NONE YET
SCNLUP:	MOVE A,SCNJFN
	HRRZM A,JFN		;SETUP SINGLE JFN FOR ROUTINES
	TXNE A,GN%DIR		;DIRECTORY CHANGED?
	CALL BEGUSR		;YES
	CALL DMPFIL		;DO THE FUNCTION
	MOVE A,SCNJFN
	GNJFN			;STEP TO NEXT FILE
	 JRST ENDU		;NO MORE
	XOR A,SCNJFN		;SET CHANGED BITS
	ANDX A,GN%DIR+GN%NAM+GN%EXT
	XORB A,SCNJFN
	TXNE A,GN%DIR		;DIRECTORY CHANGED?
	CALL ENDUSR		;YES, CLEANUP USER
	JRST SCNLUP
;END OF GROUP

ENDU:	CALL ENDUSR		;CLEAN UP LAST USER
	TXNN F,SAVUSF		;DOING USER DATA?
	JRST ENDU2		;NO - SKIP THIS
ENDU1:	MOVX A,RC%STP!RC%AWL	;MAKE SURE WE GOT ALL DIRECTORIES
	HRROI B,RCDSTR
	MOVE C,RCDNUM		;LAST NUMBER
	RCDIR			;STEP
	TXNN A,RC%NMD		;MORE?
	JRST [	MOVEM C,RCDNUM	;YES - SAVE NUMBER
		CALL DMPUSR	;DUMP USER INFO
		JRST ENDU1]	;LOOP TILL DONE
ENDU2:	RET			; Done
PASS2:	SETZM LTARDR		; No current directory
	MOVEI A,[EXP CSCD,CSWD,CSCD,CSCD]	;POINT TO ROUTINES
	CALL FILDFI		;DEFAULT THE FILE SPEC
	MOVE A,[.NULIO,,.NULIO]	;AS IN COMMAND, BUT FILE SPEC.
	MOVEM A,GJBLK+.GJSRC	;NOT FROM TERMINAL THIS TIME
	MOVX A,GJ%OLD+GJ%IFG+GJ%XTN  ;ALLOW STARS, CK EXTENDED BLOCK
	HLLM A,GJBLK+.GJGEN
	MOVEI A,GJBLK		;GTJFN BLOCK
	HRROI B,DEVNAM		;GET JFN FOR ALL FILES SPEC. AT SCNJFG
	GTJFN
	 ERRORJ BMBCMD,<?COMMAND ABORTED>
	MOVEM A,P2JFN
	SKIPE INCRSW		; Incremental?
	JRST SCNLU1		; Yes, skip archive/coll/mig. setup
	TMSG < Pass 2 started.
>
	SETZM FNDDIR		; Flag terminating directory not found
	SKIPN IDIR		;INITIAL DIRECTORY SET UP?
	JRST SCNLU0		;NO--START FROM BEGINNING OF RUN
	MOVEI A,GJBLK		; Same as just used
	HRROI B,ISPEC		; Initial filespec on tape
	GTJFN			; File still there?
	 JRST TRYDIR		; No, try for initial directory
	TXO F,TF2		; Yes, flag cont. (or just 1st) file
	JRST XP2JFN		; Go switch RH of P2JFN

TRYDIR:	MOVEI A,GJBLK		;SAME AS JUST USED
	HRROI B,IDIR		;INITIAL DIRECTORY ON THIS TAPE
	GTJFN
	 JRST SCNLU0		;OK TO START FROM BEGINNING OF RUN
XP2JFN:	MOVE B,P2JFN		;BETTER TO START FROM 1ST DIR. ON TAPE
	HRRM A,P2JFN		;BY REPLACING RH OF JFN FOR GNJFN
	HRRZ A,B		;FINISHED WITH 1ST P2JFN
	RLJFN
	JFCL
SCNLU0:	MOVE A,P2JFN		; Initial P2JFN for archive/col/mig. run
	TXO A,GN%DIR		; Set new directory flag bit
SCNLU1:	SKIPE INCRSW		;INCREMENTAL?
	JRST [	CALL FIXBCK	;NOTE INCREMENTAL DUMP COMPLETED FOR FILE
		JRST SCNLU2]
	MOVE D,A		; Keep bits returned by GNJFN
	HRRZ A,A		; Clear bits for GTFDB
	MOVE B,[1,,.FBBBT]	;GET FLAG BITS
	MOVEI C,B		; INTO B
	GTFDB
	ERJMP [	CALL JSERR1
		JRST SCNLU2]	;FAILURE: SKIP THIS FILE
	MOVEM B, FDB+.FBBBT	;YES, SAVE FLAG BITS
	SKIPE XSPEC		;CONT. SAVESET AT END OF THIS TAPE?
	TXNN D,GN%DIR		; And new directory?
	JRST DIRCHK		; No, skip dir. termination test
	HRROI A,CDIR		; Place for current str:dir string
	HRRZ B,P2JFN
	MOVX C,1B2+1B5+1B35	; Get structure:dir
	JFNS
	HRROI A,CDIR		; Test string is current dir
	HRROI B,XDIR		; Base string is dir at end of tape
	STCMP
	 JUMPE A,[SETOM FNDDIR	; Flag have found XDIR
		JRST DIRCHK]	; And go on to check for XSPEC in part.
	SKIPE FNDDIR		; Had previously reached XDIR?
	CALLRET P2DON1		; Yes, terminate pass 2
DIRCHK:	MOVE B,FDB+.FBBBT
	TXNN B,AR%1ST		;ARCH./COLL. IN PROGRESS FOR THIS FILE?
	JRST SCNLU2		;NO, NOTHING TO DO HERE
	SKIPN FNDDIR		; In XDIR?
	JRST TAPCHK		; No, go on to check tape ID's
	HRROI A,CSPEC		; Place for current filespec
	HRRZ B,P2JFN
	MOVX C,1B2+1B5+1B8+1B11+1B14+1B35 ; STR: to VER
	JFNS
	HRROI A,CSPEC		; Test string is current filespec
	HRROI B,XSPEC		; Base string is last filespec on tape
	STCMP
	 JUMPE A,P2DON1		; This file is XSPEC--all done
TAPCHK:	MOVE A,P2JFN
	MOVX B,.ARGST		;GET TAPE INFO
	MOVEI C,FDBARC		;INTO FDBARC BLOCK
	ARCF
	 ERJMP SCNLU2		;FAILURE: SKIP THIS FILE
	TXZE F,TF2		; Cont. (or just 1st) file?
	JRST DOFXBK		; Yes, known to be on this tape
	MOVE B,VOLID6		; Tape ID of current tape
	CAMN B,FDBARC+.ARTP1	; There as tape 1?
	JRST DOFXBK		; Yes, do fixup
	CAMN B,FDBARC+.ARTP2	; There as tape 2?
	JRST DOFXBK		; Yes, do fixup
	SKIPN FNDDIR		; Have reached terminating dir (if any)?
	JRST SCNLU2		; No, skip this file and go on
	LOAD B,AR%RSN,FDB+.FBBBT ; Yes, check further: get reason code
	CAIN B,.AREXP		; File expired?
	SKIPG COLSW		; And this is a collection run?
	CAIA			; No, go on
	CALLRET P2DON1		; Yes, file was not reached, so done
	CAIN B,.ARRAR		; File archived?
	SKIPN ARCSW		; And this is an archive run?
	CAIA			; No, go on
	CALLRET P2DON1		; Yes, file was not reached, so done
	CAIN B,.ARRIR		; File was migrated?
	SKIPN COLSW		; And this is a coll. or mig. run?
	JRST SCNLU2		; Not of this run--skip it
	CALLRET P2DON1		; Yes, file was not reached, so done

DOFXBK:	CALL ARFXBK		;NOTE ARCHIVE RUN COMPLETED FOR FILE
SCNLU2:	MOVE A,P2JFN
	GNJFN			;STEP JFN
	 JRST [	CAIE A,GNJFX1	;DONE?
		CALL JSERR1	;NO, SCREWUP
		SKIPN COLSW	; Collection/migration?
		SKIPE ARCSW	;ARCHIVAL?
		CALLRET P2DONE	; Yes, tell user pass 2 done
		RET]		; No, done here
	JRST SCNLU1

P2DON1:	HRRZ A,P2JFN
	RLJFN			;Through with pass 2 JFN
	JFCL
P2DONE:	TMSG < Pass 2 completed.

>
	SETZM IDIR		; THROUGH WITH PASS2 FILE LIMITS
	SETZM ISPEC
	SETZM XDIR
	SETZM XSPEC
	MOVEI A,SNDTO
	SKIPE LTARDR	;ANY MESSAGES WAITING?
	CALL SNDMSG	;YES
	SETZM LTARDR	;NONE NOW
	RET
;BEGIN NEW TAPE

DNEWV:	CALL MTOPNW		;REOPEN MAGTAPE
DNEWV1:	MOVSI A,(1B1)		;SAY MUCHO TAPE LEFT
	MOVEM A,TAPLFT
	CALL LPTOPN		;REOPEN LPT
	MOVEI B,1
	MOVEM B,LPTPAG		;INIT PAGE NUMBER
	TXZN F,TNSF		;SKIP IF TAPE NUMBER SET
	AOS TAPNO		;COUNT TAPES
	CALL UNMAPB		;RESET BUFFERS
	MOVEI B,CURFMT		;THE CURRENT FORMAT
	MOVEM B,BUFF		;TO THE HEADER
	MOVE B,BGNTAD		;BEGINNING TAD
	MOVEM B,BUFF+BFTAD
	MOVEI B,BFMSG		;OFFSET FOR MESSAGE
	MOVEM B,BUFF+BFMSGP	;TO THE HEADER AS WELL
	SKIPN COLSW		;COLLECTION/MIGRATION?
	SKIPE ARCSW		;OR ARCHIVE?
	JRST [	CALL GTVOL	;YES, GET VOLID
		CALL ARCSSN	; Construct arc/col/mig header
		SETZM IDIR
		SKIPN B,JFN	; JFN from end of previous tape (if any)
		HRRZ B,INIJFN	; Initial JFN (if any)
		JUMPE B,.+1	; Start from beginning of this tape
		HRROI A,IDIR	; Dev & directory at start of tape
		MOVX C,<FLD(.JSAOF,JS%DEV)+FLD(.JSAOF,JS%DIR)+JS%PAF>
		JFNS
		HRROI A,ISPEC	; Full filespec at start of tape
		MOVX C,1B2+1B5+1B8+1B11+1B14+1B35
		JFNS
		JRST .+1]
	MOVE A,[POINT 7,BUFF+BFMSG] ;LOC IN HEADER FOR SSNAME
	MOVE B,[POINT 7,SSNBUF]
	MOVEI C,0
	SOUT			;COPY SET NAME TO HEADER
	SETZM PAGNO		;RESET PAGE NUMBER IN TAPE HEADER
	MOVNI A,TPHDX
	SKIPE INIPGN		;SKIP IF NOT CONTINUED FILE
	MOVNI A,CTPHX		;CONTINUED TAPE HEADER
	MOVEM A,TYP
	CALL MTOUT
	MOVE A,[POINT 7,LSTHDR]	;SET TO BUILD LISTING HEADER MESSAGE
	CALL PRHEDR		;BUILD IT
	HRROI B,LSTHDR
	CALL BTMSGQ		;TYPE AND PRINT IT
	BTMSG <
>
	LPMSG <
Directory (number)
>
PRTHDR:	MOVEI B,FLCOL
	CALL TAB		;POSITION FILE COLUMN HEADING
	LPMSG <file>
	MOVEI B,WTCOL		;DO LIST COLUMN HEADINGS
	CALL TAB
	LPMSG <last write>
	MOVEI B,SIZCOL
	CALL TAB
	LPMSG <size (pages)>
	MOVEI B,CSCOL		;TAB TO CHECKSUM COLUMN
	CALL TAB		;TAB OVER
	LPMSG <checksum
>
	SKIPN COLSW
	SKIPE ARCSW
	JRST [	TMSG < Pass 1 started
>
		JRST .+1]
	RET
;DUMP ONE FILE

DMPFIL:	MOVEI A,[CALL NDMESS	;PRINT REASON FOR ERROR
		CALL UNMAPB	;RESET BUFFERS
		TMSG <%File skipped
>
		SKIPN COLSW	; Migration/collection?
		SKIPE ARCSW	;  or archive?
		CALL UNARC	; Yes, undo invalid tape info (if any)
		JRST DMPFIX]	;SKIP TO NEXT FILE
	CALL SETTRP		;SET TRAP FENCE
	MOVE A,JFN
	MOVE B,[.FBLN0,,0]
	MOVEI C,FDB
	GTFDB			;READ ENTIRE FDB
	 ERJMP [CALLRET JSERR1]	;FAILED
	MOVE B,FDB+.FBCTL	;GET BITS
	TXNE B,FB%NXF!FB%NEX!FB%DEL!FB%TMP
	JRST DMPFIZ
	TXNE	F,ICMODF	;SKIP IF NOT INTERCHANGE MODE
	JRST DMPFI2		;SKIP IT
	HRR A,JFN		;PIC UP FILE JFN
	HRLI A,.GFAUT
	HRROI B,FDBAUT		;STORE AUTHOR HERE
	GFUST
	 ERJMP [SETZM FDBAUT	;SET AS NULL
		JRST .+1]
	HRLI A,.GFLWR		;FUNCTION IS LAST WRITER
	HRROI B,FDBLWR
	GFUST			;GET LAST WRITER
	 ERJMP [SETZM FDBLWR
		JRST .+1]
	MOVE A,JFN
	MOVX B,.ARGST		; Get tape info
	MOVEI C,FDBARC		; Where to put the info
	ARCF			; Get it
	 ERJMP [MOVE A,[FDBARC,,FDBARC+1]
		SETZM -1(A)
		BLT A,FDBARC+.ARPSZ
		JRST .+1]
DMPFI2:	MOVE A,[POINT 7,NAMBUF]
	MOVEI C,0
	HRROI B,DIRNAM		;COPY CURRENT DIRECTORY NAME
	SOUT
	MOVEM A,NAMPTR
	MOVE B,JFN
	MOVX C,1B8+1B11+1B14+1B35
	JFNS
	MOVE B,FDB+.FBCTL
	TXNE B,FB%NOD		;IS THIS FILE NOT TO BE DUMPED?
	JRST NODUMP		;YES, DONT DUMP IT
	MOVE A,FDB+.FBCRE	;GET LAST MODIFICATION DATE
	CAMG A,MBTAD		;NOT 'BEFORE'?
	CAMGE A,MSTAD		;NOT 'SINCE'?
	JRST NODUMP		;YES, DON'T DUMP
	MOVE A,FDB+.FBWRT	;GET LAST WRITE DATE
	CAMG A,WBTAD		;NOT 'BEFORE'?
	CAMGE A,WSTAD		;NOT 'SINCE'
	JRST NODUMP		;YES, DON'T DUMP
	CAMGE A,FDB+.FBREF	;GET MOST RECENT OF WRITE, READ
	MOVE A,FDB+.FBREF
	CAMG A,ABTAD		;NOT 'BEFORE'?
	CAMGE A,ASTAD		;NOT 'SINCE'?
	JRST NODUMP		;YES, DON'T DUMP
	; ..
	; ..
	SKIPLE A,INCRSW		;SKIP IF NOT INCREMENTAL OR /FULL-INCREMNTAL
	JRST [	HLRZ B,FDB+.FBCNT ;GET COUNT OF WRITES
		HLRE C,FDB+.FBBK0 ;GET TAPE COUNT AND FLAG
		HRRZ D,FDB+.FBBK0 ;GET LAST WRITE COUNT OF SAVE
		CAMN B,D	;SAME WRITE COUNT?
		CAMGE C,A	;YES-- HAS IT BEEN SAVED ENOUGH TIMES?
		JRST .+1	;NO-- DUMP THE FILE
		JRST NODUMP]	;YES-- DON'T DUMP IT
	SKIPN COLSW		; Collection/migration?
	SKIPE ARCSW		; Or archive run?
	JRST [	CALL ARCTST	; Yes, check this file for inclusion
		JRST NODUMP	; Don't dump on this tape
		JRST .+1]	; Do dump on this tape

;FILE WILL BE DUMPED

	CALL TSTEOT		;CHECK TO MAKE SURE FILE WILL FIT ON TAPE
	SKIPN INIPGN		;SKIP IF CONTINUED FILE
	JRST DMPF4		;NO
	LPMSG <
(File continued from previous reel)
>
DMPF4:	CALL GOFNAM		;MAKE UP TAPE FILE NAME
	MOVEI B,FLCOL
	CALL TAB		;TAB TO FILESPEC COLUMN
	MOVE B,ONMPTR		;PRINT FILE NAME
	CALL LPMSGQ		;NAME TO LISTING
	MOVEI B,WTCOL		;TAB TO WRITE COLUMN
	CALL TAB
	SKIPN NOFILS		;FIRST FILE THIS USER?
	SKIPE INIPGN		; And not continued file?
	CAIA
	CALL TDRNAM		;TYPE DIRECTORY NAME
	TXNE F,LFILF		;TYPE FILE NAMES REQUESTED?
	TXNE F,LTTYF		;AND NOT LOGGING TO TTY?
	JRST DMPF2		;NO
	MOVE B,NAMPTR		;YES, TYPE NAME
	CALL TMSGQ
	TMSG < (AS) >
	MOVE B,ONMPTR
	CALL TMSGQ		;TYPE OUTPUT NAME
DMPF2:	MOVE A,JFN
	HRLOM A,LASTID		;REMEMBER FILE IN CASE ERROR ON OPENF
	MOVX 2,OF%RD+OF%PDT	;READ AND PRESERVE ACCESS DATES
	OPENF
	 JRST [	CAIE A,OPNX2	;NONEXISTENT (EMPTY OR...)
		CAIN A,OPNX31	; File offline?
		JRST .+1	; Yes, dump it
		MOVE A,JFN
		MOVX B,OF%RD+OF%THW+OF%PDT ;TRY THAW MODE
		OPENF
		 JRST [ CALL NDMESS ;PRINT REASON
			RET]
		JRST .+1]
	SKIPN COLSW
	SKIPE ARCSW
	JRST [	SKIPN INIPGN	; Info already set if cont file
		CALL ARC1	; Go set archive/collection info
		JRST .+1]
	MOVE A,[POINT 7,BUFF]	;SET TO PUT NAME IN FILE HEADER
	HRROI B,ONMBUF
	SETZ C,
	SOUT			;COPY FILESPEC THROUGH VERSION
	CALL GOFPAT		;GET OUTPUT PROTECTION, ACCOUNT AND ;T
	MOVEI B,0
	IDPB B,A
	MOVE A,[FDB,,BUFF+FHFDB]
	BLT A,BUFF+FHFDB+.FBLN0-1+20+.ARPSZ+1 ;COPY FDB TO HEADER
	TXNE F,CHKSM		;SKIP IF NOT CHECKSUMMING
	CALL [	SKIPE INIPGN	;SKIP IF START OF FILE
		RET		;MIDDLE OF FILE
		SETZM CHKCN0	;INITIALIZE CHECKSUM
		SETZM LSTPGE	;AND PAGE #
		CALL FILSZE	;FIGURE FILE SIZE
		RET]

;SETUP INITIAL PAGNO AND PAGE CNTR

	SKIPGE A,INIPGN		;SKIP IF NOT MIDDLE OF FILE
	JRST [	MOVE B,INICNT	;SAVE SAVED COUNTER
		MOVEM B,CNTR	;STORE IT
		JRST DMPF3]
	MOVE A,FDB+.FBBYV	;GET SIZE
	HRRZM A,CNTR
	AOS NOFILS
	AOS TOTFIL		;BUMP TOTAL FILE COUNT
	HRLZ A,TOTFIL		;GET FILE NUMBER
	TXZ A,PGNCFL!PGNNFL	;CLEAR FLAG BITS
	TXO A,PGNNFL		;SET FLAG TO INDICATE PAGNO HAS FILE NUMBER
DMPF3:	MOVEM A,PAGNO		;STORE PAGE NUMBER WORD
	SETZM INIPGN		;BE SURE INIPGN OFF

;WRITE FILE HEADER TO TAPE

	MOVNI A,FLHDX
	MOVEM A,TYP
	CALL MTOUT
	MOVX A,PGNCFL!PGNNFL	;COMPLEMENT THE CONTINUED FILE FLAGS
	SKIPGE PAGNO		; IF THIS IS
	XORM A,PAGNO		;  A CONTINUED FILE
	SKIPN LPTJFN
	JRST DMPF1
	HRROI A,LPTBUF		;SET TO GET WRITE TAD STRING
	SKIPN B,FDB+.FBWRT	;HAVE ONE?
	JRST [	LPMSG <(NEVER)>	;NO
		JRST DMPF1]
	MOVX C,1B10+1B12+1B17
	ODTIM			;CONVERT TO STRING
	HRROI B,LPTBUF
	CALL LPMSGQ		;COPY TO LISTING
DMPF1:	MOVEI B,SIZCOL		;TAB TO NEXT COLUMN
	CALL TAB
	SETZM CURBUF		;NO PAGES MAPPED YET
	SKIPN CNTR		; 0 pages in file? (e.g. offline)
	JRST DMPLUX		; Yes--no pages to write to tape
	; ..
;LOOP FOR ALL PAGES IN FILE

DMPLUP:	SKIPG TAPLFT		;ANY TAPE LEFT?
	JRST DMPEOT		;NO, CLOSE OUT REEL

;MAP A WINDOW OF THE FILE INTO BUF0

DMPIT:	HRRZ A,PAGNO		;FORM FILE PAGE
	HRL A,JFN		; PAGE ID
	SKIPN CURBUF		;FIRST TIME HERE?
	JRST DMPL1		;YES - SET UP WINDOW
	HRRZ B,A		;GET PAGE DESIRED
	HRRZ C,LASTID		; BASE PAGE # IN WINDOW
	SUB B,C			;SEE IF INSIDE WINDOW
	CAMGE B,NBUF		;...
	JRST [	IMULI B,PGSIZ	;YES - CALC BUFFER ADDRS
		ADDI B,BUF0	;BASE ADDR
		HRRZM B,CURBUF	;SET BUFFER ADDRS
		JRST DMPL2]	;CONTINUE
DMPL1:	MOVEM A,LASTID		;SAVE BASE PAGE INFO
	MOVEI B,BUF0		;SETUP CURBUF
	MOVEM B,CURBUF
	MOVE B,[XWD .FHSLF,BUF0PG]
	MOVX C,PM%RD!PM%PLD!PM%CNT
	HRR C,NBUF		;NUMBER OF PAGES TO MAP
	PMAP
	 ERJMP DMPL4		;IN CASE NON-EX PT

;MAKE SURE THE PAGE WE ARE ABOUT TO DUMP EXISTS

DMPL2:	SKIP @CURBUF		;TEST READABILITY
	ERJMP DMPL4		;CAN'T ACCESS PAGE-- FIND OUT WHY

;WRITE THE PAGE OUT TO TAPE

DMPL3:	SETZM TYP
	TXNE F,CHKSM		;SKIP IF NOT CHECKSUMMING
	CALL [	HRRZ A,CURBUF	;CURRENT BUFFER
		LSH A,-11	;PAGE #
		HRLI A,.FHSLF
		MOVE B,[XWD .FHSLF,BUFPAG]
		MOVX C,PM%RD
		PMAP		;POINT TO CURRENT BUFFER
		CALLRET PGECSM]
	CALL MTOUT
	SOS CNTR
	AOS A,PAGNO		;INCREMENT PAGE #
	TRNE A,777777		;WRAP AROUND TO ZERO??
	JRST DMPLUP		;NO-- KEEP ON GOING
	MOVX A,-<XWD 1,0>	;YES-- MUST UNDO
	ADDB A,PAGNO		; CARRY INTO LH
	JRST DMPLUX		;AND NOW DONE WITH FILE

;HERE WHEN CURRENT PAGE CANNOT BE ACCESSED (SKIP ERJMP'ED)

DMPL4:	HRRZ B,CURBUF		;GET PAGE
	LSH B,-^D9		; NUMBER
	HRLI B,.FHSLF		; IN OUR PROCESS
	SETO A,			;UNMAP
	SETZ C,			; FILE PAGE FROM
	PMAP			; THIS PROCESS
	MOVE D,B		;SAVE PROCESS PAGE ID
	HRRZ A,PAGNO		;FIND OUT
	HRL A,JFN		; WHAT FILE PAGE'S ACCESS IS
	RPACS			; . . .
	TXNE B,PA%PEX		;PAGE EXIST?
	JRST [	MOVE B,D		;YES-- GET BACK PROCESS PAGE ID
		MOVX C,PM%RD!PM%PLD	; . .
		PMAP			;MAP THE FILE PAGE BACK AGAIN
		 ERJMP DMPL3		; . .
		JRST DMPL3]		; AND TRY TO ACCESS PAGE ANYWAY
	FFUFP			;NO-- FIND NEXT PAGE WHICH DOES EXIST
	 JRST DMPLUX		;NO MORE PAGES IN FILE-- ALL DONE
	HRRM A,PAGNO		;FOUND A PAGE-- REMEMBER IT
	JRST DMPIT		; AND TRY TO WRITE IT

;DONE WITH FILE-- FINISH UP AND WRITE TRAILERS

DMPLUX:	TXNE F,ICMODF		;SKIP IF NOT INTERCHANGE MODE
	TRNE A,777777		;ZERO LENGTH FILE ?
	JRST DMPLX2		;NOT INTERCHANGE OR NOT ZERO 
				;LENGTH FILE
	MOVEI A,BUFF		;USE THIS BUFFER
	MOVEM A,CURBUF		;...
	SETZM TYP		;DATA TYPE PAGE
	CALL MTOUT
DMPLX2:	SKIPG CNTR
	JRST DMPLX1
	BTMSGC <%Cannot find all the pages of file >
	HRROI B,NAMBUF
	CALL BTMSGQ		;TYPE FILESPEC
	BTMSG <
>
	; ..
DMPLX1:	CALL UNMAPB		;RESET BUFFERS
	MOVE A,[FDB,,BUFF]
	BLT A,BUFF+.FBLN0-1+20+.ARPSZ+1 ;COPY FDB TO TRAILER BLOCK
	MOVNI 1,FLTRX
	MOVEM 1,TYP
	SKIPE INCRSW		;INCREMENTAL?
	JRST [	HLRZ B,BUFF+.FBCNT	;GET COUNT OF WRITES
		MOVE C,BUFF+.FBBK0	;GET LAST BACKUP WORD
		CAIN B,(C)		;SAME WRITE COUNT AS LAST SAVE?
		SKIPGE INCRSW		;YES-- BUT FULL-INCREMENTAL?
		HRRZ C,B		;FULL OR NEW WRITE-- SET TAPE COUNT TO 0
					; AND WRITE COUNT TO NEW WRITE COUNT
		TXO C,1B0		;INDICATE INCOMPLETE DUMP
		MOVE A,JFN
		HRLI A,.FBBK0
		TXO A,CF%NUD		;SUPPRESS DIRECTORY UPDATE
		MOVNI B,1		;CHANGE ALL BITS
		CHFDB			;NOTE DUMP PARTIALLY DONE
		TXZ C,1B0		;STORE FDB ON TAPE
		ADD C,[XWD 1,0]		; AS IF
		MOVEM C,BUFF+.FBBK0	; DUMP COMPLETED SUCCESSFULLY
		JRST .+1]
	CALL MTOUT		;OUTPUT TRAILER RECORD
	TXNE F,LFILF		;TYPE FILE NAMES ?
	TXNE F,LTTYF		;AND NOT LOGGINT TO TTY?
	JRST DMPLX3
	TMSG <	[OK]
>
DMPLX3:	HRRZ B,FDB+.FBBYV	;GET SIZE
	ADDM B,USRCNT		;COUNT PAGES FOR THIS DIR
	MOVEI C,^D10
	CALL LPNOUT		;OUTPUT SIZE TO LISTING
	TXNE F,CHKSM		;SKIP IF NOT CHECKSUMMING
	CALL PRTCSM		;PRINT CHECKSUM
	LPMSG <
>
DMPFIX:	MOVE A,JFN
	TXO A,CO%NRJ		;NO RELEASE JFN
	CLOSF			;CLOSE FILE
	 JFCL
NODUMP:
DMPFIZ:	RET			;DONE WITH FILE
;FILE NOT DUMPED

NDMESS:	TMSGC <%File >
	HRROI B,NAMBUF
	CALL TMSGQ		;TYPE FILESPEC
	TMSG < not dumped because:
  >
	CALL JSERRM		;PRINT REASON SYSTEM GAVE
	HRROI B,[ASCIZ /not dumped
/]
	CALL LPMSGQ
	RET			;RETURN
;ENCOUNTERED END OF TAPE IN THE MIDDLE OF FILE.
;REMEMBER CURRENT FILE POSITION FOR NEXT REEL.

DMPEOT:	CALL UNMAPB		;RESET BUFFERS
	MOVE A,[FDB,,BUFF]
	BLT A,BUFF+.FBLN0-1+20+.ARPSZ+1 ;COPY FDB TO FILE TRAILER
	MOVNI 1,FLTRX
	MOVEM 1,TYP		;SET RECORD TYPE TO FILE TRAILER
	MOVX B,PGNCFL!PGNNFL	;SET CONTINUED FILE FLAG
	XORB B,PAGNO		;SET IN PAGE NUMBER WORD
	MOVEM B,INIPGN		;MARK TO CONTINUE FILE ON NEXT REEL
	MOVE B,CNTR		;SAVE COUNTER
	MOVEM B,INICNT		;...
	CALL MTOUT		;WRAP UP FILE IN USUAL WAY
	LPMSG <
(File continued on next reel)
>
	MOVE A,JFN
	HRLI A,(1B0)		;SAY DON'T RELEASE JFN
	CLOSF			;CLOSE THE FILE
	 JFCL
	CALL TSTEOT		;START NEW TAPE
	JRST DMPFIL		;RESTART THIS FILE


;ROUTINE TO CONTINUE SAVE ON NEXT TAPE IF NO TAPE LEFT

TSTEOT:	SKIPLE TAPLFT		;ANY TAPE LEFT?
	RET			;YES, ALL OK
	SKIPN COLSW		;Collection/migration run?
	SKIPE ARCSW		;Archive run?
	CALL XINFO		;Yes, get new tape #, file spec later
	SETOM PAGNO		;INDICATE CONTINUED TAPE TRAILER
	CALL ENDTAP
	CALL UNLOAD
	SKIPG MTTYP		;UNLABELED TAPE?
	CALL MTCLS		;YES, CLOSE IT
	SKIPN COLSW		;Collection or migration run?
	SKIPE ARCSW		;ARCHIVAL?
	JRST [	CALL ARDELF	;DELETE AND EXPUNGE OLD RESTART FILE
		TMSG < Pass 1 completed.
 Tape >
		HRROI B,VOLID
		CALL TMSGQ	;DISPLAY VOLID
		TMSG < is complete and ready for storage.
 Please mark it full.

>
		CALL PASS2	;FIX UP FOR FILES ON THIS TAPE
		MOVEI A,1	;1 FOR CONT. SAVESET#
		MOVEM A,ARCTSN
		MOVEI B,XBUFF
		STOR A,SSNO,(B)	; Put in record header too
		JRST .+1]
	SKIPN A,LPTJFN		;SKIP IF LISTING
	JRST TSTET1
	CLOSF			;CLOSE LISTING FILE
	 JFCL
TSTET1:	SKIPLE A,MTTYP		;LABELED TAPE?
	JRST [	MOVE A,MTJFN	;YES, GET TAPE JFN
		MOVEI B,.MOVLS
		MOVEI C,[EXP 2,.VSFLS]
		MTOPR		;FORCE VOLUME SWITCH
		 ERJMP [ERRORJ BMBCMD,<?ERROR SWITCHING VOLUMES>]
		CALL DNEWV1	;WRITE STUFF AT BEGINNING OF TAPE
		JRST TSTET2]
	JUMPL A,[TMSGC <$ End of tape, continue save on
>				;MTA, WE'LL HAVE TO ASK THE USER
		JRST .+1]
	CALL NTAPER		;GET NEW TAPE SPEC
	 JRST BMBCMD		;CAN'T
	CALL DNEWV		;START NEXT TAPE
TSTET2:	SKIPN COLSW		; Collection/migration?
	SKIPE ARCSW		;ARCHIVAL?
	JRST [	SETZM SPSEQ	;RESTART AT BEGINNING OF TAPE
		CALL SETRF	;SET RESTART FILE SPEC W/ NEW TAPE ID
		CALL WRARFL	;WRITE RESTART FILE--TAPE HEADER EXISTS
		JRST .+1]
	RET
;ROUTINE TO RESET FILE WINDOW AND CURBUF

UNMAPB:	SETO A,
	MOVE B,[.FHSLF,,BUF0PG]
	MOVX C,PM%CNT		;SET NUMBER OF PAGES
	HRR C,NBUF
	PMAP			;REMOVE THEM
	HRRI B,BUFPAG
	SETZ C,			;ONLY ONE PAGE
	PMAP
	MOVEI A,BUFF		;SET THIS TO BE CURRENT BUFFER
	MOVEM A,CURBUF
	RET			;RETURN
BEGUSR:	TXNE F,DIRCHG		;SKIP IF SAVING AS SAME DIRECTORY
	JRST BEGUS1
	HRROI A,DIRNAM
	HRRZ B,JFN		;GET CURRENT DIRECTORY NAME STRING
	MOVX C,1B2+1B5+1B35
	JFNS
	HRROI B,DIRNAM
	MOVX A,RC%EMO		;EXACT MATCH ONLY
	RCDIR
	 ERJMP BEGUS3		;RCDIR FAILURE
	TXNE A,RC%NOM!RC%AMB
	JRST BEGUS3		;REPORT ERROR
	MOVEM C,DIRNUM		;SAVE DIRECTORY NUMBER
	TXNN F,SAVUSF		;WANT USER DATA?
	JRST BEGU2		;NO - SKIP THIS
BEGU1:	MOVX A,RC%AWL		;ALLOW WILDCARDS
	SKIPE C,RCDNUM		;FIRST TIME HERE?
	TXO A,RC%STP		;NO - STEP DIRECTORIES
	HRROI B,RCDSTR
	RCDIR
	TXNE A,RC%NMD
	JRST [	TMSGC <?RCDIR out of sync on directories
>
		TXZ F,SAVUSF	;TURN THIS OFF
		JRST BEGU2]
	MOVEM C,RCDNUM		;SAVE WHERE WE ARE
	SKIPE ININUM		;HAD INITIAL FILESPEC
	JRST [	CAME C,DIRNUM	;CAUGHT UP?
		JRST BEGU1	;NO - CONTINUE
		SETZM ININUM	;DONE WITH INITIAL DDB
		JRST BEGU1A]	;DUMP THIS DIRECTORY
	CAME C,DIRNUM		;THE ONE WE WANT?
	JRST [CALL DMPUSR	;NO - DUMP A DIR
		JRST BEGU1]	;LOOP TO CATCH UP
BEGU1A:	CALL DMPUSR		;YES - DUMP USER INFO AND PROCEED
BEGU2:	LPMSG <
>
	SETZM USRCNT
	SETZM NOFILS
	HRROI B,DIRNAM
	CALL LPMSGQ		;PRINT DIR NAME
	LPMSG < (>
	HRRZ B,DIRNUM
	MOVEI C,^D8
	CALL LPNOUT		;PRINT DIR NUM FOR INFO
	LPMSG <)

>
	RET

;HERE IF DIRECTORY NAME ON DISK .NE. DIRECTORY NAME ON TAPE
BEGUS1:	HRROI A,ODRNAM		;CURRENT DIRECTORY NAME
	HRROI B,LSTDIR		;LAST DIRECTORY NAME
	STCMP
	JXE A,SC%LSS+SC%SUB+SC%GTR,BEGUS2
	CALL TSTEOT		;SEE IF ROOM ON TAPE FOR THIS DDB
	HRROI B,ODRNAM		;NEW DIRECTORY
	HRROI A,LSTDIR
	SETZ C,
	SOUT
	SETZM USRCNT
	SETZM NOFILS		;RESET # FILES
	HRROI B,ODRNAM		;NAME OF DIRECTORY
	CALL LPMSGQ
	LPMSG <

>
	SETZM BUFF
	MOVE B,[XWD BUFF,BUFF+1]
	BLT B,BUFF+777
	MOVE B,[XWD ODRNAM,BUFF+UHNAM]
	BLT B,BUFF+UHNAM+17
	MOVNI A,USRX
	MOVEM A,TYP		;STORE RECORD TYPE
	CALL MTOUT
BEGUS2:	RET

;RCDIR FAILURE - PRINT MESSAGE

BEGUS3:	TMSGC <?RCDIR failure for - >
	HRROI A,DIRNAM		;TELL ON DIRECTORY
	PSOUT
	TMSG <
>
	RET			;RETURN
;DUMP USER INFORMATION

DMPUSR:	STKVAR <DMPNUM>
	MOVEM C,DMPNUM		;SAVE NUMBER OF DIRECTORY
	CALL TSTEOT		;MAKE SURE WE HAVE SOME TAPE FOR DDB
	SETZM BUFF
	MOVE B,[XWD BUFF,BUFF+1]
	BLT B,BUFF+777
	TXNE F,SAVUSF		;NOT WHEEL OR USER DATA NOT WANTED?
	SKIPN WHEEL
	JRST DMPUS1		;YES, DON'T DUMPER DIR INFO
	MOVEI A,BUFF+CDSG	;SET UP BUFFER TO RECEIVE SUB GROUPS
	MOVEM A,BUFF+.CDCUG
	MOVEI A,BUFF+CDUG	;SET UP BUFFER TO RECEIVE USER GROUPS
	MOVEM A,BUFF+.CDUGP
	MOVEI A,BUFF+CDDG	;SET UP BUFFER TO RECEIVE DIR GROUPS
	MOVEM A,BUFF+.CDDGP
	MOVEI A,UGLEN		;LENGTH OF BUFFERS FOR GROUPS
	MOVEM A,BUFF+CDUG
	MOVEM A,BUFF+CDDG
	MOVEM A,BUFF+CDSG
	HRROI A,BUFF+UHACT	;POINT TO ACCOUNT STRING SPACE
	MOVEM A,BUFF+.CDDAC
	MOVEI A,.CDDAC+1	;CURRENT MAX SIZE
	MOVEM A,BUFF+.CDLEN
	MOVE A,DMPNUM
	MOVEI B,BUFF
	MOVE C,[POINT 7,BUFF+UHPSW]
	GTDIR
	 ERJMP [JSERR]
	MOVEI B,UHPSW		;SET PASSWORD OFFSET
	MOVEM B,BUFF+.CDPSW
	MOVEI B,UHACT		;SET POINTER TO ACCOUNT STRING
	MOVEM B,BUFF+.CDDAC
DMPUS1:	HRROI A,BUFF+UHNAM	;POINT TO NAME BUFFER
	MOVE B,DMPNUM		;THIS DIRECTORY NUMBER
	DIRST			;CONVERT TO STRING
	 JSHLT			;CANT HAPPEN
	MOVNI A,USRX
	MOVEM A,TYP
	CALL MTOUT
	RET
ENDUSR:	LPMSG <
>
	MOVEI B,FLCOL
	CALL TAB		;INDENT TOTAL
	SKIPN NOFILS
	JRST [	LPMSG <No files
>
		RET]
	LPMSG <Total >
	MOVEI C,^D10
	MOVE B,NOFILS
	CALL LPNOUT
	LPMSG < files, >
	MOVEI C,^D10
	MOVE B,USRCNT
	ADDM B,TOTCNT
	CALL LPNOUT
	LPMSG < pages
>
	SKIPN NOFILS		;SKIP IF FILES THIS DIRECTORY
	RET
	TXNN F,LFDSK		;SKIP IF LOGGING TO NON-SPOOLED
				;DISK FILE
	RET
	SKIPN A,LPTJFN		;GET LISTING JFN
	JRST ENDUS1		;NONE - RETURN
	TXO A,CO%NRJ		;KEEP JFN
	CLOSF			;UPDATE FILE
	ERROR ENDUS1,<?CANNOT CLOSE LOG FILE>
	HRRZ A,LPTJFN		;LOG FILE JFN
	MOVX B,<FLD (7,OF%BSZ)+OF%APP>
	OPENF
	SKIPA
ENDUS1:	RET
	MOVE A,LPTJFN
	RLJFN
	JFCL
	JRST LPTNAV
;OPEN LPT FOR LISTING FILE.  DONE AT BEGINNING OF EACH TAPE

LPTOPN:	SKIPN LSTFIL		;HAVE LOG FILE SPEC?
	JRST LPTOP1		;NO
	MOVX A,GJ%MSG+GJ%SHT	;MESSAGE AND SHORT FORM
	HRROI B,LSTFIL
	GTJFN
	 JRST LPTNAV
LPTOP0:	MOVEM A,LPTJFN
	DVCHR			;SEE WHAT DEVICE
	LOAD C,DV%TYP,A
	CAIN C,.DVTTY		;TTY?
	TXOA F,LTTYF		;YES
	TXZ F,LTTYF		;NO
	CAIE C,.DVDSK		;DISK?
	TXZA F,LFDSK		;LOG FILE NOT TO DISK
	TXO F,LFDSK		;IS DISK
	MOVE A,LPTJFN
	MOVX B,<FLD(7,OF%BSZ)+OF%APP>
	TXNN F,LFDSK		;OPENING A DISK?
	MOVX B,<FLD(7,OF%BSZ)+OF%WR>	;NO, THEN OPEN JUST FOR WRITE
	OPENF
	 JRST [	MOVE A,LPTJFN
		RLJFN
		 JFCL
		JRST LPTNAV]
	SETZM LPTPOS		;INIT LIST VARIABLES
	SETZM LPTLIN
	RET

LPTNAV:	TMSGC <%Log file not available, >
	CALL JSERRM
LPTOP1:	TXZ F,LFDSK+LTTYF	;NOT DISK OR TTY
	SETZM LPTJFN		;SAY NO LISTING
	RET

;FIXUP FDB BACKUP WORD AFTER DUMP COMPLETED SUCCESSFULLY

FIXBCK:	HRRZ A,P2JFN
	MOVE B,[XWD 1,.FBBK0]
	MOVEI C,C
	GTFDB
	JUMPGE C,R
	TLZ C,(1B0)		;CLEAR DUMP-IN-PROGRESS FLAG
	ADD C,[XWD 1,0]		;INCREMENT TAPE COUNT
	MOVSI B,-1		;GET MASK FOR BITS TO CHANGE
	HRLI A,.FBBK0+CF%NUD_-^D18 ;NO UPDATE DIRECTORY
	CHFDB
	RET
;INITIALIZATION FOR ARCHIVE/COLLECTION/MIGRATION RUN: DETERMINE TAPE NO., SAVESET NO.,
;STARTING POSITION FROM OLD TAPE OR FROM USER FOR NEW TAPE

ARCINI:	SETZM INIPGN		;NON-0 FOR CONT. FILE
	SETZM ARCTSN		;SAVE SET #
	CALL GTVOL		;GET VOLID
	CALL SETRF		;SET RESTART FILE SPEC. (EXT.=TAPE ID)
	SKIPE ARCSW		; Determine SS type: archival?
	MOVEI A,SSARC		; Yes, load code for archive saveset
	SKIPLE COLSW		; Collection run?
	MOVEI A,SSCOL		; Yes, code for collection saveset
	SKIPGE COLSW		; Migration run?
	MOVEI A,SSMIG		; Yes, code for migration saveset
	MOVEM A,SSTYP		; Saveset type is determined
	HRROI A,[ASCIZ /$Is this a new tape? /]
	CALL YESNO
	JUMPN A, [HRROI A,[ASCIZ /$Are you sure? /]
		CALL YESNO
		JUMPE A,[ERROR BMBCMD,<COMMAND ABORTED>]
		MOVEI B,2	;FIRST TSN ON A NEW TAPE TO BE 2
		MOVEM B,ARCTSN	;TO RESERVE 1 FOR CONT. SAVESET
		SETZM SPSEQ	;INIT. SEQUENCE NO.
		CALL MTOPNX
		CALL REWCV	;REWIND THE TAPE
		CALL MTCLS
		JRST ARINI1]
;OLD TAPE:
	CALL SCNTAP		;GET TAPNO=SSTYP!SS#,,TAPE# FROM 1ST REC ON TAPE
	MOVEI C,XBUFF		; Address of record header
;	LOAD B,TPNO,(C)		; Tape # from tape
;	CAME B,ARCTN		;=SUPPLIED TAPE #?
;	JRST [	TMSG <?TAPE # INPUT DISAGREES WITH TAPE # ON TAPE.
;THE FIRST TAPE HEADER ON THIS TAPE FOLLOWS:
;>
;		CALL TYHEDR
;		ERROR BMBCMD, <COMMAND ABORTED>]
	LOAD B,SSCOD,(C)	; SS type from tape
	CAME B,SSTYP		; Matches type for this run?
	JRST [	TMSG <?This tape has been previously used for a different DUMPER purpose.
Continuation of this run will cause a mixture of saveset types
on this tape.
The first tape header on this tape follows:>
		CALL TYHEDR
		HRROI A,[ASCIZ /$Do you wish to continue this run? /]
		CALL YESNO
		JUMPE A,[ERROR BMBCMD,<COMMAND ABORTED>]		
		JRST .+1]
	CALL RDARFL		;READ RESTART FILE, IF ANY. EXISTS?
	 JRST [	CALL SEQFND	;YES, FIND START POS. BY SEQ. NO.
		JRST ARINI1]
	CALL SCNTAP		;NO,SCAN TO TRAILER REC.
	SOS TAPNO		;GETS AOS'ED IN DNEWV

;NOW ARCTN, ARCTSN, SSTYP, SPSEQ, INIPGN, INICNT, AND XSPEC ARE
; DETERMINED FOR NEW SAVESET AND TAPE IS POSITIONED TO START

ARINI1:	MOVEI B,XBUFF		; Address of tape header block
	SKIPE A,SPSEQ		; 1st seq. # on last phys. rec.
	JRST [	ADD A,TAPBKF	; 1st seq. # of new SS
		SOS A		; But will be incremented before write
		JRST .+1]
	MOVEM A,SEQ		;SEQ NO. FOR TAPE
	MOVEM A,RSEQ		;EXPECTED SEQUENCE NO.
	MOVE A,ARCTSN		;SAVESET#
	STOR A,SSNO,(B)		; In LH of TAPNO for record header
	MOVE A,SSTYP		; Saveset type (archive, coll., mig.)
	STOR A,SSCOD,(B)	; Put in 1st 3 bits of TAPNO
	CALL WRARFL		;WRITE RESTART FILE
	MOVE A,INIPGN		;=0 EXCEPT FOR CONT. FILE
	MOVEM A,PAGNO		;INIT. PAGNO=TFN,,PAGE# FOR TAPE, EXCEPT
	RET			; =PGNCFL!PGNNFL,,PAGE# INITIALLY FOR CONT. FILE

; ROUTINE TO CONSTRUCT RESTART FILE NAME FOR ARCHIVING

SETRF:	HRROI A,RFSPEC		;SET UP RESTART FILE NAME, EXT.
	HRROI B,[ASCIZ /SYSTEM:DUMPER-TAPE-IN-PROGRESS./]
	SETZ C,
	SOUT			;RESTART FILE NAME
	HRROI B,VOLID
	SOUT			;FILE TYPE IS TAPE VOLID
	RET
; GTVOL - GET VOLUME-ID FOR ARCHIVING RUNS
; RETURNS +1: ALWAYS, IDENTIFIER IN VOLID (ASCIZ) AND VOLID6 (SIXBIT)

GTVOL:	SKIPN MTDSG		;USER GIVE ME A TAPE YET?
	CALL NTAPE		;NO, GET TAPE SPEC
	 JFCL			;WON'T FAIL
	SKIPE VOLID6		;DO I KNOW THE VOLID?
	RET			;YES, RETURN
	SKIPL MTTYP		;MT DEVICE?
	JRST [	MOVX A,GJ%SHT	;YES
		HRROI B,MTDEV
		GTJFN		;GET JFN ON MT
		 JRST .+1	;SHOULD NEVER FAIL
		PUSH P,A
		CALL GMTINF	;GET VOLID FROM MONITOR
		POP P,A
		RLJFN		;DUMP JFN
		 JFCL
		RET]
GTVOLA:	MOVEM P,TPDLP		;DON'T FEAR THE REPARSE
GTVOL0:	MOVE A,[CM%RAI+GTVOL1]	;RAISE LOWER CASE, REPARSE ADDRESS
	HRROI B,[ASCIZ/$ Enter tape ID /]
	CALL CMDINI
GTVOL1:	MOVE P,TPDLP		;RESTORE P IN CASE OF REPARSE
	MOVEI B,[FLDDB. .CMFLD,,,<tape serial number or volume identifier,
1 to 6 alphanumeric characters long>]
	CALL COMNDN		;PARSE FIELD
	 JRST GTVOL0		;ERROR, TRY AGAIN
	MOVEI B,[FLDDB. .CMCFM]
	CALL COMNDN		;GET CONFIRMATION
	 JRST GTVOL0
	DMOVE A,ACBFR
	DMOVEM A,VOLID		;SAVE ASCIZ VERSION OF VOLID
	SETZM VOLID6		;CLEAR SIXBIT VOLID
	MOVE A,[POINT 6,VOLID6]
	MOVE B,[POINT 7,ACBFR]
	MOVEI C,6
GTVOL3:	ILDB D,B		;GET CHARACTER FROM ATOM BUFFER
	JUMPN D,[SOJL C,GTVOL2	;GIVE ERROR IF TOO LONG
		SUBI D,40	;CONVERT TO SIXBIT CODE
		JUMPL D,GTVOL2
		IDPB D,A	;STORE SIXBIT CHAR
		JRST GTVOL3]	;CONTINUE SCAN
	CAIE C,6		;VACUOUS VOLID?
	RET			;NO, ALL'S WELL
GTVOL2:	TMSGC <?BAD VOLUME IDENTIFIER>
	JRST GTVOL0		;LET HIM TRY AGAIN
;SUBROUTINE TO READ RESTART FILE, DUMPER-TAPE-IN-PROGRESS, IF ANY
;RETURNS  +1 IF RESTART FILE EXISTS
;	  +2 IF NO RESTART FILE EXISTS 

RDARFL:	MOVX A,GJ%OLD+GJ%SHT
	HRROI B,RFSPEC		;RESTART FILE SPEC. (EXT.=TAPE ID)
	GTJFN
	 JRST [	CAIE A,GJFX19	;NO SUCH FILE TYPE ERROR?, OR
		CAIN A,GJFX24	;FILE NOT FOUND ERROR?
		RETSKP		;SKIP RETURN FOR NO RESTART FILE
		CAIE A,GJFX18	;NO SUCH FILENAME ERROR?
		CAIN A,GJFX20	;OR NO SUCH GENERATION ERROR?
		RETSKP		;SKIP RETURN FOR NO RESTART FILE
		JRST BDARFL]	;BAD RESTART FILE
	MOVE B,[FLD(^D36,OF%BSZ)+OF%RD]  ;36-BIT BYTE, READ ACCESS
	OPENF
	 JRST BDARFL		;BAD RESTART FILE
	HRLI A,0		;CLEAR LH
	BIN			;1ST WORD IN FILE IS TAPE#
	CAME B,VOLID6		;CHECK AGAINST REQUESTED TAPE#
	JRST BDARFL		;BAD RESTART FILE
	BIN			;2ND WORD IN FILE IS SAVESET NO.
	MOVEM B,ARCTSN		;(1 IF CONT., 2 AT START OF NEW TAPE)
	BIN			; 1st seq. no. of physical record
				;   just before new SS
	MOVEM B,SPSEQ		;SAVED IN SPSEQ
	PUSH P,A		;SAVE FOR CLOSE BELOW
	MOVE B,ARCTSN
	CAIE B,1		;SAVESET 1 FOR CONT. SAVESET, READ ON...
	JRST CLSAFL		;OTHERWISE, DONE
	BIN
	MOVEM B,INIPGN		;INITIAL PAGE NO. IN CONT. FILE
	BIN
	MOVEM B,INICNT		;INITIAL PAGES REMAINING IN CONT. FILE
	HRROI B,XSPEC		;FILE SPEC FOR CONT. SAVESET
	SETZ C,			; I.E., SPEC OF CONT. FILE
	SIN			; OR 1ST FILE FOR NEW TAPE
	MOVEI A,[EXP CSCD,CSWD,CSCD,CSCD]	;POINT TO ROUTINES
	CALL FILDFI		;SET UP FILE DEFAULTS
	MOVE A,[.NULIO,,.NULIO]	;AS IN COMMAND, BUT FILESPEC 
	MOVEM A,GJBLK+.GJSRC	;IS XSPEC
	MOVX A,GJ%OLD+GJ%IFG+GJ%XTN  ;ALLOW STARS, CK EXTENDED BLOCK
	HLLM A,GJBLK+.GJGEN
	MOVEI A,GJBLK		;GTJFN BLOCK
	HRROI B,XSPEC
	GTJFN
	 JRST [	SETZM INIPGN	;START OVER ON FILESPEC
		SETZM INICNT	; GIVEN IN SAVE COMMAND
		SETZM XSPEC
		JRST CLSAFL]
	MOVEM A,INIJFN		;INITIAL JFN SET
	HRRZ B,A		;JFN IN B FOR ADFILE
	CALL ADFILE		;ADD JFN TO JFN STACK
CLSAFL:	POP P,A
	CLOSF
	CALL JSERRM
	RET

BDARFL:	ERROR BMBCMD, <?BAD RESTART FILE.  MARK THIS TAPE AS FULL
AND USE NEW TAPE FOR FURTHER ARCHIVALS.>
SEQFND:	CALL MTOPNR
	PUSH P,TAPBKF		; Preserve blocking factor thru REWIND
	CALL REWCV		;INITIALIZES SEQ AND RSEQ
	POP P,TAPBKF
	SKIPG SPSEQ		;DONE IF SPEC. SEQUENCE NO.=0
	JRST [	CALL ARDELF	; Expunge restart file
		CALL MTCLS
		RET]
SEQFN1:	CALL TSTINT
	CALL MTRED		;READ A RECORD
	 JRST [TMSG <, Record ignored
>
		JRST SEQFN1]
	MOVN A,TYP
	CAIN A,TPTRX
	SKIPL PAGNO		;TAPE FULL?
	SKIPA			;NO
	JRST [	CALL ARDELF	;YES, Expunge restart file
		CALL REWCV
		CALL MTCLS
		ERROR BMBCMD, <?TAPE FULL. PLEASE MARK IT.>]
	MOVE A,SEQ		;SEQ NO. FROM TAPE
	CAMGE A,SPSEQ		; At or past SPSEQ yet?
	JRST SEQFN1		; No, keep scanning
	CAME A,SPSEQ		; At SPSEQ?
	JRST [	CALL MTCLS
		ERROR BMBCMD,<?Tape error prevents proper positioning of tape
for new saveset.
$Mark this tape as full.>]
	CALL BACKSP		;BACKSPACE ONE RECORD
	CALL FWRSP		;THEN ADVANCE ONE RECORD
				; TO BE GOING IN RIGHT DIRECTION
	CALL MTCLS
	RET

SCNTAP:	CALL MTOPNR
	PUSH P,TAPBKF		;Preserve blocking factor thru REWIND
	CALL REWCV		;INITIALIZES SEQ AND RSEQ
	POP P,TAPBKF
SCNTP1:	CALL TSTINT
	CALL MTRED		;READ A RECORD
	 JRST [TMSG <, RECORD IGNORED
>
		JRST SCNTP1]
	MOVE A,TAPBKF		;Blocking factor determined from tape
	MOVEM A,SETBKF		;Set as blocking factor for tape write
	MOVN A,TYP
	CAIN A,TPTRX
	SKIPL PAGNO		;TAPE FULL?
	SKIPA			;NO
	JRST [	CALL REWCV	;YES
		CALL MTCLS
		ERROR BMBCMD, <?TAPE FULL.  PLEASE MARK IT.>]
	CAIE A,CTPHX		;CONTINUED SAVE SET?
	CAIN A,TPHDX		;OR TAPE HEADER?
	JRST [	MOVE A,ARCTSN	;YES, AND ARCTSN=0 IF 1ST TAPE SCAN
		MOVEI C,XBUFF
		LOAD B,SSNO,(C)	; Saveset no. from record header
		MOVEM B,ARCTSN	;UPDATE SAVESET#
		JUMPN A,SCNTP1	;2ND SCAN: SCAN TO TRAILER REC
		CALL MTCLS	;1ST SCAN: TAPNO SET FROM 1ST REC
		RET]
	CAIE A,TPTRX		;TAPE TRAILER?
	JRST SCNTP1		;NO, KEEP SCANNING
	SKIPG MTTYP		;TRAILER FOUND, UNLABELED TAPE?
	CALL [	CALL BACKSP	;YES, BACK OVER TRAILER
		CALLRET BACKSP]	;BACKSPACE ONE RECORD
	MOVE B,SEQ		; Seq. no. just before last physical
				;  record before new savest
	SKIPG MTTYP		;DON'T INCREMENT IF LABELED
	ADDI B,1		; Calc. 1st seq. no. on last physical
				;  record before new SS
	MOVEM B,SPSEQ		; Save for restart file
	SKIPG MTTYP		;UNLABELED TAPE?
	CALL FWRSP		;YES, THEN ADVANCE ONE RECORD
				; Now positioned for new SS
	AOS ARCTSN		;NEW SAVESET NO.
	CALLRET MTCLS
ARCSSN:	HRROI A,SSNBUF
	HRROI B,[ASCII /Save set# /]
	MOVNI C,^D10		;10 CHARACTERS ONLY
	SOUT
	MOVE B,ARCTSN		;SAVESET#
	MOVEI C,^D10		;RADIX
	NOUT
	JFCL
	HRROI B,[ASCIZ /, Archive Tape/]
	MOVE C,COLSW
	CAIN C,1		; Collection?
	HRROI B,[ASCIZ /, Collection Tape/]
	CAMN C,[-1]		; Or migration?
	HRROI B,[ASCIZ /, Migration Tape/]
	SETZ C,
	SOUT
	RET

WRARFL:	MOVX A,GJ%SHT		
	HRROI B,RFSPEC		;RESTART FILE SPEC. (EXT.=TAPE ID)
	GTJFN
	JRST BDWRFL
	MOVX B,<FLD (^D36,OF%BSZ)>+OF%WR
	OPENF
	JRST BDWRFL
	HRLI A,0		;CLEAR LH
	MOVE B,VOLID6		;1ST WORD OF FILE IS TAPE NO.
	BOUT
	MOVE B,ARCTSN		;2ND WORD IS SAVESET NO.
	BOUT
	MOVE B,SPSEQ		; 1st seq. no. of last physical
	BOUT			;  record before new saveset
	PUSH P,A		;SAVE FOR CLOSF BELOW
	SKIPN XSPEC		;CONTINUED SAVESET?
	JRST CLSWFL		;NO, WRITE IS COMPLETE
	MOVE B,INIPGN		;REMAINING PAGES IN CONT. FILE
	BOUT
	MOVE B,INICNT		;PAGE LOC. IN CONT. FILE
	BOUT
	HRROI B,XSPEC		;FILESPEC OF CONT. SAVESET
	SETZ C,
	SOUT
CLSWFL:	POP P,A
	CLOSF
	JRST BDWRFL
	RET

BDWRFL:	ERROR BMBCMD, <?CANNOT CREATE RESTART FILE>
;FOR ARCHIVE/MIGRATION/COLLECTION RUN, TEST FILE FOR INCLUSION ON THIS TAPE
;RETURNS +1 FOR NO DUMP
;	 +2 FOR OK TO DUMP

ARCTST:	SKIPE INIPGN		;CONT. FILE?
	RETSKP			;YES, GO ON WITH DUMP
	MOVE B,FDB+.FBCTL
	TXNE B,FB%OFF		; File offline?
	RET			; Yes, skip it
	SKIPE ARCSW		; Archive run?
	JRST [	MOVE B,FDB+.FBBBT
		TXNN B,AR%RAR	; Archive requested?
		RET		; No, skip it
		JRST .+1]	; Yes, go on with check
	SKIPE COLSW		; Colletcion/migration?
	JRST [	MOVE B,FDB+.FBBBT
		TXNE B,AR%RIV	; Migration request?
		JRST .+1	; Explict request, cont. with test
		SKIPG COLSW	; We taking expired files? (collection)
		RET		; No, bypass the file
REPEAT 0,<		HLRZ B,FDB+.FBNET ; Get online expiration
		GTAD		; Get now
		HLRZS A
		CAIGE A,(B)	; File expired?
		RET		; No (& does have exp. date)
		JUMPN B,.+1	; Expired date if non-zero--dump it
		MOVE A,FDB+.FBCRE ; Interval, find most recent date
		CAMG A,FDB+.FBCRV
		MOVE A,FDB+.FBCRV
		CAMG A,FDB+.FBWRT
		MOVE A,FDB+.FBWRT
		CAMG A,FDB+.FBREF
		MOVE A,FDB+.FBREF
		HRRZ B,FDB+.FBNET ; Get the interval
		HLRZS A
		ADD B,A		; Form expiration date
		GTAD
		HLRZS A
		CAIG A,(B)	; Expired?
		RET		; No, skip it
> ; End REPEAT 0
		JRST .+1]	; Yes, dump it
	CALL NSETS		;DETERMINE ARSETS=NO. SETS TAPE INFO
	MOVE B,FDB+.FBBBT
	TXNE B,AR%1ST		;IF AR%1ST ON, IGNORE INVALID TAPE INFO
	JRST [	SOS A,ARSETS	;CORRECT ARSETS FOR IGNORED SET
		SKIPGE ARSETS
		SETZB A,ARSETS	;ENSURE ARSETS>=0
		JRST .+1]
	CAIN A,2		;ARSETS=2,I.E., 2 SETS TAPE INFO?
	JRST [	MOVE B,FDB+.FBCTL
		TXNE B,FB%ARC	; File archived?
		SKIPN ARCSW	; And during archive run?
		RET		; No, just skip it (REAPER will take it)
		CALLRET OLDARC]	; Yes, complain and skip it
	CAIE A,1		;NOW ARSETS=0 FOR 1ST RUN,=1 FOR SECOND
	RETSKP			;FINISHED IF 1ST RUN
	MOVE B,FDBARC+.ARTP1  	;FOR 2ND RUN, CHECK FIRST TAPE NO.
	CAME B,VOLID6		;1ST TAPE # = 2ND TAPE #?
	RETSKP			;NO, OK TO DUMP
	RET			;YES, DEFER DUMP TILL ANOTHER TAPE

OLDARC:	CALL GOFNAM		;GET TAPE FILE NAME SET
	TMSG <%FILE >
	MOVE B,ONMPTR		;POINTER TO FILENAME INCL. DIR.
	CALL TMSGQ
	TMSG < SKIPPED BECAUSE
ALREADY MARKED AS HAVING TWO VALID TAPE COPIES.
>
	RET

;FOR ARCHIVE/COLL./MIG. RUN, SET TAPE INFO AND AR%1ST

ARC1:	CALL ARSST0		;SET UP ARG BLOCK FOR .ARSST
	MOVE A,JFN
	HRLI A,.FBBBT		;SET AR%1ST IN .FBBBT
	MOVX B,AR%1ST		;TO MARK 1ST PASS OF ARC./COL./MIG. RUN
	MOVE C,B		;IN PROGRESS
	CHFDB
	MOVX B,.ARSST		;CODE FOR SET ARCHIVE STATUS
	MOVEI C,ARSSTB		;ARG BLOCK FOR .ARSST
	ARCF			;SET ARCHIVE STATUS
	MOVX B,.ARGST		;READ TAPE INFO JUST SET
	MOVEI C,FDBARC		;INTO FDBARC FOR USE IN TAPE WRITE
	ARCF
	MOVX B,AR%1ST+AR%RAR+AR%RIV  ;WRITE FDB ON TAPE AS IF THE ARCHIVE
	ANDCAM B,FDB+.FBBBT	;RUN HAD COMPLETED SUCCESSFULLY
	RET
NSETS:	SETZB A,ARSETS		; Assume none
	SKIPE FDBARC+.ARTP1	; First one there?
	AOS A,ARSETS		; Yes, note that
	SKIPE FDBARC+.ARTP2	; How about the 2nd tape?
	AOS A,ARSETS		; That one too
	RET

ARSST0:	SETZM ARSSTB+.AROFL	; Set up blk - use not for tape write
	SETZM ARSSTB+.ARODT
	MOVX B,AR%ARC		; Flag archive?
	SKIPE ARCSW
	MOVEM B,ARSSTB+.AROFL	; Yes
	SKIPE ARSETS		;FIRST ARCHIVE RUN?
	JRST ARCP2		;NO
	MOVX B,AR%O1		;YES, IN 1ST TAPE SLOTS
	IORM B,ARSSTB+.AROFL	;FLAG FIRST RUN
	MOVE B,TOTFIL		;TAPE FILE NUMBER
	ADDI B,1		; TOTFIL WILL BE INC'D BY TIME IS WRITTEN
	HRRM B,ARSSTB+.ARSF1
	MOVE B,ARCTSN		;TAPE SAVE SET NUMBER
	HRLM B,ARSSTB+.ARSF1
	MOVE B,VOLID6		;TAPE NUMBER
	MOVEM B,ARSSTB+.ARTP1
	RET

ARCP2:	MOVX B,AR%O2
	IORM B,ARSSTB+.AROFL	;FLAG SECOND RUN
	MOVE B,TOTFIL		;TAPE FILE NUMBER
	ADDI B,1		; TOTFIL WILL HAVE BEEN INC'D BY TIME WRITTEN
	HRRM B,ARSSTB+.ARSF2
	MOVE B,ARCTSN		;TAPE SAVE SET NUMBER
	HRLM B,ARSSTB+.ARSF2
	MOVE B,VOLID6		;TAPE NUMBER
	MOVEM B,ARSSTB+.ARTP2
	RET

;REMOVE ONE SET TAPE INFO FROM FDB IF AR%1ST IS SET
;DOES NOT UPDATE TAPE INFO IN MEMORY AFTER REMOVAL FROM FDB

UNARC:	MOVE A,JFN
	MOVE B,[1,,.FBBBT]	;GET CURRENT FLAG BITS
	MOVEI C,B		; INTO B
	GTFDB
	 ERJMP [CALLRET JSERR1]
	TXNN B,AR%1ST		;TAPE INFO VALID?
	RET			;YES
	MOVX B,.ARGST		; Get the tape info
	MOVEI C,FDBARC		; Put with other FDB info
	ARCF
	CALL NSETS		;NO. OF SETS TAPE INFO IN A
	JUMPE A,R		; None?
	MOVX C,AR%CR1		;RUN 1:CLEAR THAT INFO
	CAIN A,2		;RUN 2?
	MOVX C,AR%CR2		;YES: CLEAR ONLY RUN 2 INFO
	MOVX B,.ARDIS		;DISCARD TAPE INFO
	MOVE A,JFN
	ARCF
	 ERJMP [TMSG <Unable to discard invalid tape backup information.
>
		RET]
	HRLI A,.FBBBT		;DISCARD SUCCEEDED: TURN OFF AR%1ST
	MOVX B,AR%1ST
	SETZ C,
	CHFDB
	 ERJMP [TMSG <?Unable to clear AR%1ST after discarding tape information
>
		RET]
	RET
ARFXBK:	MOVE A,P2JFN
	HRLI A,.FBBBT		;SET AR%1ST TO ZERO
	MOVX B,AR%1ST		;CHANGE JUST THIS BIT
	SETZ C,			;TO 0
	CHFDB
	ERJMP R			;FAILURE: SKIP THIS FILE
	ANDCAM B,FDB+.FBBBT
	CALL NSETS		;DETERMINE ARSETS= #SETS ARCH INFO
	CAIE A,2		;2ND RUN?
	RET			;NO, DONE
	MOVE C,FDB+.FBBBT	; Get backup bits
	TXNE C,AR%NDL		; Delete on disk not allowed?
	JRST ARFXB1		; Right, skip delete
	MOVX A,DF%CNO!DF%NRJ	;Delete disk contents only
	HRR A,P2JFN
	DELF
	 JRST [	MOVX B,AR%NDL
		IORM B, FDB+.FBBBT
		JRST .+1]
ARFXB1:	MOVE A,P2JFN		;GET JFN
	MOVX B,.ARRAR		;CODE FOR SET/CLEAR ARCH REQUESTS
	MOVE C,FDB+.FBBBT
	TXNE C,AR%RIV
	MOVX B,.ARRIV		; Migration request
	MOVX C,.ARCLR		; Clear it
	ARCF
	 ERJMP [TMSG <?Unable to clear archive/migration request bit after migration to tape complete.
>
		JRST .+1]
	MOVE D,FDB+.FBBBT	; Get who archived it
	HRLI A,.FBCTL
	MOVX B,FB%INV		; Change invisible bit
	MOVE C,B
	TXNN D,AR%NDL		;FLUSH NOT ALLOWED?
	TXNN D,AR%RAR		; User request the archive?
	CAIA			;FILE MADE INVISIBLE ONLY IF
	CHFDB			;FLUSHED & USER REQUESTED ARCHIVE
	ERJMP .+1		;FAILURE SHOULD NOT BE DISASTROUS
	HRRZ A,P2JFN		; JFN for file being messed with
	MOVE B,FDB+.FBBBT	; Get old back up words
	ANDX B,AR%NDL		; Save only that bit (flag for ARMSUS)
	CALL ARMSUS		; Message to user about this file
	CALL USAINI		; Init USAGE block here
	MOVX A,.UTARC
	SKIPGE COLSW		; -1=migration
	MOVX A,.UTMIG
	SKIPLE COLSW		; 1=collection
	MOVX A,.UTCOL
	HRRM A,USABLK		; Store entry type
	LOAD A,FB%PGC,FDB+.FBBYV ; Get # pages that were in the file
	MOVEM A,USABLK+10
	MOVEI A,FDBARC		; Point to tape info blk
	CALL USATAP		; And spray it into the USAGE blk
	LOAD B,AR%RSN,FDB+.FBBBT ; Get reason off-line code
	MOVEM B,USABLK+26	; Add reason code to blk
	HRRZ B,P2JFN		; JFN of file in question
	HRROI A,USASTR		; Structure of the file
	MOVX C,<FLD(.JSAOF,JS%DEV)>
	JFNS
	HRROI A,USADIR
	MOVX C,<FLD(.JSAOF,JS%DIR)>
	JFNS
	MOVE A,B		; JFN
	HRROI B,USAACT		; Account of the file
	GACTF
	 CAIA			; Error, ignore it
	JRST [	MOVEM B,USABLK+6 ; We somehow got a numeric account
		MOVX B,US%IMM
		IORM B,USABLK+5 ; Mark as an immediate quanity
		JRST .+1]
	MOVEI A,USASTR		;GET ASCIZ STRUCTURE NAME
	HLL A,[POINT 7,0]
	MOVEI B,USASSI		;PUT SIXBIT STRUCTURE NAME INTO
	CALL SEVSIX		; USASSI
	MOVX A,.USENT
	MOVEI B,USABLK
	USAGE
	 ERJMP [TMSG <%USAGE entry failed in ARFXBK
>
		JRST .+1]
	RET
;FOR ARCHIVE RUN, END-OF-TAPE FUNCTIONS

XINFO:	TMSG < This >
	CALL PRTTYP		; Print archive/collection/migration
	TMSG < run will be continued onto another tape.
>
	HRROI A,XSPEC		;FILESPEC AT TAPE SWITCH
	MOVE B,JFN		;CURRENT FILE, TO BE CONT.
	MOVX C,1B2+1B5+1B8+1B11+1B14+1B35
	JFNS
	HRROI A,XDIR		;STR:DIRECTORY AT TAPE SWITCH
	MOVX C,1B2+1B5+1B35
	JFNS
	RET

PRTTYP:	HRROI B,[ASCIZ/archive/]
	SKIPE ARCSW
	JRST TMSGQ
	HRROI B,[ASCIZ/collection/]
	SKIPL COLSW
	JRST TMSGQ
	HRROI B,[ASCIZ/migration/]
	JRST TMSGQ

ARDELF:	MOVX A,GJ%SHT
	HRROI B,RFSPEC		;RESTART FILE SPEC. (EXT.=TAPE ID)
	GTJFN
	CALLRET DELBMB
	HRLI A,0
	TXO A,DF%EXP		;DELETE AND EXP
	DELF			;OLD RESTART FILE
	CALLRET DELBMB
	RET

DELBMB:	TMSG <%FAILED IN ATTEMPT TO DELETE RESTART FILE
>
	HRROI B,RFSPEC		;RESTART FILE SPEC. (EXT.=TAPE ID)
	CALL TMSGQ
	TMSG <
IMPORTANT: MAKE SURE THIS FILE DOES NOT REMAIN ON THE SYSTEM.
>
	RET
	SUBTTL PSEUDO INTERRUPT ROUTINES

CHNMSK:	1B<CECHN>+1B<QSRCHN>+1B<VSCHN>+1B<.ICPOV>+1B<.ICDAE>+17B<.ICIEX>+1B<.ICMSE>+1B<.ICQTA> ;CHANNELS USED

;TERMINAL INTERRUPT - ^E

CEINT:	MOVEM 17,INT3AC+17	;SAVE ACS
	MOVEI 17,INT3AC
	BLT 17,INT3AC+16
	MOVE P,[IOWD NINTPD,INT3PD]
	SKIPN CEXFLG		;EXECUTING COMMAND?
	JRST [	TMSGC <%No interruptible command in progress
>
		JRST CEINT1]
	SKIPE INTRQ		;ALREADY REQUEST PENDING?
	JRST [	TMSGC <%Interrupt request already in progress.
>
		JRST CEINT1]
	TMSG <
Interrupting...
>
	SETOM INTRQ		;REQUEST INTERRUPT
CEINT1:	MOVSI 17,INT3AC		;RESTORE ACS
	BLT 17,17
	DEBRK

;TEST FOR INTERRUPT REQUEST, RETURN IMMEDIATELY IF NONE.
;OTHERWISE, ENTER COMMAND INPUT AND RETURN WHEN 'CONTINUE' GIVEN

TSTINT:	SKIPN INTRQ		;INT REQUEST?
	RET			;NO
	POP P,INTPC		;YES, SAVE PC AND NOTE INTERRUPTED
	MOVE A,CMDTYP		;GET CURRENT COMMAND TYPE
	TXNN A,TY%DBL		;SKIP IF SAVE OR RESTORE COMMAND
	SETZM NIJFN		;DON'T SAVE JFNLST POINTER
	MOVEM A,ICMDTY		;SAVE AS INTERRUPTED COMMAND TYPE
	MOVEM P,IPDLP		;SAVE PUSH DOWN POINTER
	SETZM	INTRQ		;CLEAR INTERRUPT REQUEST
	MOVE A,CURPTR
	MOVEM A,CMDPTR
	SETZM CEXFLG		;COMMAND NO LONGER IN PROGRESS
	MOVE A,TRAPJ		;GET TRAP STUFF
	MOVEM A,ITRAPJ		;SAVE TRAP STUFF
	MOVE A,TRAPSP		;..
	MOVEM A,ITRAPS		;..
	JRST RESTRT		;GO TO COMMAND LEVEL

;'CONTINUE' COMMAND

$CONT:	CALL CONFRM
	SKIPN INTPC		;WERE INTERRUPTED?
	ERROR RESTRT,<?CANNOT CONTINUE>
	MOVE A,ICMDTY		;GET INTERRUPTED COMMAND TYPE
	MOVEM A,CMDTYP		;AND RESTORE
	SETZM ICMDTY		;INDICATE NO INTERRUPTED COMMAND
	MOVE A,ITRAPJ		;RESTORE TRAP STUFF
	MOVEM A,TRAPJ		;...
	MOVE A,ITRAPS		;...
	MOVEM A,TRAPSP		;...
	MOVE A,INIPTR		;RESET CMDPTR
	MOVEM A,CMDPTR		;...
	MOVE P,IPDLP		;RESTORE PDL
	SETOM CEXFLG		;YES, NOTE RESUMING EXECUTION
	MOVE A,INTPC		;GET PC
	SETZM INTPC		;ZERO INTERRUPT PC
	JRST 0(A)		;RETURN TO POINT OF INTERRUPTION

;LABELED-TAPE VOLUME-SWITCH INTERRUPT

VSINT:	MOVEM 17,INT3AC+17	;SAVE ACS
	MOVEI 17,INT3AC
	BLT 17,INT3AC+16
	MOVE P,[IOWD NINTPD,INT3PD]
	MOVE A,MTJFN		;GET JFN
	CALL GMTINF		;UPDATE VOLID
	SETZM RSEQ		;RESET RECORD SEQUENCE NUMBER
	JRST CEINT1
;UNEXPECTED TRAP LOGIC

;SET FENCE FOR TRAPS
; A/ WHERE TO GO IF UNEXPECTED TRAP

SETTRP:	POP P,CX		;GET LOCAL PC OFF STACK
	PUSH P,TRAPJ		;SAVE PREVIOUS FENCE
	PUSH P,TRAPSP
	MOVEM A,TRAPJ		;SAVE DISPATCH
	MOVEM P,TRAPSP		;SAVE STACK FENCE
SETTR1:	PUSHJ P,0(CX)		;CONTINUE ROUTINE
	 SKIPA			;NO SKIP RETURN
	AOS -2(P)
	POP P,TRAPSP		;RESTORE PREVIOUS FENCE
	POP P,TRAPJ
	RET

;UNEXPECTED TRAP HANDLERS

;ILLEG INSTRUCTION

ITRAP:	JSR EINT1		;SWITCH CONTEXT
	SKIPE TRAPJ		;TRAP FENCE?
	JRST ITRAP1		;YES - SKIP SYSTEM MESSAGE
	TMSGC <?>
	CALL JSERRM		;DO JSYS ERROR MESSAGE
ITRAP1:	SKIPE A,TRAPJ		;HAVE TRAP FENCE?
	JRST [	MOVEM A,INT1AC+CX ;YES, SETUP DISPATCH ADDRESS
		TMSG <
>
		MOVE A,TRAPSP	;AND RESET STACK TO FENCE
		MOVEM A,INT1AC+P
		MOVEI A,SETTR1	;DEBREAK ADDRESS
		JRST BADIXP]
	TMSG <  Command aborted
>
	MOVEI A,BMBCMD		;DEBREAK TO BOMB COMMAND
BADIXP:	MOVEM A,LPC1		;SET DEBREAK ADDRESS
BADIX:	MOVSI 17,INT1AC		;RESTORE ACS
	BLT 17,17
	DEBRK

BADINT:	TMSG <?PC = >
	HRRZ B,LPC1
	MOVEI C,^D8
	CALL TTNOUT		;PRINT PC
	TMSG <
>
	JRST ITRAP1

;HERE IF NO RECOVERY

BADEX:	HALTF
	JRST .-1		;CANT CONTINUE

;MEMORY READ TRAP

MEMRTP:	JSR EINT1		;SWITCH CONTEXT
	TMSGC <?Unexpected memory read trap in DUMPER
>
BADIVA:	TMSG <?VA = >
	MOVEI A,.FHSLF		;GET ADDRESS OF BAD REFERENCE
	GTRPW
	HRRZ B,A
	MOVEI C,^D8
	CALL TTNOUT		;REPORT IT
	TMSG <
>
	JRST BADINT		;CONTINUE AS FOR ITRAP

;MEMORY WRITE, EXECUTE TRAPS

MEMWTP:	JSR EINT1		;SWITCH CONTEXT
	TMSGC <?Unexpected memory write trap in DUMPER
>
	JRST BADIVA

MEMXTP:	JSR EINT1		;SWITCH CONTEXT
	TMSGC <?Unexpected memory execute trap in DUMPER
>
	JRST BADIVA

;MACHINE SIZE EXCEEDED OR DISK QUOTA EXCEEDED

MSETRP:	JSR EINT1		;SWITCH CONTEXT
	TMSGC <?Disk full or quota exceeded.>
	SKIPE RETSW		;RETRIEVING?
	JRST ITRAP1		;YES, TAKE TRAP
	TMSG < Type <CR> to attempt to continue >
	CALL RDLIN
	MOVE A,LPC1		;GET FAILING PC
	TLNE A,(PC%USR)		;FAILED IN JSYS?
	JRST BADIX		;NO, DEBREAK
	MOVE A,-1(A)		;GET FAILING JSYS
	CAMN A,[PMAP]		;FAILED IN PMAP?
	SOS LPC1		;YES, CHANGE PC TO RETRY PMAP FROM START
	JRST BADIX		;DEBREAK WITHOUT CHANGING PC

;PDL OVERFLOW

PDLOV:	JSR EINT1		;SWITCH CONTEXT
	TMSGC <?PDL overflow trap in DUMPER
>
	JRST BADINT

;SETUP LEVEL 1 PSI CONTEXT
;	JSR EINT1

EINT1A:	MOVEM 17,INT1AC+17	;SAVE ACS
	MOVEI 17,INT1AC
	BLT 17,INT1AC+16
	MOVE P,[IOWD NINTPD,INT1PD] ;SETUP LOCAL STACK
	JRST @EINT1
LEVTAB:	LPC1
	LPC2
	LPC3

CHNTAB:	PHASE 0
	0
CECHN:!	3,,CEINT		;^E
QSRCHN:!3,,QSRINT		;IPCF Msg from QUASAR recv'd
VSCHN:!	3,,VSINT		;LABELED TAPE VOLUME SWITCH
	0
	0

	0
	0
	0
	1,,PDLOV		;STACK OVERFLOW
	0
	2,,MEMERR		;FILE DATA ERROR

	1,,MSETRP		;QUOTA EXCEEDED
	0
	0
	1,,ITRAP		;ILLEG INSTRUCTION TRAP
	1,,MEMRTP		;MEM READ
	1,,MEMWTP		;MEM WRITE

	1,,MEMXTP		;MEM XCT
	0
	1,,MSETRP		;MACHINE SIZE EXCEEDED
	REPEAT ^D35-.ICMSE,<0>
	DEPHASE
;PSI RECEIVED ON IO ERROR CHANNEL

MEMERR:	MOVEM 17,INT2AC+17
	MOVEI 17,INT2AC
	BLT 17,INT2AC+16
	MOVE P,[IOWD NINTPD,INT2PD] ;SETUP LOCAL STACK
	PUSH P,40
	MOVE 1,LASTID
	CAMN 1,LSTERO
	JRST MEMXIT
	MOVEM 1,LSTERO
	BTMSGC <?Disk error in file >
	HLRZ 1,LASTID
	GTSTS
	TLNN 2,(1B10)
	JRST [	BTMSG <(Unknown file name)>
		JRST MEMERZ]
	HRROI B,NAMBUF
	CALL BTMSGQ		;TYPE FILE NAME
	HRRZ 2,LASTID		;GET PAGE NUMBER
	CAIN 2,-1		;ON OPENF?
	JRST [	BTMSG <, page table>
		JRST MEMERZ]
	BTMSG <, page >
	HRRZ 2,LASTID
	MOVEI 3,^D10
	CALL TTNOUT		;TYPE PAGE NUMBER
	CALL LPNOUT		;PRINT "
MEMERZ:	BTMSG <
>
MEMXIT:	POP P,40
	MOVSI 17,INT2AC
	BLT 17,17
	DEBRK
	SUBTTL LOAD AND CHECK

LIT1:	FLDDB. (.CMFIL,CM%SDH,,<file group descriptor>,,LIT2)
LIT2:	FLDDB. (.CMCMA,,,,,LIT3)
LIT3:	FLDDB. (.CMCFM)


CHCK:	SETOM CHECK		;CHECK command
	SETZM RETSW		;NOT RETRIEVING
	SETOM NJFN1		;FAKE ACTIVE JFN
	HRROI A,[ASCIZ/ALL TAPE FILES/]
	CALL NOISE
	JRST LOAD2

$RETRI:	SKIPN WHEEL
	ERROR BMBCM1,<?RETRIEVE requires WHEEL or OPERATOR capabilities enabled>
	SETOM RETSW		; Flag we're doing retrievals
	TXZ F,USRDAT		; No user data from arc/col/mig tapes
	TXOA F,LFILF		; Cause file names to print AND SKIP
$LOAD:	SETZM RETSW		;NOT RETRIEVING
	SETZM CHECK
	SETOM LODARC		;Default is to load archive info
	HRROI A,[ASCIZ/TAPE FILES/]
	SKIPE RETSW		;Doing retrievals?
	HRROI A,[ASCIZ/FILES/]	;YES
	CALL NOISE
	CALL GETCON		;SAVE CONNECTED DIRECTORY
	SKIPE ICMDTY		;SKIP IF NOT UNDER ^E
	SKIPN Q1,NIJFN		;PICK UP OLD POINTER, IF ANY
	MOVSI Q1,-NJFNL+1	;INIT PTR TO JFN LIST
LOAD1:	MOVEI A,[EXP CSCD,CSWD,WSWD,WSWD]	;POINT TO ROUTINES
	CALL FILDFI		;SETUP DEFAULT FILE SPEC
	HRROI A,[ASCIZ/DSK*/]
	SKIPE RETSW		;RETRIEVING?
	MOVEM A,GJBLK+.GJDEV	;YES, DEFAULT STRUCTURE TO DSK*:
	MOVX A,GJ%OFG		;SET PARSE-ONLY FOR GTJFN
	HLLM A,GJBLK+.GJGEN
	MOVEI A,CBLK
	MOVEI B,[FLDDB. .CMSWI,,LSWTB,,,FILCDB]
	SKIPE RETSW		;RETRIEVING?
	MOVEI B,FILCDB		;YES, DON'T ALLOW SWITCHES
	COMND
	TXNE A,CM%NOP
	ERRORJ BMBCM1,<?NOT A SWITCH OR FILESPEC>
	LOAD C,CM%FNC,0(C)	; Get code of block used
	CAIE C,.CMSWI		; A switch?
	JRST LOADF		; No, must be a file name
	HRRZ B,0(B)		; Get dispatch
	JRST 0(B)		; Do it
; Switch table

LSWTB:	NLSWTB,,NLSWTB
	TB $NOARC,<NOTAPE-INFORMATION>
	TB $LOARC,<TAPE-INFORMATION>
NLSWTB==.-LSWTB-1

$LOARC:	SETOM LODARC		; Do load tape info
	JRST LOAD1

$NOARC:	SKIPE RETSW		; Doing a retrieval?
	ERROR BMBCM1,<?Cannot suppress tape information for a retrieval>
	SETZM LODARC		; Flag NO tape info
	JRST LOAD1
LOADF:	CALL ADLIST		;ADD FILE TO JFNSTACK
	JUMPGE Q1,[ERROR (BMBCM1,<?TOO MANY ITEMS IN FILESPEC LIST>)]
	MOVEM B,JFNLST(Q1)	;SAVE A JFN
	SETZM JF2LST(Q1)
	AOBJN Q1,.+1
	SKIPE RETSW		; Doing retrievals?
	JRST LOAD2		; Yes, we already have output names
	HRROI A,[ASCIZ/TO/]
	CALL NOISE
	CALL OFNAME		;SETUP OUTPUT DEFAULTS
	MOVX B,GJ%OFG
	HLLM B,GJBLK+.GJGEN
	MOVX B,.GJNHG
	TXNE F,SSA		;SUPERSEDE ALWAYS?
	HRRM B,GJBLK+.GJGEN	;YES, DEFAULT GEN IS NEXT HIGHER
	MOVEI B,LIT1
	MOVEI A,CBLK		;POINT TO COMMAND BLOCK
	COMND			;GET MORE FILESPECS OR TERMINATOR
	TXNE A,CM%NOP
	ERRORJ BMBCM1,<?INVALID FILE GROUP DESCRIPTOR>
	LOAD C,CM%FNC,0(C)	;GET CODE USED
	CAIN C,.CMCMA		;COMMA?
	JRST LOAD1		;YES, ANOTHER SOURCE SPEC
	CAIE C,.CMCFM		;TERMINATED?
	JRST [	CALL ADFILE	;ADD JFN TO JFN STACK
		MOVEM B,JF2LST-1(Q1) ;NO, OUTPUT FILESPEC. SAVE JFN
		MOVEI B,[FLDDB. (.CMCMA,,,,,[FLDDB. .CMCFM])]
		COMND
		TXNE A,CM%NOP	;COMMA OR CR?
		ERROR BMBCM1,<?NOT A COMMA OR CR>
		LOAD C,CM%FNC,0(C) ;YES, SEE WHICH
		CAIE C,.CMCFM
		JRST LOAD1	;COMMA, DO MORE
		JRST .+1]	;CR, DONE
	CALL JFNCFM		;FIX UP JFN STACK FOR CONFIRM
	MOVEM Q1,NIJFN		;SAVE IN CASE OF ^E
	HRRZM Q1,NJFN1		;SAVE NUMBER ACTIVE JFNS
	MOVNI Q1,0(Q1)		;SAVE NUMBER OF JFNS SETUP
	MOVEM Q1,NJFN
	JRST LOAD3
LOAD2:	CALL CONFRM
LOAD3:	TXNN F,TNSF		;SKIP IF TAPE NUMBER SET
	SETZM RTAPNO
	MOVSI B,-1		;GET LARGE NEGATIVE NUMBER
	MOVEM B,TOTFIL		;INDICATE DON'T HAVE FILE NUMBER YET
	SETZM LSTDIR		;NO LAST DIRECTORY
	SETOM CDIRN		;NO CONNECTED DIR NOW
	TXZ F,TF2		;CLEAR THIS (NO FILE YET)
	SKIPN RETSW		; Some more special code for retrieves?
	JRST LODFI1		; No, go on with the load
	CALL QSRINI
	 ERROR (CDONE,<Retrievals cannot be processed at this time>)
	CALL NXTRET		; Get the first of them
	 ERROR (CDONE,<No retrievals match the specified file descriptor>)
LOAD21:	JUMPE P6,LDFLND		; Done?
	CALL RETTAP		; Ask for the tape to be mounted
	JUMPE P6,LDFLND		; May have been unavailable
	; ..
;BEGIN LOADING OF A TAPE

LODFI1:	CALL MTOPNR
LODFI2:	SETOM CEXFLG		;ALLOW INTERRUPT
	TXZN F,TNSF		;SKIP IF TAPE NUMBER SET
	AOS RTAPNO		;COUNT TAPES
	TMSG <
>
	CALL MTRED
	 JRST [	TMSG < in tape header, record skipped
>
		JRST LODHX1]
	MOVN A,TYP		;GET RECORD TYPE
	CAIE A,TPHDX		;TAPE HEADER?
	CAIN A,CTPHX		; OR CONTINUATION
	CAIA			;YES, PROCEED
	ERROR LODHX2,<%Tape does not start with header, continuing...>
	SKIPN RETSW		; Retrievals are quiet
	CALL TYHEDR		;TYPE HEADER INFO
	MOVEI B,XBUFF
	LOAD A,SSNO,(B)		; Saveset # non-0 for arch./col. tape
	JUMPN A,[ SKIPN WHEEL	; Must be an enabled WHEEL
		ERROR BMBCMD,<?WHEEL or OPERATOR capabilities required to
restore from an archive or virtual disk tape>
		SKIPE RETSW	; Doing a retrieval?
		JRST .+1	; Yes, proceed
		TMSG <%This tape is an archive or virtual disk tape. It should
%not be used to restore files. This action may breach the security of the
%system.
>
		HRROI A,[ASCIZ /$Are you sure you should do this? /]
		CALL YESNO
		JUMPE A,BMBCM1	; Said no, exit
		SETZM LODARC	; No archive info from the tape
		TMSG <%Files being restored without tape information
>
		JRST .+1]
	HRRZ A,TAPNO		; Tape # in RH on tape
	SKIPN RTAPNO		;TAPE # KNOWN?
	MOVEM A,RTAPNO		;NO, THEN THIS IS IT
	SKIPN RETSW		;NO TAPE# CHECK IF RETRIEVING
	CAMN A,RTAPNO		;RIGHT TAPE # MOUNTED?
	JRST LODHX1		;YES, PROCEED WITH LOAD
	TXNN F,TF2		;WRONG TAPE #, IN MIDDLE OF FILE?
	JRST LODHX5		;NO
	TMSGC <?Tapes not in order, cannot restore continued file >
	HRROI B,TFNAME		;FILE NAME
	CALL TMSGQ		;TYPE FILE NAME
	CALL MTCLS		;CLOSE MTA
	TMSGC <%Mount correct tape>
	SKIPL MTTYP		;MT DEVICE?
	JRST [	TMSG < and type CONTINUE> ;YES
		HALTF		;WAIT FOR USER TO MOUNT TAPE
		JRST .+1]
	SETZM MTDSG		;FORCE NTAPE TO PROMPT FOR TAPE SPEC
	CALL NTAPER		;GET SPEC
	 JRST BMBCMD		;CAN'T
	JRST LODFI1		;TRY AGAIN

LODHX5:	TMSGC <%Tapes not in order, continuing
>
	MOVE A,TAPNO
	MOVEM A,RTAPNO
LODHX1:	MOVSI A,-1
	SKIPE RETSW		;RETRIEVING?
	TXNE F,TF2		; AND NOT IN THE MIDDLE OF A FILE?
	CAIA
	MOVEM A,TOTFIL		;YES TO BOTH, DON'T KNOW FILE# YET

	; ..
;LOAD THE NEXT FILE

LODFIL:	SKIPE ABTFLG		; QUASAR say to abort this retrieve?
	CALL ABTRET		; Yes, do that
	 JFCL
	TXNN F,TF2		;SKIP TAPE CHECK IF CONTINUED FILE
	SKIPN RETSW		; In a RETRIEVE?
	JRST LDFIL1		; No, skip tape check
	LOAD A,TPNM2,(P6)	; Get desired tape #
	SKIPGE .ARODT(P6)	; Use alternate set?
	LOAD A,TPNM1,(P6)
	CALL NSVOL		;CONVERT POSSIBLE INTEGER VOLID TO 6BIT
	CAME A,VOLID6		; This the tape?
	JRST LOAD21		; No, next request on another tape
LDFIL1:	SKIPN NJFN1		;ANY ACTIVE JFNS LEFT?
	TXNE F,TF2		; OR CONTINUED FILE?
	CAIA			;YES TO EITHER
	JRST LDFLND		;NO, ALL DONE
	CALL MTRED
	 JRST [	TMSG < while searching for file 
>
		JRST LODFIL]

;LOOK FOR BEGINNING OF NEXT FILE OR END OF TAPE

LODHX2:	MOVN A,TYP		;GET TYPE CODE
	CAIN A,TPTRX		;TAPE TRAILER?
	JRST LODEND		;YES
	CAIE A,CTPHX
	CAIN A,TPHDX		;HEADER?
	JRST [	SKIPE RETSW	;YES, DOING RETRIEVALS?
		JRST [	MOVSI B,-1 ; Yes, use large neg # to cause
			MOVEM B,TOTFIL ;  of file numbers
			JRST LODFIL] ; Otherwise just keep going
		TMSG <
End of saveset
>
		CALL BKTPHD	;BACK OVER SAVESET HEADER & CLOSE TAPE
		JRST CDONE]
	CAIN A,USRX		;USER BLOCK?
	JRST LODUSR		;YES
	CAIN A,FLTRX		;FILE TRAILER?
	JRST [	SKIPGE PAGNO	;YES, FILE CONTINUED ON NEXT VOLUME?
		SOS TOTFIL	;YES, IT WILL HAVE THE SAME SEQ# THERE
		JRST LODFIL]
	CAIE A,CTPHX		;GO ON IF CONTINUED SAVE
	CAIE A,FLHDX		;FILE HEADER?
	JRST LODFIL		;NO, ASSUME DATA RECORD BEING SKIPPED
	CALL LODSBR		;YES, LOAD IT
	 JRST LODFIL		;LOADED OK - GET NEXT FILE
	JRST LODHX2		;TRAILER RECORD MISSING - ANALYZE THIS RECORD

;HERE WHEN RESTORE/RETRIEVE IS COMPLETED

LDFLND:	SKIPE MTJFN		;HAVE JFN ON TAPE?
	JRST [	SKIPE NWTBIT	;YES, OVERLAPPING?
		SKIPLE MTTYP	; AND UNLABELED?
		SKIPA		;NOT BOTH
		CALL BACKSP	;YES, UNDO ONE READ AHEAD
		SKIPE RETSW	; Retrieval?
		CALL UNLOAD	; Yes, spin off the tape
		CALL MTCLS
		JRST .+1]
	SETZ A,
	CALL SETMNT		;DISMOUNT MT IF I MOUNTED ONE
	JRST CDONE

;HERE WHEN TAPE TRAILER RECORD HAS BEEN READ

LODEND:	SETOM CDIRN
	SKIPL PAGNO		;SKIP IF TRAILER NOT END OF SAVESET
	SKIPE RETSW		; Retrieval?
	CAIA			; Cont. saveset or retrieval--go on
	JRST [	TMSGC <
End of saveset
>
		SKIPG MTTYP	;UNLABELED?
		CALL BACKSP	;YES, BACK OVER TAPE TRAILER
		CALL MTCLS
		JRST CDONE]
	TXNN F,TF2		; File completed?
	SKIPN RETSW		; And doing retrieval?
	CAIA
	JRST [	JUMPN P6,LODENX	; Yes, done with this tape--more ret's?
		JRST LDFLND]	; No, all done
	MOVEI B,XBUFF
	LOAD B,SSNO,(B)		; Saveset #, non-0 for arch/col tape
	JUMPN B,[HRROI B,[ASCIZ /%Saveset/]
		TXNE F,TF2
		HRROI B,[ASCIZ /%File/]
		CALL TMSGQC
		TMSG < continued on next tape.
>
		SKIPN RETSW	; Retrieval run?
		JRST LODEN1	; No, skip retrieval block update
		MOVE C,FORMAT	; To identify old arch. tapes
		MOVEI B,1	; Cont'd on saveset 1,TFN n
		SKIPGE .ARODT(P6)
		JRST [	STOR B,TSN1,(P6) ; Using alternate set
			CAIL C,FMTV4 ; Old archive tape?
			JRST LODEN1 ; No
			SETONE TFN1,(P6) ; Yes, TFN=-1
			JRST LODEN1]
		STOR B,TSN2,(P6) ; Using alternate set
		CAIL C,FMTV4	; Old archive tape?
		JRST LODEN1	; No
		SETONE TFN2,(P6); Yes, TFN=-1
		JRST LODEN1]
	HRROI B,[ASCIZ/$ End of tape, mount next reel /]
	SKIPGE MTTYP		;MTA?
	CALL TMSGQC		;YES, PROMPT FOR NEXT TAPE SPEC
	TXNN F,TF2		;SKIP IF FILE BEING RESTORED
				;IS CONTINUED ON NEXT REEL
	JRST LODEN1
	TMSGC <%File >
	HRROI B,TFNAME		;FILE NAME
	CALL TMSGQ
	TMSG < continued on next reel
>
LODEN1:	SKIPLE MTTYP		;LABELED TAPE?
	JRST LODFI2		;YES, VOLUME-SWITCH IS AUTOMATIC
	SKIPE RETSW		;RETRIEVING
	SKIPN MNTDSG		; FROM MOUNTED TAPE?
	JRST [	CALL UNLOAD	;NO
		CALL MTCLS	;CLOSE MTA
		CALL NTAPER	;GET NEXT VOLUME
		 JRST BMBCMD	;CAN'T
		JRST LODFI1]	;OPEN MTA AND CONTINUE
	TMSGC <Key in the ID of the next retrieval tape in the set>
	CALL GTVOLA		;PROMPT AND GET VOLID
LODEN2:	MOVE A,VOLID6		;GET VOLID
	CALL MREQ		;TRY TO MOUNT IT
	 JRST [	HRROI A,[ASCIZ/Try again? /] ;ERROR
		CALL YESNO
		JUMPN A,LODEN2	;TRY AGAIN
		HRROI P1,[ASCIZ/Tape currently unavailable
/]				;DON'T TRY AGAIN
		CALL RETFAI	;RETRIEVE FAILED FOR THIS FILE
		JRST LOAD21]	;GO CHECK FOR MORE RETRIEVALS
	CALL MTBOT		;RESET RECORD#
	JRST LODFI1		;TAPE MOUNTED, CONTINUE RESTORE

LODENX:	LOAD A,TPNM2,(P6)	; Get desired tape #
	SKIPGE .ARODT(P6)	; Should we use alternate set?
	LOAD A,TPNM1,(P6)	; Yes
	CAME A,VOLID6		; MATCH THE CURRENT VOLUME?
	JRST LOAD21		; No, go ask for the proper one
	TMSG <%End of tape reached and requested file not found
>
	HRROI P1,[ASCIZ /End of tape reached and requested file not found/]
	CALL RETFAI
	JRST LOAD21
;HAVE USER INFO BLOCK

LODUSR:	SKIPE WHEEL		;WHEEL LOADING?
	SKIPE CHECK
	JRST LODFIL		;NO, DON'T CREATE DIRECTORIES
	SKIPE BUFF+.CDNUM	;INFORMATION PRESENT?
	TXNN F,USRDAT		;LOAD DDB REQUESTED?
	JRST LODFIL		;NO, IGNORE
	SKIPG FORMAT		; TENEX tape?
	ERROR (LODFIL,<?ATTEMPT TO CREATE DIRECTORIES FROM A TENEX TAPE>)
	SKIPN B,JF2LST		;HAVE OUTPUT DEFAULT?
	JRST LODUSD		;GET NAME FROM TAPE (OR DSK:)
	HRROI A,DIRNAM
	HRRZS B			;JFN ONLY
	MOVX C,<FLD(.JSAOF,JS%DEV)+JS%PAF>
	JFNS			;GET DEVICE NAME:
LODUSA:	MOVEI B,"<"		;OPEN BRACKET
	IDPB B,A		;STASH
	MOVE B,A		;SETUP OUTPUT PNTR IN B
	MOVE A,[POINT 7,BUFF+UHNAM] ;BEG OF NAME ON TAPE
	MOVE C,FORMAT		;SEE WHICH FORMAT
	CAIGE C,FMTV3		;HAVE FULL DIR SPEC?
	JRST LODUS2		;NO - JUST COPY NAME
LODUS1:	ILDB C,A		;YES - LOCATE DIRECTORY NAME
	CAIE C,"<"
	JRST LODUS1		;LOOP TILL OPEN BRACKET FOUND
LODUS2:	ILDB C,A		;GET CHAR IN NAME
	CAIE C,">"		;LOOK FOR CLOSE BRACKET OR NULL
	JUMPN C,[IDPB C,B	;COPY CHAR IN NOT NULL
		JRST LODUS2]
	MOVEI C,">"		;TERMINATE DIRECTORY NAME
	IDPB C,B
	MOVEI C,0		;ADD NULL TO STRING
	IDPB C,B		;...
	HRROI B,BUFF
	ADDM B,BUFF+.CDPSW	;SET PASSWORD STRING ADDRESS
	SKIPE BUFF+.CDLEN	;CHECK FOR LENGTH
	ADDM B,BUFF+.CDDAC	;SET DEFAULT ACCOUNT ADDRS
	MOVX A,RC%EMO		;CHECK FOR ALREADY EXISTING DIR
	HRROI B,DIRNAM		;...
	RCDIR
	 ERJMP .+3		;ERROR, ASSUME DOESN'T EXIST
	TXNN A,RC%NOM!RC%AMB	;EXISTS?
	HRRM C,BUFF+.CDNUM	;YES - USE EXISTING NUMBER
	MOVE B,CRDWRD		;CRDIR FLAG WORD
LODUST:	SKIPE BUFF+.CDLEN	;OLD FORMAT?
	TXO B,CD%SDQ!CD%DAC!CD%CUG ;NEW BITS
	MOVX A,CD%NSQ		;DO NOT UPDATE SUPERIOR'S QUOTA
	IORM A,BUFF+.CDLEN	; NOR CHANGE THE SUPERIOR DIR'S QUOTA
	HRROI A,DIRNAM		;LOCATION OF DIRECTORY TO CREATE
	CRDIR
	 ERJMP LODUS9		;CHECK LOSAGE
	HRROI B,DIRNAM
	CALL TMSGQ		;TYPE NAME
	TMSG < created
>
	JRST LODFIL

LODUSD:	MOVE C,FORMAT		;SEE IF DEVICE NAME ON TAPE
	CAIGE C,FMTV3		;...
	JRST LODUSF		;USE DSK:
	MOVE A,[POINT 7,DIRNAM]	;INIT POINTER
	MOVE B,[POINT 7,BUFF+UHNAM]
LODUSE:	ILDB C,B		;GET A CHAR
	JUMPE C,LODUSF		;NO DEVICE - USE DSK:
	IDPB C,A		;COPY CHARACTER
	CAIE C,":"		;COLON?
	JRST LODUSE		;NO - GET MORE
	JRST LODUSA		;YES - DONE

LODUSF:	MOVE C,[ASCII "DSK:"]
	MOVEM C,DIRNAM		;V2 OR EARLIER - USE DSK:
	MOVE A,[POINT 7,DIRNAM,27]
	JRST LODUSA		;PROCEED

;HERE ON CRDIR FAILURE - CHECK REASON AND TRY AGAIN IF INCORRECT
;DIRECTORY NUMBER

LODUS9:	SKIPN BUFF+.CDNUM	;HERE BEFORE?
	JRST LODU91		;YES - FAIL NOW
	MOVEI A,.FHSLF		;GET ERROR
	GETER
	HRRZS B			;ERROR ONLY
	CAIE B,CRDIX2		;ILLEGAL NUMBER?
	CAIN B,CRDIX8
	SKIPA B,CRDWRD		;GET CRDIR FLAG WORD
	JRST LODU91		;REAL ERROR
	TXZ B,CD%NUM		;TRY TO NOT SPECIFY NUMBER
	SETZM BUFF+.CDNUM
	HRRZS BUFF+.CDLEN	;RESET HEADER
	JRST LODUST		;TRY AGAIN

LODU91:	TMSG <?Directory >
	HRROI B,DIRNAM
	CALL TMSGQ
	TMSG < not created because,
>
	CALL JSERRM
	JRST LODFIL		;TRY TO CONTINUE

CRDWRD:	777740,,BUFF		;CRDIR FLAGS AND BUFFER ADDRS
LODSBR:	MOVEI A,[CALL CANTLD	;PRINT MESSAGE
		 TMSG <%File skipped
>
		SKIPN RETSW	; Retrieval?
		JRST LODCLZ	; No, normal way out
		CALL REFUSE	;TELL QUASAR TO HOLD ONTO THIS ONE
		CALL NXTRET	; Get the next one
		 SETOM VOLID6
		JRST LODCLZ]	;TRAP ACTION
	CALL SETTRP		;SET TRAP FENCE
	TXNN F,TF2		;IF THIS IS NOT A CONTINUED FILE,
	AOS TOTFIL		; COUNT THIS FILE
	CALL NOFCHK		;CHECK FILE NUMBER
	 TXZ F,TF2		;MISSING FILES-- CAN'T BE CONTINUED
	TXNE F,TF2		;SKIP IF FILE NOT CONTINUED
	JRST [	SKIPGE A,PAGNO	;GET PAGE NO
		CAME A,INIPGN	;SHOULD MATCH
		CALL MISFPG	;MISSING PAGES IN FILE
		MOVE A,INICNT	;GET SAVED PAGE COUNT
		JRST LODSB1 ]
	SKIPGE PAGNO		;CONTINUED FILE-DONT LOAD
	JRST [	SKIPE RETSW	; Retrieval?
		RET		; Yes, skip it quietly
		TMSGC <%Partial file >
		HRROI B,BUFF
		CALL TMSGQ
		TMSG < skipped 
>
		RET]			;GO BACK, SKIP THIS FILE
	HRRZ A,BUFF+FHFDB+.FBBYV ;GET PAGE COUNT FOR FILE

LODSB1:	MOVEM A,CNTR		;KEEP TRACK OF PAGES WRITTEN
	CALL LODTST		;SEE IF THIS FILE SHOULD BE LOADED, GET JFN
	 JRST [	TXNN F,TF2	;NO LOAD, IN MIDDLE OF FILE?
		RET		;NO, RETURN NOW
		SKIPN RETSW	;RETRIEVING?
		CALLRET MISFPG	;NO, TELL USER ABOUT MISSING FILE PAGES
		CALL REQUE	;REQUEUE REQUEST
		ERROR BMBCMD,<?Wrong tape mounted, cannot retrieve continued file
>]
	MOVE A,JFN		;PICK UP JFN
	MOVX B,OF%WR
	TXNE F,TF2		; Continued file?
	TXO B,OF%RD		; Yes, update it
	SKIPE CHECK
	MOVX B,OF%RD+OF%PDT
	OPENF
	 JRST [	SKIPE CHECK	; On CHECK
		CAIE A,OPNX31	;  OFFLINE files are ok
		CAIA
		JRST .+1
		CALL CANTOP
		SKIPN RETSW	;RETRIEVING?
		RET		;NO
		CALL REFUSE	;YES, TELL QUASAR TO HOLD ONTO THIS ONE
		CALL NXTRET	;GET NEXT REQUEST
		 SETOM VOLID6	;NONE
		RET]

;MAIN LOAD LOOP - READ RECORD, MAP PAGE INTO FILE

LODLUP:	SKIPE ABTFLG		; QUASAR say to abort?
	JRST [	MOVE A,JFN	; Abort this file
		TXO A,CZ%ABT
		CLOSF		; Do that
		 JFCL
		SETZM JFN
		RET]		; Done here
	CALL MTRED
	 JRST [	TMSG < in data or trailer of file >
		MOVEI A,.PRIOU
		MOVE B,JFN
		MOVE C,[1B2+1B5+1B8+1B11+1B14+1B21+1B35]
		JFNS
		TMSG <
>
		JRST LODLUP]
	CALL NOFCHK		;CHECK OUT FILE NUMBER
	 JRST LODEOF		;NO GOOD-- GIVE UP ON THIS FILE
	SKIPE TYP		;DATA RECORD?
	JRST LODEFL		;NO
	SOS CNTR		;COUNT DOWN THIS PAGE
	HRLZ B,JFN		;CONSTRUCT IDENT FOR PAGE
	HRR B,PAGNO
	SKIPE CHECK		;CHECKING?
	JRST CHKLUP		;YES
	MOVE A,[.FHSLF,,BUFPAG]	;PUT PAGE INTO FILE
	MOVX C,PM%RD!PM%WR!PM%EX
	PMAP
	JRST LODLUP
;HERE WHEN ENCOUNTERED NON-DATA RECORD, LOOK FOR FILE TRAILER

LODEFL:	MOVNI A,FLTRX
	CAME A,TYP
	JRST LODEOF
	SETZM INIPGN		
	SKIPL A,PAGNO		;SKIP IF FILE NOT COMPLETE
	TXZA F,TF2		;BE SURE BIT OFF
	JRST [	TXO F,TF2	;NOTE FILE IS CONTINUED
		MOVEM A,INIPGN	;REMEMBER PAGE #
		MOVE A,CNTR	;GET CURRENT PAGE COUNTER
		MOVEM A,INICNT	;REMEMBER IT FOR SECOND PART
		JRST .+1]
	SKIPE CHECK		;ONLY CHECKING FILES?
	JRST CHKFDB		;YES, GO DO IT

;LOOP TO TRANSFER FDB INFORMATION FROM TAPE TO FILE

	MOVSI P1,-.FBLN0
FIXFDB:	MOVE A,JFN		;SETUP FDB PROPERLY
	MOVE 3,BUFF(P1)
	SKIPN WHEEL
	SKIPA 2,NWMASK(P1)
	MOVE 2,MASK(P1)
	TXNE F,ICMODF		;INTERCHANGE MODE?
	MOVE B,ICMASK(P1)	;YES, DIFFERENT MASK
	HRL A,P1
	TXO A,CF%NUD		;NO UPDATE DIRECTORY
	TXNE F,ICMODF		; Interchange?
	JRST FIXFD0		; Yes, bypass TENEX stuff
	SKIPG FORMAT		; TENEX format tape?
	CALL @MSK10X(P1)	; Do any necessary conversion
FIXFD0:	SKIPE B
	CHFDB
	 ERJMP [ERRORJ (.+1,<%CHFDB failure>)]
	AOBJN P1,FIXFDB

;MAKE FILE INVISIBLE IF NECESSARY

	HRLI A,.FBCTL
	MOVX B,FB%INV		;GET MASK FOR INVISIBLE BIT
	MOVE C,BUFF+.FBCTL	;GET .FBCTL WORD FROM FDB ON TAPE
	MOVE D,FORMAT
	CAIG D,2		;OLD-FORMAT TAPE?
	JRST [	TLNN C,(1B11)	;YES, OLD INVISIBLE BIT SET?
		TDZA C,C	;NO, RESET FB%INV
		MOVX C,FB%INV	;YES, SET FB%INV
		JRST .+1]
	SKIPE RETSW		;RETRIEVING?
	SETZ C,			;YES, MAKE SURE FILE IS VISIBLE
	CHFDB			;SET FILE VISIBLE
	 ERJMP .+1		;IGNORE ERROR (MIGHT BE ON TOPS-20 V3A)

;SET AUTHOR, WRITER STRINGS

	TXNE F,ICMODF		;SKIP IF NOT INTERCHANGE MODE
	JRST FIXFD1		;DON'T SET AUTHOR OR WRITER
	MOVE A,FORMAT		;GET TAPE FORMAT
	CAIGE A,FMTV3		;SKIP IF FMTV3 OR LATER
	CALL GTUNS		;CONVERT DIRECTORY #'S TO
				;STRINGS FOR OLD TAPES
	MOVE A,JFN		;GET FILE'S JFN
	HRLI A,.SFAUT		;SET AUTHOR IS FUNCTIN
	HRROI B,BUFF+.FBLN0 ;PONT TO NAME
	SFUST
	 ERJMP .+1		;IGNORE ERROR (MAYBE WRONG SYSTEM)
	SKIPN WHEEL		;SET LAST WRITER ONLY IF
				;PRIVELEGED OR OPERATOR
	JRST FIXFD1
	HRLI A,.SFLWR		;SET LAST WRITER IS FUNCTION
	HRROI B,BUFF+.FBLN0+10	;POINT TO NAME
	SFUST
	 ERJMP .+1
FIXFD1:	TXNN F,TF2		;FILE COMPLETELY RESTORED?
	CALL ARCFIX		;YES, PUT ARCHIVE INFO IN FDB
	TXNE F,TF2		;SKIP IF FILE COMPLETE
	JRST LODCLZ		;NOT FINISHED
				;C(P5) := INDEX INTO JFNLST
				;  SETUP IN LODTST
	MOVE A,JFNLST(P5)	;THE SOURCE FILESPEC WHICH MATCHED
	TXNN A,GJ%DEV+GJ%UNT+GJ%DIR+GJ%NAM+GJ%EXT+GJ%VER ;ANY STARS IN IT?
	JRST [	SETZ A,		;NO, THEN DONE WITH IT
		EXCH A,JFNLST(P5)
		RLJFN
		 JFCL
		SOS NJFN1	;NOTE ONE LESS ACTIVE JFN IN LIST
		JRST .+1]
	SKIPN RETSW		; Doing a retrieval?
	JRST FIXFD3		; No, by pass following
	MOVX A,GJ%OLD+GJ%XTN	;GET DESIRED FLAGS
	MOVEM A,RETBLK+.GJGEN	;SET IN GTJFN BLOCK
	MOVEI A,RETBLK		; Point to special blk to restore these
	HRROI B,FILNM(P6)	; Point to file name
	GTJFN			; Get a handle on the file
	 JRST [	CALL BADOFP	;BUILD ERROR MESSAGE
		CALL WASHOU	; Say it failed & why
		CALL NXTRET
		 SETOM VOLID6	;CASE OF NO MORE RET'S
		JRST LODCLZ]
	PUSH P,A		; Save JFN
	MOVE A,JFN		; File pages are currently in
	TXO A,CO%NRJ		; Save JFN
	CLOSF
	 JFCL
	POP P,A
	MOVE C,JFN
	MOVX B,.ARRST		; Want to restore the file please
	ARCF			; Do it
	 ERJMP [MOVX A,.FHSLF
		GETER		; Get the error #
		HRRZS B
		CAIN B,ARCFX9	; File already online?
		JRST [ HRROI P1,[ASCIZ/ File was already online.
/]
			CALL WASHOU ; Delete request & tell user
			CALL NXTRET
			 SETOM VOLID6	;CASE OF NO MORE RET'S
			JRST LODCLZ]
		HRLI B,.FHSLF
		SETZ C,
		HRROI A,TEMPS
		ERSTR
		 JFCL
		 JFCL
		HRROI P1,TEMPS
		CALL RETFAI
		JRST LODCLZ]
	PUSH P,A		; Save JFN
	GTAD
	MOVE C,A		; Make the file look just read
	POP P,A			; Recover JFN
	HRLI A,.FBREF
	SETO B,			; Entire word
	CHFDB
	 ERJMP .+1		; If it fails, no worse than never trying
	HRRZS A
	RLJFN
	 JFCL
	SETZM JFN		;DONE WITH THIS JFN
	CALL RETOK		; Tell the user file is back
	CALL USAINI		; Init USAGE block
	MOVX A,.UTRET		; Is a retrieval
	HRRM A,USABLK		; Insert type
	LOAD A,AR%PSZ,BUFF+.FBBBT ; Get # pages returned online
	MOVEM A,USABLK+10	; Put it in the blk
	LOAD A,AR%RSN,BUFF+.FBBBT
	MOVEM A,USABLK+26	; Put reason it was offline in blk
	MOVEI A,BUFF+.FBLN0+10+10 ; Point to ARCF blk
	CALL USATAP		; Do tape info
	HRROI A,USADIR		; User who requested retrieval
	MOVE B,TPRQUS
	DIRST
	 JRST [	TMSG <?DIRST failed while building USAGE block
>
		JRST .+1]
	MOVEI A,TPACT		; Account for this
	MOVEM A,USABLK+6	; Point to the account
	HRROI A,TAPNAM
	HRROI B,USASTR
	MOVEI C,^D12		; Max # of characters
	MOVEI D,":"		; End on colon
	SOUT			; Get structure file was on
	SETZ C,
	DPB C,B			; End string & get rid of colon
	MOVEI A,USASTR		;GET ASCIZ STRUCTURE NAME
	HLL A,[POINT 7,0]
	MOVEI B,USASSI		;PUT SIXBIT STRUCTURE NAME INTO
	CALL SEVSIX		; USASSI
	MOVX A,.USENT		; Make an entry
	MOVEI B,USABLK
	USAGE
	 ERJMP [ TMSG <%USAGE entry failed in FIXFDB
>
		JRST .+1]
	CALL NXTRET		; Get the next one
	 SETOM VOLID6		; Say no next
FIXFD3:	SKIPE RETSW
	SOS NJFN1		; One more completed
	TXNE F,LFILF		;TYPE FILE NAMES ?
	TXNE F,LTTYF		;AND NOT LOGGINT TO TTY?
	JRST LODCLZ
	TMSG <	[OK]
>
LODCLZ:	SKIPN A,JFN		;JFN STILL ACTIVE?
	RET			;NO
	SKIPLE CNTR		;DID WE FIND ALL THE PAGES?
	TXNE F,TF2		;NO-- BUT IS IT A CONTINUED FILE?
	JRST LODCZ1		;YES, YES-- ALL PAGES OR CONTINUED FILE
	TMSGC <%File >
	MOVEI A,.PRIOU
	MOVE B,JFN		;JFN OF FILE
	SETZ C,
	JFNS			;NAME OF FILE
	TMSG < has page(s) missing
>
LODCZ1:
	CLOSF
	 JRST [	SKIPN CHECK	;CHECK?
		CALL JSERR1	;NO--SHOULD HAVE HAD OPEN FILE
		MOVE A,JFN
		RLJFN		;COULD BE OFF-LINE FILE FOR CHECK
		 CALL JSERR1	;NO, SOMETHING WRONG
		JRST .+1]
	SETZM JFN
	RET

LODEOF:	TXNE F,ICMODF		;SKIP IF NOT INTERCHANGE MODE
	JRST LODEO1
	TMSG <
%File trailer missing for file >
	HRROI P1,[ASCIZ/ File trailer missing for file
/]
	MOVEI A,.PRIOU
	MOVE B,JFN		;JFN OF FILE
	SETZ C,
	SKIPN RETSW		; Doing a retrieval?
	JFNS			;NAME OF FILE
	SKIPE RETSW
	CALL PRRTFL		; If a retrieve, print ret blk name
	TMSG <
>
	SKIPE RETSW
	CALL RETFAI		; This one failed
LODEO1:	CALL LODCLZ		;CLOSE FILE
	RETSKP			;SKIP RETURN TO INDICATE TRAILER MISSED

; Routines for TENEX FDB conversion

TIM10X:	PUSH P,C
	PUSH P,D
	HRRZS C			; Need to convert time
	MULI C,-1
	DIVI C,^D60*^D60*^D24
	HRRM C,-1(P)		; Save with old date
	POP P,D
	POP P,C
	RET

CLRMSK:	SETZB B,C		; Clear the mask word
	RET

ARCFIX:	SKIPE LODARC		;SUPPRESS ARCHIVE INFO, OR
	SKIPE RETSW		; Doing a retrieval?
	RET			; Yes, don't do this stuff then
	MOVE A,JFN		; Must close file for FLUSH to work
	TXO A,CO%NRJ		; But need the JFN
	CLOSF
	 CALL JSERR1		; Should work ok
	MOVE B,FORMAT		; What style tape is this?
	CAIGE B,FMTV4		; Greater than release 3?
	JRST OLDAFX		; No, fixup from old style
	SKIPN WHEEL		;PRIVILEGED?
	JRST ARCFI2		;NO, CAN'T DO ARCF STUFF SO DON'T TRY
	HLLZ D,BUFF+.FBBBT	; Get archive bits
	TXZ D,AR%1ST		; This has been done already
	JUMPE D,ARCFI1		; None set, skip this part
	HRRZ A,JFN		; JFN for this file
	MOVX B,.ARRAR		; Request for archive
	MOVX C,.ARSET		; Set it
	TXNE D,AR%NDL		; No flush please?
	TXO C,AR%NDL		; Yes, flag that
	TXNE D,AR%RAR		; Was it requested?
	ARCF			; Yes, reset that
	 ERCAL ARCFF
	MOVX B,.ARRIV
	MOVX C,.ARSET
	TXNE D,AR%RIV		; Involuntary request?
	ARCF			; Yes
	 ERCAL ARCFF
	MOVX B,.ARNAR
	MOVX C,.ARSET
	TXNE D,AR%NAR		; Resist archive?
	ARCF			; Yes,
	 ERCAL ARCFF
	MOVX B,.AREXM
	TXNE D,AR%EXM		; Exempt from archiving?
	ARCF			; Yes, set that
	 ERCAL ARCFF
ARCFI1:	MOVE A,[BUFF+.FBLN0+20,,ARSSTB]
	BLT A,ARSSTB+.ARPSZ	; Copy tape info
	SETZ B,			; No flags yet
	SKIPE ARSSTB+.ARTP1	; 1st tape exist?
	TXO B,AR%O1		; Yes, set that
	SKIPE ARSSTB+.ARTP2	; 2nd tape exist?
	TXO B,AR%O2		; 2nd exists
	JUMPE B,ARCFI2		; Neither tape there, skip this
	MOVE C,BUFF+.FBCTL
	TXNE C,FB%OFF		; Was it offline?
	TXO B,AR%OFL		; Yes, do that too
	TXNE C,FB%ARC		; Was it archived?
	TXO B,AR%ARC		; Yes, do that too
	MOVEM B,ARSSTB+.AROFL	; Put bits into block
	HRRZ A,JFN
	MOVX B,.ARSST		; Set the status
	MOVEI C,ARSSTB
	ARCF			; Set it
	 ERCAL ARCFF
ARCFI2:	MOVE A,JFN
	RLJFN			; Done with it & CLOSF in LODCLZ will lose
	 JFCL
	SETZM JFN		; No longer valid
	RET			; Done here

ARCFF:	TMSGC <%ARCF failure, >
	CALLRET JSERRM

;CONVERT DIRECTORY NUMBER TO STRING FOR OLD TAPES

GTUNS:	HLRZ B,BUFF+.FBUSE	;LAST WRITER FIELD OF OLD .FBUSE
				;WORD OF FDB
	HRLI B,USRLH		;SAY IT IS A USER #
	HRROI A,BUFF+.FBLN0+10	;STORE IN LAST WRITER FIELD
	SETZM 0(A)		;IN CASE FAILURE - USE NULL
	DIRST
	 ERJMP .+1
	HRRZ B,BUFF+.FBUSE	;AUTHOR FIELD OF OLD .FBUSE 
				;WORD OF FDB
	HRLI B,USRLH		;SAY IT IS A USER NUMBER
	HRROI A,BUFF+.FBLN0	;STORE IN AUTHOR FIELD
	SETZM 0(A)		;USE NULL IF FAILURE
	DIRST
	 ERJMP .+1
	RET


; NOFCHK -- CHECK FILE NUMBER FOR PROPER SEQUENCE

NOFCHK:	HLLZ A,PAGNO		;GET PAGE NUMBER/FILE NUMBER WORD
	TXCE A,PGNCFL!PGNNFL	;OLD FORMAT TAPE (WITH JFN IN LH!)?
	TXZN A,PGNCFL!PGNNFL	; OR WITH -1 IN LH?
	RETSKP			;OLD TAPE-- MUST ASSUME OK
	SKIPGE TOTFIL		;FIRST TIME HERE?
	JRST [	HLRZM A,TOTFIL	;YES, INITIALIZE FILE COUNTER
		MOVEI A,1	;GET NUMBER FOR FIRST FILE AND TAPE
		CAMN A,RTAPNO	;IF NOT THE FIRST TAPE IN SEQUENCE
		CAMN A,TOTFIL	;OR IF THIS IS REALLY THE FIRST FILE
		RETSKP		;THEN EVERYTHING IS FINE
		JRST NOFCHE]	;OTHERWISE FILES REALLY MISSING
	HRLZ B,TOTFIL		;GET FILE COUNT TO LH
	TXZ B,PGNCFL!PGNNFL	;CLEAR FLAG BIT PART
	CAMN A,B		;FILE COUNT MATCH TAPE FILE NUMBER?
	RETSKP			;YES-- ALL OK
	HLRZM A,TOTFIL		;NO-- ADJUST COUNTER
NOFCHE:	TMSGC <%Tape has file(s) missing
>
	RET			;RETURN +1 FROM NOFCHK TO INDICATE FILE
				; SEQUENCING ERROR
; Here to do archive info if old style archive tape (only BBN should
; have this kind of tape)

OLDAFX:	SKIPN WHEEL		;ENABLED?
	JRST ARCFI2		;NO, SKIP ARCF'S
	HLLZ D,BUFF+.BBNBT	; Get bits etc, were in BK0
	TXZ D,1B0		; Partially dumped flag already done
	JUMPE D,OLDAF1		; No bits to handle
	TXZE D,1B6		; Old AR%1ST
	JRST [	HRLI A,.FBBBT	; Must set it
		MOVX B,AR%1ST
		MOVE C,B
		CHFDB
		 ERJMP [ERRORJ (.+1,<%CHFDB failure in OLDAFX>)]
		JRST .+1]
	HRRZ A,JFN
	MOVX B,.ARRAR		; Put in the request
	MOVX C,.ARSET
	TXNE D,1B3		; Old AR%NDL (was AR%NFH)
	TXO C,AR%NDL		; Was on, restore it
	TXNE D,1B1		; Old AR%RAR bit
	ARCF			; Set it
	 ERJMP [ERRORJ (.+1,<%ARCF failure in OLDAFX>)]
	MOVX B,.ARRIV		; Migration request?
	MOVX C,.ARSET
	TXNE D,1B2		; Old AR%RIV
	ARCF			; Do it if necessary
	 ERJMP [ERRORJ (.+1,<%ARCF failure in OLDAFX>)]
	MOVX B,.ARNAR		; Do resist
	MOVX C,.ARSET
	TXNE D,1B4		; Old AR%NAR
	ARCF			; Set if necessary
	 ERJMP [ERRORJ (.+1,<%ARCF failure in OLDAFX>)]
	MOVX B,.AREXM		; File exempt
	TXNE D,1B5		; Old AR%EXM
	ARCF
	 ERJMP [ERRORJ (.+1,<%ARCF failure in OLDAFX>)]

; Now convert tape info to correct form for new style ARCF

OLDAF1:	MOVEI C,ARSSTB		; Where the data will be
	MOVX A,AR%O1+AR%O2+AR%ARC ; Do both tapes & will be archived
	MOVEM A,.AROFL(C)	; Into flags word
	SKIPN A,BUFF+.BBNTP	; Get old tape #'s
	JRST ARCFI2		; No tape #'s to do
	HLRZM A,.ARTP1(C)	; Tape 1 ID
	HRRZM A,.ARTP2(C)	; Tape 2 ID
	MOVE A,BUFF+.BBNTS	; Get Save Set Numbers
	HLLM A,.ARSF1(C)	; Save set # 1
	HRLM A,.ARSF2(C)	; Save set # 2
	MOVE A,BUFF+.BBNTF	; (old .FBBK3) Get TFN's
	HLRM A,.ARSF1(C)	; Tape file # 1
	HRRM A,.ARSF2(C)
	MOVE A,BUFF+.FBNET	; (old .FBBK4) Get tape date & time
	MOVEM A,.ARODT(C)
	MOVX A,AR%OFL
	MOVE B,BUFF+.FBCTL
	TXNE B,1B12		; Old FB%OFF
	IORM A,.AROFL(C)	; Should be flushed too
	HRRZ A,JFN
	MOVX B,.ARSST		; Set archive status
	ARCF
	 ERJMP [TMSG <%ARCF failed to set tape information in OLDAFX
>
		JRST ARCFI2]
	JRST ARCFI2		; Done here
;TEST NEXT FILE ON TAPE FOR INCLUSION IN CURRENT LOAD SPEC
; RETURN +1: DON'T LOAD
; RETURN +2: LOAD

LODTST:	SKIPG FORMAT		;NEW FORMAT VERSION PUNCTUATION?
	CALL FIXFMM		;NO, FIXUP FIRST
	SKIPE CHECK		;check?
	JRST [	HRROI A,ONMBUF	;YES-- COPY FILE NAME
		HRROI B,BUFF	; FROM TAPE BUFFER
		SETZ C,
		SOUT
		MOVX A,GJ%OLD+GJ%XTN	;GET FLAGS
		MOVEM A,RETBLK+.GJGEN	;SET IN GTJFN BLOCK
		MOVEI A,RETBLK	;POINT AT USEFUL EXTENDED BLOCK
		HRROI B,ONMBUF	;LOOKUP EXACTLY AS ON TAPE
		GTJFN
		 JRST CANNOT
		MOVEM A,JFN
		HRROI A,TFNAME	;GET READY
		MOVE B,JFN	;TO COPY FILE SPEC
		SETZ C,		;SO CAN TYPE IT OUT
		JFNS		;IN CASE OF ERRORS
		CALL FILSZE	;COMPUTE FILE SIZE
		JRST LODCHK]
	SKIPE RETSW		;RETRIEVING?
	JRST LODRET		;YES, SPECIAL HANDLING
	HRROI B,BUFF
	CALL TSTNAM		; See name matches specs given
	 JRST [	MOVEM A,JFN	; Save it for
		JRST LODTNO]	;  fail path
	MOVEM A,JFN		;TSTNAM RETURNS JFN IN A

;MATCHED ALL FIELDS, THIS FILENAME OK TO LOAD.  NOW CHECK DATES

	MOVE A,BUFF+FHFDB+.FBCRE ;GET MODIFIED DATE
	CAMG A,MBTAD		;NOT 'BEFORE'?
	CAMGE A,MSTAD		;NOT 'AFTER'?
	JRST LODTNO
	MOVE A,BUFF+FHFDB+.FBWRT ;GET WRITE TAD
	CAMG A,WBTAD		;NOT 'BEFORE'?
	CAMGE A,WSTAD		;NOT 'SINCE'
	JRST LODTNO		;YES, FAIL
	CAMGE A,BUFF+FHFDB+.FBREF ;GET MOST RECENT OF WRITE, READ
	MOVE A,BUFF+FHFDB+.FBREF
	CAMG A,ABTAD		;NOT 'BEFORE'
	CAMGE A,ASTAD		;NOT 'SINCE'
	JRST LODTNO		;YES, FAIL

;NOW COOK UP APPROPRIATE OUTPUT NAME
; P5/ INDEX TO JFNLST AND JF2LST TABLES

	CALL GOFNAM		;GET OUTPUT NAME INTO ONMBUF
	TXNN F,TF2		;CONTINUED FILE?
	JRST LODNM6		;NO-- ALL OK
	PUSH P,A		;SAVE CURRENT POINTER
	MOVE A,OGNPTR		;YES-- GET GENERATION POINTER
	ILDB B,A		;GET START OF GENERATION
	CAIE B,"."		;SPECIFIED?
	JRST LODNM5		;NO-- SKIP CHECK FOR NEXT HIGHEST VERSION
	MOVEI C,^D10		;YES, GET IT
	NIN			;IN DECIMAL
	 JRST LODNM5		;NO SUCH LUCK
	AOJN B,LODNM5		;IF NOT -1, DON'T CHANGE IT
	MOVE A,OGNPTR		;GEN IS -1 (NEXT HIGHEST):  MUST USE HIGHEST SO
	MOVEM A,(P)		; DON'T SPECIFY GEN, GTJFN WILL GET HIGHEST
	IDPB B,A		;MARK END OF FILENAME WITHOUT GENERATION
LODNM5:	POP P,A			;RESTORE POINTER TO FILE STRING
LODNM6:	CALL GOFPAT		;GET PROTECTION, ACCOUNT, ;T
	; ..
	
	; ..
LODNM7:	HRROI A,TFNAME	;TAPE FILE NAME BUFFER
	MOVE B,JFN		
	SETZ C,
	JFNS			;STORE FILE NAME FOR LATER
	MOVE A,JFN		;DONE WITH LOCAL JFN ON  NAME FROM TAPE
	RLJFN
	 JFCL

;CHECK SUPERSEDE RULE

	TXNE F,SSA!TF2		;SUPERCEDE ALWAYS OR MIDDLE OF FILE?
	JRST LODNM3		;YES, NO CHECK
LODNM8:	ILDB D,OGNPTR		;GET FIRST BYTE OF GENERATION
	SETZ A,			;STORE A NULL
	DPB A,OGNPTR		; SO WE LOOKUP HIGHEST EXISTING GENERATION
	MOVX A,GJ%OLD+GJ%XTN	;GET DESIRED FLAGS
	MOVEM A,RETBLK+.GJGEN	;AND SET IN GTJFN BLOCK
	MOVEI A,RETBLK		;POINT AT BLOCK WITH G1%IIN FLAG SET
	HRROI B,ONMBUF		; . .
	GTJFN			;GET MOST RECENT VERSION
	 JRST [	DPB D,OGNPTR		;ISN'T ONE, RESTORE BYTE OF GENERATION
		JRST LODNM3]		; AND GO LOAD FILE
	DPB D,OGNPTR		;RESTORE THE BYTE WE BIT
	MOVEM A,JFN
	TXNE F,SSN		;SUPERSEDE NEVER?
	JRST LODTNO
	MOVSI B,.FBLN0
	MOVEI C,FDB
	GTFDB			;GET FDB OF EXISTING FILE
	 ERJMP [CALL JSERR1	;SCREWUP...
		JRST .+1]
	MOVE B,FDB+.FBWRT	;GET WRITE DATE OF EXISTING FILE
	CAML B,BUFF+FHFDB+.FBWRT ;WHICH FILE IS NEWER?
	JRST LODTNO		;DISK FILE IS NEWER, DON'T LOAD FROM TAPE
	LOAD B,FB%GEN,BUFF+FHFDB+.FBGEN ;GET GEN NUMBER OF TAPE FILE
	LOAD C,FB%GEN,FDB+.FBGEN ;GET GEN NUMBER OF EXISTING DISK FILE
	CAML B,C		;NEWER (TAPE) FILE HAS HIGHER GEN NO?
	JRST LODNM9		;YES, OK
	TMSG <%File >		;No, must delete disk file to prevent
	MOVEI A,.PRIOU		; GENERATION MIS-ORDERING
	MOVE B,JFN
	MOVX C,1B2+1B5+1B8+1B11+1B14+1B35
	JFNS			;TYPE WARNING MESSAGE
	TMSG < deleted while superseding
>
	MOVE A,JFN
	DELF			;DELETE (NO EXPUNGE) DISK FILE
	 CALL JSERR1
	JRST LODNM8		;SEE IF OTHER DISK FILES NEED DELETING
LODNM9:	MOVE A,JFN		;NOW DONE WITH LOCAL JFN
	RLJFN
	 JFCL

;NOW GET JFN FOR ACTUAL DISK FILE TO BE WRITTEN

LODNM3:	MOVX A,GJ%XTN		;SET TO GET JFN FOR FILE TO BE WRITTEN
	TXNN F,TF2		;CONTINUED FILE?
	TXO A,GJ%FOU		;NO-- USE NEXT HIGHEST GEN IF 0 SUPPLIED
	MOVEM A,RETBLK+.GJGEN	;SET IN BLOCK
	MOVEI A,RETBLK
	HRROI B,ONMBUF		;POINT TO FILENAME STRING
LODN31:	GTJFN
	 SKIPA			;ERROR-- CHECK IT OUT
	JRST LODN39		;GOT IT-- GO ON

;ERROR FROM GTJFN-- SEE IF BECAUSE OF INVALID ACCOUNT

	CAIE A,VACCX0		;FAILED-- INVALID ACCT?
	JRST CANNOT		;NO-- GIVE UP
	MOVE D,OACPTR		;YES-- GET POINTER TO ACCT
	ILDB A,D		;GET FIRST CHARACTER OF ACCT
	CAIE A,";"		;IS ACCT SPECIFIED?
	JRST CANNOT		;NO-- GIVE UP
	TMSG <%Invalid account for file >
	HRROI B,ONMBUF		;POINT TO FILE SPEC
	CALL TMSGQ		;TYPE FILE SPEC
	TMSG <, system default used
>
	SETZ A,			;USE
	DPB A,D			; SYSTEM DEFAULT
	JRST LODNM3		; AND TRY AGAIN

LODN39:	MOVEM A,JFN

;SEE IF THIS FILE GOING TO DIFFERENT DIRECTORY THAN LAST FILE

LODNMA:	SKIPE RETSW		; Doing retrievals?
	JRST LODNM4		; Yes, forget this message
	HRROI A,DIRNAM
	MOVE B,JFN
	MOVX C,<FLD(.JSAOF,JS%DEV)+FLD(.JSAOF,JS%DIR)+JS%PAF>
	JFNS
	HRROI A,DIRNAM
	HRROI B,LSTDIR
	STCMP			;CHECK DIR NAME STRINGS
	JXE A,SC%LSS+SC%SUB+SC%GTR,LODNM4
	HRROI B,DIRNAM		;STRINGS DIFFERENT, SET NEW CURRENT DIR
	HRROI A,LSTDIR
	SETZ C,
	SOUT
	TMSG <Loading file(s) into >
	MOVEI A,.PRIOU
	MOVE B,JFN
	MOVX C,<FLD(.JSAOF,JS%DEV)+FLD(.JSAOF,JS%DIR)+JS%PAF>
	JFNS			;TYPE NEW DIRECTORY
	TMSG <
>
;type file name if requested

LODNM4:	TXNN F,LFILF		;TYPE FILE NAMES?
	JRST LODNMX		;NO
	HRROI B,BUFF		;YES, SOURCE
	CALL TMSGQ
	TMSG < (TO) >
	SKIPE RETSW
	JRST [ HRROI B,FILNM(P6)
		SETZB C,D
		SOUT
		JRST LODNMX]
	MOVE B,JFN
	MOVEI A,.PRIOU
	MOVX C,2B2+2B5+1B8+1B11+1B14+1B35
	JFNS			;DESTINATION
	JRST LODNMX
; SPECIAL LODTST CODE FOR RETRIEVALS

LODRET:	LOAD A,TPNM2,(P6)
	SKIPGE .ARODT(P6)
	LOAD A,TPNM1,(P6)	; Use alternate tape
	CALL NSVOL		;CONVERT TO SIXBIT
	CAME A,VOLID6		;DOES VOLID MATCH CURRENT TAPE?
	TXNE F,TF2		;MISMATCH OK IF CONTINUED FILE
	CAIA
	RET			; No, skip it
	LOAD A,TSN2,(P6)
	SKIPGE .ARODT(P6)
	LOAD A,TSN1,(P6)
	MOVEI C,XBUFF
	LOAD B,SSNO,(C)		; Get saveset # from tape
	CAIE A,0(B)		; Savesets match?
	RET			; No, skip it
	LOAD A,TFN2,(P6)
	SKIPGE .ARODT(P6)
	LOAD A,TFN1,(P6)	; Use alternate
	HLRZ B,PAGNO
	TXZ B,(1B0+1B1)		; Clear info bits
	CAIE A,0(B)		; Tape file #'s match?
	RET			; No, skip file
	HRROI A,TEMPS		; Place to build a string
	HRROI B,FILNM(P6)	; Point to file name we want
	MOVEI C,6+1+1+^D39+1	; Maximum device size
	MOVEI D,">"		; Stop at the directory field
	SOUT
	HRROI B,[ASCIZ/RETRIEVE.TEMP-FILE;T/]
	SETZB C,D
	SOUT
	TXNN F,TF2		; Continued file?
	JRST LODRE1		; No, just make the temp file
	MOVX A,GJ%OLD+GJ%SHT
	HRROI B,TEMPS
	GTJFN			; Exist?
	 JRST LODRE1		; No, just create it
	MOVEM A,JFN		; Save the JFN
	JRST LODNMA

LODRE1:	MOVX A,GJ%FOU+GJ%SHT
	HRROI B,TEMPS
	JRST LODN31

LODCHK:	TXNN F,LFILF		;SKIP IF WANT FILE NAMES
	JRST LODNMX		;NOPE
	HRROI  B,BUFF		;SOURCE
	CALL TMSGQ		;TYPE NAME
	TMSG <
>
LODNMX:	MOVE A,JFN		;RETURN THE OUT JFN
	RETSKP			;PASSES ALL TESTS, LOAD IT

;RETURN NO-LOAD AND RELEASE LOCAL JFN

LODTNO:	MOVE A,JFN
	RLJFN
	 JFCL
	RET
;ROUTINE TO CHANGE ";" TO "."

FIXFMM:	PUSH P,A		;SAVE REGS
	PUSH P,B		;""
	PUSH P,C
	PUSH P,D
	PUSH P,D+1
	TXZ F,FST%PN		; Clear first seen flag
	MOVE A,[POINT 7,BUFF]	;WHERE THE NAME IS
	MOVE B,[POINT 7,TEMPS]	; Where to build temp
FIXF1:	ILDB C,A		;GET BYTE
	JUMPE C,FIXF2		;JUMP IF END
	CAIN C,"V"-100		;QUOTE?
	JRST [			; Quoted, force into line
		IDPB C,B
		ILDB C,A
		IDPB C,B
		JRST FIXF1]	; Loop for more
	IDIVI C,^D36		; Find which word&bit to check
	MOVSI D+1,(1B0)
	MOVNS D
	ROT D+1,0(D)		; Put in correct position
	TDNN D+1,QUTBIT(C)	; Special character?
	JRST FIXNO		; No, just copy it
	MOVEI C,"V"-100
	IDPB C,B
	LDB C,A
	IDPB C,B		; And special character
	JRST FIXF1
FIXNO:	LDB C,A			; Retrieve character
	CAIN C,";"
	TXOE F,FST%PN	; Set ";" seen flag, skip if done once
	CAIA
	MOVEI C,"."		; Replace first with "."
	IDPB C,B
	JRST FIXF1
FIXF2:	SETZ C,
	IDPB C,B		; End new string
	MOVE A,[POINT 7,BUFF]
	MOVE B,[POINT 7,TEMPS]
FIXF21:	ILDB C,B
	IDPB C,A
	JUMPN C,FIXF21
	POP P,D+1
	POP P,D
	POP P,C
	POP P,B
	POP P,A
	RET

; Special character table; if bit is on, character needs to be quoted for
; use on TOPS20

QUTBIT:	EXP 377777777777	; ^@ to #
	EXP 777100022600	; $ to G
	EXP 000000377777	; H to k
	EXP 777777600000	; l to rubout
CHKLUP:	MOVE A,B
	MOVE B,[XWD 400000,BF2PAG]
	MOVSI 3,100000
	PMAP
	TXNN F,ICMODF		;SKIP IF INTER CHANGE FORMAT
	JRST CHKLP1		;CHECK EVERYTHING
	SOSGE FPGCNT		;DECREMENT PAGE COUNT
	JRST CHKLP2		;DONE WITH ALL FULL PAGES
CHKLP1:	MOVSI P1,-1000
CMPLUP:	MOVE A,BUFF(P1)
	SKIPA B,BUFF2(P1)	;GET FILE WORD
	ERJMP CMPERR		;IF PAGE NONEXISTANT, COMPARE ERROR
	CAME A,B
	JRST CMPERR
	AOBJN P1,CMPLUP
CMPLP2:	JRST LODLUP

CMPERR:	TMSG <%Compare error>
CMPER1:	TMSG <, page >
	HRRZ B,PAGNO
	MOVEI C,12
	CALL TTNOUT
	TMSG <, file >
	MOVE B,JFN
	MOVEI C,0
	JFNS
	TMSG <
>
	JRST LODLUP

CHKLP2:	SKIPN P1,RMRPGE		;SKIP IF PARTIAL PAGE
	JRST CMPLP2		;ALL DONE
	MOVNS P1		;SET UP FOR AOBJN LOOP
	HRLZS P1
	SETZM RMRPGE		;DONT TRY AGAIN
	JRST CMPLUP		;CHECK PARTIAL PAGE
CHKFDB:	MOVNI A,1
	MOVE B,[.FHSLF,,BF2PAG]
	SETZ C,
	PMAP
	TXNE F,TF2		;CONTINUED FILE?
	JRST LODCLZ		;YES, ONLY CHECK AUTHORS WHEN ALL DONE
	MOVE A,JFN
	MOVE B,[XWD 25,0]
	MOVEI 3,BUFF2
	GTFDB
	MOVSI P1,-25
CHKFDL:	MOVE A,BUFF(P1)
	XOR A,BUFF2(P1)		;COMPARE WORDS
	AND A,CKMASK(P1)	;BUT CHECK ONLY CERTAIN BITS
	TXNE F,ICMODF		;INTERCHANGE MODE?
	AND A,ICMASK(P1)		;YES, FEWER BITS PERTINENT
	JUMPN A,FDBERR		;JUMP IF COMPARED BITS DIFFERENT
CHKFD0:	AOBJN P1,CHKFDL
	MOVE A,FORMAT		;GET CURRENT FORMAT
	CAIL A,FMTV3		;SKIP IF OLD TAPE
	TXNE F,ICMODF		;SKIP IF NOT INTERCHANGE FORMAT
	JRST LODCLZ		;DON'T CHECK AUTHER &LAST WRITER
	HRR A,JFN		;JFN OF FILE
	HRLI A,.GFAUT		;FUNTCION IS GET AUTHOR
	HRROI B,FBUF1		;STORE STRING HERE
	GFUST
	 ERJMP [SETZM FBUF1
		JRST .+1]
	HRROI A,FBUF1	;AUTHOR
	HRROI B,BUFF+.FBLN0	;COMPARE TO TAPE
	STCMP
	SKIPE A			;SKIP IF STRINGS ARE SAME
	CALL [	TMSG <%File author differs for file >
		MOVE B,JFN
		MOVEI A,101
		MOVEI C,0
		JFNS
		TMSG <
>
		RET ]
	HRR A,JFN
	HRLI A,.GFLWR		;GET LAST WRITER
	HRROI B,FBUF1
	GFUST
	 ERJMP [SETZM FBUF1
		JRST .+1]
	HRROI A,FBUF1		;LAST WRITER
	HRROI B,BUFF+.FBLN0+10		;CHECK AGAINST TAPE
	STCMP
	SKIPE A			;SKIP IF SAME
	CALL [	TMSG <%File last-writer differs for file >
		MOVE B,JFN
		MOVEI A,101
		MOVEI C,0
		JFNS
		TMSG <
>
		RET ]
	JRST LODCLZ

FDBERR:	TMSG <%Difference in >
	MOVE B,FDBNAM(P1)
	MOVEI A,0
	ROTC A,6
	JUMPE A,FDBER9
	ADDI A,40
	PBOUT
	JRST .-5

FDBER9:	TMSG < of file >
	MOVE B,JFN
	MOVEI 1,101
	MOVEI C,0
	JFNS
	TMSG <
>
	JRST CHKFD0
;FAILED TO GTJFN FOR FILE TO BE LOADED

CANNOT:	TMSGC <%Cannot get JFN for file >
	JRST CANT1

CANTOP:	MOVE A,JFN
	RLJFN
	 JFCL
	TMSGC <%Cannot open file >
	JRST CANT1

CANTLD:	TMSGC <%Cannot load file >

CANT1:	HRROI B,ONMBUF		;FILESPEC STRING
	SKIPE RETSW		; %%% Repair when QUASAR interface ready
	HRROI B,TAPNAM
	CALL TMSGQ
	TMSG < because:
  >
	CALL JSERRM
	RET

PRRTFL:	HRROI B,FILNM(P6)	; Point into retrieve blk
	SETZB C,D		; %%% Repair
	SOUT
	RET
;TYPE HEADER INFORMATION

TYHEDR:	MOVEI A,.PRIOU
	CALL PRHEDR		;HEADER TO PRIMARY OUT
	TMSG <
>
	MOVE B,FORMAT
	CAIN B,CURFMT		;CURRENT FORMAT?
	JRST TYH1		;YES
	TMSG <%Tape is format version >
	MOVE B,FORMAT
	MOVEI C,^D10
	CALL TTNOUT
	TMSG <, not current
>
TYH1:	RET

;CONSTRUCT HEADER INFORMATION
; A/ OUT DESIGNATOR

PRHEDR:	STKVAR <OUTD>
	MOVEM A,OUTD		;SAVE DESIGNATOR
	SKIPL MTTYP		;MT DEVICE?
	CALL GTVOL		;YES, GET VOLID IN VOLID6
	MOVE A,OUTD		;RESTORE DESIGNATOR
	HRROI B,[ASCIZ /
DUMPER tape/]
	SETZ C,
	SOUT
	MOVEI B,XBUFF		;VIRTUAL DISK TAPE?
	JE SSCOD,(B),[HRROI B,[ASCIZ/ # /] ;NO, DISPLAY TAPE  #
		SOUT
		HRRZ B,TAPNO
		MOVEI C,^D10
		NOUT			;PUT TAPE # IN MESSAGE
		 JFCL
		SETZ C,
		JRST .+1]
	SKIPE VOLID6		;KNOW VOLID?
	JRST [	HRROI B,[ASCIZ/  Volid /] ;YES
		SOUT
		HRROI B,VOLID	;DISPLAY VOLID
		SOUT
		JRST .+1]
	HRROI B,[ASCIZ /, /]
	SOUT
	MOVEM A,OUTD		;SAVE OUT DESIG
	CALL SETHDR		;CHECK FORMAT TYPE AND GET TEXT ADR
	HRROI B,BUFF(A)
	MOVE A,OUTD
	SOUT			;INCLUDE SAVE SET NAME
	SKIPN FORMAT		;BBN FORMAT?
	RET			;YES, NO MORE INFORMATION
	HRRZ B,BUFF+BFMSGP	;NO, GET MSG OFFSET
	CAIG B,BFTAD		;BEYOND TAD WORD?
	RET			;NO, THEREFORE NO TAD WORD
	HRROI B,[ASCIZ /, /]
	SOUT
	MOVE B,BUFF+BFTAD	;GET BEGINNING TAD
	MOVX C,3B2+1B10+1B12
	ODTIM			;PUT IT IN MESSAGE
	RET

;ROUTINE TO LOOK AT TAPE HEADER AND DETERMINE FORMAT TYPE
;RETURN +1 ALWAYS, A/ OFFSET ADR TO TITLE STRING

SETHDR:	MOVE B,BUFF		;GET FIRST WORD OF BUFFER
	SETZ A,			;ASSUME OLD FORMAT
	SETZM FORMAT		;""
	TLNE B,(177B6)		;IS IT ASCII?
	RET			;YES
	MOVEM B,FORMAT		;SAVE DATA FORMAT
	MOVE A,BUFF+BFMSGP	;GET OFFSET FOR THE TITLE
	RET			;RETURN
	SUBTTL MAGTAPE BUFFERED IO ROUTINES

; MTOPNR - OPEN MAGTAPE FOR READING OR SKIPPING RECORDS
; MTOPNW - OPEN MAGTAPE FOR WRITING RECORDS
; MTOPNX - OPEN MAGTAPE FOR REWIND OR STATUS-GATHERING OPERATION
; RETURNS +1: ALWAYS

MTOPNX:	MOVEI A,OF%RD		;OPEN FOR READ
	JRST MTOP0		;DON'T HAVE TO SET DATA MODE
MTOPNR:	SKIPA A,[OF%RD]		;OPEN FOR READ ACCESS
MTOPNW:	MOVEI A,OF%WR		;OPEN FOR WRITE ACCESS
	TLO A,(1B0)		;INDICATE NEED TO SET DATA MODE
MTOP0:	MOVEM A,TMODE		;SAVE MODE REQUEST
MTOP1:	SKIPE A,MTJFN		;HAVE JFN?
	JRST [	GTSTS		;YES
		TXNE B,GS%OPN	;IS IT OPEN?
		CALL MTCLS	;YES, CLOSE AND DISCARD
		JRST .+1]
	SKIPE A,MTJFN		;SKIP IF NO JFN ASSIGNED
	CALL RLSJFN		;RELEASE JFN
	MOVE A,MTDSG		;GET LAST MTA DESIGNATOR
	JUMPE A,MTOP4		;NO TAPE COMMAND GIVEN SO FAR
	MOUNT
	 ERROR MTOFAI,<?FAILED TO MOUNT MTA, >
	HRROI B,MTDEV
	MOVX A,GJ%SHT
	GTJFN
	 ERROR MTOFAI,<?FAILED TO FIND MAGTAPE, >
	MOVEM A,MTJFN		;SAVE JFN
	MOVX B,<FLD 17,OF%MOD>	;REQUEST DUMP MODE
	HRR B,TMODE		;READ/WRITE AS SPECIFIED BY CALLER
IFN DSKDMP, <MOVX B,OF%RD+OF%WR>  ;ALLOW UPDATE
	OPENF
	 ERROR MTOFAI,<?FAILED TO OPEN MAGTAPE, > ;NO
IFN DSKDMP, <MOVE B,SEQ	;# RECORDS DOWN "TAPE"
		IMULI B,NHEAD+PGSIZ ;RECORD SIZE
		SFPTR		;SET PTR BACK THERE
		CALL JSERRM>
	SKIPLE MTTYP		;LABELED TAPE?
	JRST [	MOVEI B,.MOPST	;YES
		MOVEI C,VSCHN
		MTOPR		;SET UP TO GET VOLUME-SWITCH INTERRUPTS
		 ERCAL R	;IGNORE FAILURE
		MOVEI B,.MOSDS
		MOVE C,TMODE
		TXNE C,OF%WR	;OPEN FOR WRITE?
		MTOPR		;YES, SET DEFERRED VOLUME-SWITCH
		 ERCAL R	;IGNORE FAILURE
		JRST .+1]
	SKIPG MTTYP		;UNLABELED?
	JRST [	MOVEI B,.MOSDN	;YES, SET DENSITY PER REQUEST
		MOVE C,DENSIT
		MTOPR
		 ERJMP [TMSGC <%UNABLE TO SET DENSITY, JOB DEFAULT USED
>
			JRST .+1]
		MOVEI B,.MOSPR	;SET PARITY PER REQUEST
		MOVE C,PARITY
		MTOPR
		 ERJMP .+1
		JRST .+1]
	SKIPGE TMODE		;WANT TO SET DATA MODE?
	CALL SETMOD		;YES, DO IT

;SET BLOCKING-FACTOR

	TXNE F,ICMODF		;FOR INTERCHANGE FORMAT,
	JRST [	MOVEI A,1	; USE BLOCKING FACTOR
		MOVEM A,TAPBKF	; OF 1 ALWAYS
		JRST MTOPB9]
	MOVE A,TMODE		;GET I/O MODE
	TXNE A,OF%WR		;WRITE?
	SKIPE TAPBKF		;YES-- TAPE BLOCKING FACTOR ALREADY KNOWN?
	JRST MTOPB9		;YES-- (OR READ) USE EXISTING TAPBKF
	MOVE A,MTJFN		;GET TAPE JFN
	MOVX B,.MORDN		;READ DENSITY
	MTOPR			; THAT HAS BEEN SET
	 ERJMP MTOPB4		;NOT AVAILABLE-- DON'T CHECK BLOCKING-FACTOR LIMITS
	MOVSI B,-DNBKTZ		;AOBJN POINTER TO DNBKTB (DENSITY/BLOCKING-FACTOR
				; LIMIT TABLE)
MTOPB3:	HRRZ A,DNBKTB(B)	;GET A DENSITY
	CAMN A,C		;MATCH TAPE DENSITY?
	JRST [	HLRZ A,DNBKTB(B) ;YES-- USE LIMIT FOR THIS DENSITY
		JRST MTOPB6]
	AOJN B,MTOPB3		;NO-- LOOP THROUGH TABLE FOR TAPE DENSITY
				;TAPE DENSITY NOT FOUND IN TABLE
MTOPB4:	MOVE A,SETBKF		;USE BLOCKING FACTOR SET BY USER (OR DEFAULT)
MTOPB6:	CAMLE A,SETBKF		;USER SET A LOWER BLOCKING-FACTOR?
	MOVE A,SETBKF		;YES-- USE USER'S VALUE
	MOVEM A,TAPBKF		;REMEMBER THE BLOCKING-FACTOR
	CAME A,SETBKF		;ARE WE USING USER'S VALUE?
	CALL [	TMSG <%BLOCKING-FACTOR too high for current tape density
%Tape will be written with BLOCKING-FACTOR of >
		MOVE B,TAPBKF		;NO-- TELL USER WHAT WE WILL USE
		MOVEI C,^D10		; IN DECIMAL
		CALL TTNOUT
		TMSG <
>
		RET]
MTOPB9:

;INITIALIZE FLAGS AND VARIABLES

	TXZ F,LREOF+LRERR+ICMT1	;CLEAR FLAGS
	SETZM MTRACT
	SETZM MTBUFF		;INIT VARIABLES
	SETZM BLKCNT		;INDICATE MTBUF EMPTY
	MOVE B,NWTBT0		;INIT NORMAL OVERLAP MODE
	IFN DSKDMP, <	MOVEI B,1	;1 RECORD AT TIME
			MOVEM B,TAPBKF	; FOR DUMP TO DISK
			SETZ B,>	; AND NO OVERLAPPING
	MOVEM B,NWTBIT
	CALLRET SETIOW		;SETUP DUMPI/O COMMAND LIST AND RETURN


;SETMOD - SET MTA DATA MODE
; F/ T36MOD - IF SET, USE 36-BIT MODE; IF RESET, USE CORE-DUMP MODE
; MTJFN/ MAGTAPE JFN
;RETURNS +1: ALWAYS

;NOTE:  IN SOME INSTANCES INVOLVING LABELED TAPES, IT IS NOT POSSIBLE
;TO SET THE DATA MODE WITH THE .MOSDM MTOPR.  THE ACTION TAKEN HERE
;IS TO ISSUE AN ERROR MESSAGE IF THE DATA MODE REQUESTED DOESN'T MATCH
;THE JOB DEFAULT DATA MODE.

SETMOD:	SETO A,			;SPECIFY THIS JOB
	HRROI B,D		;-# OF WORDS ,, ADDR OF 1ST WORD
	MOVEI C,.JIDM		;OFFSET TO JOB DEFAULT DATA MODE
	GETJI			;FIND OUT JOB DEFAULT DATA MODE
	 SETO D,		;CAN'T GET IT (SHOULDN'T HAPPEN)
	CAIN D,.SJDDM		;IS MODE "SYSTEM DEFAULT" ?
	MOVEI D,.SJDMC		;YES, EVERYONE KNOWS THAT'S CORE DUMP
	MOVEI C,.SJDMC		;ASSUME USER WANTS CORE-DUMP
	TXNE F,T36MOD		;WANTS INDUSTY-COMPATIBLE?
	MOVEI C,.SJDM8		;YES
	CAMN C,D		;DOES REQUEST MATCH JOB DEFAULT?
	RET			;YES, DON'T HAVE TO CHANGE ANYTHING

;REQUESTED DATA MODE DOESN'T MATCH JOB DEFAULT - MUST ISSUE MTOPR

	MOVE A,MTJFN		;GET TAPE JFN
	MOVEI B,.MOSDM		;FUNCTION = SET DATA MODE
	MTOPR			;DO IT
	 ERJMP [TMSGC <%UNABLE TO SET TAPE DATA MODE, JOB DEFAULT USED
>				;FAILED
		JRST .+1]
	RET
;OPEN FAILURE

MTOFAI:	CALL JSERRM		;SAY WHY
	HRROI A,[ASCIZ\Try again? \]
	CALL YESNO
	JUMPN A,MTOP1		;YES
	JRST CLRST		;NO

MTOP4:	MOVX A,GJ%SHT
	HRROI B,[ASCIZ /MTA-DUMPER:/]
	GTJFN			;TRY DEFAULT LOGICAL NAME
	 JRST MTOP3		;N.G.
	CALL CHKMTJ		;SETUP
	 JRST MTOP3		;NOT A MAGTAPE
	JRST MTOP1		;TRY AGAIN

MTOP3:	TMSG <Tape specification needed,
>
	PUSH P,TMODE		;SAVE MODE (NTAPE CALLS MTOPNX)
	CALL NTAPE
	 JRST BMBCMD		;CAN'T
	POP P,TMODE
	JRST MTOP1


;DENSITY/BLOCKING-FACTOR LIMIT TABLE
; *** THESE LIMITS WERE ESTABLISHED UNDER THE FOLLOWING ASSUMPTIONS:
;	1)  2 RECORDS NEED TO BE WRITTEN AFTER EOT (REFLECTIVE STRIP).
;	2)  14 RETRYS OF EACH RECORD MAY BE NEEDED.
;	3)  EACH RETRY ERASES (3 INCHES) RECORD IN ERROR, THEN REWITES RECORD.
;	4)  500 INCHES OF TAPE ARE AVAILABLE AFTER REFLECTIVE STRIP.
;	    (THIS IS NOT TRUE.  ONLY 300 INCHES (25 FEET) AVAILABLE,
;	     BUT ALL THOSE RETRIES ARE WORST CASE.  300 INCH LIMITS
;	     ARE IN PARENTHESES.)

DNBKTB:	XWD ^D1,.SJDN2		;200 BPI:  LIMIT 1 (1)
	XWD ^D3,.SJDN5		;556:  3 (1)
	XWD ^D4,.SJDN8		;800:  4 (2)
	XWD ^D8,.SJD16		;1600:  8 (4)
	XWD ^D35,.SJD62		;6250:  35 (17)
DNBKTZ==.-DNBKTB
;CLOSE MAGTAPE JFN
;	CALL MTCLS
; RETURN +1 ALWAYS

MTCLS:	SKIPN A,MTJFN		;HAVE JFN?
	RET			;NO, RETURN
	CLOSF			;YES, CLOSE AND DISCARD
	 JRST [	MOVE A,MTJFN	;WON'T CLOSE
		TXO A,CZ%ABT	;SO FORCE IT!
		CLOSF
		 JFCL
		JRST .+1]
	SETZM MTJFN
	RET

;REWIND, UNLOAD FUNCTIONS

REWCV:	SKIPG MTTYP		;REWIND CURRENT VOLUME
	JRST REWVS		;UNLABELED, DO .MOREW
	MOVEI B,.MORVL		;LABELED, SPECIAL MTOPR
	JRST REWU1

UNLOAD:	SKIPL MTTYP		;MT DEVICE?
	RET			;YES, DON'T UNLOAD
	SKIPA B,[EXP .MORUL]	;UNLOAD FUNCTION
REWVS:	MOVEI B,.MOREW		;REWIND VOLUME-SET
REWU1:	SKIPE A,MTJFN
	MTOPR
	 ERJMP [CAIN B,.MORUL	;ERROR, UNLOADING?
		JRST .+1	;YES, IGNORE
		TMSGC <%Error rewinding tape, >
		CALL JSERRM	;TELL USER
		JRST .+1]
;	CALLRET MTBOT		;SAY NOW AT BOT AND RETURN


;SET PARAMETERS FOR BOT OR NEW TAPE

MTBOT:	SETZM TAPBKF		;INDICATE NO BLOCKING-FACTOR FOR TAPE YET
	SETZM RSEQ		;RESET SEQUENCE NUMBERS
	SETZM SEQ
	RET			;RETURN FROM MTBOT


;MARK END OF TAPE

ENDTAP:	CALL MTFILL		;FILL LAST PHYSICAL RECORD OUT SO THAT
				;TAPE TRAILER IS A SINGLE PHYS RECORD
	MOVNI A,TPTRX
	MOVEM A,TYP		;BUILD TAPE-TRAILER RECORD
	SKIPLE MTTYP		;LABELED TAPE?
	JRST [	SKIPL PAGNO	;YES, CONTINUED SAVESET?
		RET		;NO, ALL DONE
		CALL MTOUT	;WRITE TRAILER
		CALLRET MTFILL]	;FORCE IT OUT AND RETURN
	CALL MTOUT		;WRITE TRAILER RECORD
	TXNE F,ICMODF		;INTERCHANGE MODE?
	CALL ICOFIN		;YES, FINISH BUFFERS
	CALL MTFILL		;FORCE TRAILER RECORD TO BE WHOLE PHYSICAL RECORD
	CALL ENDFIL
	CALL ENDFIL		;WRITE 2 EOF'S
	MOVEI D,3
	TXNE F,ICMODF		;INTERCHANGE?
	MOVEI D,2		;YES, BACK OVER EOF'S ONLY
ENDTA1:	CALL BACKSP		;BACK OVER 2 EOF'S AND TRAILER RECORD
	SOJG D,ENDTA1
	RET

;WRITE FILE MARK

ENDFIL:	PUSH P,A
	PUSH P,B
	MOVEI B,.MOEOF		;REQUEST WRITE EOF
	CALL XMTOPR
	MOVE A,TAPBKF		;COUNT EOF AS PHYSICAL RECORD
	ADDB A,RSEQ		; . .
	MOVEM A,SEQ		;KEEP READ SEQ UP TO DATE
	POP P,B
	POP P,A
	RET

;FORWARD SPACE ONE RECORD (NO CHECK FOR EOT)

FWRSP:	MOVEI B,.MOFWR		;MTOPR CODE FOR FORWARD SPACE REC
	CALL XMTOPR
	SKIPN A,BLKCNT		; Read part of a record
	MOVE A,TAPBKF		; No, # seq's per record
	SKIPE BLKCNT		;READ PART OF A RECORD?
	SUBI A,1		;YES-- ACCOUNT FOR PART OF
	ADD A,BLKCNT		; RECORD LEFT UNREAD
	ADDB A,RSEQ		;UPDATE RECORD NUMBER
	SETZM BLKCNT		;NOW AT BEGINNING OF RECORD
	MOVEM A,SEQ		; Keep tape seq uptodate
	RET

;BACKSPACE ONE RECORD

BACKSP:	MOVEI B,.MOBKR
	CALL XMTOPR		;DO BACKSPACE
	MOVE A,MTJFN
	GDSTS
	TXNE B,MT%BOT		;NOW AT BOT?
	ERROR MTBOT,<%BEGINNING OF TAPE ENCOUNTERED>
				;YES-- GIVE WARNING, RESET SEQ #'S, AND RETURN FROM BACKSP
	MOVN A,TAPBKF		;GET NEGATIVE BLOCKING FACTOR, A RECORD'S
				; WORTH OF SEQUENCE NUMBERS
	SKIPE BLKCNT		;READ PART OF A RECORD?
	SUBI A,1		;YES-- ACCOUNT FOR PART OF RECORD ALREADY READ
	ADD A,BLKCNT		; . . .
	ADDB A,RSEQ		;UPDATE RECORD NUMBER
	SETZM BLKCNT		;NOW AT BEGINNING OF RECORD
	MOVEM A,SEQ		;KEEP TAPE SEQ UP TO DATE
	RET
;MTOPR FUNCTION - CHECK PREVIOUS OPERATION FIRST
; B/ FUNCTION FOR MTOPR

XMTOPR:	PUSH P,B		;SAVE FUNCTION CODE
	MOVE A,MTJFN
	SKIPN NWTBIT
	JRST XMTOP1		;NOT OVERLAPPING
	MOVE B,TMODE		;CHECK CURRENT MODE
	TXNN B,OF%WR		;WRITE?
	JRST [	CALL MTBKRA		;NO, READ-- BACK OVER READ-AHEAD
		JRST XMTOP1]
	CALL WFERR		;WRITE-- RECOVER FROM ANY ERRORS THAT HAVE OCCURED

XMTOP1:	POP P,B			;RECOVER FUNCTION CODE
	MOVE A,MTJFN
	MTOPR			;DO FUNCTION
	RET


;FILL REST OF PHYSICAL RECORD WITH FILLER RECORDS

MTFILL:	SKIPN BLKCNT		;JUST WROTE A PHYSICAL RECORD?
	RET			;YES-- RETURN NOW FROM MTFILL
	MOVNI A,FILLX		;GET FILLER TYPE
	MOVEM A,TYP		;SET RECORD TYPE
	CALL MTOUT		;WRITE FILLER RECORD
	JRST MTFILL		;SEE IF DONE YET
;MAGTAPE OUTPUT ROUTINE.  REQUESTS ONE TRANSFER AHEAD

MTOUT:	SAVEAC <A,B>
	CALL TSTINT		;CHECK FOR INTERRUPT REQUEST
	SKIPG BLKCNT		;TIME FOR A NEW BUFFER?
	CALL SETNXB		;YES, SET UP ADDRESS AND BLOCK COUNT
	JXN F,ICMODF,[MOVE A,MTBPTR ;GET POINTER TO CURRENT BUFFER
		CALL ICOCNV	;INTERCHANGE MODE, DO CONVERSION
		 RET		;NO OUTPUT
		JRST MTOUT1]	;DATA NOW IN BUFFER, GO WRITE IT
	AOS A,RSEQ
	MOVEM A,SEQ		;KEEP READ SEQ UP TO DATE
	SETZM CHKSUM
	HRRZ B,CURBUF		;POINT TO CURRENT BUFFER
	CALL COMCKB		;CHECKSUM IT
	SETCAM A,CHKSUM
	MOVE A,MTBPTR		;GET CURRENT BUFFER POINTER
	HRLI A,XBUFF		;COPY HEADER FIRST
	MOVEI B,NHEAD(A)
	BLT A,-1(B)		;...
	HRL B,CURBUF		;SET UP BLT PNTR
	MOVEI A,PGSIZ(B)	;LAST ADDRS
	BLT B,-1(A)		;MOVE IT
MTOUT1:	MOVEI A,NHEAD+PGSIZ	;ADVANCE BUFFER POINTER
	ADDM A,MTBPTR		; TO NEXT RECORD
	SOSLE BLKCNT		;FILLED THIS PHYSICAL RECORD?
	RET			;NO, ALL DONE FOR NOW
MTOUT2:	MOVEI A,MTBUF1-1	;SETUP DUMPO START ADDRESS
	SKIPE MTBUFF
	MOVEI A,MTBUF2-1
	HRRM A,MTCOMS
	MOVEI B,MTCOMS
	TDO B,NWTBIT		;SET OVERLAP IO BIT OR 0
	MOVE A,MTJFN
	DUMPO
	 JRST [	CALL WFERR	;WRITE ERROR, RECOVER IT
		SKIPE NWTBIT	;OVERLAPPING?
		JRST MTOUT2	;YES, TRY TRANSFER AGAIN
		JRST .+1]	;NO, ACTUAL TRANSFER RECOVERED
	RET
;WRITE ERROR HANDLER.  ANY DATA ERROR IS HANDLED BY RE-WRITING THE
;SAME RECORD.  CERTAIN OTHER FLAG CONDITIONS (E.G. EOT) ARE
;IGNORED EXCEPT FOR PASSING STATUS BACK TO MAIN FORK.  TAPE
;IS *NEVER* BACKSPACED.
;IF NO ERRORS ARE DETECTED, THEN NO ACTION IS TAKEN.

WFERR:	CAIN A,DUMPX3		;BUFFER TOO BIG?
	ERROR CLRST,<?Not enough monitor table space for current BLOCKING-FACTOR>
	CALL TSTINT		;CHECK FOR INTERRUPT REQUEST
	CALL XGDSTS		;GET AND CLEAR ERROR FLAGS
	TXNE B,MT%ILW		;ILLEG WRITE?
	JRST [	HRROI A,[ASCIZ /?Tape is write-protected, type <CR> when ready to try again. /]
		SKIPGE MTTYP	;MTA DEVICE?
		JRST WFTRYM	;YES, ASK TO TRY AGAIN
		TMSGC <?Tape is write-protected
?DISMOUNT tape, then MOUNT it with /WRITE-ENABLED switch>
		JRST CLRST]
	TXNE B,MT%DVE		;DRIVE OFF-LINE?
	JRST [	HRROI A,[ASCIZ /?Drive probably off-line, type <CR> when ready to try again. /]
		CALLRET WFTRYM]
	TXNE B,MT%EOT		;EOT?
	SETZM TAPLFT		;YES, FLAG MAIN FORK
	SKIPN COLSW		;COLLECTION/MIGRATION?
	SKIPE ARCSW		;ARCHIVAL?
	JRST[	SKIPE NWTBIT	;GET TYPE FROM OTHER BUFFER UNLESS
		SKIPE MTBUFF	;NOT OVERLAPPING
		SKIPA C,MTBUF1+XTYP
		MOVE C,MTBUF2+XTYP
		CAME C,[-TPTRX]	;TRAILER RECORD?
		JRST .+1	;NO, PROCEED AS USUAL
		TMSG <?WRITE ERROR ON TRAILER RECORD!
?This >
		CALL PRTTYP
		TMSG < tape is valid for the current and all previous runs
?BUT, it should NOT be used for any future runs!!!
?****** MARK THIS TAPE AS FULL *********
>
		RET]
	TXNE B,MT%DAE		;DATA ERROR?
	JRST [	TMSGC <%Write error on tape, record >
		MOVEI B,XSEQ	;SEQ WORD IN RECORD
		TXNE F,ICMODF	;UNLESS INTERCHANGE MODE
		MOVEI B,G$SEQ	;IN WHICH CASE IT IS THIS
		SKIPE NWTBIT	;GET SEQ FROM OTHER BUFFER UNLESS
		SKIPE MTBUFF	;NOT OVERLAPPING
		SKIPA B,MTBUF1(B)
		MOVE B,MTBUF2(B)
		MOVEI C,^D10
		CALL TTNOUT	;REPORT IT
		TMSG <, writing duplicate record.
>
		CALLRET WFTRY]
	RET			;UNKNOWN ERROR, IGNORE
;TRY ERRONEOUS TRANSFER AGAIN.  THIS WILL BE A DUPLICATE RECORD IF
;PREVIOUS ATTEMPT FAILED BECAUSE OF DATA ERROR.

WFTRYM:	PUSH P,A		;HERE IF MSG IN A TO TYPE FIRST
	MOVEI A,101
	DOBE			;WAIT FOR ANY MAIN FORK OUTPUT TO FINISH
	POP P,B
	CALL TMSGQC
	CALL RDLIN		;GET CR FROM USER

;HERE TO TRY AGAIN WITHOUT MSG

WFTRY:	SKIPE NWTBIT		;WRITE FROM OTHER BUFFER UNLESS
	SKIPE MTBUFF		;NOT OVERLAPPING
	SKIPA A,[MTBUF1-1]
	MOVEI A,MTBUF2-1
	HRRM A,MTCOMS
	MOVEI B,MTCOMS
	TDO B,NWTBIT		;SET BIT IF OVERLAPPING
	MOVE A,MTJFN
	DUMPO
	 JRST WFERR		;FAILED AGAIN
	RET			;RETRY REQUESTED OK
;MAG TAPE READ - REQUESTS ONE BUFFER IN ADVANCE

MTRED:	PUSH P,A
	PUSH P,B
	CALL TSTINT		;CHECK FOR INTERRUPT REQUEST
	TXZE F,ICMT1		;INTERCHANGE MODE REPEAT RECORD?
	JRST [	CALL ICICN1	;YES
		 JRST MTRED5	;GET ANOTHER RECORD
		JRST MTRED2]	;DATA NOW IN BUFF
MTRED5:	TXZE F,LRERR		;LAST RECORD HAD ERROR?
	JRST MTRED3		;YES, CURRENT RECORD WAITING IN BUFF
	MOVEI A,NHEAD+PGSIZ	;BUMP ADDRESS
	ADDM A,MTBPTR		; OF CURRENT RECORD
	SOSLE BLKCNT		;ANY RECORDS LEFT IN THIS PHYSICAL RECORD?
	JRST MTRED4		;YES-- USE IT

;READ NEXT RECORD FROM TAPE

	CALL SETNXB		;SET NEXT BUFFER ADDRESS
	TXZ F,LREOF		;NO EOF
	MOVEI P1,NRETRY		;INIT RETRY COUNT
MTRED1:	MOVEI B,MTBUF1-1	;SELECT BUFFER
	SKIPE MTRACT		;NOW TO DO READ-AHEAD?
	JRST [	SKIPN MTBUFF	;YES-- USE OTHER BUFFER
		MOVEI B,MTBUF2-1
		JRST MTRD12]
	SKIPE MTBUFF
	MOVEI B,MTBUF2-1
MTRD12:	HRRM B,MTCOMS
	MOVEI B,MTCOMS
	SKIPE TAPBKF		;DON'T OVERLAP IF RECORD LENGTH NOT YET KNOWN
	TDO B,NWTBIT
	MOVE A,MTJFN
	DUMPI			;REQUEST INPUT
	 JRST MTRERR		;READ ERROR
	SKIPE NWTBIT		;OVERLAPPING?
	SKIPE MTRACT		;YES-- NO READ-AHEAD YET?
	JRST MTRED4		;NO-- NOW RETURN DATA TO BUFF
	SKIPN TAPBKF		;BLOCKING-FACTOR KNOWN?
	JRST MTRED4		;NO-- DON'T READ-AHEAD UNTIL WE FIND IT
	SETOM MTRACT		;YES-- TIME TO DO READ-AHEAD
	JRST MTRED1		; SO GO BACK AND DO IT

MTRED4:	HRLZ A,MTBPTR		;POINT TO CURRENT RECORD
	TXNE F,T36MOD		;36-BIT MODE?
	CALL W36CNV
	TXNE F,ICMODF		;INTERCHANGE MODE?
	JRST [	CALL ICICNV	;YES, REFORMAT RECORD
		 AOSA RSEQ	;RECORD BEING SKIPPED, ADJUST SEQ
		JRST MTRED2	;DATA NOW IN BUFF
		JRST MTRED5]	;GET ANOTHER RECORD
	HRRI A,BUFF-NHEAD	;COPY BUFFER
	BLT A,BUFF+PGSIZ-1
	CALL COMCHK		;CHECK CHECKSUM
	JUMPN A,MTRCSE		;JUMP IF CHECKSUM ERROR
MTRED2:	AOSGE A,RSEQ		;BUMP RECORD NUMBER, IN SEQUENCE RECOVERY?
	JRST [	CALL MTRRCK	;YES
		 JRST MTRERX	;FAILURE, RETURN ERROR
		JRST MTRED3]	;OK
	CAMN A,SEQ		;SAME AS TAPE?
	JRST MTRED3		;YES-- OK
	CALL MTRSQE		;NO-- CHECK IT OUT
	 JRST [	SETZM BLKCNT		;DUPLICATE RECORD--
		JRST MTRED5]		; IGNORE IT

MTRED3:	MOVN A,TYP		;GET CURRENT RECORD TYPE
	CAIN A,FILLX		;FILLER?
	JRST MTRED5		;YES-- IGNORE IT
	POP P,B
	POP P,A
	RETSKP

;ERROR RETURN

MTRERX:	TXO F,LRERR		;NOTE BUFFER NOT RETURNED, DATA IN BUFF IS NEXT RECORD
	POP P,B
	POP P,A
	RET

;CONVERT FROM 36-BIT TAPE FORMAT

W36CNV:	SAVEQ
	HLRZ B,A		;CONVERT BUFFER IN PLACE
	HRLI B,(POINT 8,0)
	HLRZ C,A
	HRLI C,(POINT 4,0)
	MOVEI Q1,^D<<NHEAD+PGSIZ>*9/2> ;SOURCE BYTE COUNT
W36C1:	ILDB D,B		;ONE SOURCE BYTE...
	ROT D,-4		; ... BECOMES TWO DEST BYTES
	IDPB D,C
	ROT D,4
	IDPB D,C
	SOJG Q1,W36C1
	RET
;ERROR HANDLING STRATEGY:

;1. DEVICE ERRORS WHICH DO NOT READ ANY DATA (E.G. OFF-LINE) WAIT
;	FOR CONFIRMATION FROM USER THEN TRY AGAIN.
;2. DEVICE DATA ERRORS ARE RETRIED HERE BECAUSE WE HAVE
;	SUPPRESSED THE MONITOR ERROR CORRECTION LOGIC.
;3. CHECKSUM IS CHECKED ONLY IF DEVICE REPORTS NO ERRORS IN DATA.
;	CHECKSUM ERROR PRODUCES LOCAL RETRY SINCE THE MONITOR DID NOT
;	KNOW OF THE ERROR.
;4. ANY HARD DATA ERROR WILL SET A FLAG WHICH CAUSES THE NEXT RECORD
;	TO BE READ AND ITS SEQUENCE NUMBER CHECKED.  IF IT IS THE
;	SAME AS THE EXPECTED SEQUENCE NUMBER OF THE ERRONEOUS RECORD,
;	THEN THE ERROR WAS ALSO DETECTED ON WRITE AND A DUPLICATE
;	RECORD WAS THEN WRITTEN.  THIS CONSTITUTES FULL
;	RECOVERY AND IS SO REPORTED.

;ERROR REPORTED BY MAGTAPE

MTRERR:	CAIN A,DUMPX3		;BUFFER TOO BIG?
	JRST [	HLRE A,MTCOMS	;YES, GET CURRENT WORD COUNT
		ADDI A,PGSIZ+NHEAD ;COUNT DOWN A BUFFER'S WORTH
		HRLM A,MTCOMS	;PUT IT BACK
		CAMGE A,[EXP -<PGSIZ+NHEAD>] ;CAN WE STILL READ A WHOLE RECORD?
		SKIPE TAPBKF	;YES, ALSO LOOKING FOR BLOCKING-FACTOR?
		ERROR CLRST,<?Not enough monitor table space> ;NO
		JRST MTRED1]	;YES, TRY DUMPI AGAIN
	CAIE A,GJFX52		;END OF LABELED TAPE?
	CAIN A,IOX24		;END OF LABELED TAPE?
	JRST [	CALL XGDSTS	;YES, CLEAR ERROR STATUS
		JRST MTREOF]	;TREAT LIKE END-OF-FILE
	CAIE A,IOX4		;EOF
;*** THE NEXT 4 LINES ARE A HACK UNTIL MONITOR SETS MT%EOF WITH IOX4
	CAIA			;*
	JRST [	CALL XGDSTS	;*
		SETZM MTRACT	;*
		JRST MTREOF]	;*
	CAIN A,IOX5		; OR ERROR ?
	SKIPA			;ONE OF THE ABOVE
	JRST [	TMSGC <?Unexpected error reading tape
?>
		CALL JSERRM	;CAN'T HANDLE THIS ONE
		TMSGC <Type <CR> to try again. >
		CALL RDLIN	;GET CR FROM USER
		JRST MTRED1]
	CALL TSTINT		;CHECK FOR INTERRUPT REQUEST
	CALL XGDSTS		;GET AND CLEAR ERROR FLAGS
	TXNE B,MT%DVE!MT%DAE!MT%EOF ;ANY TRANSFER-ABORT CONDITIONS?
	SETZM MTRACT		;YES, NOTE NO OUTSTANDING REQUEST
	TXNE B,MT%DVE		;OFF-LINE?
	JRST [	CALL MTRSQR	;MAKE SURE SEQ RECOVERY FINISHED
		TMSGC <?Device error, possible incorrect density.
  Type <CR> to try again. >
		CALL RDLIN	;GET CR FROM USER
		JRST MTRED1]
	TXNE B,MT%DAE		;DATA ERROR?
	JRST [	CALL MTRSQR	;MAKE SURE SEQ RECOVERY FINISHED
		TMSGC <?MAGTAPE data error>
		CALL TSEQN	;REPORT SEQ NUMBER
		JRST MTREX1]	;YES, GO SETUP RETRY
	TXNE B,MT%EOF		;EOF?
MTREOF:	JRST [	MOVE B,TAPBKF	;YES
		SKIPG MTTYP	;LABELED, IGNORE INTER-FILE GAP
		ADDM B,RSEQ	;UNLABELED, COUNT EOF AS PHYSICAL RECORD
		TXON F,LREOF	;SET EOF AND CHECK FOR TWO SEQUENTIAL
		JRST MTRED1	;IGNORE
		MOVX B,-TPTRX	;TWO EOF'S, SIMULATE EOT RECORD
		MOVEM B,TYP
		MOVE B,RSEQ
		MOVEM B,SEQ
		JRST MTRED3]	;AND EXIT
	TXNE B,MT%IRL		;RECORD LENGTH DISAGREES?
	JRST MTRERL		;YES
	CALL MTRSQR		;FINISH SEQ RECOVERY
	TMSGC <?MAGTAPE unknown error>
	CALL TSEQN		;REPORT SEQ NUMBER

;ATTEMPT TO RECOVER ASSUMING ERROR WAS ALSO SEEN ON WRITE AND
;THAT DUPLICATE RECORD WAS WRITTEN.  IF NEXT RECORD HAS SAME
;SEQUENCE NUMBER AS WAS EXPECTED FOR BAD RECORD, THEN PROBLEM
;HAS BEEN RECOVERED.

MTREX1:	SKIPN RSEQ		;AT BOT?
	JRST [	TMSG <
%Tape may be wrong format>
		JRST .+1]
	MOVSI A,(1B0)		;SET FLAG IN SEQ
	IORM A,RSEQ
	MOVEI P1,NRETRY		;REINIT RETRY COUNT
	JRST MTRED1		;GO READ NEXT RECORD

;RECORD LENGTH ERROR REPORTED.  MONITOR DOES NOT RETRY ON THIS
;BECAUSE SOME PROGRAMS DON'T KNOW HOW LONG THEIR RECORDS ARE.
;WE DON'T KNOW WHAT THE BLOCKING FACTOR WILL BE, SO THE MAXIMUM SIZE
;RECORD IS READ THE FIRST TIME AND WILL COME THROUGH HERE.
;IF WE HAVE ALREADY READ AT LEAST ONE RECORD, WE KNOW THE BLOCKING
;FACTOR AND THE RECORD LENGTH, SO ANY A RECORD LENGTH ERROR
;IS A GENUINE ERROR AND WE WILL TRY TO RE-READ THE RECORD.
;AC C/ XWD # FRAMES READ, 0 (FROM GDSTS)

MTRERL:	SKIPE TAPBKF		;BLOCKING-FACTOR KNOWN?
	JRST MTRRL1		;YES-- MUST BE REAL ERROR
	HLRZ A,C		;GET WORDS ACTUALLY READ
	IDIVI A,NHEAD+PGSIZ	;COMPUTE NUMBER OF RECORDS READ
	JUMPN B,MTRRL1		;NOT AN INTEGRAL NUMBER OF RECORDS-- REAL ERROR
	MOVEM A,TAPBKF		;SAVE RECORD BLOCKING FACTOR
	MOVEM A,BLKCNT		;ALSO SET AS CURRENT BLOCK COUNT IN BUFFER
	CALL SETIOW		;SET DUMPI COMMAND LIST FOR RIGHT SIZE
	JRST MTRED4		;IGNORE THE ERROR, PROCESS RECORD

;HERE WITH REAL RECORD LENGTH ERROR

MTRRL1:	HRRZ A,MTCOMS
	MOVE A,1(A)		;GET FIRST WORD READ FROM TAPE
	TDZ A,[1B0+1B8+1B16+1B24+17] ;CLEAR TRASH
	CAMN A,[BYTE (8) "V","O","L","1"] ;IS IT A VOL1?
	JRST [	HRROI B,[ASCIZ/?Labeled tapes must be MOUNTed/] ;YES
		SKIPL MTTYP	;SELECT APPROPRIATE DIAGNOSTIC
		HRROI B,[ASCIZ/?Cannot read labeled tapes in BYPASS mode/]
		CALL TMSGQC
		CALL MTCLS	;CLOSE THE TAPE
		JRST BMBCMD]
	SOJG P1,MTRTRY		;COUNT ATTEMPTS AND TRY AGAIN
	CALL MTRSQR		;FINISH SEQ RECOVERY
	TMSGC <?MAGTAPE record length error>
	CALL TSEQN		;REPORT SEQ NUMBER
	JRST MTREX1		;TRY TO RECOVER BY SEQ NUMBER

;HERE WHEN TRYING TO RECOVER ERROR BY SEQUENCE NUMBER
;AFTER NEXT RECORD HAS BEEN READ. THIS RECORD WILL BE USED IN ANY CASE.

MTRRCK:	MOVSI C,(1B0)
	ANDCAB C,RSEQ		;CLEAR RETRY FLAG
	MOVE B,SEQ		;GET SEQ NUM OF RECORD JUST READ
	CAME B,C		;DESIRED NUMBER?
	JRST [	MOVEM B,RSEQ	;NO, RESET NUMBER
		RET]
	TMSG <, recovered.
>
	RETSKP


;HERE WHEN WE WANT TO REPORT ANOTHER ERROR.
;IF ALREADY IN SEQUENCE RECOVERY, TYPE ", RECORD IGNORED." TO
;COMPLETE LAST ERROR MESSAGE.

MTRSQR:	SKIPL RSEQ		;IN SEQUENCE RECOVERY?
	RET			;NO-- ALL OK
	TMSG <, record ignored.
>
	RET			;RETURN FROM MTRSQR
;HERE IF SEQUENCE NUMBERS DISAGREE UNEXPECTEDLY.
;IF ACTUAL IS BLOCKING-FACTOR LESS THAN EXPECTED, PROBABLY GOT ERROR ON WRITE
;WHICH DIDN'T APPEAR ON READ, SO DUPLICATE RECORD WAS WRITTEN.
;THE DUPLICATE RECORD IS IGNORED (+1 RETURN).
;IF ACTUAL IS 1 AND EOF JUST READ, PROBABLY NEW SAVESET. PROCEED QUIETLY.
;ANYTHING ELSE IS AN ERROR.

MTRSQE:	MOVE C,RSEQ
	MOVE B,SEQ		;GET NUMBER JUST READ
	MOVEM B,RSEQ		;RESET NUMBERS
	SUB C,B			;COMPUTE DIFFERENCE
	CAMN C,TAPBKF		;ACTUAL 1 LESS THAN EXPECTED?
	JRST [	TMSGC <%Duplicate record encountered, record >
		MOVE B,RSEQ	;REPORT NUMBER
		MOVEI C,^D10
		CALL TTNOUT
		TMSG <, ignored.
>
		RET]		;RETURN +1 FROM MTRSQE TO IGNORE RECORD
	TXNE F,LREOF		;LAST RECORD FILE MARK?
	JRST [	CAIN B,1	;YES-- NEW SAVESET?
		RETSKP		;YES-- ASSUME OK
		JRST .+1]	;NO-- REAL SEQUENCE ERROR
	TMSGC <?Sequence error, record >
	MOVE B,RSEQ		;REPORT NUMBER
	MOVEI C,^D10
	CALL TTNOUT
	TMSG <, continuing.
>
	RETSKP


;BKTPHD - BACK UP OVER TAPE HEADER THAT WAS JUST READ AND CLOSE TAPE
;LABELED TAPES ARE BACKSPACED 1 FILE TO PREVENT REPOSITIONING AT CLOSE

BKTPHD:	SKIPG MTTYP		;WHAT LABEL TYPE?
	JRST [	CALL BACKSP	;UNLABELED, JUST BACKSPACE
		CALLRET MTCLS]	;CLOSE TAPE AND RETURN
	CALL XGDSTS		;LABELED, CLEAR ERRORS
	MOVE A,MTJFN
	MOVEI B,.MOBKF		;BACKSPACE-FILE FUNCTION
	MTOPR			;GET TO START OF PREVIOUS FILE
	 ERJMP BKTPHX
	MOVEI B,.MOFWF		;THIS IS A CROCK BUT IT DOES WORK
	MTOPR
	 ERJMP BKTPHX
	SOS RSEQ		;COUNT THE RECORD I JUST BACKED UP OVER
	CALLRET MTCLS		;CLOSE TAPE AND RETURN
BKTPHX:	TMSGC <?ERROR POSITIONING TAPE: >
	CALL JSERRM
	JRST BMBCMD
;HERE ON CHECKSUM ERROR.  CHECKSUM ERROR MAY ARISE ONLY WITHOUT
;CONCURRENT DEVICE DATA ERROR.  SINCE NO DEVICE ERROR APPEARED, THEN
;DEVICE HAS GONE AHEAD TO READ NEXT RECORD AND WE WILL HAVE TO
;BACKSPACE 2.

MTRCSE:	CALL TSTINT		;CHECK FOR INTERRUPT REQUEST
	CALL XGDSTS		;WAIT FOR BACKUP OPERATION
	SOJG P1,MTRTRY		;TRY AGAIN WITH 2-RECORD BACKSPACE
	TMSGC <?Checksum error>
	CALL TSEQN
	CALL MTBKRA		;BACK UP OVER READ-AHEAD (IF ANY)
	JRST MTREX1		;TRY SEQ NUMBER RECOVERY

;HERE TO BACKSPACE BEFORE RETRY

MTRTRY:	CALL MTBKRA		;BACK OVER READ-AHEAD, IF ANY
	CALL MTRBKR		;BACK FOR RETRY
	JRST MTRED1		;START FROM TOP

;BACK OVER READ-AHEAD, IF ANY

MTBKRA:	SKIPN MTRACT		;READ-AHEAD OUTSTANDING?
	RET			;NO, DO NOTHING
	SETZM MTRACT		;RESET FLAG
	CALL XGDSTS		;WAIT FOR THINGS TO SETTLE DOWN
;	CALLRET MTRBKR		;BACK OVER RECORD AND RETURN FROM MTBKRA

;BACKSPACE A RECORD

MTRBKR:	MOVE A,MTJFN		;GET MTA JFN
	MOVX B,.MOBKR		;BACKSPACE RECORD FUNCTION
	MTOPR			; . . .
	RET			;RETURN FROM MTRBKR
;REPORT SEQUENCE NUMBER

TSEQN:	TMSG < record >
	MOVE B,RSEQ
	TXZ B,1B0		;CLEAR FLAG IF ANY
	AOS B			;COMPUTE EXPECTED SEQ NUMBER
	MOVEI C,^D10
	CALLRET TTNOUT

;COMPUTE CHECKSUM FOR RECORD.  CHECKSUM WORD IS INCLUDED IN
;COMPUTATION.  ON WRITE, IT IS SET TO 0 BEFORE THE CHECKSUM IS
;COMPUTED, THEN THE CHECKSUM IS STORED COMPLEMENTED.  HENCE ON
;READ, THE CHECKSUM COMPUTATION SHOULD PRODUCE 0.

COMCHK:	MOVEI B,BUFF-NHEAD	;ENTER HERE FOR STANDARD BUFFER
	HRLI B,-1000-NHEAD
	MOVEI A,0
COMCHA:	JCRY0 COMCH1
COMCH1:	ADD A,0(B)
	JCRY0 [AOJA A,.+1]
	AOBJN B,COMCH1
	CAMN A,[EXP -1]
	AOS A
	RET

;ROUTINE TO CHECKSUM DISJOINT BUFFER (PAGE ADDRS IN B)

COMCKB:	MOVE C,[-NHEAD,,XBUFF]
	MOVEI A,0		;INIT CHECKSUM
	JCRY0 COMCB1
COMCB1:	ADD A,0(C)
	JCRY0 [AOJA A,.+1]
	AOBJN C,COMCB1
	HRLI B,-PGSIZ		;SET UP FOR REMAINDER OF RECORD
	JRST COMCHA

;GET ERROR FLAGS AND THEN CLEAR SYSTEM COPY OF THEM

XGDSTS:	MOVE A,MTJFN
	GDSTS			;GET ERROR BITS
	PUSH P,B		;SAVE STATUS BITS
	MOVEI B,.MOCLE
	MTOPR			;CLEAR ERROR FLAGS
	POP P,B
	RET

;SETUP DUMPI/O COMMAND LIST

SETIOW:	MOVSI A,-PGSIZ-NHEAD	;SETUP BLOCK SIZE
	TXNE F,ICMODF		;INTERCHANGE MODE?
	MOVSI A,-PGSIZ-NIHEAD	;YES
	SKIPN B,TAPBKF		;GET BLOCKING-FACTOR
	JRST [	MOVSI A,-MTBFSZ	;NONE SET YET, USE MAX BUFFER SIZE
		JRST SETIO1]
	IMUL A,B		;RECORD-SIZE TIMES BLOCKING-FACTOR
	JXN F,T36MOD,<[IMULI A,^D9		;ADJUST FOR TAPE FORMAT
		IDIVI A,^D8
		JRST .+1]>
SETIO1:	MOVEM A,MTCOMS		;CONSTRUCT DUMPI/O COMMAND LIST
	SETZM MTCOMS+1
	RET			;RETURN FROM SETIOW


;SET NEXT BUFFER ADDRESS AND BLOCK COUNT

SETNXB:	SKIPE NWTBIT		;OVERLAPPING I/O?
	SETCMM MTBUFF		;YES, SWITCH BUFFERS
	MOVEI A,MTBUF1		;SELECT BUFFER
	SKIPE MTBUFF		; . . .
	MOVEI A,MTBUF2		; . . .
	MOVEM A,MTBPTR		;SAVE AS CURRENT BUFFER POINTER
	MOVE A,TAPBKF		;SET BLOCK COUNT
	MOVEM A,BLKCNT		; FOR THIS PHYSICAL RECORD
	RET			;RETURN FROM SETNXB
	SUBTTL INTERCHANGE CONVERSION

;ROUTINES TO CONVERT BACKUP/INTERCHANGE FORMAT RECORD INTO DUMPER
;FORMAT.
; A/ SOURCE BUFFER ADR,,0

ICICNV:	ACVAR <Q1,Q2>

	HLRZ Q1,A		;KEEP SOURCE BUFFER ADR
	MOVE A,[BUFF-NHEAD,,BUFF-NHEAD+1]
	SETZM -1(A)		;CLEAR DEST BUFFER FIRST
	BLT A,BUFF+PGSIZ-1
	MOVE A,G$SEQ(Q1)	;MOVE COMMON ITEMS - SEQ NUMBER
	MOVEM A,SEQ
	MOVE A,G$RTNM(Q1)	;TAPE NUMBER
	MOVEM A,TAPNO
	MOVE A,G$TYPE(Q1)	;DISPATCH ON TYPE
	CAIN A,T$LBL
	JRST T.LBL		;LABEL
	CAIN A,T$BEG
	JRST T.BEG		;BEGINNING OF SAVE SET
	CAIN A,T$END
	JRST T.END		;END OF SAVE SET
	CAIN A,T$FIL
	JRST T.FIL		;FILE DATA
	CAIN A,T$UFD
	JRST T.UFD		;DIRECTORY INFO
	CAIN A,T$CON
	JRST T.CON		;CONTINUATION
	TMSG <%UNRECOGNIZED RECORD TYPE ON INTERCHANGE TAPE, RECORD SKIPPED
>
	RET

;HERE FOR SECOND AND SUBSEQUENT PROCESSING OF SAME SOURCE RECORD

ICICN1:	ACVAR <Q1,Q2>
	SOS RSEQ		;KEEP SAME SEQ NUM
	MOVEI Q1,MTBUF1		;SETUP BFR ADR AGAIN
	SKIPE MTBUFF
	MOVEI Q1,MTBUF2
	MOVE A,[BUFF,BUFF+1]
	SETZM -1(A)		;CLEAR DATA AREA
	BLT A,BUFF+PGSIZ-1
	MOVE A,G$TYPE(Q1)	;GET TYPE
	CAIE A,T$FIL		;FILE?
	RET			;NO, ???
	MOVE A,G$FLAG(Q1)
	TXNE A,GF$SOF		;START OF SHORT FILE?
	JRST TFIL0		;YES, GET DATA
	TXNE A,GF$EOF		;LAST RECORD?
	JRST TFIL8		;YES
	RET			;UNKNOWN, ???

;RECORD TYPES IGNORED, LBL, UFD, END

T.END:
T.UFD:
T.LBL:	RET

;BEGINNING, END, OR CONTINUATION OF SAVESET

T.CON:
T.BEG:	MOVX A,-TPHDX		;MEANS TAPE HEADER
	MOVEM A,TYP
	MOVE A,S$DATE(Q1)	;TAD OF SAVE
	MOVEM A,BUFF+BFTAD
	MOVEI A,BFMSG		;USUAL MESSAGE PTR
	MOVEM A,BUFF+BFMSGP
	MOVEI A,CURFMT		;USUAL FORMAT
	MOVEM A,BUFF
	MOVEI D,NIHEAD(Q1)	;SET TO SCAN DATA AREA
TBEG1:	SKIPN 0(D)		;MORE TO COME?
	JRST TBEG2		;NO
	HLRZ A,0(D)		;GET BLOCK TYPE
	CAIN A,O$SSNM		;SAVESET NAME?
	JRST TBEG3		;YES
	HRRZ A,0(D)		;NO, STEP TO NEXT BLOCK
	ADDM A,D
	JRST TBEG1

TBEG3:	HRROI A,BUFF+BFMSG
	HRROI B,1(D)		;COPY SAVESET NAME STRING
	SETZ C,
	SOUT
TBEG2:	RETSKP
;FILE DATA RECORD

T.FIL:	MOVE A,G$FLAG(Q1)
	TXNE A,GF$SOF		;FIRST RECORD?
	JRST TFIL1		;YES
TFIL0:	MOVX A,GF$SOF
	ANDCAB A,G$FLAG(Q1)	;NOTE NOT FIRST RECORD NOW
	SKIPG G$SIZ(Q1)		;ANY DATA IN RECORD?
	JRST [	TXNN A,GF$EOF	;NO, EOF?
		RET		;NO, IGNORE RECORD
		JRST TFIL8]	;YES, HANDLE EOF
	MOVEI A,NIHEAD(Q1)	;LOCATION OF DATA
	ADD A,G$LND(Q1)		;PLUS OFFSET IF ANY
	HRLZ A,A		;SOURCE FOR BLT
	HRRI A,BUFF		;DEST FOR BLT
	MOVEI B,BUFF
	ADD B,G$SIZ(Q1)		;NUMBER OF WORDS TO TRANSFER
	BLT A,-1(B)		;COPY DATA 
	SETZM TYP		;DUMPER FILE TYPE
	MOVE A,F$RDW(Q1)	;WORD NUMBER
	IDIVI A,PGSIZ		;CONVERT TO PAGE NUMBER
	MOVEM A,PAGNO
	MOVX A,PM%RD+PM%WT
	MOVEM A,ACCESS		;USUAL ACCESS
TFIL9:	MOVE A,G$FLAG(Q1)
	TXNE A,GF$EOF		;LAST RECORD?
	TXO F,ICMT1		;YES, REPEAT IT
	RETSKP

;FIRST RECORD OF FILE

TFIL1:	MOVX A,-FLHDX		;SAY DUMPER FILE HEADER
	MOVEM A,TYP
	MOVEI D,NIHEAD(Q1)	;SET TO SCAN DATA
	HRLI D,-F$NND		;SIZE OF NON-DATA AREA
TFIL2:	HLRZ A,0(D)		;GET BLOCK TYPE
	CAIN A,O$NAME		;NAME?
	JRST TFIL2N		;YES
	CAIN A,O$FILE		;ATTRIBUTES?
	JRST TFIL2F		;YES
TFIL7:	HRRZ A,0(D)		;STEP BLOCK
	HRL A,A
	ADDM A,D
	SKIPE 0(D)		;END OF DATA?
	JUMPL D,TFIL2		;OR END OF BLOCK?
	SKIPLE G$SIZ(Q1)	;YES, DATA IN THIS BLOCK ALSO?
	TXO F,ICMT1		;YES, REPEAT IT
	JRST TFIL9		;CHECK FOR LAST REC AND RETURN
;FILE NAME BLOCK

TFIL2N:	MOVE A,[POINT 7,BUFF+FHNAM] ;SET TO CONSTRUCT NAME IN BUFF
	MOVEI B,.FCDIR
	CALL SCNBF		;FIND DIRECTORY BLOCK
	 JRST TFIL3		;NONE
	MOVEM B,Q2		;SAVE PTR TO IT
	MOVEI B,DIRBP		;DO DIR PUNCTUATION
	IDPB B,A
	HRLI Q2,(POINT 7,0)	;SET TO COPY STRING
TFIL32:	ILDB B,Q2
	JUMPE B,TFIL31		;END ON NULL
	CAIN B,","		;PPN SEPARATOR?
	MOVEI B,"-"		;YES, TRANSLATE
	IDPB B,A
	JRST TFIL32

TFIL31:	MOVEI B,DIREP
	IDPB B,A		;CLOSE DIR PUNCT
TFIL3:	MOVEI B,.FCNAM
	CALL SCNBF		;FIND NAME BLOCK
	 JRST TFIL4		;NONE
	HRROI B,0(B)
	SETZ C,
	SOUT			;COPY IT
TFIL4:	MOVEI B,EXTPCT
	IDPB B,A		;PUNCTUATE EXTENSION
	MOVEI B,.FCEXT
	CALL SCNBF		;FIND EXTENSION BLOCK
	 JRST TFIL5		;NONE
	HRROI B,0(B)
	SETZ C,
	SOUT			;COPY IT
TFIL5:	MOVEI B,GENPCT
	IDPB B,A		;PUNCTUATE GENERATION
	MOVEI B,.FCGEN
	CALL SCNBF		;FIND GEN
	 JRST TFIL6		;NONE
	HRROI B,0(B)
	MOVEM B,Q2		;SAVE PTR TO GEN STRING
	SETZ C,
	SOUT			;COPY IT
	MOVE A,Q2		;GET PTR TO GEN STRING
	MOVEI C,^D10
	NIN			;CONVERT GEN TO NUMBER
	 CALL JSERR1
	STOR B,FB%GEN,BUFF+FHFDB+.FBGEN ;PUT IN FDB
TFIL6:	JRST TFIL7		;DONE WITH NAME
;ROUTINE TO SCAN NAME BLOCK LOOKING FOR SPECIFIED SUB-BLOCK
; B/ DESIRED BLOCK TYPE
; D/ PTR TO BLOCK
;RETURN +1,
;  B/ PTR TO DATA

SCNBF:	STKVAR <TT1>
	MOVEM D,TT1		;SAVE MAIN PTR
	MOVN C,0(D)		;GET LENGTH OF BLOCK
	HRL D,C			;SET LIMIT
	AOBJN D,.+1		;STEP PAST HEADER
SCNBF1:	HLRZ C,0(D)		;GET SUB-BLOCK TYPE
	CAMN C,B		;REQUESTED ONE?
	JRST [	MOVEI B,1(D)	;YES, RETURN PTR TO DATA
		MOVE D,TT1	;RESTORE D
		RETSKP]
	HRRZ C,0(D)		;BUMP SUB-BLOCK
	HRL C,C
	ADDM C,D
	SKIPE 0(D)		;END OF DATA?
	JUMPL D,SCNBF1		;JUMP UNLESS END OF BLOCK
	MOVE D,TT1		;RESTORE D
	RET			;TYPE NOT FOUND

;ATTRIBUTE BLOCK

TFIL2F:	MOVEI C,1(D)		;POINT TO DATA PORTION
	MOVE A,A$WRIT(C)	;COPY ITEMS - WRITE DATE
	MOVEM A,BUFF+FHFDB+.FBWRT
	MOVE A,A$BSIZ(C)
	STOR A,FB%BSZ,BUFF+FHFDB+.FBBYV
	PUSH P,C		;SAVE C
	SKIPN A			;IS BYTE SIZE ZERO?
	MOVEI A,^D36		;YES-- ASSUME 36 BIT BYTES
	MOVEI B,^D36		;BITS IN A WORD
	IDIV B,A		;BYTES IN A WORD
	POP P,C			;RESTOR C
	MOVE A,A$LENG(C)
	MOVEM A,BUFF+FHFDB+.FBSIZ
	ADDI A,-1(B)		;ROUND UP
	IDIV A,B		;WORDS IN FILE
	ADDI A,PGSIZ-1		;ROUND UP
	IDIVI A,PGSIZ		;FULL PAGES IN FILE
	STOR A,FB%PGC,BUFF+FHFDB+.FBBYV
	MOVE A,[BUFF+FHFDB,,ICFDB]
	BLT A,ICFDB+.FBLN0-1	;SAVE FDB FOR EOF
	JRST TFIL7

;LAST RECORD OF FILE, DATA ALREADY COPIED

TFIL8:	MOVE A,[ICFDB,,BUFF]	;COPY FDB SAVED FROM FIRST RECORD
	BLT A,BUFF+.FBLN0
	MOVX A,-FLTRX		;FILE TRAILER
	MOVEM A,TYP
	RETSKP
;DUMPER FORMAT TO INTERCHANGE FORMAT CONVERSION ON OUTPUT
; A/ DUMP BUFFER ADDRESS

ICXBUF=ICOBUF+NHEAD		;DATA AREA OF LOCAL BUFFER

ICOCNV:	ACVAR <Q1>
	MOVEM A,Q1		;SAVE BUFFER ADDRESS
	TXZ F,TF1		;NOTE NO OUTPUT DATA YET
	TXZN F,ICMT1		;HAVE PREVIOUS BUFFER?
	JRST ICOCNX		;NO, RETURN IMMEDIATELY
	MOVEI A,1(Q1)		;CLEAR DEST BUFFER
	HRL A,Q1
	SETZM -1(A)
	BLT A,NIHEAD+PGSIZ-1(Q1)
	MOVE A,ICOBUF+XTAPNO	;COPY STANDARD ITEMS - TAPE NUMBER
	MOVEM A,G$RTNM(Q1)
	MOVX A,GF$NCH		; - FLAGS, NO CHECKSUM
	MOVEM A,G$FLAG(Q1)
	MOVN A,ICOBUF+XTYP	;DISPATCH ON TYPE
	CAIN A,DATAX		;DATA RECORD?
	JRST ICODAT
	CAIE A,CTPHX
	CAIN A,TPHDX		;TAPE HEADER?
	JRST ICOTPH
	CAIN A,FLHDX		;FILE HEADER?
	JRST ICOFLH
	CAIN A,FLTRX		;FILE TRAILER?
	JRST ICOFLT
	CAIN A,TPTRX		;TAPE TRAILER?
	JRST ICOTPT
	CAIN A,USRX		;USER DATA?
	JRST ICOUSR
	JRST ICOCNX		;(IMPOSSIBLE)

;STANDARD RETURNS, VALID DATA IN DEST BUFFER

ICOCNY:	TXO F,TF1		;NOTE DATA IN BUFFER
	AOS A,RSEQ		;COMPUTE NEXT SEQ NUMBER
	MOVEM A,G$SEQ(Q1)	;LEAVE IT IN BUFFER

;NO DATA IN DEST BUFFER

ICOCNX:	HRLZ A,CURBUF		;CURRENT DATA BUFFER
	HRRI A,ICOBUF+NHEAD	; TO TEMP BUFFER
	BLT A,ICOBUF+NHEAD+PGSIZ-1 ;COPY BUFFER
	MOVE A,[XBUFF,,ICOBUF]	;NOW COPY HEADER
	BLT A,ICOBUF+NHEAD-1
	TXO F,ICMT1		;NOTE ICOBUF VALID
	TXNN F,TF1		;DEST BUFFER VALID?
	RET			;NO
	RETSKP			;YES
;FINISH PENDING OUTPUT - DONE AT END OF TAPE

ICOFIN:	CALL MTOUT		;CAUSE PENDING RECORD TO BE WRITTEN
	TXZ F,ICMT1		;NO PENDING RECORD NOW
	RET

;FILE TRAILER, USER DATA - PRODUCE NO OUTPUT

ICOFLT:
ICOUSR:	JRST ICOCNX

;TAPE HEADER

ICOTPH:	MOVX A,T$BEG		;SAVESET BEGIN
ICOTP1:	MOVEM A,G$TYPE(Q1)
	MOVE A,ICXBUF+BFTAD	;TAD
	MOVEM A,S$DATE(Q1)
	MOVX A,BKFMT		;BACKUP FORMAT VERSION
	MOVEM A,S$FMT(Q1)

;S$BVER, S$MON, S$SVER, S$APR, S$DEV, S$MTCH NOT PROVIDED

	HRROI A,NIHEAD+1(Q1)	;DEST FOR SAVESET NAME
	HRROI B,ICXBUF+BFMSG	;SOURCE OF SAVESET NAME
	SETZ C,
	SOUT			;COPY SAVESET NAME TO DEST BFR
	SUBI A,NIHEAD-1(Q1)	;COMPUTE NUMBER WORDS USED
	MOVEM A,NIHEAD(Q1)	;SETUP ONE-WORD HEADER
	MOVEM A,G$LND(Q1)	;NOTE SIZE OF NON-DATA AREA
	MOVX A,O$SSNM		;INCLUDE CODE
	HRLM A,NIHEAD(Q1)
	JRST ICOCNY		;RETURN VALID BUFFER

;TAPE TRAILER

ICOTPT:	MOVX A,T$END		;SAVESET END
	JRST ICOTP1		;SAME AS HEADER

;DATA RECORD

ICODAT:	MOVX A,T$FIL		;TYPE CODE
	MOVEM A,G$TYPE(Q1)
	MOVEI A,PGSIZ		;ASSUME FULL PAGE OF DATA HERE UNLESS...
	CAMLE A,ICOLEN		;NOT THAT MUCH LEFT IN FILE
	MOVE A,ICOLEN		;USE WHATEVER IS LEFT
	MOVEM A,G$SIZ(Q1)	;SET DATA WORD COUNT THIS RECORD
	MOVN A,A
	ADDM A,ICOLEN		;UPDATE REMAINING COUNT
	MOVX A,GF$EOF
	MOVN B,TYP		;CHECK TYPE OF NEXT RECORD
	CAIN B,FLTRX		;IS IT FILE TRAILER?
	IORM A,G$FLAG(Q1)	;YES, NOTE THIS LAST RECORD OF FILE
	HRRZ A,ICOBUF+XPAGNO	;COMPUTE RELATIVE WORD NUMBER
	IMULI A,PGSIZ
	MOVEM A,F$RDW(Q1)
	MOVSI A,ICXBUF		;COPY DATA TO DEST BUFFER
	HRRI A,NIHEAD(Q1)
	BLT A,NIHEAD+PGSIZ-1(Q1)
	JRST ICOCNY		;RETURN BUFFER
;FILE HEADER

ICOFLH:	MOVX A,T$FIL		;RECORD TYPE
	MOVEM A,G$TYPE(Q1)
	MOVEI A,F$NND		;NOTE SIZE OF NON-DATA AREA THIS RECORD
	MOVEM A,G$LND(Q1)
	MOVX A,GF$SOF		;FLAGS - START OF FILE
	IORM A,G$FLAG(Q1)
	MOVEI D,NIHEAD+1(Q1)	;BEG OF AREA FOR FILENAME
	MOVX A,O$NAME		;INDICATE NAME BLOCK
	HRLM A,-1(D)
	MOVX A,F$NND/2		;STANDARD SIZE
	HRRM A,-1(D)
	MOVE B,[POINT 7,ICXBUF+FHNAM] ;PTR TO NAME
ICOFH1:	ILDB C,B		;FIND START OF DIRECTORY
	CAIE C,DIRBP
	JRST ICOFH1
	MOVX A,.FCDIR		;INDICATE DIR BLOCK
	HRLM A,0(D)
	MOVEI A,DIREP
	CALL ICOFHC		;COPY DIRECTORY STRING
	MOVX A,.FCNAM		;INDICATE NAME BLOCK
	HRLM A,0(D)
	MOVEI A,EXTPCT
	CALL ICOFHC		;COPY NAME STRING
	MOVX A,.FCEXT
	HRLM A,0(D)		;INDICATE EXT BLOCK
	MOVEI A,GENPCT
	CALL ICOFHC		;COPY EXT STRING
	MOVX A,.FCGEN		;INDICATE GENERATION BLOCK
	HRLM A,0(D)
	MOVEI A,ATTPCT
	CALL ICOFHC		;COPY GENERATION STRING
	MOVEI D,NIHEAD+F$NND/2+1(Q1) ;BEG OF AREA FOR ATTRIBUTES
	MOVX A,O$FILE		;INDICATE ATTRIBUTE BLOCK
	HRLM A,-1(D)
	MOVX A,F$NND/2		;STANDARD SIZE
	HRRM A,-1(D)
	MOVE A,ICXBUF+FHFDB+.FBWRT
	MOVEM A,A$WRIT(D)	;COPY WRITE DATE
	LOAD B,FB%BSZ,ICXBUF+FHFDB+.FBBYV ;GET FILE BYTE SIZE
	JUMPE B,[		;IF BYTE SIZE IS ZERO, USE 36
		LOAD A,FB%PGC,ICXBUF+FHFDB+.FBBYV ;GET PAGE COUNT
		IMULI A,PGSIZ		;GET ACTUAL SIZE IN WORDS
		MOVEM A,ICXBUF+FHFDB+.FBSIZ ;AND USE AS FILE BYTE COUNT
		MOVEI B,^D36		;GET BYTE SIZE
		JRST .+1]
	MOVEM B,A$BSIZ(D)
	MOVEI A,^D36
	IDIV A,B		;COMPUTE ACTUAL BYTES/WD
	MOVE B,ICXBUF+FHFDB+.FBSIZ ;GET FILE BYTE COUNT
	MOVEM B,A$LENG(D)	;SET BYTE COUNT
	IDIV B,A		;CONVERT BYTE COUNT TO 36-BIT BYTES
	SKIPE C			;REMAINDER?
	AOS B			;YES, ACCOUNT FOR PARTIAL WORD
	MOVEM B,ICOLEN		;KEEP LOCAL COUNT
	MOVEM B,A$ALLS(D)	;USE IT AS ALLOCATION ALSO
	MOVX A,.DMIMG		;USE STANDARD MODE
	MOVEM A,A$MODE(D)
	JRST ICOCNY

;LOCAL ROUTINE TO COPY FILESPEC STRING
; A/ TERMINATING CHARACTER FOR CURRENT FIELD
; B/ SOURCE STRING PTR
; D/ DEST ADDRESS

ICOFHC:	ACVAR <Q1>
	MOVEM A,Q1		;SAVE TERMINATOR
	MOVEI A,1(D)		;CONSTRUCT STRING PTR
	HRLI A,(POINT 7,0)
ICOFC1:	ILDB C,B		;GET CHAR
	CAME C,Q1		;TERMINATOR?
	JUMPN C,[IDPB C,A	;NO, APPEND IT TO DEST
		JRST ICOFC1]
	SUBI A,-1(D)		;YES, COMPUTE WORDS IN BLOCK
	HRRM A,0(D)		;PUT COUNT IN BLOCK HEADER
	ADDI D,0(A)		;BUMP DEST PTR
	RET
	SUBTTL UTILITY SUBROUTINES

;READ LINE INTO LINBUF
;	CALL RDLIN
; RETURN +1 ALWAYS

RDLIN:	CALL TSTINT		;CHECK FOR INTERRUPT REQUEST
	HRROI A,LINBUF
	MOVE B,[RD%BRK+RD%BEL+RD%RAI+NLINB*5]
	SETZ C,
	RDTTY
	 JSERR
	MOVEI B,.CHCRT		;TIE OFF LINE IN CASE ESC OR ^Z
	IDPB B,A
	MOVEI B,.CHLFD
	IDPB B,A
	RET

;ROUTINE TO ACCEPT YES/NO ANSWER FROM USER.  REQUIRES USER TO
;TYPE Y OR N.  RETURNS "TRUE" (NON-0) ON Y, "FALSE" (0) ON N IN AC1.
;CALL WITH PROMPT STRING IN A

YESNO:	MOVEM A,CBLK+.CMRTY	;SAVE PROMPT STRING
YESNO0:	PUSH P,CBLK+.CMRTY	;SAVE PROMPT STRING
	CALL TSTINT		;CHECK FOR INTERRUPT REQUEST
	POP P,B			;GET POINTER TO PROMPT
	MOVEI A,YESNO1		;REPARSE ADDRESS
	CALL CMDINI		;INIT FOR COMND JSYS
YESNO1:	MOVEI B,[FLDDB. .CMKEY,,YNTBL]
	COMND
	TXNE A,CM%NOP
	ERROR YESNO0,<?YES or NO only>
	HRRZ D,0(B)		;GET DATA
	MOVEI B,[FLDDB. .CMCFM]
	COMND
	TXNE A,CM%NOP		;CONFIRMED?
	ERROR YESNO0,<?NOT CONFIRMED>
	MOVE A,D		;GET DATA BACK
	RET			;RETURN FROM YESNO, 1= YES, 0= NO IN A

YNTBL:	XWD YNTBLZ,YNTBLZ
	TB 0,<NO>
	TB 1,<YES>
YNTBLZ==.-YNTBL-1



TDRNAM:	TXNE F,LDIRF	;YES, TYPE DIR NAMES REQUESTED?
	TXNE F,LTTYF	;AND NOT LOGGING TO TTY?
	RET		;NO
	HRROI B,DIRNAM	;YES, TYPE DIR NAME
	CALL TMSGQ
	TXNN F,DIRCHG 	;SKIP IF DIRECTORY NAMES CHANGE
	JRST TDRNA1	;NO
	TMSG < (AS) >
	HRROI B,ODRNAM		;OUTPUT DIRECTORY NAME
	CALL TMSGQ
TDRNA1:	TMSG <
>
	RET

; NSVOL - CONVERT INTEGER ARCHIVE TAPE NUMBERS TO SIXBIT
;  A/ INTEGER TAPE NUMBER OR SIXBIT VOLID
; RETURNS +1: ALWAYS, A/ SIXBIT VOLID

NSVOL:	TLNE A,-1		;IS IT SIXBIT ALREADY?
	RET			;YES, RETURN
	MOVE B,A		;COPY INTEGER TO B
	SETZ A,
NSVOL1:	IDIVI B,12		;DIVIDE BY 10
	ADDI C,20		;CONVERT REMAINDER TO SIXBIT DIGIT
	LSH A,-6		;MAKE ROOM
	DPB C,[POINT 6,A,5]	;STORE IT
	JUMPN B,NSVOL1		;LOOP UNTIL NO DIGITS LEFT
	RET

; TYP6 - TYPE SIXBIT QUANTITY IN A

TYP6:	MOVE B,A
TYP61:	SETZ A,
	LSHC A,6		;GET SIXBIT CHAR
	ADDI A,40		;CONVERT TO ASCII
	PBOUT			;TYPE IT
	JUMPN B,TYP61		;LOOP IF MORE CHARACTERS TO TYPE
	RET
;PRINT STANDARD ERROR MSG AND RETURN

JSERR1:	PUSH P,A
	CALL NOCTRO		;TURN OFF CONTROL O
	HRROI A,[ASCIZ /
?JSYS error: /]
	PSOUT
	JRST JSERM1

;ENTRY TO PRINT ERROR MESSAGE ONLY

JSERRM:	PUSH P,A
JSERM1:	PUSH P,B
	PUSH P,C
	MOVEI A,101
	HRLOI B,400000		;SAY THIS FORK,,LAST ERROR
	SETZ C,
	ERSTR
	 JFCL
	 JFCL
	HRROI A,[ASCIZ /
/]
	PSOUT
	POP P,C
	POP P,B
	POP P,A
	RET

;TURN OFF CONTROL O (IN CASE IT IS ON) FOR ERROR MESSAGE

NOCTRO: PUSH P,A
	PUSH P,B
	MOVEI A,.PRIOU		;PRIMARY OUTPUT
	RFMOD
	TLZ B,(TT%OSP)		;TURN OFF
	SFMOD
	POP P,B
	POP P,A
	RET

;HERE IF CHANGED REELS IN MIDDLE OF RESTORING FILE AND PAGE #'S
;MISSING OR DON'T MATCH
MISFPG:	TMSGC <%File >
	HRROI B,TFNAME		;FILE NAME
	CALL TMSGQ
	TMSG < continued from previous reel has missing page(s)
>
	RET
;SUBROUTINE TO SET UP DEFAULT FILE SPECS FOR THE SOURCE FILE SPECS IN
;THE SAVE AND RESTORE COMMANDS.  THE CALLER SUPPLIES IN T1 THE ADDRESS
;OF A LIST OF FOUR ROUTINES TO BE CALLED DEPENDING ON WHETHER OR NOT
;WE ARE IN INTERCHANGE MODE, OR A WHEEL.  THE ROUTINES ARE ONE OF:
;
;	CSCD	SET UP CONNECTED STRUCTURE AND DIRECTORY AS DEFAULTS
;	CSWD	SET UP CONNECTED STRUCTURE, BUT WILD DIRECTORY
;	WSCD	SET UP WILD STRUCTURE, BUT CONNECTED DIRECTORY
;	WSWD	SET UP WILD STRUCTURE AND DIRECTORY AS DEFAULTS
;
;THE BLOCK POINTED TO BY AC T1 GIVES WHICH ROUTINE TO CALL.  THE OFFSETS
;INTO THE BLOCK CORRESPOND TO THE FOLLOWING CASES:
;
;	0	NOT WHEEL, NOT INTERCHANGE MODE
;	1	WHEEL, NOT INTERCHANGE MODE
;	2	NOT WHEEL, INTERCHANGE MODE
;	3	WHEEL, INTERCHANGE MODE



FILDFI:	SKIPE WHEEL		;PRIVILEGED?
	ADDI T1,1		;YES, CHANGE POINTER TO RIGHT ROUTINE
	TXNE F,ICMODF		;INTERCHANGE MODE?
	ADDI T1,2		;YES, CHANGE POINTER SOME MORE
	CALL @(T1)		;SET UP STRUCTURE AND DIRECTORY POINTERS
	HRROI A,[ASCIZ/*/]	;GET WILDCARD STRING
	MOVEM A,GJBLK+.GJNAM	;DEFAULT NAME TO FULL WILDCARD
	MOVEM A,GJBLK+.GJEXT	;AND EXTENSION
	MOVEI A,.GJALL		;DEFAULT VERSION TO *
	HRRM A,GJBLK+.GJGEN
	MOVE A,[.PRIIN,,.PRIOU]	;PRIMARY INPUT AND OUTPUT
	MOVEM A,GJBLK+.GJSRC
	MOVX A,G1%IIN		;FIND INVISABLE FILES
	MOVEM A,GJBLK+.GJF2
	RET
;ROUTINE TO SET UP DEFAULTS TO BE MY CONNECTED DIRECTORY AND STRUCTURE.

CSCD:	MOVE A,CONSTR		;GET POINTER TO CONNECTED STRUCTURE
	MOVEM A,GJBLK+.GJDEV	;STORE IT
	MOVE A,CONDIR		;AND POINTER TO CONNECTED DIRECTORY
	MOVEM A,GJBLK+.GJDIR	;STORE IT TOO
	RET			;DONE



;ROUTINE TO SET DEFAULT TO CONNECTED STRUCTURE, BUT WILD DIRECTORY

CSWD:	MOVE A,CONSTR		;GET POINTER TO CONNECTED STRUCTURE
	MOVEM A,GJBLK+.GJDEV	;SET IT
	HRROI A,[ASCIZ/*/]	;THEN GET WILD DIRECTORY STRING
	MOVEM A,GJBLK+.GJDIR	;AND SET IT
	RET			;DONE



;ROUTINE TO SET DEFAULT TO WILD STRUCTURE, CONNECTED DIRECTORY

WSCD:	HRROI A,[ASCIZ/DSK*/]	;POINT TO WILD STRUCTURE STRING
	MOVEM A,GJBLK+.GJDEV	;SET IT
	MOVE A,CONDIR		;GET POINTER TO CONNECTED DIRECTORY
	MOVEM A,GJBLK+.GJDIR	;SET IT TOO
	RET			;DONE



;ROUTINE TO SET DEFAULT TO WILD STRUCTURE AND DIRECTORY

WSWD:	HRROI A,[ASCIZ/DSK*/]	;POINT TO WILD STRUCTURE
	MOVEM A,GJBLK+.GJDEV	;SET IT
	HRROI A,[ASCIZ/*/]	;POINT TO WILD DIRECTORY TOO
	MOVEM A,GJBLK+.GJDIR	;SET IT
	RET			;DONE
;SUBROUTINE TO OBTAIN THE CURRENTLY CONNECTED STRUCTURE AND DIRECTORY.
;POINTERS TO THE STRINGS ARE RETURNED IN LOCATIONS CONSTR AND CONDIR,
;OR ZERO IF WE FAIL.  ALWAYS RETURNS +1.



GETCON:	SETZM CONSTR		;CLEAR THIS IN CASE OF FAILURE
	SETZM CONDIR		;AND THIS TOO
	GJINF			;READ INFORMATION ABOUT THIS JOB
	HRROI A,CONBUF		;POINT TO STORAGE
	DIRST			;STORE CONNECTED STRUCTURE AND DIRECTORY
	 ERJMP JSERR1		;FAILED
	MOVE A,[POINT 7,CONBUF]	;GET POINTER TO THE STRING
GETCN1:	ILDB B,A		;READ NEXT CHARACTER
	JUMPE B,R		;RETURN IF STRING ENDS TOO EARLY
	CAIE B,DEVPCT		;END OF DEVICE?
	JRST GETCN1		;NO, KEEP GOING
	SETZ C,			;YES, GET A NULL
	DPB C,A			;OVERWRITE COLON TO TERMINATE DEVICE
	HRROI B,CONBUF		;GET POINTER TO DEVICE STRING
	MOVEM B,CONSTR		;AND REMEMBER IT
	ILDB B,A		;GET NEXT CHARACTER
	CAIE B,DIRBP		;DIRECTORY COMING UP?
	RET			;NO, RETURN
	MOVEM A,CONDIR		;YES, REMEMBER POINTER TO IT
GETCN2:	ILDB B,A		;SEARCH FOR END OF DIRECTORY
	JUMPE B,R		;DONE IF STRING ENDS
	CAIE B,DIREP		;FOUND ENDING PUNCTUATION?
	JRST GETCN2		;NO, KEEP GOING
	DPB C,A			;REPLACE BRACKET WITH NULL
	RET			;DONE
;USE INPUT FIELDS AS DEFAULTS FOR OUTPUT SIDE
; Q1-1/ INDEX TO JFNLST AND JF2LST TABLES

OFNAME:	MOVSI D,-NFFLD		;SETUP NUMBER OF FIELDS TO CONSTRUCT
OFNAM1:	MOVE B,JFNLST-1(Q1)	;GET INPUT JFN
	HRRO A,FSTRT(D)		;SETUP ADR OF DEFAULT STRING
	MOVEM A,GJBLK+.GJDEV(D) ;IN GTJFN BLOCK ALSO
	MOVE C,FFLDT(D)		;REQUEST FIELD FROM JFNS
	JFNS			;SETUP DEFAULT STRING
OFNAM2:	AOBJN D,OFNAM1		;DO ALL FIELDS
	SETZM GJBLK+.GJPRO	;CLEAR PROTECTION WORD WRONGLY SET ABOVE
	RET			;HAVE DEFAULT OUTPUT NAME


;NOW COOK UP APPROPRIATE OUTPUT NAME
; P5/ INDEX TO JFNLST AND JF2LST TABLES

OUTFIL:	MOVSI Q1,-NFFLD		;SETUP NUMBER OF FIELDS TO CONSTRUCT
	SKIPN D,JF2LST(P5)	;HAVE AN OUTPUT SPEC?
	JRST [	SETZM GJBLK+.GJDEV ;NO, USE DEFAULT DEVICE
		MOVX D,GJ%DEV+GJ%UNT+GJ%DIR+GJ%NAM+GJ%EXT+GJ%VER ;ASSUME ALL STARS
		JRST .+1]
OUTFI1:	MOVE B,D		;USE OUTPUT JFN UNLESS...
	HLLZ A,FSTRT(Q1)	;GET STAR BIT FOR THIS FIELD
	TDNE D,A		;OUTPUT STAR HERE?
	HRRZ B,JFN		;YES, USE INPUT FIELD
	HRRO A,FSTRT(Q1)	;SETUP ADR OF DEFAULT STRING
	MOVEM A,GJBLK+.GJDEV(Q1) ;IN GTJFN BLOCK ALSO
	MOVE C,FFLDT(Q1)	;REQUEST FIELD FROM JFNS
	JFNS			;SETUP DEFAULT STRING
OUTFI2:	AOBJN Q1,OUTFI1		;DO ALL FIELDS
	SETZM GJBLK+.GJPRO	;CLEAR PROTECTION WORD WRONGLY SET ABOVE
	RET


;HERE GET FULL OUTPUT FILE SPEC, DEVICE THROUGH GENERATION
;STORE IN ONMBUF

GOFNAM:	HRROI A,ONMBUF		;STORE NAME HERE
	MOVX D,GJ%DEV+GJ%UNT	;DEVICE
	MOVX C,<FLD(.JSAOF,JS%DEV)+JS%PAF>
	CALL .JFNS		;DO JFNS
	MOVX D,GJ%DIR		;DIRECTORY
	MOVX C,<FLD(.JSAOF,JS%DIR)+JS%PAF>
	CALL .JFNS
	MOVX D,GJ%NAM		;NAME
	MOVX C,<FLD(.JSAOF,JS%NAM)+JS%PAF>
	MOVEM A,ONMPTR		;SAVE NAME POINTER
	CALL .JFNS
	MOVX D,GJ%EXT		;EXTENSION
	MOVX C,<FLD(.JSAOF,JS%TYP)+JS%PAF>
	CALL .JFNS
	MOVX D,GJ%VER		;GENERATION #
	MOVX C,<FLD(.JSAOF,JS%GEN)+JS%PAF>
	MOVEM A,OGNPTR		;SAVE GENERATION POINTER
;	CALLRET .JFNS		;GET GEN # AND RETURN FROM GOFNAM

.JFNS:	TDNN D,JF2LST(P5)	;OUTPUT * HERE?
	SKIPN B,JF2LST(P5)	;NO, USE OUTPUT FIELD
	HRRZ B,JFN		;PICKUP INPUT FIELD
	JFNS
	RET

;GET REST OF OUTPUT FILE NAME: PROTECTION, ACCOUNT, AND ;T

GOFPAT:	TXNE F,ICMODF		;INTERCHANGE MODE?
	JRST GOFPT1		;YES, DON'T USE TAPE PROTECTION
	MOVX D,GJ%PRO		;PROTECTION
	MOVX C,<FLD(.JSAOF,JS%PRO)+JS%PAF>
	TXNE F,RESPRO		;USE SYSTEM DEFAULT?
	CALL .JFNSX		;NO-- GET SPECIFIED VALUE
GOFPT1:	MOVX D,GJ%TFS		; ;T
	MOVX C,<JS%TMP+JS%PAF>
	CALL .JFNSX		;GET ;T
	MOVEM A,OACPTR		;REMEMBER WHERE ACCOUNT STARTS
	MOVX D,GJ%ACT		;ACCOUNT
	MOVX C,<FLD(.JSAOF,JS%ACT)+JS%PAF>
	TXNE F,RESACC		;USE SYSTEM DEFAULT?
	CALL .JFNSX		;NO-- GET SPECIFIED VALUE
	RET			;RETURN FROM GOFPAT

.JFNSX:	TXNE F,ICMODF		;INTERCHANGE MODE?
	TDNE D,JF2LST(P5)	;YES-- BUT IS OUTPUT SPECIFIED?
	SKIPA			;OUTPUT SPECIFIED OR NOT INTERCHANGE-- OK
	RET			;INTERCHANGE MODE AND NO OUTPUT SPEC-- USE SYSTEM DEFAULT
	TDNE D,JF2LST(P5)	;OUTPUT SPECIFIED HERE?
	SKIPN B,JF2LST(P5)	;YES, USE OUTPUT FIELD
	HRRZ B,JFN		;PICKUP INPUT FIELD
	JFNS
	RET

;FILESPEC FIELD TABLES

FSTRT:	GJ%DEV+GJ%UNT+DEFDEV	;STAR FOR DEVICE ,, DEFAULT DEVICE STRING
	GJ%DIR+DEFDIR		;STAR FOR DIRECTORY
	GJ%NAM+DEFNAM		; " NAME
	GJ%EXT+DEFEXT		; " EXTENSION
	GJ%VER+DEFVER		; " VERSION

FFLDT:	1B2			;JFNS PRINT DEVICE
	1B5			;JFNS PRINT DIRECTORY
	1B8			; " NAME
	1B11			; " EXTENSION
	1B14			; " VERSION
NFFLD==.-FFLDT
;HERE TO FIGURE FILE SIZE IN PAGES AND REMAINDER

FILSZE:	LOAD A,FB%BSZ,BUFF+FHFDB+.FBBYV
	MOVEI B,44	;BITS IN A WORD
	IDIV B,A	;BYTES IN A WORD
	MOVE C,BUFF+FHFDB+.FBSIZ  ;BYTES IN FILE
	IDIV C,B	;WORDS IN FILE
	SKIPE D		;SKIP IF NO REMAINDER
	AOS C
	IDIVI C,PGSIZ	;PAGES IN FILE
	MOVEM C,FPGCNT	;FILE PAGE COUNT
	MOVEM D,RMRPGE	;REMAINDER PAGE
	RET

;HERE FOR CHECKSUM OF PAGE

PGECSM:	TXNE F,CS%SEQ	;SKIP IF NOT SEQUENTIAL CHECKSUM
	JRST SEQCSM	;DO SEQUENTIAL CHECKSUM
	HRRZ D,PAGNO	;GET PAGE #
	SUB D,LSTPGE	;SEE IF HOLE
	SOJLE D,PCHKS1		;JUMP IF NO HOLE
	MOVNI C,(D)		;YES, GET -PAGE #
	HRL C,D			;MAKE IT PAGE #,,-PAGE #
	PUSH P,C		;STUFF WORD ONTO STACK
	MOVSI C,-1
	HRRI C,-BUFF(P)	;ARRANGE TO POINT AT IT
	CALL CHKSOM		;CHECKSUM 1 WORD
	POP P,(P)		;RESTORE STACK
PCHKS1:	MOVSI C,-1000		;SETUP AOBJN POINTER TO WHOLE PAGE
	CALL CHKSOM		;CHECKSUM IT
	MOVE A,PAGNO		;GET PAGE #
	HRRZM A,LSTPGE		;STORE
	RET			;DONE WITH PAGE
;HERE FOR SEQUENTIAL CHECKSUM
SEQCSM:	SOSGE FPGCNT		;DECREMENT WHOLE PAGE CONT
	JRST SEQCS1		;NO WHOLE PAGES LEFT
	MOVSI C,-1000		;WORDS TO CHECKSUM
	CALLRET CHKSOM		;CHECKSUM PAGE

SEQCS1:	SKIPN C,RMRPGE		;GET REMAINDER TO CHECK
	RET			;NOTHING TO CHECK
	MOVNS C			;NEGATE WORDS TO CHECK
	HRLZS C			;...
	SETZM RMRPGE		;DON'T CHECK AGAIN
	CALLRET CHKSOM		;CHECK SUM PAGE

;HERE TO CHECKSUM COUNT OF WORDS IN C
CHKSOM:	MOVE D,CHKCN0
CHKSM1:	ROT D,1
	ADD D,BUFF(C)
	AOBJN C,CHKSM1		;LOOP ON WORD COUNT
	MOVEM D,CHKCN0
	RET
;ROUTINES TO MANIPULATE JFN STACK

;ADD JFN TO JFN STACK
;ALL AC'S PRESERVED
;	B HAS JFN IN RIGHT HALF

ADLIST: PUSH P,D		;SAVE AC
	HLRZ D,CURPTR		;CHECK FOR STACK OVERFLOW
	CAIN D,-1		;SKIP IF NOT FULL
	ERROR START,<?JFN STACK OVERFLOW>
	MOVE D,CURPTR		;PICK UP STACK POINTER
	PUSH D,B		;PUT JFN ON STACK
	MOVEM D,CURPTR		;STORE UPDATED STACK POINTER
	POP P,D			;RESTORE D
	RET			;RETURN

;HERE TO RELEASE JFN STORED ON STACK
;	A HAS JFN IN RH

RLSJFN:	HRRZS A			;CLEAR LEFT HALF
	GTSTS			;GET JFN STATUS
	TXNN B,GS%NAM		;SKIP IF JFN OWNED
	RET			;NOTHING TO DO
	TXNN B,GS%OPN		;SKIP IF JFN IS OPEN
	JRST [RLJFN		;RELEASE IT IF NOT
		ERROR START,<?CANNOT RELEASE JFN>
		RET]
	CLOSF			;CLOSE AND RELEASE JFN
	ERROR START,<?CANNOT CLOSE AND RELEASE JFN>
	RET

;HERE TO ADD A FILE--BE SURE IT IS A DISK FILE

ADFILE:	CALL ADLIST		;ADD TO JFN STACK
	CALL CHKDVC		;CHECK FOR DEVICE DISK
	RET

;ROUTINE TO TAKE JFN'S OFF STACK
;	D HAS FINAL DESIRED POINTER
;	RETURNS FINAL DESIRED POINTER IN D
;ASSUMES A,B,C,D ARE FREE

RSTSTK:	CAMN D,CURPTR		;SEE IF ANYTHING THERE
	RET			;NOPE
	PUSH P,D		;SAVE FINAL POINTER
	MOVE D,CURPTR		;CURRENT POINTER
RSTST1:	POP D,A			;GET JFN OFF STACK
	CALL RLSJFN		;RELEASE JFN
	CAME D,(P)		;COMPARE POINTERS
	JRST RSTST1		;NOT DONE
	POP P,D			;GET FINAL POINTER
	MOVEM D,CURPTR		;USE AS CURRENT POINTER
	RET			;RETURN
;CHKDVC - CHECK THAT JFN IN B SPECIFIES A DISK FILE

CHKDVC:	PUSH P,A	;SAVE AC'S
	PUSH P,B
	HRRZ A,B	;GET JFN TO CHECK
	DVCHR
	 ERJMP CHKDV1	;PROBABLY STDVX1 (NO SUCH DEVICE)
	LOAD A,DV%TYP,B
	CAIE A,.DVDSK	;SHOULD ALWAYS BE A DISK FILE TYPE
CHKDV1:	ERROR BMBCM1,<?DEVICE MUST BE DISK>
	POP P,B
	POP P,A
	RET

;HERE TO RESET BACK TO INIPTR

INIRST:	MOVE D,INIPTR		;FINAL POINTER
	CALL RSTSTK		;RESET STACK TO START OF WORLD
	MOVEM D,RPSPTR		;RESET REPARSE POINTER
	MOVEM D,CMDPTR		;COMMAND POINTER
	RET
TTNOUT:	MOVEI A,.PRIOU
	NOUT
	 JSERR
	RET

BTNOUT:	TXNN F,LTTYF		;LISTING TO TTY?
	CALL TTNOUT		;NO, DO TTY FIRST
LPNOUT:	SKIPN LPTJFN		;SKIP IF LISTING
	RET
	HRROI A,LPTBUF		;PUT NUMBER IN LOCAL BUFFER FIRST
	NOUT
	 JSERR
	PUSH P,B
	PUSH P,C
	MOVE B,[POINT 7,LPTBUF]
	CALL LPMSGQ		;TRANSMIT TO LPT
	POP P,C
	POP P,B
	RET

TMSGQC:	PUSH P,B
	MOVEI 1,.PRIOU
	DOBE
	RFPOS
	TRNN B,-1
	JRST TMSGC1
	TMSG <
>
TMSGC1:	POP P,B

TMSGQ:	MOVEI 1,.PRIOU
	MOVEI C,0
	SOUT
	RET

BTMSQC:	PUSH P,B
	TXNE F,LTTYF
	SKIPN A,LPTJFN
	JRST BTMSC1
	DOBE
	RFPOS
	TRNN B,-1
	JRST BTMSC2
BTMSC1:	LPMSG <
>
BTMSC2:	MOVE B,(P)
	TXNN F,LTTYF
	CALL TMSGQC
	POP P,B
	CALLRET LPMSGQ

BTMSGQ:	PUSH P,B
	TXNN F,LTTYF		;NOT TO TTY IF LOGGING IS TO TTY
	CALL TMSGQ
	POP P,B
LPMSGQ:	SKIPN LPTJFN
	RET
	MOVE A,LPTLIN
	CAIL A,PAGLEN		;AT END OF LISTING PAGE?
	CALL LNEWPG		;YES, START A NEW ONE
	MOVE A,LPTJFN
	MOVEI C,0
	PUSH P,B		;SAVE PTR
	SOUT
	POP P,B			;RECOVER PTR
	HLRZ A,B		;NORMALIZE IT
	CAIN A,-1
	HRLI B,(POINT 7,0)
LPTM1:	ILDB A,B		;ACCOUNT LINE POSITION
	JUMPE A,R		;NULL, DONE
	CAIN A,.CHLFD		;EOL
	JRST [	SETZM LPTPOS	;RESET
		AOS LPTLIN	;COUNT LINES
		JRST LPTM1]
	CAIN A,.CHTAB		;TAB?
	JRST [	MOVEI A,7	;YES, BUMP
		IORM A,LPTPOS
		JRST .+1]
	AOS LPTPOS		;COUNT ONE SPACE
	JRST LPTM1

;START NEW LISTING PAGE

LNEWPG:	SKIPE LPTJFN
	SKIPE LPTPOS		;DON'T OUTPUT HEADER UNLESS AT START OF LINE!
	RET
	PUSH P,B
	MOVE A,LPTJFN
	MOVEI B,.CHFFD		;SEND A FORMFEED
	BOUT
	HRROI B,LSTHDR		;SEND PAGE HEADER
	SETZ C,
	SOUT
	HRROI B,[ASCIZ /   Page /]
	SOUT			;SEND PAGE NUMBER
	AOS B,LPTPAG
	MOVEI C,^D10
	NOUT
	 JSERR
	HRROI B,[ASCIZ /

/]
	SETZ C,
	SOUT			;FINISH HEADER
	MOVEI B,2		;INIT LINE COUNT TO NUMBER LINES
	MOVEM B,LPTLIN		; PRINTED ABOVE
	POP P,B
	RET

;TAB TO SPECIFIED COLUMN IN LISTING FILE
; B/ COLUMN

TAB:	SKIPN LPTJFN
	RET
	MOVE A,LPTLIN
	CAIL A,PAGLEN		;AT END OF LISTING PAGE?
	CALL LNEWPG		;YES, START A NEW ONE
	SUB B,LPTPOS		;COMPUTE NUMBER SPACES NEEDED
	JUMPLE B,R		;MAYBE NONE
	ADDM B,LPTPOS		;UPDATE POSITION
	MOVE A,LPTJFN
	MOVN C,B
	HRROI B,SPACES
	SOUT			;OUTPUT THEM
	RET

SPACES:	ASCII /                                                  /
	ASCII /                                                  /
;HERE TO PRINT CHECKSUM OF FILE

PRTCSM:	MOVEI B,CSCOL		;CHECKSUM COLUMN
	CALL TAB		;TAB TO CHECKSUM
	HLRZ B,CHKCN0
	HRRZ C,CHKCN0
	ADD C,B			;MAKE IT 18-BITS WORTH
	HLRZ B,C		;...
	ADDI B,(C)		;...
	MOVEI C,^D8		;OCTAL RADIX
	TXO C,NO%LFL+NO%ZRO
	TLO C,6			;6 COLUMNS
	CALL LPNOUT
	TXNN F,CS%SEQ		;SKIP IF SEQUENTIAL CHECKSUM
	LPMSG < P>		;FLAG AS BY-PAGES CHECKSUM
	RET
; Here to say HELLO to QUASAR, get our PID etc.

QSRINI:	SAVEQ
	SETZM NXTRTP		; No next
	CALL GQPID		;GET QUASAR'S PID IN QSRPID
	 RET			;FAILED
	GJINF			; GET JOB #
	MOVE D,C		; SAVE THE JOB #
	MOVEI A,3		; LENGTH OF BLK
	MOVEI B,C		; LOCATION OF BLK
	MOVEI C,.MUSPQ		; SET PID QUOTA
	MOVEI D+1,^D15		; MAX NUMBER OF PIDS
	MUTIL
	 JRST [	TMSG <%FAILED TO SET PID QUOTA FOR DUMPER
>
		JRST .+1]
	MOVEI A,3
	MOVEI B,C
	MOVEI C,.MUCRE		; Create a PID for me
	MOVEI D,.FHSLF		; No flags etc
	MUTIL
	 JRST [	SETZM MYPID
		TMSG <?Unable to create a PID for DUMPER
>
		RET]
	MOVEM Q1,MYPID		; Remember mine too
	MOVEI A,3
	MOVEI B,C
	MOVEI C,.MUPIC		; Set my PID on an interrupt channel
	MOVE D,MYPID
	MOVEI Q1,QSRCHN
	MUTIL
	 JRST [	TMSG <?Unable to set DUMPER PID on interrupt channel
>
		RET]
	MOVEI A,3
	MOVEI B,C
	MOVEI C,.MUSSQ		; Set recieve/send quotas
	MOVE D,MYPID
	MOVEI Q1,777777		; 777 For each
	MUTIL
	 JRST [	TMSG <%Unable to set send/recieve quotas to maximum
>
		JRST .+1]
	SETZ A,			; No bits
	CALL HELLO		; Say we are here
	 RET			; SAY INIT FAILED
	RETSKP

RETCLN:	CALL GDBYE		; Say good-bye to QUASAR
	 JFCL			; UNABLE TO TELL QUASAR GOODBYE
	CALL RELPID		; PID IS NO LONGER NEEDED

; Now process all built up retrieval message files

RETCL1:	MOVX A,GJ%OLD+GJ%IFG+GJ%SHT
	HRROI B,[ASCIZ/SYSTEM:*.RET-MSGS.*/]
	GTJFN
	 RET
	PUSH P,A		; Save the JFN
	HRRZS A			; Ditch the bits
	MOVE B,[FLD(7,OF%BSZ)+OF%RD]
	OPENF
	 FATAL <RETCLN: Failed to open retrieval msg file>
	MOVE B,[1,,.FBSIZ]
	MOVEI C,C
	GTFDB			; Get # of bytes in the file
	MOVNS C			; Faster with neg count
	PUSH P,C		; Save file count
	MOVE B,[SNDBDY,,SNDBDY+1]
	SETZM -1(B)
	BLT B,SNDBDY+NSNDBD-1	; Clear the space
	MOVE A,[POINT 7,SNDBDY]
	MOVEM A,SNDTXT
	HRROI B,[ASCIZ/ The following files have been restored/]
	SETZB C,D
	SOUT
	CALL IFHOST		; Output a host name if applicable
	HRROI B,[ASCIZ/:

/]
	SOUT
	POP P,C			; Recover file count
	MOVE B,A		; Move pointer
	HRRZ A,0(P)		; And JFN
	SIN			; Eat the file
	HRROI A,TOLST
	MOVEM A,SNDTO
	HRRZ B,0(P)
	MOVX C,<FLD(.JSAOF,JS%NAM)>
	JFNS			; Who gets this msg
	HRROI B,[ASCIZ/Files restored to disk/]
	MOVEM B,SNDSUB
	MOVEI A,SNDTO		; Point to the sndmsg blk
	CALL MLTLST
	HRRZ A,0(P)
	TXO A,CO%NRJ
	CLOSF
	 JFCL
	TXZ A,CO%NRJ
	DELF
	 CALL JSERR1		; Report error
	ADJSP P,-1
	JRST RETCL1		; Do all there are
; Here to get ptr to next file to restore
; Returns: +1 no more retrievals; +2 1/ Ptr to retrieval blk

; **** Note **** RETWAT is a tag that QSRINT looks for - if DUMPER is
; in the WAIT JSYS at RETWAT-1, then QSRINT bumps the PC by one to cause
; the WAIT to terminate when the DEBRK in QSRINT is done. This skips over
; the JRST NXTRE1

NXTRET:	SKIPN P6,NXTRTP		; Next request ready for us?
	WAIT			; No, wait until QUASAR gets to us
RETWAT:	JRST NXTRE1		; If here, we have a ptr in C
	JFCL			; Is this needed????
	SETZ A,			; In case we get none
	SKIPN P6,NXTRTP		; Make sure we've a copy of the ptr
	RET			; No more to do
NXTRE1:	HRROI B,FILNM(P6)	; Point to file name
	CALL TSTNAM		; Ok?
	 JRST [	RLJFN
		 JFCL
		CALL REFUSE	; Don't want this one
		JRST NXTRET]	; Try again
	RLJFN
	 JFCL
	MOVX A,GJ%OLD+GJ%XTN	;GET FLAGS
	MOVEM A,RETBLK+.GJGEN	;SET IN BLOCK
	MOVEI A,RETBLK		; Use blk with invisible etc.
	HRROI B,FILNM(P6)	; Point to name
	GTJFN
	 JRST NXTRE2		;GTJFN FAILED
	MOVE B,[1,,.FBCTL]	; Get CTL word
	MOVEI C,C
	GTFDB
	RLJFN			;DUMP JFN
	 JFCL
	TXNN C,FB%OFF		; File offline?
	JRST [	CALL RETOK	;YES, RELEASE RETRIEVAL REQUEST
		JRST NXTRET]	; Try again
	MOVE A,P6		; Hand the pointer back
	RETSKP			; Return with ptr

NXTRE2:	CAIN A,GJFX16		;INVALID DEVICE?
	JRST [	TMSGC <%Structure not mounted, skipping file > ;YES
		HRROI A,FILNM(P6)
		PSOUT		;DISPLAY FILENAME
		CALL TCRLF	;CRLF
		CALL REFUSE	;REQUEUE THE REQUEST
		JRST NXTRET]	;GET NEXT RETRIEVAL REQUEST
	CALL BADOFP		;SOME OTHER ERROR, COMPOSE MESSAGE
	CALL WASHOU		;TELL USER AND REQUESTOR
	CALL RELQSR		;RELEASE THE RETRIEVAL REQUEST
	 JFCL
	JRST NXTRET
; RETTAP - GET RETRIEVAL TAPE MOUNTED
;  P6/ ADDRESS OF INFORMATION BLOCK OF FILE TO BE RETRIEVED

RETTAP:	SAVEQ
	CALL UNLOAD
	CALL MTCLS
RETTA1:	LOAD A,TPNM2,(P6)
	SKIPGE .ARODT(P6)
	LOAD A,TPNM1,(P6)	; Use alternate tape #
	CALL NSVOL		;CONVERT TO SIXBIT IF NECESSARY
	MOVE Q1,A		;COPY VOLID TO A SAFE PLACE
	MOVEI A,.SFMTA
	TMON			;TAPE DRIVE ALLOCATION ENABLED?
	JUMPN B,RETTA3		;YES, CALL FOR TAPE MOUNT THRU QUASAR
	TMSGC <%Please mount tape >
	MOVE A,Q1		;GET VOLID
	CALL TYP6		;TYPE VOLID
	HRROI A,[ASCIZ \ Is this tape available? \]
	CALL YESNO		; Tape may be broken, lost, etc.
	JUMPN A,[CALL NTAPER	;SAID YES, GET TAPE SPEC
		 JRST BMBCMD	;CAN'T
		MOVEM Q1,VOLID6	;SET CURRENT VOLID
		JRST RETTA4]
RETTA2:	HRROI P1,[ASCIZ/Tape currently unavailable
/]
	CALL RETFAI		; Say that failed
	JUMPE P6,R		; None left in Q
	LOAD A,TPNM2,(P6)	; Get tape # on this one
	SKIPGE .ARODT(P6)
	LOAD A,TPNM1,(P6)
	CALL NSVOL		;CONVERT TO SIXBIT IF NECESSARY
	CAMN A,Q1		; Same as last one?
	JRST RETTA2		; Yes, assume tape still unavailable
	JRST RETTA1		; Try this tape

RETTA3:	MOVE A,Q1		;GET VOLID
	CALL MREQ		;SEND MOUNT REQUEST AND GET ANSWER
	 JRST [	HRROI A,[ASCIZ/Try again? /] ;FAILED
		CALL YESNO
		JUMPN A,RETTA3	;WANTS TO TRY AGAIN
		JRST RETTA2]	;DON'T TRY AGAIN
RETTA4:	SETOM RTAPNO		;TAPE IS READY, SET TAPE # UNKNOWN
	CALL MTOPNX
	CALL REWCV		;REWIND IT
	CALLRET MTCLS		;CLOSE AND RETURN TO CALLER
; Here to report file retrieved (to user)

RETOK:	HRROI A,TOLST
	MOVE B,TPRQUS		; Get requesting user
	DIRST
	 RET			; ? No such user?
	MOVEI A,[0,,0		; Either use old or create one
		.NULIO,,.NULIO	; No I/O
		-1,,[ASCIZ /SYSTEM/]
		0
		-1,,TOLST	; User name
		-1,,[ASCIZ/RET-MSGS/] ; Type
		0
		0
		0]
	HRROI B,CRLF		; Use defaults
	GTJFN
	 FATAL <RETOK: Failed to get user retrieval file>
	MOVX B,<FLD(7,OF%BSZ)+OF%APP>
	OPENF
	 FATAL <RETOK: Failed open retrieval msg file>
	HRROI B,FILNM(P6)	; Point to the file
	SETZB C,D
	SOUT
	movei b,"	"
	bout
	seto b,			; time stamp it
	setz c,
	odtim
	HRROI B,CRLF
	SOUT
	CLOSF
	 JRST [	TMSG <%Failed to close retrieval msg file
>
		JRST .+1]
	CALL RELQSR		; Release the ret request
	 JFCL
	RET
; Here to say we're done with a request block

RELQSR:	SETZM NXTRTP		; Nothing there now
	CALL ZIPMSS		; Setup to send
	MOVE B,[REL.SZ,,.QOREL] ; Set to release the one we've done
	MOVEM B,.MSTYP(P1)	; Length and type
	MOVE B,TPTSK		; Include the task name
	MOVEM B,REL.IT(P1)	; Internal task name
	MOVE P1,[REL.SZ,,QSRMSS]
	CALL SNDQSR		; Send the release
	 JRST [	TMSG <%Failed to release task
>
		RET]		; Just abort now
	RETSKP

; Here to say "no thanks" to QUASAR's choice of retrieve requests

REFUSE:	GTAD			; Get timestamp
	MOVE B,TPBLK+.ARODT
	TXNE B,%EQUFT		; Using alternate tape?
	TXO A,%EQUFT		; Yes, send it back that way
	CALL REQUE
	 JFCL
	RET

; Here to abort current retrieval; Assumes retrieval described by
; info in TPBLK

ABTRET:	TMSG <%Retrieve aborted
>
	CALL RELQSR		; Tell QUASAR we're "done"
	 JFCL
	CALL NXTRET		; Step to the next retrieval
	 SETOM VOLID6		; None left
	RETSKP

; Here when a retrieval failed; P1 has string ptr to error message
; Assumes current blk

RETFAI:	SKIPGE .ARODT(P6)	; Already on 2nd set of tapes?
	JRST [	CALL WASHOU	; Yes, Bomb this retrieve request
		CALL RELQSR	; Release the task
		 JFCL
		CALL NXTRET	; Get the next one
		 SETOM VOLID6	; No next
		RET]
	MOVX A,%EQUFT		; Flag we want alternate tapes
	CALL REQUE		; And requeue the request
	 JFCL
	CALL NXTRET		; Get the next one
	 SETOM VOLID6		; No next
	RET

; BADOFP - COMPOSE ERROR MESSAGE FOR BAD OFFLINE FILE POINTER
;  A/ ERROR CODE
; RETURNS +1: ALWAYS, P1/ -1 ,, ADDRESS OF ERROR MESSAGE

BADOFP:	MOVE D,A		;SAVE ERROR CODE
	HRROI A,TEMP		;BUILD MESSAGE HERE
	HRROI B,[ASCIZ/ CANNOT ACCESS OFFLINE FILE POINTER: /]
	SETZ C,
	SOUT
	MOVSI B,.FHSLF		;GET DUMMY HANDLE
	HRR B,D			; ,, ERRORCODE
	ERSTR			;TACK ON ERROR STRING
	 JFCL
	 JFCL
	HRROI P1,TEMP		;RETURN ADDRESS OF TEXT TO CALLER
	RET
; Here to report terrible failure to requestor
; Error message ptr in P1

WASHOU:	TMSG <%Failed to restore >
	MOVE Q1,P6
	HRROI A,FILNM(Q1)	; Point to file name
	PSOUT
	TMSGC < Because >
	MOVE B,P1
	CALL TMSGQ
	HRROI A,CRLF
	PSOUT
	HRROI A,TOLST
	MOVEM A,SNDTO		; Pointer to TO list
	HRROI B,[ASCIZ /PS:</]
	SETZB C,D
	SOUT
	MOVE B,TPRQUS		; Get user that requested it
	DIRST
	 JRST [	MOVE A,SNDTO
		HRROI B,[ASCIZ/*SYSTEM:RETRIEVAL.FAILURES/]
		SETZB C,D
		SOUT
		JRST WASHO1]
	MOVEI C,">"
	IDPB C,A
	IDPB D,A		; End the thing
WASHO1:	HRROI B,[ASCIZ/Files not retrieved/]
	MOVEM B,SNDSUB		; Subject
	HRROI A,SNDBDY
	MOVEM A,SNDTXT		; Ptr to text part
	HRROI B,FILNM(Q1)	; Point to file name
	SETZB C,D
	SOUT
	CALL IFHOST		; Host name (maybe)
	HRROI B,[ASCIZ/ was not retrieved because:
/]
	SOUT
	MOVE B,P1		; Error message
	SOUT
	MOVEI A,SNDTO		; Point to blk
	CALL SNDMSG		; Send the failure message off
	SOS NJFN1		; Discount one of them

; SET THE BIT IN THE FILE'S FDB SAYING THAT THE RETRIEVAL FAILED

	SETZM GJBLK		;ZERO GTJFN ARG BLOCK
	MOVE A,[GJBLK,,GJBLK+1]
	BLT A,GJBLK+.GJBFP
	MOVX A,GJ%OLD+GJ%XTN
	MOVEM A,GJBLK+.GJGEN	;OLD FILE, LONG GTJFN BLOCK
	MOVX A,G1%IIN
	MOVEM A,GJBLK+.GJF2	;INCLUDE INVISIBLE FILES
	MOVE A,[.NULIO,,.NULIO]
	MOVEM A,GJBLK+.GJSRC	;JUST USE STRING
	MOVEI A,GJBLK		;GET ARG BLOCK ADDRESS
	HRROI B,FILNM(Q1)	;GET POINTER TO FILESPEC
	GTJFN			;GET JFN ON FILE
	 JRST WASHO2
	MOVEI B,.ARRFL
	ARCF			;SET AR%RFL (RETRIEVE FAILED) IN FDB
	 ERJMP .+1
	RLJFN			;DUMP JFN
	 JFCL
WASHO2:	RET
; Here to build message to user about files which have been archived
; JFN to current file in A

ARMSUS:	PUSH P,B		; Save flag (0=> file flushed)
	TLC A,-1
	TLCN A,-1		; Make sure of good ptr
	HRLI A,(POINT 7)
	PUSH P,A
	SKIPN LTARDR		; Have a previous one?
	JRST ARMSU2		; No, start things going
	HRROI B,TEMP
	EXCH A,B
	MOVX C,<FLD(.JSAOF,JS%DEV)+FLD(.JSAOF,JS%DIR)+JS%PAF>
	JFNS
	MOVE A,[POINT 7,LTARDR]
	MOVE B,[POINT 7,TEMP]
	STCMP			; Compare them
	JXE A,SC%LSS+SC%SUB+SC%GTR,ARMSU1
	MOVEI A,SNDTO
	CALL SNDMSG		; Send it off
ARMSU2:	MOVE A,[POINT 7,LTARDR]	; Pointer to dir name for msg
	MOVEM A,SNDTO
	MOVE B,0(P)		; JFN of current file
	MOVX C,<FLD(.JSAOF,JS%DEV)+FLD(.JSAOF,JS%DIR)+JS%PAF>
	JFNS			; Save this directory
	HRROI A,[ASCIZ /Collected files/]
	SKIPG COLSW
	HRROI A,[ASCIZ /Migrated files/]
	SKIPE ARCSW
	HRROI A,[ASCIZ /Archived files/]
	MOVEM A,SNDSUB
	HRROI A,SNDBDY		; Set up things
	MOVEM A,SNDTXT		; Point to where text starts
	HRROI B,[ASCIZ / The following files have been collected/]
	SKIPG COLSW
	HRROI B,[ASCIZ / The following files have been migrated/]
	SKIPE ARCSW
	HRROI B,[ASCIZ/ The following files have been archived/]
	SETZB C,D
	SOUT
	CALL IFHOST		; Do host name (maybe)
	HRROI B,[ASCIZ/:

/]
	SOUT
	MOVEM A,CURSNP		; Save the pointer
ARMSU1:	MOVE A,CURSNP
	MOVE B,0(P)
	MOVX C,<FLD(.JSAOF,JS%DEV)+FLD(.JSAOF,JS%DIR)+FLD(.JSAOF,JS%NAM)+FLD(.JSAOF,JS%TYP)+FLD(.JSAOF,JS%GEN)+JS%PAF>
	JFNS
	SKIPN ARCSW		; The following only on archive runs
	JRST ARMSU3
	HRROI B,[ASCIZ/ File archived/]
	SKIPN -1(P)
	HRROI B,[ASCIZ/ File archived, contents deleted/]
	SETZB C,D
	SOUT
ARMSU3:	HRROI B,CRLF
	SETZB C,D
	SOUT
	MOVEM A,CURSNP		; Update the ptr
	POP P,A
	POP P,B			; Flag
	RET
;SEVSIX - ROUTINE TO CONVERT 7-BIT ASCII TO 6-BIT
; A/ POINTER TO ASCIZ STRING
; B/ ADDRESS OF WORD IN WHICH TO STORE 6-BIT STRING
;RETURNS: +1, ALWAYS

SEVSIX:	SETZM (B)		;ZERO WORD FIRST
	HRLI B,(POINT 6,0)	;SET UP SIXBIT POINTER
	MOVEI D,6		;MAXIMUM OF 6 CHARACTERS
SEVLOP:	ILDB C,A		;GET 7-BIT CHARACTER
	JUMPE C,R		;RETURN IF END OF STRING
	CAIL C,"a"		;LOWER CASE ALPHA?
	TRZ C,40		;YES, CHANGE TO UPPER CASE
	SUBI C,40		;CONVERT TO 6-BIT
	IDPB C,B		;STORE CHARACTER
	SOJG D,SEVLOP		;JUMP IF MORE CHARACTERS
	RET
; Here to build scratch file to give to SND (actually do the SNDMSG)
; A has location of pointer to to SNDMSG block
; Which is 0: TO list ptr to be converted to directory # for MLTOWN
;	   1: Subject ptr
;	   2: Text body ptr

SNDMSG:	PUSH P,A		; Save location of blk ptr
	MOVX A,RC%EMO		; Exact match only
	MOVE B,@0(P)		; Get pointer to directory string
	SETZ C,
	RCDIR
	TXNE A,RC%NOM+RC%AMB+RC%NMD ; Any form of failure?
	JRST [	TMSG <%RCDIR in SNDMSG failed
>
		RET]
	POP P,B			; Blk ptr location
	MOVEM C,0(B)		; Directory #
	MOVE A,B
	CALL MLTOWN		; Do the work
	RET

; Here to output a host name if applicable - A setup with output
; designator

IFHOST:	PUSH P,A		; Save state of byte ptr
	SKIPLE LHOSTN		; Any host #?
	JRST [	HRROI B,[ASCIZ/ on /]
		SOUT		; Yes, add it
		MOVE B,LHOSTN
		CVHST
		 ERJMP [MOVE A,0(P) ; Take back the " on "
			JRST .+1]
		CAIL A,600000	; Did we get an error of some kind?
		CAILE A,677777
		JRST .+1	; No, all is fine
		MOVE A,0(P)	; Yes, an error, take back " on "
		JRST .+1]
	POP P,0(P)		; Byte ptr no longer needed
	RET
; Here to see if a file name matches specs given by user
; Accepts pointer to file name on tape in B
; Returns JFN for file on tape in A

TSTNAM:	MOVX A,GJ%OFG+GJ%SHT	;SET TO PARSE NAME
	GTJFN
	 JRST [	CALLRET JSERR1]	;SHOULDN'T FAIL
	PUSH P,A
	HRLZ P5,NJFN		;SCAN ALL SPECS GIVEN TO LOAD
TSTNA3:	SKIPN B,JFNLST(P5)	;JFN STILL HERE?
	JRST [	AOBJN P5,TSTNA3	;NO, IT WAS COMPLETED
		POP P,A		;RETURN JFN IN A
		RET]		;DONE ALL FILESPECS, FAILED TO MATCH
	MOVEI A,.WLJFN		;WANT TO COMPARE FILE SPECS
	HRRZ C,0(P)		;GET CURRENT FILE JFN
	WILD%			;FIND DIFFERENCES BETWEEN THE SPECS
	 ERJMP TSTN3A		;FAILED
	TXNE A,WL%DEV!WL%DIR!WL%NAM!WL%EXT!WL%GEN	;ANY MISMATCHES?
	JRST [	AOBJN P5,TSTNA3	;YES, STEP TO NEXT FILESPEC
		POP P,A		;DONE ALL FILESPECS, FAILED TO MATCH ANY
		RET]
	POP P,A			; Return JFN in A
	RETSKP			; Is OK

;********TEMPORARY FOR REL 3A RUNNABILITY (several pages)

TSTN3A:MOVSI Q1,-NFFLD		;SCAN ALL FIELDS OF FILESPEC
	AOBJN Q1,.+1		;SKIP DEVICE FIELD
TSTNA2:	HRROI A,FBUF1		;GET STRINGS FOR NEXT FIELD
	MOVE B,0(P)		;JFN FOR FILE ON TAPE
	MOVE C,FFLDT(Q1)
	JFNS			;FOR FILE ON TAPE...
	HRROI A,FBUF2
	MOVE B,JFNLST(P5)
	MOVE C,FFLDT(Q1)
	JFNS			;FOR LOAD FILESPEC
	MOVE A,[POINT 7,FBUF1]
	MOVE B,[POINT 7,FBUF2]
	CALL CHKWLD		;SEE IF THIS FILE SPEC MATCHES
	JRST [	AOBJN P5,TSTNA3	;NOT EQUAL, STEP TO NEXT FILESPEC
		POP P,A
		RET]		;DONE ALL FILESPECS, FAILED TO MATCH ANY
TSTNA1:	AOBJN Q1,TSTNA2		;STEP TO NEXT FIELD
	POP P,A
	RETSKP			; Is ok
; GMTINF - GET INFO ABOUT MT DEVICE
;  A/ MT JFN
; RETURNS +1: ALWAYS
;  A/ LABEL TYPE, VOLID/ ASCIZ VOLID, VOLID6/ SIXBIT VOLID

GMTINF:	STKVAR <<MTIAB,3>>
	MOVEI B,2
	MOVEM B,MTIAB		;SET SIZE IN ARG BLOCK
	MOVEI B,.MORLI		;FUNCTION CODE
	MOVEI C,MTIAB		;ARG BLOCK ADDRESS
	MTOPR			;GET LABEL INFORMATION IN ARG BLOCK
	MOVE D,1+MTIAB		;GET LABEL TYPE

; GET VOLID OF TAPE USING .MOINF MTOPR

	MOVEI B,2
	MOVEM B,MTIAB		;SET # OF ARGS TO RETURN
	MOVEI B,.MOINF		;FUNCTION CODE
	MTOPR
	MOVE A,.MOIID+MTIAB	;GET SIXBIT VOLID
	MOVEM A,VOLID6		;SAVE IT
	MOVE B,[POINT 7,VOLID]	;GET DESTINATION POINTER
GMTIN1:	JUMPN A,[LDB C,[POINT 6,A,5] ;GET CHARACTER FROM VOLID
		LSH A,6		;SHIFT THE REST OVER
		ADDI C,40	;CONVERT SIXBIT CHARACTER TO ASCII
		IDPB C,B	;STORE ASCII CHAR
		JRST GMTIN1]	;LOOP UNTIL LAST NON-BLANK
	IDPB A,B		;TERMINATE WITH A NULL

	MOVE A,D		;GET LABEL TYPE
	RET
	SUBTTL ROUTINE TO CHECK SPECS AGAINST A WILDCARD STRING

;THE FOLLOWING ROUTINE WAS RIPPED OUT FROM THE MONITOR MODULE
;LOOKUP.  WHENEVER A JSYS IS WRITTEN TO DO THIS FUNCTION, THIS
;ROUTINE SHOULD BE REPLACED WITH THAT JSYS CALL.

; THIS SUBROUTINE COMPARES A STRING TO A GENERALIZED WILD-CARD
;MASK. A IS A POINTER TO THE STRING AND B IS A POINTER TO THE
;MASK.
; RETURNS +1 IF THE MASK CANNOT MATCH THE STRING. RETURNS +2
;IF IT DOES MATCH

CHKWLD:	SAVEQ		;SAVE PERMANENT ACS
	STKVAR <SVPTR,SVMSK> ;POINTERS TO LAST STAR POSITION
	SETZ Q2,	;NO PREVIOUS ON THE FIRST BYTE
	SETZM SVMSK	;NO PREVIOUS
MRTEST:	MOVE Q3,Q2	;SAVE PREVIOUS CHARACTER
	ILDB Q2,B	;GET NEXT MASK CHARACTER
	JUMPE Q2,EMASK	;END OF MASK
	CAIN Q2,"%"	;A SINGLE CHARACTER WILD CARD?
	JRST SNGL	;YES
	CAIN Q2,"*"	;ANY WILD MATCH?
	JRST ANY	;YES
	CALL GETSRC	;GET NEXT STRING BYTE
	 RET		;END OF STRING AND FAILURE
	CAIN Q2,(C)	;MATCH?
	JRST MRTEST	;YES. GO ON
FAIL:	SKIPN B,SVMSK	;NO. HAVE A PREVIOUS "*" ?
	RET		;NO. CANT MATCH THESE TWO
	IBP SVPTR	;STRETCH THE MASK
	MOVE A,SVPTR	;MAKE IT CURRENT POINTER
	JRST MRTEST	;AND TRY AGAIN

;GET SOURCE BYTE

GETSRC:	ILDB C,A	;GET IT
	JUMPE C,R	;IF END OF STRING, FAIL RETURN
	RETSKP		;GOT ONE

;END OF MASK ROUTINE

EMASK:	CAIN Q3,"*"	;DID MASK END IN A "*"
	RETSKP		;YES. IT IS A MATCH
	CALL GETSRC	;NO. AT END OF SOURCE TOO?
	 RETSKP		;YES. A MATCH
	JRST FAIL	;NO. TRY TO STRETCH THE MASK


;FOUND A "%" IN THE MASK

SNGL:	CALL GETSRC	;GET A SOURCE BYTE
	 RET		;NO MORE BYTES
	JRST MRTEST	;GO GET MORE

;FOUND A "*" IN THE STRING

ANY:	MOVEM A,SVPTR	;SAVE POINTER TO STRING
	MOVEM B,SVMSK	;SAVE MASK POINTER
	JRST MRTEST	;GO DO THE REST
;******END OF TEMP
	SUBTTL TAPE MOUNT/DISMOUNT LOGIC

; MREQ - PERFORM MOUNT DIALOGUE WITH QUASAR
;  A/ SIXBIT VOLID
; RETURNS +1: ERROR, MESSAGE TYPED
;	  +2: SUCCESS, MTDSG/ MT DEVICE DESIGNATOR

MREQ:	SAVEQ
	MOVE Q1,A		;SAVE VOLID
	SETZB A,MTDSG
	CALL SETMNT		;DUMP CURRENTLY-MOUNTED TAPE
	TMSGC <[Mounting tape volume >
	MOVE A,Q1
	CALL TYP6		;TYPE VOLID
	TMSG <]
>
	DMOVE A,[EXP .MURSP,.SPQSR] ;GET PID OF REAL QUASAR
	DMOVEM A,MPDB
	MOVEI A,3		;ARG BLOCK LENGTH
	MOVEI B,MPDB		;ARG BLOCK ADDRESS
	MUTIL			;GET PID INTO MPDB+.IPCFR
	 ERJMP [HRROI B,[ASCIZ/?Cannot get PID for QUASAR/]
		CALLRET TMSGQC]

; BUILD IPCF MOUNT MESSAGE FOR QUASAR
; (MESSAGE LENGTH AND MOUNT-REQUEST ENTRY LENGTH FILLED IN LATER)

	MOVE Q3,[IOWD 1000,MBUF] ;GET STACK POINTER
	MOVSI B,-TMSKSZ		;GET AOBJN POINTER TO SKELETON
	PUSH Q3,TMSKEL(B)	;TRANSFER SKELETON WORD TO MESSAGE
	AOBJN B,.-1		;LOOP UNTIL ALL OF SKELETON IS MOVED
	SKIPE DENSIT		;ANY DENSITY SPECIFIED?
	JRST [	PUSH Q3,[2,,.TMDEN] ;YES, CREATE DENSITY SUBENTRY
		PUSH Q3,DENSIT
		JRST .+1]
	PUSH Q3,[2,,.TMVOL]
	PUSH Q3,Q1		;CREATE VOLID ENTRY IN IPCF MESSAGE

; NOW FIX UP THE COUNT FIELDS IN THE IPCF MESSAGE

	HRRZ A,Q3		;GET ADDRESS OF LAST WORD OF MESSAGE
	SUBI A,MBUF-1		;COMPUTE SIZE OF MESSAGE
	STOR A,MS.CNT,MBUF+.MSTYP ;STORE IN GALAXY HEADER
	SUBI A,.MMHSZ		;COMPUTE SIZE OF MOUNT ENTRY
	STOR A,AR.LEN,MBUF+.MMHSZ ;STORE IN MOUNT ENTRY LENGTH FIELD
	MOVEI A,MBUF+.MMHSZ+.MEHSZ ;POINT AT FIRST SUBENTRY
TMX2:	AOS MBUF+.MMHSZ+.MECNT	;COUNT THIS SUBENTRY
	LOAD B,AR.LEN,(A)	;GET SIZE OF SUBENTRY
	ADD A,B			;POINT AT NEXT SUBENTRY
	CAIGE A,(Q3)		;ANOTHER SUBENTRY?
	JRST TMX2		;YES, CONTINUE SCAN

; SEND IPCF MESSAGE TO QUASAR

	MOVEI B,MPDB-1		;SET UP PDB FOR MSEND
	PUSH B,[IP%CPD+IP%CFV]	;FLAGS
	PUSH B,[0]		;SENDER'S PID (WILL BE CREATED)
	ADJSP B,1		;RECEIVER'S PID FILLED IN ALREADY
	PUSH B,[1000,,<MBUF_-9>] ;PACKET DESCRIPTOR
	MOVEI A,4		;GET SIZE OF PDB
	MOVEI B,MPDB		;GET ADDRESS OF PDB
	MSEND			;SEND REQUEST TO QUASAR
	 ERRORJ TCRLF,<?COULD NOT SEND IPCF MOUNT REQUEST>

; MOUNT MESSAGE HAS BEEN SENT, NOW RECEIVE THE REPLY

	MOVE A,MPDB+.IPCFS
	MOVEM A,MPDB+.IPCFR	;SET RECEIVER'S PID
MREQ2:	MOVX A,IP%CFV
	MOVEM A,MPDB+.IPCFL	;STORE FLAGS
	MOVE A,[1000,,<MBUF/1000>]
MREQ3:	MOVEM A,MPDB+.IPCFP	;POINTER TO MESSAGE BUFFER
	MOVEI A,.IPCFC+1	;PDB LENGTH
	MOVEI B,MPDB		;PDB ADDRESS
	MRECV			;RECEIVE MESSAGE
	 JRST [	CAIE A,IPCF16	;ERROR BECAUSE OF WRONG DATA MODE?
		ERRORJ TCRLF,<?ERROR RECEIVING MOUNT RESPONSE> ;NO
		SETZM MPDB+.IPCFL ;YES, CLEAR IP%CFV
		MOVE A,[1000,,MBUF] ;GET POINTER FOR NON-PAGE-MODE
		JRST MREQ3]	;TRY AGAIN
	MOVE A,MPDB+.IPCFC
	TXNN A,SC%WHL+SC%OPR	;IS SENDER LEGIT?
	JRST MREQ2		;NO, TRY AGAIN
	LOAD Q3,MS.TYP,MBUF+.MSTYP ;GET MESSAGE TYPE
	JN MF.FAT,MBUF+.MSFLG,CKMNT1 ;JUMP IF MOUNT FAILED
	CAIE Q3,.QOMNA		;IS IT A RESPONSE TO MOUNT REQUEST?
	JRST MREQ2		;NO, IGNORE IT
	CALL MRKPID		;DELETE MOUNTING PID
	MOVEI A,[1
		  .MNRDV,,CKMDV]
	CALL SCNMBK		;SUCCESSFUL MOUNT, GET DESIGNATOR
	MOVE A,MTDSG
	CALL SETMNT		;REMEMBER I HAVE MOUNTED A TAPE
	HRROI A,MTDEV		;DESTINATION STRING POINTER
	MOVE B,MTDSG
	DEVST			;CONVERT DESIGNATOR TO STRING
	 JRST JSERR1
	MOVEI B,":"
	IDPB B,A		;BUILD FILESPEC
	SETZ B,
	IDPB B,A
	MOVX A,GJ%SHT
	HRROI B,MTDEV		;GET POINTER TO FILESPEC
	GTJFN			;GET JFN ON MT DEVICE
	 JRST JSERR1
	CALL CHKMTJ		;CHECK OUT MT DEVICE
	 JRST [	SETZ A,		;MT DEVICE IS BAD (SHOULDN'T HAPPEN)
		CALLRET SETMNT]	;DISMOUNT AND TRY AGAIN
	TMSGC <[Volume >
	MOVE A,Q1		;GET VOLID
	CALL TYP6		;TYPE IT
	TMSG < mounted]

>
	RETSKP			;EVERYTHING OK, RETURN +2

CKMDV:	MOVE A,1(A)		;GET DESIGNATOR
	MOVEM A,MTDSG		;STORE IT
	ASND			;ASSIGN MT DEVICE TO THIS JOB
	 JFCL
	RET

; MOUNT FAILED

CKMNT1:	CALL MRKPID		;DELETE MOUNTING PID
	CAIN Q3,MT.TXT		;TEXT MESSAGE?
	JRST [	MOVEI A,MBUF+.OHDRS+ARG.DA ;YES, GET ADDRESS OF TEXT
		CALLRET CKMTX]	;TYPE ERROR MESSAGE AND TAKE +1 RETURN
	MOVEI A,[2
		 .MNREC,,CKMEC
		 .MNRTX,,CKMTX]
	CALLRET SCNMBK		;ANALYZE REPLY AND RETURN +1

CKMTX:	HRRO Q1,A		;GET STRING POINTER TO TEXT
	TMSG <?>
	MOVE B,Q1		;GET STRING POINTER IN B FOR TMSGQ
	CALL TMSGQ		;DISPLAY IT
	CALLRET TCRLF		;TYPE CRLF AND RETURN

CKMEC:	MOVE Q1,(A)		;GET ERROR CODE
	TMSGC <?Cannot mount tape, >
	MOVEI A,.PRIOU
	MOVE B,Q1		;GET ERROR CODE
	HRLI B,.FHSLF		;APPEASE ERSTR WITH FORKHANDLE
	SETZ C,			;NO LIMIT
	ERSTR			;TYPE ERROR MESSAGE
	 JFCL
	 JFCL
TCRLF:	TMSG <
>
	RET

; ROUTINE TO DELETE MOUNTING PID IN MPDB+.IPCFR

MRKPID:	MOVEI A,.MUDES
	MOVEM A,MPDB+1		;BUILD MUTIL ARGUMENT BLOCK
	MOVEI A,2		;ARG BLOCK LENGTH
	MOVEI B,MPDB+1		;ARG BLOCK ADDRESS
	MUTIL			;DESTROY THE PID I USED TO DO THE MOUNT
	 JFCL
	RET

; SKELETON IPCF MESSAGE FOR TAPE MOUNT

TMSKEL:	0,,.QOMNT		;GLX HEADER - LENGTH,,TYPE
	0			;GLX HEADER - FLAGS
	0			;GLX HEADER - ACK CODE
	0			;MOUNT MESSAGE FLAGS
	SIXBIT/RETRVL/		;MOUNT REQUEST NAME
	1			;MOUNT ENTRY COUNT
	0,,.MNTTP		;MOUNT ENTRY LENGTH,,TYPE
	0			;MOUNT ENTRY FLAGS
	0			;SUBENTRY COUNT (FILLED IN LATER)
	2,,.TMSET		;SETNAME SUBENTRY
	SIXBIT/RETRVL/
	2,,.TMDRV		;DRIVE-TYPE SUBENTRY
	.TMDR9
	4,,.TMRMK
	ASCIZ/RETRIEVAL TAPE/
TMSKSZ==.-TMSKEL	;LENGTH OF SKELETON
; SCNMBK - SCAN REPLY TO MOUNT REQUEST AND CALL BLOCK-PROCESSORS
;  A/ ADDRESS OF BLOCK-TYPE/PROCESSOR-ADDRESS LIST
; RETURNS +1: ALWAYS

SCNMBK:	SAVEQ
	MOVE Q1,MBUF+.OARGC	;GET # OF BLOCKS IN LIST
	MOVEI Q2,MBUF+.OHDRS	;GET ADDRESS OF FIRST BLOCK
	MOVE Q3,A		;COPY CALLER'S LIST ADDRESS
SCNMB1:	SOJL Q1,R		;EXIT IF NO MORE BLOCKS TO SCAN
	MOVEI A,1(Q2)		;GET ADDRESS OF DATA IN BLOCK
	HRRZ B,(Q2)		;GET BLOCK TYPE CODE
	HLRZ C,(Q2)		;GET BLOCK LENGTH
	ADD Q2,C		;POINT Q2 AT NEXT BLOCK
	MOVN C,(Q3)		;GET NEGATIVE # OF LIST ENTRIES
	MOVSS C			;MOVE TO LEFT HALF FOR AOBJN POINTER
	HRRI C,1(Q3)		;MAKE POINTER TO CALLER'S LIST
SCNMB2:	HLRZ D,(C)		;GET TYPE CODE FROM LIST
	CAMN B,D		;DOES IT MATCH THE CODE FOR THIS BLOCK?
	JRST [	HRRZ D,(C)	;YES, GET PROCESSOR ROUTINE ADDRESS
		CALL (D)	;INVOKE PROCESSOR
		JRST SCNMB1]	;GO SCAN NEXT BLOCK
	AOBJN C,SCNMB2		;CONTINUE LIST SCAN
	JRST SCNMB1		;UNRECOGNIZED BLOCK TYPE, IGNORE IT
; GQPID - GET QUASAR'S PID IN "QSRPID"
; RETURNS +1: FAILED, MESSAGE TYPED
;	  +2: SUCCESS

GQPID:	SKIPN .JBOPS		;PRIVATE GALAXY?
	JRST [	SAVEQ		;NO
		MOVEI Q1,.MURSP	;MUTIL FUNCTION CODE
		MOVEI Q2,.SPQSR	;INDEX INTO SYSTEM PID TABLE
		MOVEI A,3	;ARG BLOCK LENGTH
		MOVEI B,Q1	;ARG BLOCK ADDRESS
		MUTIL
		 ERROR R,<?CANNOT GET PID FOR QUASAR>
		MOVEM Q3,QSRPID	;STORE QUASAR'S PID
		RETSKP]
	MOVE B,[[EXP IP%CPD,0,0,<20,,PDB+4>,.IPCIW,0],,PDB]
	BLT B,PDB+5		;MOVE PDB AND PART OF MESSAGE TO BUF
	GJINF			;GET USER# IN A
	MOVE B,A		;COPY INTO B
	MOVE A,[POINT 7,PDB+6]	;GET POINTER
	MOVEI C,"["
	IDPB C,A
	DIRST			;ADD USER NAME
	 JFCL
	HRROI B,[ASCIZ/]QUASAR/]
	SETZ C,			;STOP ON NULL
	SOUT			;ADD PID NAME
	MOVEI A,4
	MOVEI B,PDB
	MSEND			;SHIP OFF QUESTION TO INFO
	 JSHLT
	SETZM PDB		;CLEAR FLAGS WORD FOR RECEIVE
	MOVE C,PDB+1		;GET MY PID SO I CAN RECEIVE
	MOVE D,[20,,PDB+4]	;SIZE,,MSGADDR
	DMOVEM C,PDB+2		;SET WORDS 2 & 3 OF PDB
	MRECV			;RECEIVE INFO'S REPLY
	 JSHLT
	MOVEI A,2		;ARG BLOCK LENGTH
	MOVEI B,C		;ARG BLOCK ADDRESS
	MOVEI C,.MUDES		;MUTIL FUNCTION CODE
	MOVE D,PDB+.IPCFR	;PID
	MUTIL			;DELETE PID USED FOR TALKING TO INFO
	 JFCL
	LOAD A,IP%CFE,PDB+.IPCFL ;ERROR FROM INFO?
	JUMPN A,[TMSGC <?CAN'T GET PID FOR > ;YES
		HRROI A,PDB+6
		PSOUT		;DISPLAY PID NAME
		RET]
	MOVE A,PDB+5		;GET PRIVATE QUASAR'S PID
	MOVEM A,QSRPID		;STORE IT
	RETSKP
; SETMNT - SET OR CLEAR CURRENTLY-MOUNTED TAPE
; THIS APPLIES ONLY TO TAPES THAT DUMPER HAS MOUNTED VIA QUASAR
;  A/ MT DEVICE DESIGNATOR OR 0 TO CLEAR

SETMNT:	PUSH P,A		;SAVE NEW DESIGNATOR
	CALL MTCLS
	SKIPE A,MNTDSG		;HAVE DESIGNATOR CURRENTLY?
	RELD			;YES, DUMP IT
	 JFCL
	POP P,MNTDSG		;SET NEW DESIGNATOR

; CREATE OR DELETE LOGICAL NAME FOR MOUNTED TAPE

	MOVEI A,.CLNJ1		;ASSUME DELETING LOGICAL NAME
	SKIPE B,MNTDSG		;SETTING NEW DEVICE?
	JRST [	HRROI A,MTDEV	;YES
		DEVST		;COMPOSE LOGICAL NAME
		 JFCL		; DEFINITION STRING
		MOVEI B,":"
		IDPB B,A
		SETZ B,
		IDPB B,A
		MOVEI A,.CLNJB	;SET TO CREATE LOGICAL NAME
		JRST .+1]
	HRROI B,[ASCIZ/RETRVL/] ;LOGICAL NAME = RETRVL:
	HRROI C,MTDEV		;POINTER TO DEFINITION, MTn:
	CRLNM			;CREATE OR DELETE LOGICAL NAME
	 JFCL
	RET
	SUBTTL Routines to communicate with QUASAR

; Here on PSI for IPCF message arrived

QSRINT:	MOVEM 17,INT3AC+17
	MOVEI 17,INT3AC
	BLT 17,INT3AC+16
	MOVE P,[IOWD NINTPD,INT3PD]
	PUSH P,40
	CALL RCVQSR		; Read the message
	 JRST QSRRET		; Nothing there for us
	MOVE A,.MSFLG(P1)	; Get flags
	MOVE B,.MSCOD(P1)	; Get ack code
	TXNE A,MF.ACK		; Guy want an ACK?
	CALL DOACK		; Ack him now
	TXNE A,MF.NOM		; No message?
	JRST QSRRET		; Yes, just eat that
	TXNN A,MF.WRN		; Warning message?
	TXNE A,MF.FAT		; Fatal message
	JRST QSTEXT		; Is a message, print it
	LOAD A,MS.TYP,.MSTYP(P1), ; Get type code
	CAIN A,.QONEX		; Next job msg?
	JRST QSNXT		; Yes
	CAIN A,.QOABO		; Abort msg?
	JRST QSABT		; Yes
	CAIN A,.QORCK		; Checkpoint?
	JRST QSCKPT		; Yes
	CAIN A,.QOSUP		; Setup message?
	JRST QSSETU		; Yes
	TMSG <%Unknown message type recieved from QUASAR>
QSRRET:	POP P,40
	MOVSI 17,INT3AC
	BLT 17,17
	DEBRK			; Done here

QSNXT:	MOVE A,.EQITN(P1)	; Get task name
	MOVEM A,TPTSK		; And remember it
	MOVX A,RC%EMO		; Exact match pls
	HRROI B,.EQOWN(P1)	; Point to owner of request
	SETZ C,			; No stepping info
	RCUSR
	 ERJMP .+2		; Bombed
	TXNE A,RC%NOM+RC%AMB+RC%NMD+RC%WLD ; Failure or wild?
	JRST [	TMSG <%RCUSR failed in QSNXT
>
		JRST QSRRET]	; Leave it
	MOVEM C,TPRQUS		; Remember who
	HRLI A,.EQLIM+1(P1)	; From there
	HRRI A,.ARTP1+TPBLK	; To there
	BLT A,TPBLK+.ARSF2	; Move tape info
	MOVE A,.EQLIM(P1)	; Get time & flag
	MOVEM A,.ARODT+TPBLK
	MOVEI P1,QSRMSR
	HRROI A,TAPNAM		; Move file name to there
	LOAD B,EQ.LOH,.EQLEN(P1)
	ADD B,P1		;POINT TO THE FP
	LOAD C,FP.LEN,(B)	;GET FP LENGTH
	ADD B,C			;POINT TO FD
	MOVEI B,.FDFIL(B)	;POINT TO FILESPEC
	HRLI B,(POINT 7)
	SETZB C,D
	SOUT			; Move file name
	HRROI A,TPACT		; Where account should be
	HRROI B,.EQACT(P1)	; Where it is now
	SETZB C,D
	SOUT			; Move account too
	MOVEI A,TPBLK
	MOVEM A,NXTRTP
	AOS NJFN1		; We have something to do now
QSNXT1:	HLRZ A,CHNTAB+QSRCHN	; Get level we're at
	HRRZ B,@LEVTAB-1(A)	; Get return PC
	CAIN B,RETWAT		; Waiting on us?
	AOS @LEVTAB-1(A)	; Yes, make him go again
	JRST QSRRET

QSSETU:	MOVE A,SUP.TY(P1)	; Get object type
	CAIE A,.OTRET		; Of type we expect?
	JRST [	TMSG <%Recieved invalid object type in SETUP message
>
		JRST QSRRET]
	MOVE A,SUP.FL(P1)	; Get flags
	TXNE A,SUFSHT		; Shutdown rather than start up?
	JRST QSNXT1		; Right, leave as though we got a null
				;  request
	MOVE B,SUP.UN(P1)	; Get the unit #
	MOVE C,SUP.NO(P1)	; And NODE name
	CALL ZIPMSS		; Setup to send
	MOVE A,[RSU.SZ,,.QORSU] ; Respond to setup
	MOVEM A,.MSTYP(P1)	; Length and type
	MOVE A,[.OTRET]		; Object type
	MOVEM A,RSU.TY(P1)
	MOVEM B,RSU.UN(P1)	; Unit number
	MOVEM C,RSU.NO(P1)	; Node name
	MOVX A,%RSUOK		; Say SETUO KO
	MOVEM A,RSU.CO(P1)	; Response code
	SETZM RSU.DA(P1)	; No attributes
	MOVE P1,[RSU.SZ,,QSRMSS]
	CALL SNDQSR		; Send it
	 JRST [	TMSG <%SETUP REPLY message send failed
>
		JRST QSRRET]
	JRST QSRRET

QSABT:	TMSG <%Abort recieved
>
	AOS ABTFLG		; Note we got the abort poke
	JRST QSRRET

QSCKPT:	JRST QSRRET		;TAKE NO ACTION
QSTEXT:	TXNE A,MF.FAT		; Fatal msg?
	JRST [	PUSH P,A
		TMSG <?Fatal: >
		POP P,A
		JRST .+1]
	TXNE A,MF.WRN		; Warning?
	JRST [	PUSH P,A
		TMSG <%Warning: >
		POP P,A
		JRST .+1]
	HRROI B,.OHDRS+ARG.DA(P1) ;GET ADDRESS OF TEXT
	CALL TMSGQ		;PRINT IT
	HRROI B,CRLF
	CALL TMSGQ
	JRST QSRRET		; Done here

; Here to send a message ; P1 HAS LENGTH,,MSG ADDR

SNDQSR:	MOVEI B,PDB-1		; WHERE TO BUILD PDB
	PUSH B,[0]		; PID's are known
	PUSH B,MYPID		; SENDER'S PID
	PUSH B,QSRPID		; RECIEVER'S PID
	PUSH B,P1		; WHERE ACTUAL MSG IS
	MOVEI A,.IPCFP+1	; PDB LENGTH
	MOVEI B,PDB
	MSEND			; SEND MSG
	 RET			; FAILED, TELL CALLER
	RETSKP

; Here to receive a message; P1 HAS ADDR OF DATA

RCVQSR:	MOVEI B,PDB-1
	PUSH B,[0]
	PUSH B,[0]		; SENDER'S PID
	PUSH B,MYPID
	PUSH B,[NQSRML,,QSRMSR]
RCVQS1:	MOVEI A,4
	MOVEI B,PDB
	MRECV			; READ IT
	 JRST [	CAIE A,IPCF16	; SENT IN PAGE MODE?
		JRST JSERR1	;NO, ERROR
		MOVX A,IP%CFV	; SAY PAGE MODE
		MOVEM A,PDB+.IPCFL
		MOVE A,[1000,,<QSRMSR/PGSIZ>]
		MOVEM A,PDB+.IPCFP
		JRST RCVQS1]
	MOVEI P1,QSRMSR		; Point to RECEIVed message
	MOVE A,PDB+.IPCFS	; GET SENDER'S PID
	CAMN A,QSRPID		; MATCH QUASAR'S?
	RETSKP			; YES, RETURN WITH MSG IN HAND
	TMSG <%Message received not from QUASAR
>
	JRST RCVQSR		; TRY AGAIN
; Here to reque a retrieval request

REQUE:	SETZM NXTRTP		; Current block now invalid
	PUSH P,P1
	CALL ZIPMSS		; Setup to send
	MOVE B,[REQ.SZ,,.QOREQ]
	MOVEM B,.MSTYP(P1)	; Length, type
	MOVE B,TPTSK		; External task
	MOVEM B,REQ.IT(P1)	; Internal task name
	MOVEM A,REQ.IN(P1)	; Timestamp
	HRLI B,.ARTP1(P6)	; COPY TAPE INFO FROM
	HRRI B,REQ.IN+1(P1)	; TO
	BLT B,REQ.IN+1+.ARSF2(P1) ; Copy in tape info
	MOVE P1,[REQ.SZ,,QSRMSS]
	CALL SNDQSR		; Send it to QUASAR
	 JRST [	TMSG <?SNDQSR failed in REQUE
>
		POP P,P1
		RET]
	POP P,P1
	RETSKP

; Here to send goodbye message

GDBYE:	MOVX A,HEFBYE		; SAY GOOD-BYE
	CALL HELLO		; AND DISSAPPEAR
	RET
	RETSKP

; Here to ACK a message

DOACK:	MOVE B,.MSCOD(P1)	; Get ack code
	MOVEM B,.MSCOD+ACKBLK
	PUSH P,P1
	MOVE P1,[MSHSIZ,,ACKBLK]
	CALL SNDQSR		; Send it
	 JRST [	TMSG <%ACK send failed
>
		POP P,P1
		RET]
	POP P,P1
	RET

; Here to release MYPID

RELPID:	SKIPN A,MYPID		; Have PID?
	RET			; No, done
	MOVEM A,PDB+1
	MOVEI A,.MUDES		; Delete the PID
	MOVEM A,PDB
	MOVEI A,2
	MOVEI B,PDB
	MUTIL
	 ERROR R,<%Failed to release PID>
	SETZM MYPID
	SETZM QSRPID		; Forget about QUASAR too
	RET
; Here to send hello message; A Has flags desired to be on

HELLO:	HRRZS A			; No LH flags
	PUSH P,P1		; SAVE THIS
	CALL ZIPMSS		; Setup for sending
	MOVE B,[HEL.SZ,,.QOHEL] ; HELLO MSG
	MOVEM B,.MSTYP(P1)	; Drop in length & type
	MOVE B,[SIXBIT /DUMPER/]
	MOVEM B,HEL.NM(P1)	; Program name
	HRLI A,%%.QSR		; Internal version,,flags
	MOVEM A,HEL.FL(P1)	; Version and flags
	MOVE B,[1,,1]		; 1 object type, 1 concurrent job
	MOVEM B,HEL.NO(P1)
	MOVE B,[.OTRET]		; Which is a retrieval
	MOVEM B,HEL.OB(P1)	; Object type
	MOVE P1,[HEL.SZ,,QSRMSS]
	CALL SNDQSR		; SEND IT
	 JRST [	PUSH P,A
		TMSG <%SNDQSR failed in HELLO
>
		POP P,A
		CALL JSERR1	; REPORT ERROR
		POP P,P1
		RET]
	POP P,P1
	RETSKP

; Here to clear send page & set up P1 pointing to it

ZIPMSS:	SETZM QSRMSS
	MOVE P1,[QSRMSS,,QSRMSS+1]
	BLT P1,QSRMSS+777	; Clear the entire page
	MOVEI P1,QSRMSS
	RET
; Here to initialize the USAGE block before making an entry

USAINI:	MOVE A,[VUSABL,,USABLK]
	BLT A,USABLK+NUSABL-1
	RET

; drop tape info into USAGE blk, A should point to ARCF style blk

USATAP:	LOAD B,TPNM1,(A)	; Get Tape 1 ID
	MOVEM B,USABLK+12
	LOAD B,TSN1,(A)
	MOVEM B,USABLK+14	; Saveset 1
	LOAD B,TFN1,(A)
	MOVEM B,USABLK+16	; Tapefile 1
	LOAD B,TPNM2,(A)	; Get tape 2 ID
	MOVEM B,USABLK+20
	LOAD B,TSN2,(A)
	MOVEM B,USABLK+22	; Saveset # 2
	LOAD B,TFN2,(A)
	MOVEM B,USABLK+24
	RET

VUSABL:	USENT. (.-.,1,0)	; Type to be filled in, version
	USSSI. (USASSI)		; Structure name
	USDIR. (USADIR,,^D39)	; Directory name
	USACT. (USAACT,,^D39)	; Account string
	USUSG. (.-.,US%IMM,6)	; # pages 000000-999999
	USTP1. (.-.,US%IMM,6)	; Tape 1 ID
	USTS1. (.-.,US%IMM,4)	; Tape 1 saveset #
	USTF1. (.-.,US%IMM,6)	; Tape 1 tape file #
	USTP2. (.-.,US%IMM,6)	; Tape 2 ID
	USTS2. (.-.,US%IMM,4)	; Tape 2 saveset #
	USTF2. (.-.,US%IMM,6)	; Tape 2 tape file #
	USRSN. (.-.,US%IMM,1)	; Reason offline line code
MASK:	0
	FB%PRM+FB%NOD+FB%FCF	; CTL (FB%INV IS SPECIAL-CASED)
	0			; EXL
	0			; ADR
	0			; PRT
	777777777777		; CRE
	0			;OLD AUTHOR WRITER WORD
	0			; GEN
	0			; ACT
	777717000000		; BYV
	777777777777		; SIZ
	777777777777		; CRV
	777777777777		; WRT
	777777777777		; REF
	777777777777		; CNT
	1B0+777777		; BK0
	0			; BK1
	0			; BK2
	AR%1ST+AR%WRN		; BBT
	0			; NET
	777777777777		; USW
	0			; GNL
	0			; NAM
	0			; EXT
	0			;.FBLWR POINTER
	0			; TDT
	0			; FET
	0			; TP1
	0			; SS1
	0			; TP2
	0			; SS2
IFN .-MASK-.FBLEN,<PRINTX ** FDB MASK ARRAY SIZE WRONG **>

NWMASK:	0
	FB%TMP+FB%PRM+FB%NOD+FB%FCF ;(FB%INV IS SPECIAL-CASED)
	0
	0
	0
	0
	0
	0
	0
	777717000000
	777777777777
	777777777777
	777777777777
	777777777777
	0
	0
	0
	0
	0
	0
	777777777777
	0
	0
	0
	0			;.FBLWR POINTER WORD
	0			; TDT
	0			; FET
	0			; TP1
	0			; SS1
	0			; TP2
	0			; SS2
IFN .-NWMASK-.FBLEN,<PRINTX ** FDB NWMASK ARRAY SIZE WRONG **>
;FDB MASK FOR INTERCHANGE MODE RESTORE

ICMASK:	0			;FBHDR
	0			;FBCTL
	0			;FBEXL
	0			;FBADR
	0			;FBPRT
	0			;FBCRE
	0			;FBAUT
	0			;FBGEN/FBDRN
	0			;FBACT
	007700,,0		;FBBYV
	-1			;FBSIZ
	0			;FBCRV
	-1			;FBWRT
	0			;FBREF
	0			;FBCNT
   REPEAT 3,<0>			;FBBK0-FBBK2
	0			; BBT
	0			; NET
	0			;FBUSW
	0			;FBGNL
	0			;FBNAM
	0			;FBEXT
	0			;FBLWR
	0			; TDT
	0			; FET
	0			; TP1
	0			; SS1
	0			; TP2
	0			; SS2
   IFN .-ICMASK-.FBLEN,<PRINTX ** FDB ICMASK ARRAY SIZE WRONG **>

;FDB MASK FOR CHECK

CKMASK:	0			;FBHDR
	FB%TMP+FB%PRM+FB%NOD+FB%INV+FB%FCF ;FBCTL
	0			;FBEXL
	0			;FBADR
	0,,777777		;FBPRT
	-1			;FBCRE
	0			;FBAUT
	0			;FBGEN/FBDRN
	0			;FBACT
	777717,,0		;FBBYV
	-1			;FBSIZ
	-1			;FBCRV
	-1			;FBWRT
	-1			;FBREF
	-1			;FBCNT
   REPEAT 3,<0>			;FBBK0-FBBK2
	0			; BBT
	-1			; NET
	-1			;FBUSW
	0			;FBGNL
	0			;FBNAM
	0			;FBEXT
	0			;FBLWR
	0			; TDT
	-1			; FET
	0			; TP1
	0			; SS1
	0			; TP2
	0			; SS2
   IFN .-CKMASK-.FBLEN,<PRINTX ** FDB CKMASK ARRAY SIZE WRONG **>

MSK10X:	R			; Header
	R			; FDBCTL
	R			; FDBEXT
	R			; FDBADR
	R			; FDBPRT
	TIM10X			; FDBCRE (time format)
	R			; FDBUSE
	R			; FDBVER
	R			; FDBACT
	R			; FDBBYV
	R			; FDBSIZ
	TIM10X			; FDBCRV (time)
	TIM10X			; FDBWRT (time)
	TIM10X			; FDBREF (time)
	R			; FDBCNT
	CLRMSK			; FDBBK0
	REPEAT 4,<R>		; FDBBK1-FDBBK4 
	R			; FDBUSE
REPEAT <.FBLEN-<.-MSK10X>>,<R>	; Pad out rest of table

FDBNAM:	SIXBIT /HEADER/
	SIXBIT /.FBCTL/
	SIXBIT /.FBEXT/
	SIXBIT /.FBADR/
	SIXBIT /.FBPRT/
	SIXBIT /.FBCRE/
	SIXBIT /.FBAUT/
	SIXBIT /.FBVER/
	SIXBIT /.FBACT/
	SIXBIT /.FBBYV/
	SIXBIT /.FBSIZ/
	SIXBIT /.FBCRV/
	SIXBIT /.FBWRT/
	SIXBIT /.FBREF/
	SIXBIT /.FBCNT/
	SIXBIT /.FBBK0/
	SIXBIT /.FBBK1/
	SIXBIT /.FBBK2/
	SIXBIT /.FBBBT/
	SIXBIT /.FBNET/
	SIXBIT /.FBUSW/
	SIXBIT /.FBGNL/
	SIXBIT /.FBNAM/
	SIXBIT /.FBEXT/
	SIXBIT /.FBLWR/
	SIXBIT /.FBTDT/
	SIXBIT /.FBFET/
	SIXBIT /.FBTP1/
	SIXBIT /.FBSS1/
	SIXBIT /.FBTP2/
	SIXBIT /.FBSS2/

	END <3,,ENTVEC>