Google
 

Trailing-Edge - PDP-10 Archives - decuslib20-03 - decus/20-0098/maggie.mac
There is 1 other file named maggie.mac in the archive. Click here to see a list.
	TITLE MAGGIE -- PSEUDO RANDOM ACCESS FOR MAGTAPES
	SUBTTL J.L.MOSS, FELDBERG COMPUTER CENTER, BRANDEIS UNIVERSITY

	SALL

	VWHO==:0		;WHO LAST EDITED MAGGIE
	VMAG==:1		;MAGGIE VERSION NUMBER
	VMINOR==:1		;MINOR VERSION
	VEDIT==1		;EDIT NUMBER

	LOC 137
	BYTE	(3)VWHO(9)VMAG(6)VMINOR(18)VEDIT
	RELOC


	;	M A G G I E . M A C
	;
	;  PSEUDO RANDOM-ACCESS FOR MAGTAPES.
	;
	;
	;MAGGIE ALLOWS A USER TO STORE AND RETREIVE
	;FILES FROM MAGTAPES IN A CONVENIENT MANNER
	;AS AN ALTERNATIVE TO FAILSAFE. THE DIRECTORY
	;IS STORED AS THE FIRST FILE ON TAPE, AND IS
	;ALTERED ONLY WHEN FILES ARE ADDED OR DELETED.
	;WILD CARDS ARE ALLOWED ON FILENAMES, AND THE
	;COMMAND FORMAT IF DEC STANDARD. IN EMERGENCY
	;FILES MAY BE TAKEN OFF THE TAPE WITH PIP.
	;THERE ARE NO FILE HEADERS INCORPORATED IN ANY
	;FILE.
	;
	;		NOTE:
	;THE AUTHOR ASSUMES NO RESPONSIBILITY FOR
	;THE FUNCTIONING OF THIS PROGRAM. USERS ARE
	;ADVISED TO BECOME THOROUGHLY FAMILIAR WITH
	;MAGGIE BEFORE USING IT FOR PERMANENT 
	;STORAGE. 
	SUBTTL CONSTANTS

	PDLEN==20		;STACK LENGTH

	MT.MOD==13		;MTA OPEN MODE

	UFD==1			;UFD CHANNEL
	MTA==2			;MTA CHANNEL
	DSK==3			;DISK I/O CHANNEL
	LST==4			;LISTING I/O CHANNEL

	.JBFF==121		;FIRST FREE LOCATION

	NFILES==^D500		;DIRECTORY SIZE

	DR.LST==0		;POSITION OF LAST FILE ON TAPE
	DR.LAB==1		;POSITION OF LABEL IN DIRECTORY
	DR.FIL==0		;POSITION OF FILE IN FILE BLOCK
	DR.EXT==1		;POSITION OF EXTENSION IN FILE BLOCK
	DR.PMD==2		;POSITION OF DATE, MODE, ETC
	DR.PPN==3		;LAST WORD OF 4 WORD BLOCK
	DR.POS==4		;POSITION POINTER IN FILE BLOCK

COMMENT@
		DIRECTORY BLOCK STRUCTURE

		------------------------
	DR.LST	I # OF LAST FILE ON MTAI
		I......................I
	DR.LAB	I  SIXBIT TAPE LABEL   I
		I......................I
	DR.FIL	I SIXBIT/FILENAME/     I
		I......................I	(FILE BLOCK IS
	DR.EXT	I SIXBIT/EXT/,,DATE    I	 THE 4 WORD LOOKUP
		I......................I	 BLOCK PLUS THE
	DR.PMD	I MODE,PROT,DATE2,TIME I	 POSITION POINTER)
		I......................I
	DR.PPN	I 	[P,PN]         I
		I......................I
	DR.POS	I (UNUSED),,POSITION   I
		I......................I
		I		       I
		I		       I
		I		       I
		I	(ETC)          I
		I		       I
		------------------------
@
	SUBTTL ACCUMULATOR DEFINITIONS

	VAL==0
	DEFINE ACDEF(ACNAME),<
	ACNAME=VAL
	VAL==VAL+1
		>

	ACDEF(F)			;FLAG REGISTER
	ACDEF(CHR)			;CHARACTERS
	ACDEF(WOR)			;FULL WORDS
	ACDEF(BP)			;BYTE POINTERS
	ACDEF(CNT)			;COUNTING & INDEXING
	ACDEF(T)			;TEMPORARY
	ACDEF(AC)			;UUO'S
	ACDEF(POS)			;DIRECTORY POSITION POINTER
	ACDEF(NUM)			;NUMBERS
	ACDEF(REM)			;IDIV REMAINDERS
	ACDEF(RAD)			;RADIX
	ACDEF(PTR)			;POINTER
	ACDEF(MSK)			;SIXBIT MASK
	ACDEF(WLD)			;WILD CORE POINTER
	ACDEF(TAP)			;TAPE HEAD POSITION
	ACDEF(P)			;STACK POINTER

	;	W A R N I N G
	;
	; ACCUMULATORS "NUM" AND "REM" MUST BE ADJACENT.
	;
	SUBTTL FLAG DEFINITIONS

	VAL==1
	DEFINE FLDEF(FLAG),<
		FLAG==VAL
		VAL==VAL*2
		>

	FLDEF(FR.LMI)				;LOOKUP MANDATORY
	FLDEF(FR.MTI)				;MTA FOR INPUT
	FLDEF(FR.WLD)				;WILDCARD FILE SPEC SEEN
	FLDEF(FR.NSP)				;SIXBIT W/ NO SPACES
	FLDEF(FR.MOR)				;IF MORE LEFT IN CMD
	FLDEF(FR.EMO)				;ENTER MANDATORY ON OUTPUT
	FLDEF(FR.MTO)				;MAG TAPE FOR OUTPUT
	FLDEF(FR.CPY)				;COPY
	FLDEF(FR.DEL)				;DELETE FILES
	FLDEF(FR.REC)				;RECONSTRUCT DIRECTORY
	FLDEF(FR.REW)				;REWIND TAPE
	FLDEF(FR.FMT)				;FORMAT A TAPE
	FLDEF(FR.LST)				;LIST DIRECTORY
	FLDEF(FR.LSO)				;OUTPUT TO LISTING DEV.
	FLDEF(FR.TAG)				;LABEL TAPE CMD
	FLDEF(FR.QUI)				;QUICK DIRECTORY
	FLDEF(FR.MTS)				;MTA STATUS (/M)

		VAL==1

	FLDEF(FL.COR)				;DIRECTORY IS IN CORE
	FLDEF(FL.CHG)				;TAPE DIR IS NOT CURRENT
	FLDEF(FL.LSD)				;LISTING DEVICE OPEN
	SUBTTL MAIN PROGRAM LOOP

	;DISPATCH TABLE DEFINITION

	DEFINE DISPAT(FLAG,LOC),<
		XWD FLAG,LOC
		>

DISTAB:	DISPAT	(FR.FMT,TAPGEN)
	DISPAT	(FR.TAG,TAG)
	DISPAT	(FR.CPY,COPY)
	DISPAT	(FR.REW,REWND)
	DISPAT	(FR.LST,LIST)
	DISPAT	(FR.QUI,QUICK)
	DISPAT	(FR.DEL,DELETE)
	DISPAT	(FR.REC,HEADIR)
	DISPAT	(FR.MTS,MTSTAT)
		NCMDS==.-DISTAB

MAGGIE:	SETZ	F,
CMDSCN:	RESET
	MOVE	P,[IOWD PDLEN,PDL]		;STACK
	HLLZS	F,				;ZERO FLAGS
	OUTCHR	["*"]				;PROMPT
	PUSHJ	P,CSCLHS			;SCAN LHS
	HRLZI	CNT,-NCMDS			;LOOK THROUGH COMMAND LIST
CMLOOP:	HLRZ	T,DISTAB(CNT)			;GET A FLAG
	TRNE	F,(T)				;TEST IT
	 JRST	GOTONE				;IF A MATCH
	AOBJN	CNT,CMLOOP
	 JRST	ERRSWC				;NO SUCH ANIMAL

GOTONE:	HRRZ	T,DISTAB(CNT)			;ADR OF ROUTINE
	JRST	(T)
	SUBTTL ERROR MACROS 

	;
	;% ERROR ROUTINE
	;
	;CALL:
	;	PERROR(CODE,MESSAGE)
	;
	;TYPES OUT "%MGICODE  MESSAGE" AND RETURNS TO
	;COMMAND LEVEL.
	;
	DEFINE PERROR(CODE,TEXT),<
		XLIST
	E$$'CODE:	JSP	AC,P.EROR
			XWD	''CODE'',[ASCIZ@TEXT@]
		LIST
		>

	;
	;? ERROR ROUTINE
	;
	;CALL:
	;	QERROR(CODE,MESSAGE)
	;
	;TYPES OUT "?MGICODE MESSAGE" AND RETURNS TO
	;MONITOR LEVEL. MAY BE REENTERED AT THIS
	;POINT.
	;
	DEFINE QERROR(CODE,TEXT),<
		XLIST
	E$$'CODE:	JSP	AC,Q.EROR
			XWD	''CODE'',[ASCIZ@TEXT@]
		LIST
		>

	;
	;? ERROR WITH TYPEOUT OF A SIXBIT NAME
	;
	;CALL:
	;	PERR2(CODE,TEXT,LOC)
	;
	;TYPES "?MGICODE (LOC) TEXT" WHERE (LOC)
	;IS THE CONTENTS OF THE SPECIFIED LOCATION IN
	;SIXBIT.
	;
	DEFINE PERR2(CODE,TEXT,LOC),<
		XLIST
	E$$'CODE:	JSP	AC,PCTER2
			XWD	''CODE'',[ASCIZ@TEXT@]
			XWD	Z,LOC
		LIST
		>

	;
	;ERROR PROCESSING
	;

P.EROR:	OUTSTR	[ASCIZ/%MGI/]		;IDENTIFY ERROR 
	CLRBFI				;CLEAR THE BUFFER
	RESET				;RESET I/O DEVICES
	PUSHJ	P,ERRPUB		;PUBLISH THE MESSAGE
	PUSHJ	P,CRLF			;NEATEN UP
	JRST	CMDSCN			;BACK TO GO

Q.EROR:	OUTSTR	[ASCIZ/?MGI/]		;IDENTIFY PROGRAM AND ERROR
	CLRBFI				;CLEAR TYPE-AHEAD
	RESET				;CLEAR I/O DEVICES
	PUSHJ	P,ERRPUB		;PUBLISH THE ERROR MESSAGE
	EXIT	1,			;RETURN TO MONITOR
	JRST	CMDSCN			;IF REE-ENTRY

ERRPUB:	HLLZ	WOR,(AC)		;ERROR CODE
	PUSHJ	P,SIXOUT		;WRITE IT
	HRRZ	WOR,(AC)		;GET TEXT LOCATION
	OUTSTR	(WOR)			;WRITE TEXT
	POPJ	P,			;RETURN

PCTER2:	OUTSTR	[ASCIZ/%MGI/]		;IDENTIFY PROGRAM
	CLRBFI				;CLEAR TYPE-AHEAD
	RESET				;RELEASE I/O
	HLLZ	WOR,(AC)		;GET CODE
	PUSHJ	P,SIXOUT		;WRITE IT
	OUTSTR	[ASCIZ/  "/]		;LEFT QUOTE
	MOVE	WOR,@1(AC)		;GET SIXBIT WORD
	PUSHJ	P,SIXNSP		;WRITE IT
	OUTSTR	[ASCIZ/"  /]		;RIGHT QUOTE
	HRRZ	WOR,(AC)		;GET TEXT LOCATION
	OUTSTR	(WOR)			;WRITE ERROR MESSAGE
	PUSHJ	P,CRLF			;NEATEN UP
	JRST	CMDSCN			;BACK TO START

	;	S I X O U T
	;	   AND
	;	S I X N S P
	;
	;CALL:
	;	MOVE	WOR,[SIXBIT/WORD/]
	;	PUSHJ	P,SIXOUT   -OR-  PUSHJ	P,SIXNSP
	;
SIXNSP:	TRO	F,FR.NSP		;FLAG NO SPACES ALLOWED
SIXOUT:	MOVEI	CNT,6			;COUNT TO 6
	MOVE	BP,[POINT 6,WOR]	;SET UP BYTE POINTER
SIXP:	ILDB	CHR,BP			;GET A CHARACTER
	ADDI	CHR,40			;SIXBIT-->ASCII
	TRNN	F,FR.NSP		;PRINT SPACES?
	 JRST	.+3			;YES, DONT EVEN CHECK
	CAIN	CHR,40			;A SPACE?
	 JRST	SIXCNT			;THEN DONT PRINT IT
	PUSHJ	P,LSTCHR		;ELSE PRINT THE CHAR
SIXCNT:	SOJG	CNT,SIXP		;BACK FOR MORE
	TRZ	F,FR.NSP		;ZERO NO-SPACE FLAG
	POPJ	P,			;AND RETURN

	;	C R L F
	;
	;CALL:
	;	PUSHJ	P,CRLF
	;USE IS OBVIOUS.
	;
CRLF:	OUTSTR	[ASCIZ/
/]
	POPJ	P,
	SUBTTL RIGHT HAND SIDE COMMAND EVALUATOR

	;	G E T D E V
	;
	;CALL:
	;	PUSHJ	P,GETDEV
	;
	;RETURNS DEVICE IN DEV (DEFAULTS TO 'DSK');
	;RETURNS FILE NAME IN FILE, AND EXTENSION IN EXT.
	;
CSCRHS:
GETDEV:	TRZ	F,FR.WLD		;INIT WILD FLAG TO 0
	PUSHJ	P,FSIX			;GET A WORD IN SIXBIT
	CAIN	CHR,":"			;A DEVICE NAME?
	 JRST	DEVSEE			;YES, PROCEED FROM THERE
	MOVE	CNT,[SIXBIT/DSK/]	;SET UP DEFAULT IF NO DEVICE
	MOVEM	CNT,DEV			;STORE FOR OPEN
GETFIL:	CAIN	CHR,"."			;FILE WITH EXT SEEN?
	 JRST	EXTSEE			;YES, PROCEED FROM THERE
	MOVEM	WOR,FILE		;NO, FILE WITH NUL EXT
	MOVEM	MSK,FMASK		;STORE FILE MASK
	SETZM	EXT			;NULIFY EXT
	SETOM	EMASK			;SET UP EXT MASK
	HLLZS	EMASK			;AS 777777,,0
ENDCMD:	CAIN	CHR,","			;MORE TO COME?
	 JRST	NOTYET			;YES, MARK AS SUCH AND RETURN
	CAIN	CHR,15			;A <CR>?
	 JRST	LSTCMD			;YES, LAST COMAND
	JRST	ERRCMD			;NO, ERROR IN COMMAND STRING

DEVSEE:	MOVEM	WOR,DEV			;STORE THE DEVICE NAME
	MOVEM	MSK,DMASK		;STORE DEVICE MASK
	PUSHJ	P,FSIX			;GET THE FILENAME
	JRST	GETFIL			;AND STORE IT

EXTSEE:	MOVEM	WOR,FILE		;STORE THE FILE
	MOVEM	MSK,FMASK		;STORE FILE MASK
	PUSHJ	P,FSIX			;GET THE EXTENSION
	HLLZM	WOR,EXT			;STORE IT
	HLLZM	MSK,EMASK		;STORE EXT MASK
	JRST	ENDCMD			;SEE IF NEXT CHR IS VALID

LSTCMD:	TRZ	F,FR.MOR		;FLAG NO MORE LEFT
	INCHWL	CHR			;GET THE <LF>
	SKIPN	DEV			;CHECK NULL DEVICE
	 JRST	ERRNDI			;ILLEGAL
	MOVE	WOR,DEV			;GET INPUT DEVICE AND
	PUSHJ	P,IDEV			;VERIFY INPUT DEVICE
	 JRST	ERRIND			;A LOSER.
	POPJ	P,			;RETURN

NOTYET:	TRO	F,FR.MOR		;FLAG MORE TO COME
	SKIPN	DEV			;SCHEC NULL DEVICE NAME
	 JRST	ERRNDI			;BAD NEWS.
	MOVE	WOR,DEV			;GET INPUT DEVICE AND
	PUSHJ	P,IDEV			;VERIFY INPUT DEVICE
	 JRST	ERRIND			;BAD INPUT DEVICE
	POPJ	P,			;AND RETURN

	;	I D E V
	;
	;CALL:
	;	MOVE	WOR,[SIXBIT/DEV/]
	;	PUSHJ	P,IDEV
	;	 ERROR RETURN
	;	NORMAL RETURN
	;
	;CHECKS DEVICE IN DEV FOR COMPATIBILITY AS AN INPUT
	;DEVICE. ERROR RETURN IS GIVEN IF THE DEVICE HAS NO
	;DOIECTORY OR IS NOT A MAGNETIC TAPE.
	;
IDEV:	TRZ	F,FR.LMI!FR.MTI		;SET FLAGS TO 0 FIRST
	MOVEM	WOR,TEMP		;STASH IN CASE OF ERROR
	DEVCHR	WOR,			;GET CHAR WORD
	TLNE	WOR,4			;DIRECTORY DEVICE?
	 JRST	DIRIDV			;YES.
	TLNN	WOR,20			;A MAGTAP THEN?
	 POPJ	P,			;NO, GIVE ERROR RETURN
	TRO	F,FR.MTI		;FLAG MTA AS INPUT
	MOVE	WOR,TEMP		;RESTORE NAME
	AOS	(P)			;GIVE SKIP RETURN
	POPJ	P,
DIRIDV:	TRO	F,FR.LMI		;FLAG MANDATORY LOOKUP
	MOVE	WOR,TEMP		;RESTORE NAME
	AOS	(P)			;GIVE SKIP RETURN
	POPJ	P,

ERRCMD:	PERROR(ECS,<ERROR IN COMMAND STRING>)

ERRNDI:	PERROR(NDI,<NULL DEVICE NAME IS ILLEGAL>)

ERRIND:	PERR2(IND,<IS AN ILLEGAL INPUT DEVICE>,TEMP)
	SUBTTL LEFT HAND SIDE EVALUATOR

CSCLHS:	PUSHJ	P,FSIX			;GET A WORD
	CAIN	CHR,"/"			;A COMMAND?
	 JRST	EVAL			;YES, EVALUATE IT
	CAIE	CHR,":"			;A DEVICE SPEC?
	 JRST	ERRCMD			;NO, COMMAND ERROR
	MOVEM	WOR,OUTDEV		;STORE OUTPUT DEVICE
	DEVCHR	WOR,			;DETERMINE WHAT TYPE OF DEVICE
	TLNE	WOR,4			;A DIRECTORY DEVICE?
	 JRST	DIRDEV			;YES.
	TLNE	WOR,20			;A MAG TAPE FOR OUTPUT?
	 JRST	MTADEV			;YES.
	TLNE	WOR,40010		;DEVICE TTY OR LPT?
	 JRST	LSTDEV			;MARK AS A LISTING DEVICE
	JRST	ERROUD			;ELSE A BAD OUTPUT DEVICE
DIRDEV:	TRO	F,FR.EMO		;ENTER MANDATORY ON OUTPUT
	CAIA
MTADEV:	TRO	F,FR.MTO		;MAGTAPE DEVICE FOR OUTPUT
	CAIA
LSTDEV:	TRO	F,FR.LSO		;LISTING DEVICE FOR OUTPUT
	PUSHJ	P,NX.CHR		;IGNORE SPACES
	CAIE	CHR,"/"			;IF NO SWITCH
	 JRST	ERRCMD			;THEN ERROR
	INCHWL	CHR			;GET PARAMETER
	PUSHJ	P,SW.CHK		;SET FLAGS
	PUSHJ	P,NX.CHR		;GET REST OF LHS
	CAIN	CHR,"_"			;LSH DELIMITER?
	 POPJ	P,			;YES, GET RHS
	CAIN	CHR,"="			;ALSO A VALID DELIMITER
	 POPJ	P,			;RETURN FOR RHS
	CAIN	CHR,"/"			;TRIED ANOTHER SWITCH?
	 JRST	ERRDSI			;BUT THATS ILLEGAL!
	JRST	ERRCMD			;NO, COMMAND ERROR

	;
	;DEFINE SWITCH TABLE.
	;
	DEFINE SWDEF(SWITCH,FLAG),<
		XWD "SWITCH",FLAG
		>

SWTAB:	SWDEF(<X>,FR.CPY)		;A COPY COMMAND
	SWDEF(<D>,FR.DEL)		;A DELETE COMMAND
	SWDEF(<W>,FR.REW)		;REWIND TAPE
	SWDEF(<F>,FR.FMT)		;FORMAT THE TAPE
	SWDEF(<L>,FR.LST)		;LIST DIRECTORY
	SWDEF(<T>,FR.TAG)		;LABEL THE TAPE
	SWDEF(<Q>,FR.QUI)		;QUICK DIRECTORY
	SWDEF(<R>,FR.REC)		;RECONSTRUCT DEAD DIRECTORY
	SWDEF(<M>,FR.MTS)		;STATUS OF MTA DEVICE
		SWLEN==.-SWTAB		;NUMBER OF SWITCHES DEFINED

SW.CHK:	HRLZI	CNT,-SWLEN		;AOBJN POINTER TO SWITCHES
SWCHK1:	HLRZ	T,SWTAB(CNT)		;GET ASCII SWITCH VALUE
	CAMN	CHR,T			;DOES IT MATCH?
	 JRST	GOTSW			;YES, SET FLAG
	AOBJN	CNT,SWCHK1		;NO, TRY AGAIN
	JRST	ERRSWC			;SWITCH SPECIFICATION ERROR
GOTSW:	HRRZ	T,SWTAB(CNT)		;GET SWITCH FLAG
	TRO	F,(T)			;SET THE FLAG
	POPJ	P,			;RETURN

	;
	;LEFT-HAND-SIDE DIRECT COMMAND TABLE
	;
	DEFINE LHSDTB(SWITCH,DESTIN),<
		XWD "SWITCH",DESTIN
		>

LDISTB:	LHSDTB(<E>,MONITO)
	LHSDTB(<H>,HELP)
	LHSDTB(<S>,STATUS)
		NLDIS==.-LDISTB

EVAL:	HRLZI	CNT,-NLDIS
	INCHWL	CHR			;GET CALLING CHARACTER
EVA1:	HLRZ	WOR,LDISTB(CNT)		;GET TABLE ENTRY
	CAMN	WOR,CHR			;MATCH?
	 JRST	EVA2			;YES, GO THERE
	AOBJN	CNT,EVA1		;NO, LOOK AGAIN
	PERROR	(NSC,<NO SUCH COMMAND>)	;UNKNOWN REQUEST
EVA2:	PUSHJ	P,WIPE			;CLEAN UP
	HRRZ	WOR,LDISTB(CNT)		;GET LOC OF DISPATCH
	JRST	@WOR			;GO THERE

WIPE:	CAIN	CHR,12			;A <LF>?
	 POPJ	P,			;YES, RETURN
	INCHWL	CHR			;NO, GET ANOTHER CHAR
	JRST	WIPE			;AND LOOK AGAIN

MONITO:	TRO	F,FR.MTO		;MARK MTA AS OUTPUT
	MOVE	AC,MTANAM		;GET NAME OF TAPE IN CORE
	MOVEM	AC,OUTDEV		;THAT BECOMES OUTPUT DEVICE
	TLNE	F,FL.CHG		;DIRECTORY CHANGED?
	 PUSHJ	P,W.DIR			;YES, THEN WRITE DIRECTORY
	EXIT	1,			;AND EXIT
	EXIT

ERROUD:	PERR2(IOD,<IS AN ILLEGAL OUTPUT DEVICE>,OUTDEV)

ERRSWC:	PERROR(NSS,<NO SUCH SWITCH VALUE>)

ERRDSI:	PERROR(DSI,<DOUBLE SWITCH ILLEGAL>)
	SUBTTL SIXBIT INPUT ROUTINE FOR FILENAMES

	;	F S I X
	;
	;CALL:
	;	PUSHJ	P,FSIX
	;
	;RETURNS IN WOR A MASK FOR THE FILENAME, EXT, OR
	;DEVICE. HANDLES ? AND * WILDCARDS. RETURNS FIRST
	;CHARACTER AFTER THE SIXBIT WORD IN CHR.
	;A WILD MASK IS RETURNED IN MSK.
	;EG. USER TYPES FOO?AR. RETURNED IN WOR IS
	;F/O/O/0/A/R (WILD BITS MASKED OUT).
	;RETURNED IN MSK IS 777777,,0077
	;(ONES FOR ALL BITS EXCEPT MASKED BITS.
	;
FSIX:	MOVEI	CNT,6			;COUNT TO A MAX OF 6
	MOVE	BP,[POINT 6,WOR,35]	;BYTE POINTER
	MOVE	PTR,[POINT 6,MSK,35]	;BYTE POINTER TO MASK
	SETZ	WOR,			;IN CASE OF NULL'S
FSIX1:	INCHWL	CHR			;GET A CHARACTER
	MOVEI	NUM,77			;SET UP FOR NON-WILD MASK
	CAIN	CHR,"*"			;FULL WILD CARD?
	 JRST	FULWLD			;YES, NEGATE WOR AND RETURN
	CAIN	CHR,"."			;FILE DELIMETER?
	 JRST	FIN			;YES, RETURN
	CAIN	CHR,":"			;DEVICE DELIMETER?
	 JRST	FIN			;YES, RETURN
	CAIN	CHR,","			;MORE TO COME?
	 JRST	FIN			;YES. RETURN.
	CAIN	CHR,"/"			;A SWITCH?
	 JRST	FIN			;YES. RETURN.
	CAIN	CHR,15			;A <CR>?
	 JRST	FIN			;YES, FINISHED
	CAIE	CHR,"?"			;THIS CHARACTER WILD?
	 JRST	FSIX2			;NO, PROCEED NORMALLY
	MOVEI	CHR,40			;YES, NEGATE THIS CHARACTER
	SETZ	NUM,			;ZERO FOR MASK
	TRO	F,FR.WLD		;SET THE WILD FLAG
FSIX2:	SUBI	CHR,40			;ASCII-->SIXBIT
	LSH	WOR,6			;SHIFT LEFT 6 BITS
	LSH	MSK,6			;SAME FOR MASK
	DPB	CHR,BP			;DEPOSIT THE BYTE
	DPB	NUM,PTR			;DEPOSIT MASK BYTE
	SOJG	CNT,FSIX1		;AND GET ANOTHER
	INCHWL	CHR			;READ A CHARACTER IF 6 USED
	JRST	FSIX4			;NO NEED TO JUSTIFY HERE
FIN:	LSH	WOR,6			;LEFT JUSTIFY THE WORD
	MOVEI	NUM,77			;
	LSH	MSK,6
	DPB	NUM,PTR			;
	SOJG	CNT,FIN			;UNTIL DONE.
FSIX4:	POPJ	P,			;THEN RETURN

FULWLD:	SETZ	WOR,			;0,,0 WILD MASK
	SETZ	MSK,			;MASK 2 IS ALSO WILD
	TRO	F,FR.WLD		;SET WILDCARD FLAG
	INCHWL	CHR			;READ NEXT CHAR
	POPJ	P,			;RETURN

	;	N X . C H R
	;
	;CALL:
	;	PUSHJ	P,NX.CHR
	;
	;RETURNS NEXT NON SPACE CHARACTER IN CHR.
	;
NX.CHR:	INCHWL	CHR			;GET A CHR
	CAIN	CHR," "			;A SPACE?
	JRST	.-2			;GET ANOTHER CHR IN THAT CASE
	POPJ	P,			;ELSE RETURN
	SUBTTL MAGTAPE POSITIONING MACROS
	;	R E W I N D
	;
	;CALL:
	;	REWIND(MTA)
	;
	;WHERE MTA IS THE CHANNEL NUMBER OF THE SPECIFIED
	;TAPE. THIS INSTRUCTION CAN BE SKIP'ED.
	;
	DEFINE REWIND(CHAN),<
			XLIST
		CAIA			;NORMAL ENTRY
		 JRST	.+3		;SKIP INSTR ENTRY
		MTAPE	CHAN,1		;REWIND THE TAPE
		MTAPE	CHAN,0		;WAIT FOR COMPLETION
			LIST
		>

	;	S K I P F L
	;
	;CALL:
	;	SKIPFL(MTA)
	;
	;WHERE MTA IS THE CHANNEL OF THE SPECIFIED
	;MAGNETIC TAPE, SKIPFL CAUSES A SKIP FILE
	;OPERATION. THE SKIPFL INSTRUCTION CAN BE SKIP'ED.
	;
	DEFINE SKIPFL(CHAN),<
			XLIST
		CAIA			;NORMAL ENTRY
		 JRST	.+3		;SKIP INSTRUCTION ENTRY
		MTAPE	CHAN,16		;SKIP A FILE
		MTAPE	CHAN,0		;WAIT FOR I/O TO FINISH
			LIST
		>

	;	B A C K F L
	;
	;CALL:
	;	BACKFL(MTA)		
	;
	;CAUSES THE TAPE ON CHANNEL MTA TO BACKSPACE
	;1 FILE. THIS ESSENTIALLY CAUSES A REWIND ON
	;THE CURRENT FILE. BEGINNING OF TAPE IS
	;OBSERVED.
	;
	DEFINE BACKFL(CHAN),<
		CAIA			;NORMAL ENTRY
		 JRST	.+6		;SKIP ENTRY
		MTAPE	CHAN,17		;BACKSPACE A FILE
		MTAPE	CHAN,0		;WAIT FOR COMPLETION
		STATO	CHAN,4000	;BEGINNING OF TAPE?
		MTAPE	CHAN,16		;NO, SKIP OVER EOF
		MTAPE	CHAN,0		;WAIT TILL DONE
		>
	SUBTTL UFD SEARCH ROUTINES --MINI-WILD--

	;	M A T C H
	;
	;CALL:
	;	MATCH	(WORD,MASK1,MASK2)
	;	 NO MATCH RETURN
	;	MATCH RETURN
	;
	;MATCH DETERMINES IF THE WORD MATCHES THE
	;SPECIFICATIONS OF THE MASKS AND SKIPS ON A MATCH.
	;
	DEFINE MATCH(WORD,MASK1,MASK2),<
			XLIST
		AND	WORD,MASK2	;ZERO WILD BITS
		CAME	WORD,MASK1	;SKIP IF MATCH
			LIST
			>

	;	U F D I N I
	;
	;CALL:
	;	PUSHJ	P,UFDINI
	;
	;OPENS USER'S UFD ON THE DEVICE SPECIFIED
	;IN DEV. DISPATCHES ERROR MESSAGES IF
	;OPEN OR LOOKUP FAIL.
	;
UFDINI:	SETZ	AC,			;ZERO MEANS THIS USER
	GETPPN	AC,			;GET HIS PPN
	 JFCL
	MOVEM	AC,UFDPPN		;STORE IT IN LOOKUP BLOCK
	OPEN	UFD,UFDIBK		;TRY THE OPEN
	 JRST	ERRDOE			;OPEN FAILURE
	MOVE	AC,[SIXBIT/UFD/]	;UFD EXTENSION
	MOVEM	AC,UFDLBK+1		;STORE A NEW COPY
	SETZM	UFDLBK+2		;ZERO EXTRA STUFF
	MOVE	AC,[XWD 1,1]		;MFD PPN
	MOVEM	AC,UFDLBK+3		;A FRESH COPY OF THAT, TOO
	LOOKUP	UFD,UFDLBK		;TRY THE LOOKUP 
	 JRST	ERRULE			;LOOKUP FAILED
	POPJ	P,

	;	W I L D
	;
	;CALL:
	;	PUSHJ	P,WILD
	;	 RETURN IF NO MATCH
	;	RETURN IF FILE HAS BEEN FOUND
	;	
	;WILD SETS THE GENERAL LOOKUP/ENTER BLOCK
	;(LEBLOK) IF THE FILE MASK HAS BEEN SATISFIED.
	;ELSE IT GIVES THE ERROR RETURN.
	;
WILD:	PUSHJ	P,GT.UUW		;GET A WORD FROM THE UFD
	 JRST	EOFUFD			;END OF UFD
	MOVEM	CHR,FILENA		;STORE IN LOOKUP BLOCK
	PUSHJ	P,GT.UUW		;GET EXT WORD
	 JRST	EOFUFD			;PREMATURE END OF UFD
	HLLZS	CHR			;ISOLATE THE EXT
	MOVEM	CHR,EXTN		;STORE IN LOOKUP BLOCK
	MATCH	(CHR,EXT,EMASK)		;MATCH SPECS?
	 JRST	NO.MAT			;NOPE
	MOVE	CHR,FILENA		;YES, TEST FILENAME TOO
	MATCH	(CHR,FILE,FMASK)	;DOES IT MATCH ALSO?
	 JRST	NO.MAT			;NOPE.
	SETZM	EXTN+1			;ZERO PREVIOUS STUFF
	SETZM	EXTN+2
	AOS	(P)			;YES, GIVE SKIP RETURN
	POPJ	P,

NO.MAT:	JRST	WILD			;NO MATCH YET, TRY AGAIN
EOFUFD:	POPJ	P,			;GIVE NON-SKIP ERROR RETURN

	;	C . I N I T
	;
	;INITIALIZES FOR SCAN OF CORE DIRECTORY
	;IN SAME MANNER AS UFDINI.
	;
C.INIT:	HRLZI	WLD,-NFILES		;FILE COUNTER WORD
	MOVEM	WLD,WLDPTR		;STORE POINTER
	POPJ	P,			;AND RETURN

	;	C . W I L D
	;
	;SCANS CORE DIRECTORY AS WILD SCANS UFD.
	;SETS UP LOOKUP/ENTER BLOCK, AND RETURNS
	;POINTER TO DIRECTORY ENTRY IN WLDPTR.
	;
C.WILD:	MOVE	WLD,WLDPTR		;RESTORE THE POINTER
	MOVE	WOR,DIRECT+2+DR.FIL(WLD);GET A FILE NAME
	JUMPE	WOR,CWILD1		;NULL NAMES ARE DULL NAMES
	MOVEM	WOR,FILENA		;SAVE IT IN CASE
	MATCH	(WOR,FILE,FMASK)	;SEE IF A MATCH
	 JRST	CWILD1			;NO DICE
	MOVE	WOR,DIRECT+2+DR.EXT(WLD);TRY THE EXT
	MOVEM	WOR,EXTN
	MATCH	(WOR,EXT,EMASK)		;MATCH?
	 JRST	CWILD1			;TRY AGAIN
	SETZM	EXTN+1			;YES, SET UP ARG BLOCK
	SETZM	EXTN+2
	ADDI	WLD,4			;ADJUST WILD POINTER
	ADD	WLD,[1,,1]		;FOR NEXT TRY
	MOVEM	WLD,WLDPTR		;SAVE POINTER
	AOS	(P)			;GIVE SKIP RETURN
	POPJ	P,

CWILD1:	ADDI	WLD,4			;HERE IF NOT FOUND
	AOBJN	WLD,C.WILD+1		;TRY AGAIN
	POPJ	P,			;RETURN IF FAILED

	;	G T . U U W
	;
	;CALL:
	;	PUSHJ	P,GT.UUW
	;	 ERROR RETURN
	;	NORMAL RETURN WITH WORD IN CHR
	;
	;THIS ROUTINE GETS A WORD FROM THE UFD.
	;ERROR RETURN IS GIVEN IF THE READ CAUSED
	;AN EOF TO BE SEEN.
	;
GT.UUW:	SOSGE	UFDIBF+2		;TEST FOR EMPTY BUFFER
	 JRST	GT.UBF			;OOPS...GET ANOTHER ONE
	ILDB	CHR,UFDIBF+1		;GET A WORD
	JUMPE	CHR,GT.UUW		;NULLS ARE WORTHLESS
	AOS	(P)			;SKIP RETURN
	POPJ	P,

GT.UBF:	IN	UFD,			;GET A BUFFERFULL
	 JRST	GT.UUW			;RETURN WITH IT
	STATZ	UFD,74B23		;ERROR--SEE IF READ ERROR
	 JRST	ERRIRE			;INPUT READ ERROR
	CLOSE	UFD,			;JUST EOF--CLOSE
	RELEAS	UFD			;AND RELEASE THE CHANNEL
	POPJ	P,			;AND GIVE EOF RETURN

ERRIRE:	QERROR	(IRE,<INPUT READ ERROR ON UFD.>)

ERRDOE:	PERR2	(DOE,<DEVICE OPEN ERROR>,DEV)

ERRULE:	PERROR	(ULE,<UFD DOES NOT EXIST>)
	SUBTTL FORMAT TAPE ROUTINE

COMMENT@

	STRUCTURE OF FILE STORAGE ON TAPE


		-------------------------
		I			I
		I  DIRECTORY BLOCK	I
		I			I
		I.......................I
		I			I
		I  HEADER FILE #1	I
		I			I
		I.......................I
		I			I
		I  ACTUAL FILE #1	I
		I			I
		I.......................I
		I			I
		I  HEADER FILE #2	I
		I	.		I
		I	.		I
		I	.		I
		I   (ETC)		I
		-------------------------

SEE P. 2 (LISTING) FOR DIRECTORY BLOCK STRUCTURE.

HEADER FILE CONSISTS OF THE 4-WORD LOOKUP BLOCK FOR THE FILE
PLUS AN EXTRA WORD WHICH IS CURRENTLY 0,,POSITION WHERE
POSITION IS THE POSITION ON TAPE. THE HEADER FILE AND THE ACTUAL
FILE ARE RECORDED WITH MODE MT.MOD WHICH IS SET AT 13 FOR
DISTRIBUTION.

@
	;WRITES A DIRECTORY OF ZEROS ON TAPE AND
	;THEN 6 INCHES OF BLANK TAPE. REWINDS TAPE.

TAPGEN:	TRNN	F,FR.MTO		;MAGTAPE FOR OUTPUT?
	 JRST	ERRNMD			;CANT DO IT THEN.
	PUSHJ	P,WIPE			;KILL THE RHS
	MOVEI	AC,MT.MOD		;IMAGE BINARY MODE
	MOVEM	AC,OUTBLK		;STORE IN OUTPUT BLOCK
	MOVE	AC,OUTDEV		;GET OUTPUT DEVICE
	MOVEM	AC,OUTBLK+1		;STORE IN OUTPUT OPEN BLOCK
	OPEN	MTA,OUTBLK		;TRY THE OPEN
	 JRST	ERRDOF			;OPEN FAILURE
	REWIND	(MTA)			;REWIND TAPE
DIRLNG:	HRLZI	CNT,-5*<NFILES+^D300>	;DIRECTORY LENGTH
	SETZ	WOR,			;ZERO TO WRITE
ZERDIR:	PUSHJ	P,MTWRIT		;AND TAPE DIRECTORY
	 JRST	ERRMTW			;WRITE ERROR
	AOBJN	CNT,ZERDIR		;GO THROUGH ENTIRE DIRECTORY
	CLOSE	MTA,			;FORCE ALL DATA OUT
	MTAPE	MTA,17			;BACK UP OVER FIRST EOF
	MTAPE	MTA,0			;WAIT TILL DONE
	MTAPE	MTA,13			;WRITE 3 INCHES BLANK TAPE
	MTAPE	MTA,0			;WAIT
	MTAPE	MTA,13			;MAKE IT 6 INCHES
	MTAPE	MTA,0			;AND WAIT
	MTAPE	MTA,3			;WRITE EOF
	MTAPE	MTA,0			;AND WAIT
	REWIND	(MTA)			;REWIND THE TAPE
	RELEAS	MTA,			;RELEASE THE DEVICE
	JRST	CMDSCN			;AND BACK TO CMD LEVEL

ERRDOF:	PERR2(DOF,<DEVICE OPEN FAILURE>,OUTDEV)

ERRNMD:	PERROR(NMD,<DEVICE NOT A MAGNETIC TAPE>)

ERRMTW:	GETSTS	MTA,AC			;DETERMINE WHAT WENT WRONG
	TRNE	AC,400000		;WRITE-LOCK ERROR
	 JRST	ERRWTL
	TRNE	AC,100000		;PARITY ERROR
	 JRST	ERRPAR	
	TRNE	AC,40000		;RECORD TOO LONG
	 JRST	ERRRTL
	PERR2	(MTW,<DEVICE WRITE ERROR>,OUTDEV)

ERRWTL:	PERR2	(WTL,<DEVICE WRITE-LOCK ERROR>,OUTDEV)

ERRPAR:	PERR2	(PAR,<DEVICE PARITY ERROR>,OUTDEV)

ERRRTL:	PERR2	(RTL,<DEVICE RECORD TOO LONG>,OUTDEV)
	SUBTTL HERE TO TRANSFER FILES

COPY:	TRNN	F,FR.MTO			;COPY TO TAPE?
	 JRST	D.COPY				;NO, TO DISK
	TLNN	F,FL.COR			;DIRECTORY IN CORE?
	 PUSHJ	P,R.DIR				;NO, READ IT IN
	PUSHJ	P,T.COPY			;DO THE COPY
	JRST	CMDSCN				;AND RETURN


	;	T . C O P Y
	;
	;CALL:
	;	PUSHJ	P,T.COPY
	;
	;EVALUATES THE RIGHT-HAND ARGUMENTS AND
	;DOES THE REQUESTED COPYS.
	;
T.COPY:	PUSHJ	P,MT.INI			;INIT THE TAPE
	REWIND	(MTA)				;REWIND IT
	PUSHJ	P,EOTPOS			;POSITION IT AT END
	PUSHJ	P,MT.FIN			;AND RELEASE
TCOPY1:	PUSHJ	P,CSCRHS			;THE SCAN OF RHS
	PUSHJ	P,UFDINI			;INIT UFD
GT.FIL:	PUSHJ	P,WILD				;GET A FILE
	 JRST	FINIS				;NO MORE MATCH TAT SPEC
	MOVEI	AC,MT.MOD			;MODE FOR I/O
	MOVEM	AC,INBLOK			;STORE IN OPEN BLOCK
	MOVE	AC,DEV				;GET DEVICE
	MOVEM	AC,INBLOK+1			;STORE IT
	MOVE	AC,.JBFF			;GET FIRST FREE LOC
	MOVEM	AC,S.JBFF			;SAVE IT
	OPEN	DSK,INBLOK			;OPEN THE DISK
	 JRST	ERRDOE				;FAILED
	LOOKUP	DSK,LEBLOK			;DO THE LOOKUP
	 JRST	ERRLKE				;LOOKUP ERROR
	PUSHJ	P,MT.INI			;OPEN TAPE CHANNEL
	HRLZI	AC,-4				;PREPARE TO WRITE
TCOPY2:	MOVE	WOR,LEBLOK(AC)			;A HEADER FILE
	PUSHJ	P,MTWRIT			;FROM THE LOOKUP BLOCK
	 JRST	ERRMTW				;CAN'T WRITE IT
	AOBJN	AC,TCOPY2			;FOR THE FILE
	HRRZ	WOR,POS				;GET POSITION ON TAPE
	AOS	WOR				;ADJUST IT
	PUSHJ	P,MTWRIT			;AND WRITE IT
	PUSHJ	P,MT.FIN			;CLOSE TO GET ALL DATA
	PUSHJ	P,MT.INI			;OUT AND THEN REE-OPEN
	PUSHJ	P,XFER				;TRNASFER THE FILE
	PUSHJ	P,MT.FIN			;CLOSE THE TAPE
	CLOSE	DSK,				;CLOSE DISK
	RELEAS	DSK,				;RELEASE THE CHANNEL
	MOVE	AC,S.JBFF			;AND RECLAIM CORE
	MOVEM	AC,.JBFF			;BY RESTORING JBFF
	AOS	POS				;INCREMENT POSITN COUNT
	PUSHJ	P,E.DIR				;ENTER DATA IN DIRECTORY
	JRST	GT.FIL				;AND GET ANOTHER FILE
FINIS:	TRNE	F,FR.MOR			;MORE LEFT?
	 JRST	TCOPY1				;YES, GET THEM
	POPJ	P,				;NO, RETURN

XFER:	PUSHJ	P,DKREAD			;WORD FROM DISK
	 POPJ	P,				;EOF
	PUSHJ	P,MTWRIT			;WRITE IT
	 JRST	ERRMTW				;ERROR WHILE WRITING
	JRST	XFER				;CONTINUE

D.COPY:	SETZM	LSTLEN				;ZERO LIST POINTER
	PUSHJ	P,CSCRHS			;SCAN RHS
	TLNN	F,FL.COR			;DIRECTORY IN CORE?
	 PUSHJ	P,R.DIR				;NO, READ IT IN
	PUSHJ	P,C.INIT			;INIT WILD SCANNER
	PUSHJ	P,C.WILD			;GET A FILE
	 JRST	DCOPY1				;IF NONE LEFT
	MOVE	CNT,WLDPTR			;GET POINTER TO FILE
	SUBI	CNT,5				;ADJUST COUNT BACK DOWN
	HRRZ	AC,DIRECT+2+DR.POS(CNT)		;GET FILE POSITION
	HRRZI	NUM,DIRECT+2+DR.FIL(CNT)	;GET LOC OF FILE IN DIR.
	MOVE	CNT,LSTLEN			;GET LIST POINTER
	HRRZM	AC,LLIST(CNT)			;STORE FILE POS IN LIST
	HRRZM	NUM,DOPEV(CNT)			;STORE DIRECTORY POS.
	AOS	LSTLEN				;INCREMENT POINTER
	JRST	D.COPY+5			;GET ANOTHER FILE
DCOPY1:	TRNE	F,FR.MOR			;MORE IN COMMAND?
	 JRST	D.COPY+1			;YES, GET IT
	SKIPG	LSTLEN				;IF NO FILES IN LIST
	 JRST	CMDSCN				;SIMPLY RETURN
	PUSHJ	P,SORT				;SORT THE LIST
	PUSHJ	P,CLEAN				;CLEAN IT OUT
	SKIPN	LSTLEN				;ANY TO COPY?
	 JRST	CMDSCN				;NO, RETURN
	PUSHJ	P,MT.ONI			;YES, INIT THE TAPE
	REWIND	(MTA)				;REWIND THE TAPE
	SETZ	TAP,				;ZERO POSITION POINTER
	HRLZ	WLD,LSTLEN			;LENGTH,,0
	MOVNS	WLD				;-LENGTH,,0
DCOPY2:	SKIPN	LLIST(WLD)			;A GOOD ENTRY?
	 JRST	DCOPY3				;NO, IT WAS SUPERSEEDED
	CAMN	TAP,LLIST(WLD)			;POSITIONED YET?
	 JRST	READY				;YES, TRANSFER
	SKIPFL	(MTA)				;SKIP A HEADER FILE
	SKIPFL	(MTA)				;SKIP A FILE
	AOS	TAP				;INCREMENT POINTER
	JRST	DCOPY2				;AND TRY AGAIN
READY:	HRLZ	PTR,DOPEV(WLD)			;FILE POS,,0
	HRRI	PTR,LEBLOK			;FILE POS,,LOOKUP BLOCK
	BLT	PTR,LEBLOK+2			;BLT THE ENTRY
	SETZM	LEBLOK+3			;ZERO PPN WORD
	MOVE	AC,OUTDEV			;GET OUTPUT DEVICE
	MOVEM	AC,OUTBLK+1			;STORE IT FOR OPEN
	MOVEI	AC,MT.MOD			;OPEN MODE
	MOVEM	AC,OUTBLK			;STORE MODE
	MOVE	AC,.JBFF			;GET JBFF
	MOVEM	AC,S.JBFF			;SAVE IT
	OPEN	DSK,OUTBLK			;OPEN THE DISK
	 JRST	ERROFD				;NO DICE
	ENTER	DSK,LEBLOK			;ENTER THE FILE
	 JRST	ERREFD				;ENTER FAILED
	PUSHJ	P,D.XFER			;TRANSFER THE FILE
	PUSHJ	P,MT.FIN			;DROP MTA CHANNEL
	PUSHJ	P,MT.ONI			;AND GET IT AGAIN
	CLOSE	DSK,				;CLOSE DISK
	RELEAS	DSK,				;RELEASE IT
	SKIPFL	(MTA)				;SKIP NEXT HEADER FILE
	AOS	TAP				;MARK NEW POS ON TAPE
	MOVE	AC,S.JBFF			;GET OLD .JBFF BACK
	MOVEM	AC,.JBFF			;AND RESTORE IT
DCOPY3:	AOBJN	WLD,DCOPY2			;LOOP THROUGH
	REWIND	(MTA)				;REWIND TAPE
	PUSHJ	P,MT.FIN			;CLOSE AND RELEASE
	JRST	CMDSCN				;WHEN FINISHED

D.XFER:	PUSHJ	P,MTREAD			;GET A WORD FROM TAPE
	 POPJ	P,				;DONE.
	PUSHJ	P,DKWRIT			;WRITE IT ON DISK
	JRST	D.XFER				;UNTIL EOF

ERROFD:	PERR2	(OFD,<OPEN FAILURE>,OUTDEV)
ERREFD:	PERR2	(EFD,<ENTER FAILURE>,LEBLOK)
ERRLKE:	OUTSTR	[ASCIZ/%MGILKE  LOOKUP ERROR (/]
	HRRZ	NUM,LEBLOK+1		
	PUSHJ	P,LSTDEC
	OUTSTR	[ASCIZ/) FOR FILE: /]
	MOVE	WOR,LEBLOK
	PUSHJ	P,SIXNSP
	OUTCHR	["."]
	HLLZ	WOR,LEBLOK+1
	PUSHJ	P,SIXNSP
	PUSHJ	P,CRLF
	CLRBFI
	RESET
	JRST	CMDSCN
	SUBTTL BUBBLE SORT ROUTINE
	COMMENT@
	THIS ROUTINE IS A BUBBLE SORT WHICH SORTS THE ARRAY
	LIST IN ASCENDING ORDER. LIST IS OF LENGTH LSTLEN.
	THE FOLLOWING IS AN ALGOL FLOW-MODEL FOR THE SORT:

	FOR CNT_1 STEP 1 UNTIL LSTLEN-1 DO
	  FOR PTR_I+1 STEP 1 UNTIL LSTLEN DO
	  IF LIST[CNT] > LIST[PTR] THEN
	  BEGIN
	    T_LIST[CNT];
	    LIST[CNT]_LIST[PTR];
	    LIST[PTR]_T;
	  END;
@
SORT:
B1:	HRLZ	CNT,LSTLEN		;GET LENGTH
	CAMN	CNT,[1,,0]		;ADJUSTMENT FOR THE FACT THAT
	 POPJ	P,			;ALGOL TESTS AT BEGINNING OF LOOP
	MOVNS	CNT			;-LENGTH,,0
	ADD	CNT,[1,,0]		;GIVES -(LENGTH-1)
B2:	MOVE	PTR,CNT			;GET I
	ADD	PTR,[0,,1]		;GET I+1 POINTER
	MOVE	NUM,LLIST(CNT)		;GET LIST[I]
	CAMG	NUM,LLIST(PTR)		;LIST[I] > LIST[J] ?
	 JRST	E2			;NO, THEN DO NOTHING
	MOVE	REM,LLIST(PTR)		;YES, THEN GET LIST[J]
	MOVEM	NUM,LLIST(PTR)		;LIST[J]_LIST[I]
	MOVEM	REM,LLIST(CNT)		;LIST[I]_LIST[J]
	MOVE	NUM,DOPEV(CNT)		;ALSO EXCHANGE
	EXCH	NUM,DOPEV(PTR)		;SIMILAR POSITIONS IN
	MOVEM	NUM,DOPEV(CNT)		;THE DOPE VECTOR
E2:	AOBJN	PTR,B2+2		;END INNER LOOP
E1:	AOBJN	CNT,B2			;END OUTER LOOP
	POPJ	P,			;END OF ROUTINE

	COMMENT@
	C L E A N . L I S T

	FOR I_1 STEP 1 UNTIL LSTLEN-1 DO
	IF LIST[I] = LIST[I+1] THEN
	  LLIST[I]_0;

	THIS ROUTINE CLEANS DOUBLE ENTRIES FROM THE SORTED
	LIST.
@
CLEAN:	HRLZ	CNT,LSTLEN		;LENGTH,,0
	MOVNS	CNT			;-LENGTH,,0
	ADD	CNT,[1,,0]		;-(LENGTH-1),,0
CLEAN1:	MOVE	NUM,LLIST(CNT)		;NUM_LIST[I]
	CAMN	NUM,LLIST+1(CNT)	;LIST[I] = LIST[I+1] ?
	 SETZM	LLIST(CNT)		;YES, THEN ZERO IT
	AOBJN	CNT,CLEAN1		;END LOOP
	POPJ	P,			;END CLEAN LIST ROUTINE
	SUBTTL TAPE DIRECTORY MANIPULATION

	;	T A G
	;
	;CALL:
	;	PUSHJ	P,TAG
	;
	;WRITES A SIXBIT TAPE LABEL INTO THE CORE
	;DIRECTORY AND SETS THE NEW DIRECTORY
	;FLAG.

TAG:	TLNN	F,FL.COR		;DIRECTORY IN CORE?
	 PUSHJ	P,R.DIR			;NO, READ IT IN
	PUSHJ	P,FSIX			;GET TAPE ID
	CAIE	CHR,15			;<CR> LAST CHAR?
	 JRST	ERRCMD			;NO, BAD COMMAND
	MOVEM	WOR,DIRECT+DR.LAB	;YES, STORE THE LABEL
	PUSHJ	P,WIPE			;CLEAN UP INPUT LINE
	TLO	F,FL.CHG		;MARK CHANGED DIRECTORY
	JRST	CMDSCN			;AND RETURN


	;	W . D I R
	;
	;CALL:
	;	PUSHJ	P,W.DIR
	;
	;WRITES THE DIRECTORY ONTO TAPE.
	;

W.DIR:	TRNN	F,FR.MTO		;MTA FOR OUTPUT?
	 JRST	ERRNMD			;NO CAN DO.
	MOVEI	AC,MT.MOD		;INIT BINARY MODE
	MOVEM	AC,OUTBLK
	MOVE	AC,OUTDEV		;GET OUTPUT TAPE NAME
	MOVEM	AC,OUTBLK+1		;STORE IT
	OPEN	MTA,OUTBLK		;TRY THE OPEN
	 JRST	ERRDOF			;FAILED
	REWIND	(MTA)			;REWIND THE TAPE
	TLNN	F,FL.COR		;DIRECTORY IN CORE?
	 JRST	WLOOP1			;THEN DONT REWIND TAPE
	HRLZI	CNT,-<NFILES*5+2>	;LENGTH OF DIRECTORY BLOCK
W.LOOP:	MOVE	WOR,DIRECT(CNT)		;GET A WORD
	PUSHJ	P,MTWRIT		;WRITE IT
	 JRST	ERRMTW			;ERROR IN WRITING
	AOBJN	CNT,W.LOOP		;GET ANOTHER
	CLOSE	MTA,			;FORCE DATA OUT WITH CLOSE
	MTAPE	MTA,17			;BACK UP OVER EOF
	MTAPE	MTA,0
	MTAPE	MTA,13			;WRITE BLANK TAPE OVER EOF
	MTAPE	MTA,0
	REWIND	(MTA)			;REWIND THE TAPE
WLOOP1:	RELEAS	MTA,			;RELEASE THE CHANNEL
	POPJ	P,			;AND RETURN

	;	E . D I R
	;
	;CALL:
	;	PUSHJ	P,E.DIR
	;
	;MAKES AN ENTRY INTO THE FIRST FREE SLOT OF
	;THE CORE DIRECTORY, CHANGES THE POSITION WORD,
	;AND SETS THE DIRECTORY NOT CURRENT FLAG.
	;

E.DIR:	PUSHJ	P,DELFIL		;IF FILE ALREADY THERE,KILL IT
	HRLZI	CNT,-NFILES		;GET NUMBER FILES ALLOWED
EDIR1:	SKIPN	DIRECT+2(CNT)		;SEE IF THIS SPOT FREE
	 JRST 	EDIR2			;YES, GOT IT
	ADDI	CNT,4			;NO, LOOK AGAIN
	AOBJN	CNT,EDIR1		;LOOP THROUGH
	PERROR	(MDF,<MAGTAPE DIRECTORY FULL>)

EDIR2:	HRLZI	AC,LEBLOK		;GET ADR OF LOOKUP BLOCK
	HRRI	AC,DIRECT+2(CNT)	;ADR OF FREE SPACE
	BLT	AC,DIRECT+DR.PPN+2(CNT)	;END OF FREE SPACE
	HRRZM	POS,DIRECT+DR.POS+2(CNT);STORE POSITION IN DIRECTORY
	HRRZM	POS,DIRECT		;AND IN DIRECTORY HEADER
	TLO	F,FL.CHG		;NOTE THAT DIRECTORY HAS BEEN CHGED.
	POPJ	P,

	;	R . D I R
	;
	;CALL:
	;	PUSHJ	P,R.DIR
	;
	;READS THE DIRECTORY INTO CORE AND SETS THE
	;DIRECTORY IN CORE FLAG.
	;
R.DIR:	MOVEI	AC,MT.MOD		;INPUT MODE 
	MOVEM	AC,INBLOK		;STORE IN INPUT BLOCK
	TRNE	F,FR.MTO		;MTA FOR OUTPUT?
	 MOVE	AC,OUTDEV		;THEN USE OUTPUT DEV NAME
	TRNE	F,FR.MTI		;MTA FOR INPUT?
	 MOVE	AC,DEV			;THEN USE INPUT DEVICE
	MOVEM	AC,INBLOK+1		;STORE TAPE NAME
	MOVEM	AC,MTANAM		;	"
	OPEN	MTA,INBLOK		;TRY THE OPEN
	 JRST	ERROED			;FAILED
	REWIND	(MTA)			;GET TO LOAD POINT
	HRLZI	CNT,-<NFILES*5+2>	;LENGTH OF DIRECTORY
R.LOOP:	PUSHJ	P,MTREAD		;GET A WORD
	 JRST	ERRDOF			;PREMATURE EOF IS UNFORMATTED
	MOVEM	CHR,DIRECT(CNT)		;STASH IN DIRECTORY BLOCK
	AOBJN	CNT,R.LOOP		;READ ANOTHER
	SKIPFL	(MTA)			;JUMP OVER EOF ON DIRECTORY
	RELEAS	MTA,			;RELEASE THE CHANNEL
	MOVE	POS,DIRECT+DR.LST	;LAST FILE ON TAPE
	TLO	F,FL.COR		;MARK THAT DIRECTORY IN CORE
	POPJ	P,

	;	R E W N D
	;
	;REWINDS TAPE AND WRITES DIRECTORY
	;BACK ON.
REWND:	PUSHJ	P,W.DIR			;REWIND AND WRITE TAPE DIR.
	PUSHJ	P,WIPE			;CLEAN OUT RHS
	TLZ	F,FL.CHG		;MARK THAT DIRECTORY IS GOOD
	JRST	CMDSCN			;AND RETURN

ERROED:	PERROR	(OED,<OPEN ERROR ON ATTEMPT TO READ DIRECTORY>)
	SUBTTL MTA MANIPULATIONS

	;	M T . I N I
	;
	;INITS A MAGTAPE FOR OUTPUT.
	;
MT.INI:	MOVE	AC,OUTDEV		;GET DEVICE NAME
	MOVEM	AC,OUTBLK+1		;STORE IT
	MOVEI	AC,MT.MOD		;GET MODE
	MOVEM	AC,OUTBLK		;STORE THAT
	OPEN	MTA,OUTBLK		;OPEN THE TAPE CHANNEL
	 JRST	ERRDOF			;OPEN FAILED
	POPJ	P,			;RETURN AFTER COMPLETION

	;	M T . O N I
	;
	;OPENS A MAGTAPE FOR INPUT.
	;
MT.ONI:	MOVE	AC,DEV			;GET DEVICE NAME
	MOVEM	AC,INBLOK+1		;STORE IT
	OPEN	MTA,INBLOK		;TRY THE OPEN
	 JRST	ERRDOE			;FAILED
	POPJ	P,			;RETURN

	;	M T . F I N
	;
	;CLOSES AND RELEASES A MAG TAPE.
	;
MT.FIN:	CLOSE	MTA,
	RELEAS	MTA,
	POPJ	P,

	;	E O T P O S
	;
	;POSITIONS THE OUTPUT TAPE AT THE
	;FIRST FREE FILE (AFTER LAST FILE).
	;
EOTPOS:	REWIND	(MTA)			;REWIND TAPE
	SKIPFL	(MTA)			;SKIP OVER DIRECTORY
	SKIPN	POS			;IF NEW TAPE THEN
	 POPJ	P,			;FINISHED HERE
	SETZ	CNT,			;ELSE PREPARE TO COUNT FILES
EOTPO1:	SKIPFL	(MTA)			;SKIP A FILE
	SKIPFL	(MTA)			;AND THE ACTUAL FILE
	AOS	CNT			;INCREMENT COUNT
	CAME	CNT,POS			;DONE?
	 JRST	EOTPO1			;NO, DO ANOTHER
	POPJ	P,			;YES, RETURN
	SUBTTL DELETE FILES FROM MTA DIRECTORY

DELETE:	TLNN	F,FL.COR		;DIRECTORY IN CORE?
	 PUSHJ	P,R.DIR			;IF NOT, READ IT IN
	OUTSTR	[ASCIZ/FILES DELETED:
/]
DELET1:	PUSHJ	P,CSCRHS		;START SCAN OF RHS
	PUSHJ	P,C.INIT		;INIT CORE DIRECTORY SEARCH
DELET2:	PUSHJ	P,C.WILD		;GET FILE SPECS
	 JRST	DELEND			;NO MORE LEFT
	MOVE	WOR,LEBLOK		;GET FILE NAME
	PUSHJ	P,SIXOUT		;WRITE IT
	OUTCHR	["."]			;SEPPARATOR
	HLLZ	WOR,LEBLOK+1		;GET EXT
	PUSHJ	P,SIXNSP		;WRITE IT
	PUSHJ	P,CRLF
	PUSHJ	P,DELFIL		;DELETE THE FILE
	JRST	DELET2			;AND CONTINUE
DELEND:	TRNE	F,FR.MOR		;MORE LEFT?
	 JRST	DELET1			;YES, GET 'EM
	JRST	CMDSCN			;NO, FORGET IT

	;	D E L F I L
	;
	;CALL:
	;	PUSHJ	P,DELFIL
	;
	;DELETES A FILE FROM THE CORE DIRECTORY IF IT
	;IS FOUND.
	;
DELFIL:	HRLZI	CNT,-NFILES		;GET NUMBER FILES TO SCAN
	MOVE	T,DIRECT+2+DR.FIL(CNT)	;GET A FILE NAME
	CAME	T,LEBLOK		;MATCH?
	 JRST	DELFI1			;NO
	HLLZ	T,DIRECT+2+DR.EXT(CNT)	;YES, MATCH ON EXT?
	HLLZ	WOR,EXTN		;
	CAME	T,WOR			;SKIP IF YES
	 JRST	DELFI1			;NOPE.
	SETZM	DIRECT+2+DR.FIL(CNT)	;YES, DELETE THE ENTRY
	TLO	F,FL.CHG		;MARK THAT DIRECTORY NOT CURRENT
	POPJ	P,			;AND RETURN
DELFI1:	ADDI	CNT,4			;ADJUST POINTER
	AOBJN	CNT,DELFIL+1		;AND LOOP THROUGH
	POPJ	P,
	SUBTTL LISTING ROUTINES AND MACROS

	DEFINE PRINT(TEXT),<
			XLIST
		JSP	AC,LSTASC
		ASCIZ@TEXT@
			LIST
			>

	DEFINE TYPE(SYMB),<
			XLIST
		CAIA
		 JRST	.+3
		MOVEI	CHR,"SYMB"
		PUSHJ	P,LSTCHR
			LIST
			>

LSTASC:	HRLI	AC,440700			;BUILD A BYTE POINTER
	ILDB	CHR,AC				;GET A CHARACTER
	JUMPE	CHR,1(AC)			;RETURN IF FINISHED
	PUSHJ	P,LSTCHR			;ELSE LIST THE CHAR
	JRST	LSTASC+1			;CONTINUE LISTING

	;	L S T O C T   -AND-   L S T D E C
	;
	;CALL:
	;	MOVEI	NUM,NUMBER
	;	PUSHJ	P,LSTOCT     -OR-     PUSHJ	P,LSTDEC
	;
	;LISTS A NUMBER IN OCTAL (ENTRY AT LSTOCT)
	;OR DECIMAL INTEGER REPRESENTATION (ENTRY AT LSTDEC).
	;
LSTOCT:	SKIPA	RAD,[10]			;MOVE 8 AS RADIX AND SKIP
LSTDEC:	MOVEI	RAD,12				;BASE 10
LSTNUM:	IDIV	NUM,RAD				;DIVIDE BY RADIX
	PUSH	P,REM				;STACK THE REMAINDER
	SKIPE	NUM				;FINISHED?
	PUSHJ	P,LSTNUM			;NO, GO AGAIN
LSTNU1:	POP	P,CHR				;YES, UNSTACK
	ADDI	CHR,60				;-->ASCII
	PUSHJ	P,LSTCHR			;LIST THE CHAR
	POPJ	P,				;AND FINISH UP


	;	L S T D A T
	;
	;CALL:
	;	MOVEI	NUM,DATE
	;	PUSHJ	P,LSTDAT
	;
	;LISTS THE 15 BIT DATE IN PDP-10 FORMAT FROM
	;NUM.
	;
LSTDAT:	IDIVI	NUM,^D31			;GET DAY-1 IN REM
	AOS	REM				;ADJUST DAY
	MOVEM	REM,DAY				;STORE DAY
	IDIVI	NUM,^D12			;GET MONTH POINTER 
	MOVEM	REM,MONTH			;STASH MONTH-1
	ADDI	NUM,^D64			;MAKE YEAR CURRENT
	MOVEM	NUM,YEAR			;STORE
	MOVE	NUM,DAY				;GET DAY BACK
	CAIG	NUM,^D9				;MAKE PRETTY SPACING
	 TYPE	(< >)
	PUSHJ	P,LSTDEC			;WRITE IT
	MOVE	NUM,MONTH			;GET MONTH POINTER BACK
	MOVE	WOR,MONTAB(NUM)			;SIXBIT MONTH
	PUSHJ	P,SIXNSP			;WRITE MONTH
	MOVE	NUM,YEAR			;GET YEAR BACK
	PUSHJ	P,LSTDEC			;WRITE IT
	POPJ	P,				;DAY-MONTH-YEAR

LSTCHR:	TLNN	F,FL.LSD			;LISTING DEVICE OPEN?
	 JRST	NO.LSD				;NO, JUST OUTCHR
LSTBYT:	SOSG	OBUF+2				;BUFFER FILLED?
	 JRST	PT.BUF				;YES, OUT IT
PUTBYT:	IDPB	CHR,OBUF+1			;PUT BYTE INTO BUFFER
	POPJ	P,				;RETURN
NO.LSD:	OUTCHR	CHR				;JUST OUTCHR
	POPJ	P,


PT.BUF:	OUT	LST,				;DUMP THE BUFFER
	 JRST	PUTBYT				;PROCEED NORMALLY
	PERR2	(LWE,<DEVICE WRITE ERROR>,OUTBLK+1)

MONTAB:	SIXBIT/-JAN-/
	SIXBIT/-FEB-/
	SIXBIT/-MAR-/
	SIXBIT/-APR-/
	SIXBIT/-MAY-/
	SIXBIT/-JUN-/
	SIXBIT/-JUL-/
	SIXBIT/-AUG-/
	SIXBIT/-SEP-/
	SIXBIT/-OCT-/
	SIXBIT/-NOV-/
	SIXBIT/-DEC-/
	SUBTTL MAGTAPE DIRECTORY LISTER

QUICK:
LIST:	MOVE	AC,[LLIST,,LLIST+1]	;BLT POINTER TO CLEAR
	SETZM	LLIST			;LLIST AND THE
	BLT	AC,LLIST+^D1400		;DOPE VECTOR.
	PUSHJ	P,FSIX			;GET INPUT DEV NAME
	MOVEM	WOR,DEV			;STORE FOR A MOMENT
	DEVCHR	WOR,			;SEE WHAT TYPE OF DEVICE
	TLNN	WOR,20			;MTA?
	 JRST	ERRNMD			;NO GOOD THEN
	TRO	F,FR.MTI		;MARK MTA AS INPUT DEVICE
	TRNE	F,FR.MTO		;MTA AS OUTPUT?
	 JRST	ERRNLD			;NOT A VALID LISTING DEVICE
	TLNN	F,FL.COR		;DIRECTORY IN CORE?
	 PUSHJ	P,R.DIR			;NO, READ IT IN
	MOVE	AC,OUTDEV		;GET LISTING DEVICE
	MOVEM	AC,OUTBLK+1		;STORE IT IN OPEN BLOCK
	SETZM	OUTBLK			;MAKE ASCII MODE FOR LISTING
	OPEN	LST,OUTBLK		;TRY THE OPEN
	 JRST	ERRDOE			;FAILED
	MOVE	WOR,[SIXBIT/MAGTAP/]	;SET UP DEFAULT NAME
	SKIPE	DIRECT+DR.LAB		;IF A LABEL THERE, THEN
	 MOVE	WOR,DIRECT+DR.LAB	;USE IT
	MOVEM	WOR,LEBLOK		;STORE NAME IN BLOCK
	HRLZI	WOR,'DIR'		;EXT
	MOVEM	WOR,LEBLOK+1		;STORE SAME
	SETZM	LEBLOK+2		;AND ZERO RELEVANT WORDS
	SETZM	LEBLOK+3
	ENTER	LST,LEBLOK		;ENTER THE LISTING FILE
	 JRST	ERRELF			;LISTING FILE ENTER FAILURE
	TLO	F,FL.LSD		;MARK THAT A LISTING DEVICE
	PRINT	(<TAPE ID:>)		;TAPE I.D.
	MOVE	WOR,DIRECT+DR.LAB	;GET SAME
	PUSHJ	P,SIXNSP		;WRITE IT
	PRINT	(<
>)
	TRNE	F,FR.QUI		;QUICK LISTING?
	 JRST	LIST0			;THEN DONT PRINT HEADER
	PRINT	(<FILE		DATE	MODE	PROT	SIZE	SEQ.
>)
LIST0:	SETZM	LSTLEN			;ZERO THE LIST POINTER
LIST1:	PUSHJ	P,CSCRHS		;SCAN RHS FOR MASKS
	PUSHJ	P,C.INIT		;INIT THE WILD ROUTINE IN CORE
LIST3:	PUSHJ	P,C.WILD		;GET A FILENAME
	 JRST	LIST4			;NO MORE MATCHES
	MOVE	PTR,WLDPTR		;GET THE WILD POINTER
	SUBI	PTR,5			;MAKE IT POINT AT LAST FILE
	MOVE	WOR,DIRECT+2+DR.FIL(PTR);GET FILENAME
	MOVE	CNT,LSTLEN		;GET LIST POINTER
	MOVEM	WOR,LLIST(CNT)		;STORE FILENAME IN THE LIST
	HRRZM	PTR,DOPEV(CNT)		;STORE DIRECTORY POS IN DOPE VEC
	AOS	LSTLEN			;INCREMENT THE LIST POINTER
	JRST	LIST3			;AND GET ANOTHER FILE
LIST4:	TRNE	F,FR.MOR		;MORE IN COMMAND STRING?
	 JRST	LIST1			;THEN GET IT
	SKIPN	LSTLEN			;IF NO ENTRIES THEN
	 JRST	LIST6			;DON'T REPORT ANY
	PUSHJ	P,SORT			;ELSE SORT THE LIST ON FILENAME
	HRLZ	WLD,LSTLEN		;BUILD AOBJN POINTER
	MOVNS	WLD			;WLD=-LENGTH,,0
LIST5:	MOVE	PTR,DOPEV(WLD)		;PTR=POINTER TO DIRECTORY
	MOVE	WOR,DIRECT+2+DR.FIL(PTR);GET FILENAME
	PUSHJ	P,SIXOUT		;WRITE IT
	TYPE	(<.>)			;FILE.EXT
	HLLZ	WOR,DIRECT+2+DR.EXT(PTR);GET EXT
	PUSHJ	P,SIXOUT		;WRITE IT
	TRNE	F,FR.QUI		;QUICK LISTING?
	 JRST	LIST2			;THEN SKIP THE REST
	MOVE	T,DIRECT+2+DR.EXT(PTR)	;GET EXT WORD BACK
	MOVE	BP,[POINT 3,T,20]	;BYTE POINTER TO HIGH DATE
	SETZ	AC,			;TO RECEIVE DATE
	LDB	AC,BP			;GET HIGH ODER 3 BITS
	LSH	AC,^D12			;MAKE ROOM FOR LOW ORDER BITS
	MOVE	T,DIRECT+2+DR.PMD(PTR)	;GET MODE,DATE,PROT WORD
	MOVE	BP,[POINT 12,T,35]	;BYTE POINTER TO LOW ORDER BITS
	LDB	NUM,BP			;GET FULL DATE WORD
	IOR	NUM,AC			;GET FULL WORD
	PUSHJ	P,LSTDAT		;LIST IT
	TYPE	(<	>)		;AND A <TAB>
	MOVE	BP,[POINT 4,T,12]	;POINTER TO MODE
	SETZ	NUM,			;TO RECEIVE BYTE
	LDB	NUM,BP			;GET MODE
	PUSHJ	P,LSTOCT		;LIST IT
	TYPE	(<	>)		;TAB
	MOVE	BP,[POINT 9,T]		;POINTER TO PROTECTION
	ILDB	NUM,BP			;GET PROTECTION
	CAIG	NUM,100			;3 DIGITS LOOK NICER
	 TYPE	(<0>)			;FORCE A ZERO
	PUSHJ	P,LSTOCT		;LIST PROTECTION
	TYPE	(<	>)		;<TAB>
	MOVE	NUM,DIRECT+2+DR.PPN(PTR);GET SIZE
	JUMPGE	NUM,LIST15		;IF ALREADY IN BLOCKS
	MOVMS	NUM			;ELSE MAKE IT POSITIVE
	HLRZS	NUM			;AND IN RH
	IDIVI	NUM,^D128		;WORDS-->BLOCKS
	SKIPE	REM			;IF NEEDED,
	 AOS	NUM			;ADJUST COUNT UPWARDS
	PUSHJ	P,LSTDEC		;LIST SIZE
	 JRST	.+3			;AND CONTINUE
LIST15:	HLRZS	NUM			;BLOCK SIZE IN RH
	PUSHJ	P,LSTDEC		;PRINT IT
	TYPE	(<	>)
	HRRZ	NUM,DIRECT+2+DR.POS(PTR);GET FILE POSITION
	PUSHJ	P,LSTDEC		;PRINT IT
LIST2:	PRINT	(<
>)
	AOBJN	WLD,LIST5		;LOOP THROUGH ALL FILES
LIST6:	CLOSE	LST,
	RELEAS	LST,			;CLOSE LISTING DEV WHEN THROUGH
	TLZ	F,FL.LSD		;MARK THAT LISTING DEV CLOSED
	JRST	CMDSCN			;BACK TO CMD LEVEL

ERRNLD:	PERR2	(NLD,<IS NOT A LISTING DEVICE>,OUTDEV)
ERRELF:	PERROR	(ELF,<LISTING FILE ENTER FAILURE>)
	SUBTTL RECONSTRUCT DIRECTORY ROUTINE (/R)

HEADIR:	MOVE	WOR,OUTDEV		;GET TAPE NAME
	DEVCHR	WOR,			;SEE WHAT TYPE OF DEVICE
	TLNN	WOR,20			;MAGTAPE?
	 JRST	ERRNMD			;NO, CAN'T DO ANYTHING FOR YOU
	SETZM	DIRECT			;PREPARE TO BLT ZEROS INTO
	MOVE	AC,[DIRECT,,DIRECT+1]	;THE DIRECTORY BLOCK
	BLT	AC,DIRECT+<5*NFILES>+3	;ZERO CORE DIRECTORY
	MOVE	AC,OUTDEV		;GET OUTPUT DEV NAME
	MOVEM	AC,DEV			;STORE FOR OPEN
	PUSHJ	P,MT.ONI		;INIT THE TAPE
	REWIND	(MTA)			;REWIND THE TAPE
	SKIPFL	(MTA)			;SKIP DIRECTORY BLOCK ON TAPE
HEADI1:	HRLZI	AC,-4			;POINTER TO HEADER FILE
HEADI2:	PUSHJ	P,MTREAD		;GET A WORD
	 JRST	ENDHED			;IF FINISHED
	MOVEM	CHR,LEBLOK(AC)		;STASH THE ENTRY
	AOBJN	AC,HEADI2		;AND GET THE REST
	PUSHJ	P,MTREAD		;GET POSITION WORD
	 JRST	ENDHED			;PREMATURE EOF
	HRRZ	POS,CHR			;SET UP FOR ENTRY 
	PUSHJ	P,E.DIR			;ENTER INTO CORE DIRECTORY
	SKIPFL	(MTA)			;SKIP TO NEXT HEADER FILE
	JRST	HEADI1			;AND READ IT
ENDHED:	REWIND	(MTA)			;REWIND THE TAPE
	HRRZM	POS,DIRECT+DR.LST	;STORE LAST FREE POSITION
	PUSHJ	P,MT.FIN		;CLOSE + RELEASE
	PRINT	(<DIRECTORY RECONSTRUCTED.>)
	PUSHJ	P,CRLF
	PUSHJ	P,WIPE			;CLEAN OUT TTY BUFFER
	TLO	F,FL.COR		;MARK THAT DIRECTORY IN CORE
	JRST	CMDSCN			;AND RETURN
	SUBTTL MTA DEVICE STATUS (/M)

MTSTAT:	PUSHJ	P,WIPE			;GET JUNK OUT OF TTY BUFFER
	MOVE	AC,[XWD 13,OUTDEV]	;SET UP FOR UUO
	MTCHR.	AC,			;DO MTCHR UUO
	 JRST	ERRMUN			;FAILED
	PRINT	(<REELID: >)
	MOVE	WOR,MTCUUO		;GET REELID
	PUSHJ	P,SIXOUT		;PUBLISH IT
	PUSHJ	P,CRLF			;LINE 1
	PRINT	(<READ (R/S/H): >)
	MOVE	NUM,MTCUUO+1		;WORDS READ
	PUSHJ	P,LSTDEC		;WRITE WORDS READ
	TYPE	(</>)
	MOVE	NUM,MTCUUO+3		;SOFT ERRORS
	PUSHJ	P,LSTDEC
	TYPE	(</>)
	MOVE	NUM,MTCUUO+4		;HARD ERRORS
	PUSHJ	P,LSTDEC
	PUSHJ	P,CRLF			;END LINE 2
	PRINT	(<WRITE (W/S/H): >)
	MOVE	NUM,MTCUUO+2		;WORDS WRITTEN
	PUSHJ	P,LSTDEC
	TYPE	(</>)
	MOVE	NUM,MTCUUO+5		;SOFT WRITE ERRORS
	PUSHJ	P,LSTDEC
	TYPE	(</>)
	MOVE	NUM,MTCUUO+6		;HARD WRITE ERRORS
	PUSHJ	P,LSTDEC
	PUSHJ	P,CRLF			;END LINE 3
	PRINT	(<ERRORS: MEDIA=>)
	MOVE	NUM,MTCUUO+7		;TOTAL MEDIA ERRORS
	PUSHJ	P,LSTDEC
	PRINT	(<; DEVICE=>)
	MOVE	NUM,MTCUUO+10		;TOTAL DEVICE ERRORS
	PUSHJ	P,LSTDEC
	PUSHJ	P,CRLF			;END LINE 4
	PRINT	(<POSITION: >)
	MOVE	NUM,MTCUUO+12		;FILES FROM BEGINNING OF TAPE
	PUSHJ	P,LSTDEC
	PRINT	(< FILES FROM LOAD POINT; >)
	MOVE	NUM,MTCUUO+13		;RECORDS FROM LAST EOF
	PUSHJ	P,LSTDEC		;
	PRINT	(< RECORDS FROM EOF.>)
	PUSHJ	P,CRLF			;END TEXT
	JRST	CMDSCN

ERRMUN:	PERR2	(MUN,<DEVICE NOT AVAILIBLE OR NOT AN MTA>,OUTDEV)
	SUBTTL MTA WRITE AND READ ROUTINES

	;	M T W R I T
	;
	;CALL:
	;	MOVEI	WOR,WORD
	;	PUSHJ	P,MTWRIT
	;	 ERROR RETURN
	;	NORMAL RETURN
	;
MTWRIT:	SOSG	OBUF+2			;BUFFER FULL?
	 JRST	PUTBUF			;THEN DUMP IT
PUTC:	IDPB	WOR,OBUF+1		;WRITE THE DATA
	AOS	(P)			;GIVE SKIP RETURN
	POPJ	P,

PUTBUF:	OUT	MTA,			;DUMP THE DATA
	 JRST	PUTC			;AND RETURN
	POPJ	P,			;ELSE GIVE ERROR RETURN

	;	M T R E A D
	;
	;CALL:
	;	PUSHJ	P,MTREAD
	;	 ERROR RETURN
	;	NORMAL RETURN
	;
	;RETURNS WORD IN CHR.
	;
MTREAD:	SOSGE	IBUF+2			;BUFFER FILLED?
	 JRST	GETBUF			;NO, GET ONE
	ILDB	CHR,IBUF+1		;LOAD BYTE INTO CHR
	AOS	(P)			;GIVE SKIP RETURN
	POPJ	P,

GETBUF:	IN	MTA,			;READ BUFFERFULL
	 JRST	MTREAD			;ALL SET
	STATO	MTA,75B23		;ERROR--IS IT EOF?
	 POPJ	P,			;YES, ERROR RETURN
	GETSTS	MTA,AC			;NO, TRY DIAGNOSIS
	TRNE	AC,100000		;PARITY ERROR?
	 JRST	ERRPAR			;YES
	TRNE	AC,40000		;RECORD TOO LONG?
	 JRST	ERRRTL			;YES
	PERR2	(MRE,<READ ERROR>,INBLOK+1)
	SUBTTL DISK READ AND WRITE ROUTINES

	;	D K R E A D
	;
	;CALL:
	;	PUSHJ	P,DKREAD
	;	 ERROR RETURN
	;	NORMAL RETURN
	;
	;LOADS A WORD INTO WOR FROM THE DISK FILE.
	;ERROR RETURN IS GIVEN ON END-OF-FILE.
	;
DKREAD:	SOSGE	IBUF+2			;BUFFER EMPTY?
	 JRST	GT.DBF			;YES, GET A NEW ONE
	ILDB	WOR,IBUF+1		;LOAD THE WORD
	AOS	(P)			;GIVE SKIP RETURN
	POPJ	P,

GT.DBF:	IN	DSK,			;GET A BUFFERFULL
	 JRST	DKREAD			;RETURN WITH IT
	STATO	DSK,75B23		;ERROR--READ ERROR?
	 POPJ	P,			;NO, JUST EOF
	PERR2	(DRE,<DISK READ ERROR>,DEV)
	;	D K W R I T
	;
	;WRITES A WORD FROM CHR ON TO DISK.
	;
DKWRIT:	SOSG	OBUF+2			;FULL?
	 JRST	PBUF			;THEN DUMP IT
PUTD:	IDPB	CHR,OBUF+1		;WRITE THE WORD
	POPJ	P,			;AND RETURN

PBUF:	OUT	DSK,			;BUFFER OUT
	 JRST	PUTD			;RETURN
	PERR2	(EWD,<WRITE ERROR>,OUTDEV)
	SUBTTL STATUS OF IN CORE DIRECTORY (/S)

STATUS:	TLNN	F,FL.COR			;DIRECTORY IN CORE?
	 JRST	NOT.IN				;NO, SAY SO
	PRINT	(<TAPE ID:>)			;TAPE ID MESSAGE
	MOVE	WOR,DIRECT+DR.LAB		;GET LABEL
	PUSHJ	P,SIXNSP			;AND WRITE IT
	PUSHJ	P,CRLF				;SPACE IT PRETTY
	HRLZI	CNT,-NFILES			;AOBJN WORD TO COUNT
	SETZ	NUM,				;TO COUNT FREE SPOTS
STATU1:	SKIPN	DIRECT+2+DR.FIL(CNT)		;SKIP IF NOT FREE
	AOS	NUM				;IF FREE INCRIMENT POINTER
	ADDI	CNT,4				;TO POINT TO RIGHTPLACE
	AOBJN	CNT,STATU1			;AND LOOP THROUGH
	PUSHJ	P,LSTDEC			;WRITE # FREE SPOTS
	PRINT	(<   FREE FILES.>)
	PUSHJ	P,CRLF
	TLNN	F,FL.CHG			;UPDATED THIS DIRECTORY?
	 JRST	CMDSCN				;NO, EVERYTHING'S NORMAL
	PRINT	(<TAPE DIRECTORY IS NOT CURRENT>)
	PUSHJ	P,CRLF
	 JRST	CMDSCN
NOT.IN:	PRINT	(<NO DIRECTORY IN CORE.>)	;IF NONE THERE
	PUSHJ	P,CRLF
	 JRST	CMDSCN
	SUBTTL HELP !!!!!!!!!!!     (/H)

	DEFINE	MHELP,<
		XLIST
		ASCIZ@

	**MAGGIE**  PSEUDO RANDOM-ACCESS FOR MAGTAPES

COMMAND FORMAT:

	<DEV>:/<SWITCH>_<DEV>:<FILE.EXT>,<DEV>:<FILE.EXT>, ETC.

WHERE <DEV> IS A LOGICAL OR PHYSICAL DEVICE NAME (EG. MTA, MTA0,
DSK, DSKA); <SWITCH> IS ONE OF THE ONE CHARACTER SWITCHES DEFINED
BELOW, AND <FILE.EXT> IS A STANDARD DEC FILE SPECIFICATION ALLOWING
WILDCARDS (EG. FOOBAR.EXT, FO??.*).

SWITCHES:

/D	DELETE FILES FROM THE TAPE
/F	FORMAT THE TAPE FOR DIRECTORY
/L	LIST AN ALPHEBETIZED DIRECTORY
/M	GIVE DEVICE STATUS FOR A TAPE DRIVE
/Q	FAST FORM OF /L; LISTS FILENAMES ONLY
/R	RECONSTRUCTS A DEAD DIRECTORY FROM HEADER FILES
/T	LABEL THE TAPE (LEFT SIDE) WITH THE ID ON RIGHT SIDE
/W	REWIND THE TAPE AND WRITE DIRECTORY BACK ON
/X	COPY FROM INPUT DEVICE (RIGHT SIDE) TO OUTPUT DEVICE (LEFT SIDE)

DIRECT SWITCHES:

THESE ARE NOT PART OF THE NORMAL COMMAND SEQUENCE. THEY ACT AS A 
COMPLETE COMMAND SEQUENCE IN AND OF THEMSELVES.

/E	EXIT TO MONITOR LEVEL.
/H	TYPE THIS TEXT.
/S	GIVE STATUS OF IN-CORE DIRECTORY.

FOR MORE HELP READ HLP:MAGGIE.DOC.

[END MAGGIE.HLP]
@
			LIST
			>

HLPTXT:	MHELP					;EXPAND ABOVE TEXT
HELP:	OUTSTR	HLPTXT				;WRITE IT
	 JRST	CMDSCN				;AND RETURN
	SUBTTL STORAGE (THE BASEMENT)

PDL:	BLOCK 30
LSTLEN:	BLOCK 1
LLIST:	BLOCK ^D700
DOPEV:	BLOCK ^D700
TEMP:	BLOCK 1
FILE:	BLOCK 1
EXT:	BLOCK 1
EMASK:	BLOCK 1
FMASK:	BLOCK 1
DMASK:	BLOCK 1
OUTDEV:	BLOCK 1
MTCUUO:	BLOCK 14
MONTH:	BLOCK 1
DAY:	BLOCK 1
YEAR:	BLOCK 1
WLDPTR:	BLOCK 1
MTANAM:	BLOCK 1
S.JBFF:	BLOCK 1

	;	NOTE:
	;T H E  F O L L O W I N G  B L O C K S  M U S T
	;     N O T  B E   R E A R R A N G E D !!!!!
	;

DIRECT:	BLOCK <5*NFILES>+2
	Z
	Z
	Z
	Z


INBLOK:	EXP MT.MOD
	Z
	XWD Z,IBUF

OUTBLK:	BLOCK 2
	XWD OBUF,Z


UFDIBK:	EXP MT.MOD
DEV:	Z
	XWD Z,UFDIBF

UFDLBK:
UFDPPN:	Z
	SIXBIT/UFD/
	Z
	XWD 1,1

LEBLOK:	
FILENA:	Z
EXTN:	Z
	Z
	Z

	;	END OF CONTINUOUS BLOCKS

UFDIBF:	BLOCK 3
OBUF:	BLOCK 3
IBUF:	BLOCK 3

	END MAGGIE