Google
 

Trailing-Edge - PDP-10 Archives - decus_20tap4_198111 - decus/20-0131/libman.mac
There are 2 other files named libman.mac in the archive. Click here to see a list.
SUBTTL	B. SCHREIBER - U OF I HIGH ENERGY PHYSICS GROUP

SEARCH	JOBDAT,UUOSYM,MACTEN,SCNMAC
.DIREC	.XTABM
SALL

;LIBMAN VERSION

LIBVER==3	;MAJOR VERSION
LIBEDT==21	;EDIT LEVEL
LIBMIN==0	;MINOR VERSION
LIBWHO==0	;WHO?

DEFINE CTITLE (WORD1,TEXT,MAJVER,VEREDT)
<WORD1 'TEXT'MAJVER(VEREDT)>

CTITLE	(TITLE,<LIBMAN -- LIBRARY FILE MANIPULATION PROGRAM %>,\LIBVER,\LIBEDT)

LOC	.JBVER
%%LIBM==:VRSN.	(LIB)
EXP	%%LIBM

;SHOW UNIVERSAL VERSION NUMBERS

%%JOBD==:%%JOBD		;JOBDAT
%%UUOS==:%%UUOS		;UUOSYM
%%MACT==:%%MACT		;MACTEN
%%SCNM==:%%SCNM		;SCNMAC

;REQUEST REST OF LOADING

.REQUE	REL:ALCOR
.REQUE	REL:SCN7B
.REQUE	REL:WLD7A
.REQUE	REL:HELPER
SUBTTL	REVISION HISTORY / SUGGESTIONS / KNOWN BUGS

COMMENT	$		REVISION HISTORY

1(1)			BIRTH
2(2)	12/12/76	ADD DVERSION COMMAND TO SET VERSION OF DISK FILES
			(NOT IN LIBRARY). IMPLEMENT SUPERSEDE TOTALLY.
2(3)	12/13/76	ADD SOME INFORMATIVE TYPEOUT SO USER KNOWS WHAT
			WE ARE DOING.  BREAK UP LISTING SOME.
2(4)	12/15/76	ADD MISSING JRST CPTYEN AFTER LOOKUP IN CPYTYF
3(5)	12/16/76	IMPLEMENT LSUPERSEDE AND DSUPERSEDE TO ALLOW
			DIFFERENT SUPERSEDE OPTIONS FOR COPY AND REPLACE.
			IMPLEMENT FILDIR COMMAND WHICH RUNS DIRECT TO
			GET A DISK DIRECTORY AND RERUNS LIBMAN.  WRITE
			NNNLRL.TMP TO REMEMBER LIBMAN LIBRARY FROM LAST
			USE COMMAND (ONLY USE COMMAND!)
3(6)	12/22/76	FIX FEW BUGS.  DISREGARD /SUPERSEDE CHECKING IF
			UNIVERSAL DATE/TIME IS 0 (I.E. CONVERTED FROM
			UFLIP FORMAT WITH LIBCVT)
3(7)	12/26/76	ADD SUPPORT FOR /BEFORE/SINCE/ABEFORE/SINCE
			IN ADD COMMAND (TO SELECTIVELY LIBRARY FILES)
3(10)	12/26/76	CHECK TO MAKE SURE WE ARE NOT ADDING A LIBRARY
			TO ITSELF IN ADD COMMAND (I.E. SO ADD *.* WILL
			NOT ADD THE LIBRARY ITSELF)
3(11)	12/27/76	ADD REMEMBER VERB.  SPEED UP ADDING FILES SOMEWHAT
			(ESP. IF FILE NOT FOUND)
3(12)	1/3/77		MAKE "COPY A,B,C" WORK.  FIX USAGE OF .RBTIM IN A FEW
			CASES.
3(13)	1/3/77		FIXUP IN CASE "FILDIR 'NOT'*.TMP". SCAN WAS CHANGING
			GUIDE WORDS TO META-CHARACTERS.  I MUST RESET THEM.
3(14)	1/9/77		MAKE /NOREMEMBER THE DEFAULT.  TEACH FILDIR HOW
			TO REMEMBER LIBRARY IF NEEDED.  MESSAGE USER ABOUT
			FILES NOT COPIED/REPLACED WITH INFO ON WHY.
3(15)	1/10/77		IMPLEMENT /BUFFER:N. GET VERBOSITY BITS AND SUPPORT
			THEM IN ERROR HANDLER (AT LEAST /MESS:PREFIX)
3(16)	1/14/77		FIX MINOR BUG INTRODUCED IN COPY COMMAND.  CHANGE
			NO FILES COPIED/REPLACED MESSAGE TO "NO FILES FOUND
			TO MATCH FS,FS,FS"
3(17)	1/14/77		COUNT # FILES REJECTED FOR ONE REASON OR ANOTHER
			AND DON'T GIVE NO FILES FOUND TO MATCH MESSAGE IF
			FILES FOUND BUT REJECTED
3(20)	1/14/77		FILDIR WAS NOT WRITING TMPFILE ALL THE TIME.
3(21)	1/17/77		USE TLBVP A LITTLE MORE. ON FILDIR COMMAND, BLT
			SOME CODE TO LOWSEG, RELEASE HISEG BEFORE TRYING
			THE RUN COMMAND

	$

COMMENT	$		SUGGESTIONS

1) INCLUDE VERSION IN REQUIREMENTS FOR A MATCH

	$

COMMENT	$		KNOWN BUGS

	$
SUBTTL	ASSEMBLY / ACCUMULATOR DEFINITIONS

ND LN$PDL,^D200		;PDL SIZE
ND MX$DIR,^D32		;# ENTRIES IN PRIMARY DIRECTORY BLOCK
LN$DRB==2*MX$DIR	;SIZE OF PRIMARY DIRECTORY BLOCK
ND MY$NAM,'LIBMAN'	;MY NAME
	INTERN	MY$PFX	;MAKE IT VISIBLE
ND MY$PFX,'LIB'		;MY MESSAGE PREFIX
ND DF$EXT,'LIB'		;DEFAULT LIBRARY EXTENSION
ND DF$BUF,^D6		;DEFAULT # BUFFERS = 6
ND FT$DDT,0		;NON-ZERO FOR DEBUGGING (DDT COMMAND)

;DEFINE THE ACCUMULATORS

DEFINE	AC$ (X)
<X=ZZ
ZZ==ZZ+1
X=X>

ZZ==0

AC$ (F)		;FLAGS
AC$ (T1)	;T1-4 ARE TEMPORARY
AC$ (T2)
AC$ (T3)
AC$ (T4)
AC$ (P1)	;P1-4 ARE PERMANENT--MUST BE PRESERVED
AC$ (P2)
AC$ (P3)
AC$ (P4)
AC$ (B)			;CURRENT BLOCK IN LIBRARY
AC$ (L)			;PTR TO INPUT FDB LINKED LIST
	N==P3	;NUMBER/WORD FROM SCAN
	C==P4	;CHARACTER FROM SCAN
	P=17	;PUSHDOWN LIST PTR
SUBTTL	FLAG DEFINITIONS

;FLAGS IN LH OF F

DEFINE FLAG$ (FLG)
<FL$'FLG==ZZ
ZZ==ZZ_-1
FL$'FLG==FL$'FLG>

ZZ==(1B0)

FLAG$ (LIB)		;ON WHEN A "USE" OR "CREAT" COMMAND GIVEN
FLAG$ (CRE)		;ON IF "CREATE"
FLAG$ (TYP)		;ON IF TYPE, OFF IF COPY
FLAG$ (RDO)		;READ ONLY
FLAG$ (ONE)		;ON IF "ONEOUT", OFF IF "COPY" OR "TYPE"
FLAG$ (OFG)		;ON IF OUTPUT FILE GIVEN (SET/CLEARED BY CKOFDB)

;I/O CHANNELS

;0	;NEVER USED BY ME
LIBC==1	;LIBRARY CHANNEL
INPC==2	;INPUT
OUTC==3	;OUTPUT
ILIB==4	;LIBRARY INPUT CHANNEL FOR USE WITH DELETE AND REPLACE
TMPC==5	;ONE-SHOT TEMPORARY USES

;OPDEFINES

OPDEF	CALL	[PUSHJ	P,]	;SUBROUTINE CALL
OPDEF	JUMPU	[JUMPL	F,]	;JUMP IF "USE/CREATE" GIVEN
OPDEF	JUMPNU	[JUMPGE	F,]	;JUMP IF NO "USE/CREATE" GIVEN

;OTHER BITS AND STUFF

ATSIGN==(1B13)			;FOR OPENIO
SUBTTL	ERROR MACRO DEFINITIONS

;ERROR.	($FLGS,$PFX,$MSG)
;
;$FLGS 	IS THE COMBINITATION OF THE FOLLOWING BITS:

	EF$ERR==0	;ERROR--PREFIX MSG WITH ?, RETURN CONTROL AFTER CALL
	EF$FTL==400	;FATAL ERROR--ABORT AND RESTART
	EF$WRN==200	;WARNING MESSAGE--CONTINUE
	EF$INF==100	;INFORMATIVE MESSAGE--CONTINUE
	EF$NCR==40	;NO FREE CRLF AFTER MESSAGE

DEFINE ETYP ($TYP)
<ZZ==ZZ+1
EF$'$TYP==ZZ>

ZZ==0		;TYPE CODES ARE FROM 1-37

ETYP (DEC)	;TYPE T1 IN DECIMAL AT END OF MESSAGE
ETYP (OCT)	;TYPE T1 IN OCTAL AT END OF MESSAGE
ETYP (SIX)	;TYPE T1 IN SIXBIT AT END OF MESSAGE
ETYP (PPN)	;TYPE T1 AS A PPN AT END OF MESSAGE
ETYP (STR)	;T1 PTS TO ASCIZ STR TO TYPE AT END OF MESSAGE
ETYP (FIL)	;T1 PTS TO SCAN FILE BLOCK TO TYPE AT END OF MSG
ETYP (LEB)	;T1 PTS TO 3 WD OPEN BLOCK AND T2 PTS TO LOOKUP BLOCK
	EF$MAX==ZZ	;MAX ERROR TYPE

IFG ZZ-37,<PRINTX ?TOO MANY ERROR TYPES>

;$PFX IS THE 3-LETTER PREFIX FOR THE MESSAGE
;$MSG IS THE MESSAGE ITSELF

NOOP==	(CAI)		;DEFINE NO-MEMORY-REFERENCE RIGHT-HAND NOOP

DEFINE	ERROR.	($FLGS,$PFX,$MSG)
<CALL	EHNDLR
XWD NOOP+<$FLGS>,[''$PFX'',,[ASCIZ @$MSG@ ]
	IFN $FLGS&EF$NCR,<JRST X$$'$PFX>]
>

;FATAL. FLGS,PFX,MSG

DEFINE	FATAL.	($FLGS,$PFX,$MSG)
<ERROR.	(EF$FTL!$FLGS,$PFX,$MSG)>

;WARN.	FLGS,PFX,MSG

DEFINE	WARN.	($FLGS,$PFX,$MSG)
<ERROR.	(EF$WRN!$FLGS,$PFX,$MSG)>

;INFO.	FLGS,PFX,MSG

DEFINE	INFO.	($FLGS,$PFX,$MSG)
<ERROR.	(EF$INF!$FLGS,$PFX,$MSG)>

;STOPX$ STOPS THE PROGRAM QUICKLY WITH A HALT <CODE>

DEFINE	STOPX$
<HALT	STOP$N
STOP$N==STOP$N+1>
SUBTTL	OTHER MACRO DEFINITIONS
;SAVE$ SAVES DATA ON THE STACK

DEFINE	SAVE$	(X)
<XLIST
IRP X,<PUSH P,X>
LIST>

;RESTR$ RESTORES DATA FROM THE STACK

DEFINE	RESTR$	(X)
<XLIST
IRP X,<POP P,X>
LIST>

;MACRO TO ALLOCATE STORAGE IN THE LOW SEGMENT DATA BASE

DEFINE	U ($NAME,$WORDS<1>)
<$NAME:	BLOCK	$WORDS>

;STRNG$ (STRING) SENDS STRING TO OUTPUT THROUGH .TSTRG

DEFINE STRNG$ (S)
<MOVEI	T1,[ASCIZ \S\]
CALL	.TSTRG##>

;ASCIZ$ (STRING) CREATES XLISTED ASCIZ STRING TO KEEP LISTING PRETTY

DEFINE ASCIZ$ (S)
<XLIST
ASCIZ \S\
LIST>

;JUMPCR (LOC) JUMPS TO LOC IF CREATE COMMAND

DEFINE JUMPCR (LOC)
<TLNE	F,FL$CRE
JRST	LOC>

;JUMPNC (LOC) JUMPS TO LOC IF NOT CREATE COMMAND

DEFINE JUMPNC (LOC)
<TLNN	F,FL$CRE
JRST	LOC>

;JMPRDO (LOC) JUMPS TO LOC IF READ ONLY

DEFINE JMPRDO (LOC)
<TLNE	F,FL$RDO
JRST	LOC>
SUBTTL	MAIN-LINE PROGRAM

TWOSEG
RELOC	400000
STOP$N==0			;INITIALIZE THE FATAL COUNTER

LIBMAN:	TDZA	T1,T1		;FLAG NORMAL START
	MOVEI	T1,1		;FLAG CCL START
	MOVEM	T1,OFFSET	;SAVE FOR SCAN

	STORE	17,0,16,0	;CLEAR ACS
	STORE	17,FW$ZER,LW$ZER,0 ;AND CORE WHICH SHOULD BE CLEARED
	STORE	T1,SCN$FO,SCN$LO,-1 ;SET SWITCHES TO DEFAULTS
	RESET			;STOP EXTERNAL I/O WHICH MAY BE IN PROGRESS
	SKIPA	P,.+1		;SETUP PDL
INIPDP:	IOWD	LN$PDL,PDLIST
	CALL	.RECOR##	;RESET CORE ALLOCATION
	MOVE	T1,ISCNBL	;GET ISCAN BLOCK
	CALL	.ISCAN##	;INITIALIZE THE COMMAND SCANNER
	MOVEM	T1,ISCNVL	;REMEMBER WHAT ISCAN RETURNS
	SKIPN	OFFSET		;CCL ENTRY?
	 SKIPE	TLDVER		;OR ALREADY TOLD VERSION?
	  JRST	LIBM.0		;ONE OR THE OTHER
	STRNG$	<LIBMAN %>	;NO--DO IT NOW
	MOVE	T1,.JBVER
	CALL	.TVERW##
	CALL	.TCRLF##
	SETOM	TLDVER		;SO WE ONLY TELL VERSION ONE TIME
RESTRT:
LIBM.0:	SKIPE	FLTMPC		;HAVE WE ALREADY TRIED TO READ NNNLRL.TMP?
	 JRST	LIBM.1		;YES--JUST GO CALL .VSCAN
	SETOM	FLTMPC		;NO--FLAG DOING IT TO PREVENT A LOOP
	OPEN	TMPC,[EXP .IODMP,'DSK   ',0] ;GET DISK IN DUMP MODE
	 JRST	LIBM.1		;FAILED--GIVE UP
	CALL	MAKCCL		;GET CCL NAME
	HRRI	T1,'LRL'	;LIBMAN REMEMBER LIBRARY
	MOVSI	T2,'TMP'	;COMPLEETE NAME
	SETZB	T3,T4
	LOOKUP	TMPC,T1		;SEE IF IT LIVES
	JRST	LIBM0A		;NO--QUIT
	CALL	$GTFDB		;GET AN FDB TO READ INTO
	MOVEM	T1,LIBFDB	;REMEMBER IT FOR ASECOND
	HRLI	T1,-.FXLEN	;FORM IOWD
	HRRI	T1,-1(T1)	;...
	SETZ	T2,		;END OF I/O LIST
	INPUT	TMPC,T1		;READ FDB
	STATZ	TMPC,IO.ERR!IO.EOF ;WE SHOULD NOT SEE THESE FLAGS
	 JRST	LIBM0A		;WE DID--ASSUME JUNK
	CLOSE	TMPC,
	MOVE	T1,LIBFDB	;RESET T1 TO POINT  TO FDB FOR OPENIO
	CALL	OPENIO		;SEE IF FILE LIVES
	CAI	LIBC,0(.IOBIN)	;...
	 JRST	LIBM0A		;NO--QUIT NOW
	TLO	F,FL$LIB	;YES--FLAG WE HAVE A LIBRARY
LIBM0A:	RELEASE	TMPC,		;FREE UP CHANNELS
	RELEASE	LIBC,		;IN CASE THEY WERE OPEN
LIBM.1:	MOVE	T1,VSCNBL	;GET ARG BLOCK FOR .VSCAN
	CALL	.VSCAN##	;DO THE WORK
	CALL	.MONRT##	;EXIT TO MONITOR
	JRST	RESTRT		;GO RESTART
SUBTTL	ARGUMENT BLOCKS FOR ISCAN AND VSCAN

ISCNBL:	XWD 5,	.+1
	IOWD	N$CMDS,CMDLST
	XWD	OFFSET,MY$PFX
	EXP	0
	EXP	0
	XWD	DOPRMP,0

;ARG BLOCK FOR .VSCAN

VSCNBL:	XWD 7,	.+1
	IOWD	VSWTL,VSWTN
	XWD	VSWTD,VSWTM
	XWD	0,VSWTP
	EXP	-1
	EXP	0
	EXP	0
	EXP	0

;SCAN CALLS HERE TO PROMPT -- T1 NEGATIVE IF CONTINUATION

DOPRMP:	SKIPL	T1		;FIRST?
	 SKIPA	T1,PRMPTM	;YES--LOAD UP MESSAGE
	MOVSI	T1,'#  '	;NO--LOAD UP CONTINUATION
	PJRST	.TSIXN##	;GO TYPE IT

PRMPTM:	XWD	MY$PFX,'>  '

CMDLST:	EXP	MY$NAM
	N$CMDS==.-CMDLST

;HERE FOR DDT COMMAND IF DEBUGGING

IFN FT$DDT,<$DDT:
	SKIPN	T1,.JBDDT	;PICK UP/CHECK IF DDT  IS LOADED
	 FATAL.	0,DNL,<DDT NOT LOADED> ;FATAL ONLY SO SCAN WILL CLEAN UP
	AOS	(P)		;OK--SET TO SKIP BACK
	PUSH	P,T1		;SAVE DDT ADDRESS ON PDL
	CALL	.TCRLF##	;NEW LINE
	STRNG$	<DDT>		;ANNOUNCE HIMSELF
	POPJ	P,		;RETURN TO DDT
DX=:	POPJ	P,		;DX$X WILL GET BACK TO COMMAND MODE
>;END IFN FT$DDT
SUBTTL	SWITCH TABLE

DEFINE SWTCHS,<
SP *ADD,,$ADD,,
SP BUFFER,S.BUFR,.SWDEC##,BUF,FS.NUE
SP CREATE,,$CREAT,,
SP *COPY,,$COPY,,
IFN FT$DDT,<SP DDT,,$DDT,,>
SP DELETE,,$DELET,,
SP DIRECT,,$DIREC,,
SL DSUPER,S.DSUP,SUP,SUPOLD,FS.NUE
SP DVERSI,,$DVERS,,
SP FILDIR,,$FILDIR,,
SL LSUPER,S.LSUP,SUP,SUPOLD,FS.NUE
SP *ONEOUT,,$ONEOU,,
SP READ,,$READ,,
SN REMEMB,S.REML,FS.NUE
SP RENAME,,$RENAM,,
SP *REPLAC,,$REPLAC,,
SL *SUPERS,S.SUPR,SUP,SUPOLD,FS.NUE
SP *TYPE,,$TYPE,,
SP *USE,,$USE,,
>

DM (BUF,^D100,DF$BUF,DF$BUF)
KEYS (SUP,<ALWAYS,OLDER,NEVER>)
	ND SUPDEF,SUPOLD		;DEFAULT IN CASE NO /SUPERSEDE

DOSCAN (VSWT)
SUBTTL	PROCESS ADD COMMAND

$ADD:	JUMPNU	E$$NUC		;MUST HAVE USE OR CREATE
	JMPRDO	E$$IRO		;ILLEGAL IF READ ONLY
	CALL	.SAVE1##	;PRESERVE P1
	AOS	(P)		;SET TO SKIP BACK SO SCAN DOESN'T STORE
	CALL	$GTLST		;READ FILE LIST
	 JRST	E$$NFS		;DID'NT GIVE ONE
	MOVE	P1,L		;REMEMBER WHERE IT IS
	 CALL	$GTDIR		;READ DIRECTORY
	SETZM	FILCNT		;CLEAR COUNT OF FILES ADDED
	SETZM	NOFILR		;CLEAR COUNT OF FILES REJECTED
	STRNG$	<FILES ADDED TO LIBRARY:
>
ADDL.L:	SETZM	WLDPTR		;CLEAR WILD'S TEMP PTR
ADDL.0:	HRRZM	P1,WLDFIR	;STORE PTR FOR WILD
	MOVE	T1,LKWLDB	;GET ARG FOR .LKWLD
	CALL	.LKWLD##	;GET A FILE TO ADD
	 JRST	ADDL.5		;NOT ANY MORE THIS FDB
	MOVE	T1,DSKLKP+.RBNAM;GET FILENAME
	HLLZ	T2,DSKLKP+.RBEXT;AND EXTENSION
	MOVE	T3,LIBFDB	;GET LIBRARY FDB ADDRESS
	HLLZ	T4,.FXEXT(T3)	;GET LIBRARY EXTENSION
	CAMN	T1,.FXNAM(T3)	;SEE IF FILENAMES
	CAME	T2,T4		;AND EXTENSIONS ARE THE SAME
	 SKIPA			;NO--OK TO POSSIBLY ADD TO LIBRARY
	 JRST	ADDL.0		;YES--DON'T ADD LIBRARY TO ITSELF
	CALL	IFNDIR		;SEE IF ALREADY IN DIR
	 JRST	ADDL.A		;NO--OK TO ADD IT
	SETO	T1,		;ALREADY THERE--SEE IF WE SHOULD BITCH
	MOVEI	T2,-1		;MASK FOR EXT
	XOR	T1,.FXNMM(P1)	;SEE IF WILD FILENAME
	TDCE	T1,[EXP	-1]	;...
	 JRST	ADDL.0		;FILENAME WAS WILD--DON'T COMPLAIN
	XOR	T2,.FXEXT(P1)	;CHECK EXTENCION
	TRCE	T2,-1		;...
	 JRST	ADDL.0		;EXT WAS WILD--OK
	AOS	NOFILR		;COUNT A FILE AS REJECTED
	MOVEI	T1,DSKOPN	;POINT AT OPEN BLOCK
	MOVEI	T2,DSKLKP	;AND LOOKUP BLOCK
	WARN.	EF$LEB!EF$NCR,FAL,<FILE ALREADY IN LIBRARY - >
	STRNG$	< - IGNORING
>
X$$FAL:	JRST	ADDL.0		;GET NEXT

;HERE WHEN WILD SAYS NO MORE FILES TO BE FOUND FROM THIS FDB

ADDL.5:	HRRZ	P1,-1(P1)	;CHAIN TO NEXT FDB
	JUMPN	P1,ADDL.L	;JUMP IF MORE TO COME
	SKIPN	FILCNT		;DONE--SEE IF WE DID ANYTHING
	CALL	WRNOFM		;NO--TELL NO FILES MATCH
	MOVE	T1,L		;NO--COPY LST ADDR
	PJRST	GIVLST		;GO FREE IT UP AND RETURN

LKWLDB:	XWD	5,.+1		;ARG PTR FOR .LKWLD
	XWD	WLDFIR,0	;LOC HAVING FIRST WORD OF SPECS, 0
	XWD	DSKOPN,DSKLKP	;OPEN BLOCK,LOOKUP BLOCK
	XWD	.FXLEN,.RBTIM+1	;SIZE OF SCAN BLOCK,SIZE OF LOOKUP BLOCK
	XWD	0,WLDPTR	;CHANNEL+FLAGS,PTR FOR WILD COMMUNICATION
	EXP	0		;ROUTINE TO NOTIFY AT END OF DIR

		X$$NFM=$POPJ	;JUST RETURN IF /MESSAGE:PREFIX
WRNOFM:	SKIPE	NOFILR		;DON'T MESSAGE IF FILES WERE REJECTED
	 POPJ	P,		;REJECTED FILES--HE ALREADY KNOWS
	WARN.	EF$NCR,NFM,<NO FILES FOUND TO MATCH >
	CALL	$TYIOL		;TYPE THE LIST
	PJRST	.TCRLF##	;NEW LINE AND EXIT
;HERE TO ADD FILE TO LIBRARY

ADDL.A:	CALL	DSKOPI		;OPEN DISK FILE FOR INPUT
	JRST	ADDL.X		;FILE NOT FOUND--CLOSE OUT AND GET NEXT FILE
	CALL	.CHKTM##	;CHECK /BEFORE/SINCE/ABEFORE/ASINCE
	 JRST	ADDL.X		;LOSE--CLOSE OUT AND GET NEXT FILE
	CALL	GETNBF		;GET # BUFFERS FOR DSK INPUT
	MOVE	T2,[XWD OPNBLK,IBHR] ;...
	CALL	.ALCBF##
	SETZ	T1,		;FLAG WE WANT TO APPEND TO LIBRARY
	CALL	OLIBUP		;OPEN LIBRARY IN APPEND MODE
	HRLI	P1,(B)		;REMEMBER FIRST BLOCK FOR FILE
	PUSH	P,DSKLKP+.RBPPN	;SAVE ORIGINAL PPN AND THEN
	MOVE	T1,.MYPPN##	;   PUT MY PPN INTO LKPBLK
	MOVEM	T1,DSKLKP+.RBPPN;BEFORE WE COPY IT TO LIBRARY
	MOVSI	T1,DSKLKP-1	;SETUP SO WE CAN COPY DSKLKP TO LIB
	HRR	T1,OBHR+.BFPTR	;...
	AOBJP	T1,.+1		;OFF BY ONE IN BOTH HALFS
	MOVEI	T2,.RBTIM+1(T1)	;SET END OF BLT (REST OF BLOCK WILL BE 0'S)
	CALL	DCPY.1		;COPY LKPBLK AND THEN FILE
	POP	P,DSKLKP+.RBPPN	;RESTORE ORIGINAL PPN

;HERE AT END OF ADDITION

	CALL	OLBCLS		;CLOSE LIB
	CALL	DSKICL		;AND INPUT FILE
	MOVE	T1,DSKLKP+.RBNAM;GET FILENAME
	HLLZ	T2,DSKLKP+.RBEXT;AND EXTENSION
	HLRZ	B,P1		;GET FIRST BLOCK IN FILE BACK
	CALL	AD2DIR		;ADD TO INCORE DIRECTORY
	TLZ	F,FL$CRE	;LIBRARY EXISTS--CLEAR CREATE FLAG
	AOS	FILCNT		;COUNT A FILE AS DONE
	MOVEI	T1,DSKOPN	;POINT TO OPEN BLOCK
	MOVEI	T2,DSKLKP	;AND LOOKUP BLOCK
	CALL	.TOLEB##	;TYPE NAME TO USER
	CALL	.TCRLF##
	JRST	ADDL.0		;GO ADD MORE FILES

ADDL.X:	CALL	DSKICL		;CLOSE OUT DISK FILE
	JRST	ADDL.0		;GO GET NEXT THING

;CALL HERE TO DO THE MAJOR COPY LOOP

DOCOPY:	CALL	XCTIO		;GET A BLOCK
	 IN	INPC,		;XCT'D FROM DOWN BELOW
	  POPJ	P,		;END OF FILE
	HRLZ	T1,IBHR+.BFPTR	;GET BUFFER ADDRESSES
	HRR	T1,OBHR+.BFPTR	;...
	AOBJP	T1,.+1		;OFF BY ONE
	MOVEI	T2,200(T1)	;SET END OF BLT
DCPY.1:	BLT	T1,-1(T2)	;ZIP THE BLOCK OVER
	MOVEI	T1,200		;UPDATE OUTPUT STUFF
	ADDM	T1,OBHR+.BFPTR	;...
	SETZM	OBHR+.BFCTR
	CALL	XCTIO		;WRITE BLOCK TO LIB
	 OUT	LIBC,		;...
	 STOPX$			;***TEMP
	AOJA	B,DOCOPY	;COUNT BLOCKS INTO LIBRARY

E$$IRO:	FATAL.	0,IRO,<ILLEGAL COMMAND FOR READ-ONLY LIBRARY>
SUBTTL	PROCESS COPY/TYPE COMMANDS

$COPY:	TLZA	F,FL$TYP	;FLAG COPY NOT TYPE
$TYPE:	TLO	F,FL$TYP	;FLAG TYPE
	JUMPNU	E$$NUC		;JUMP IF NO USE COMMAND
	JUMPNC	CTYP.0		;JUMP IF NOT CREATE
E$$LIE:	FATAL.	0,LIE,<LIBRARY IS EMPTY> ;NOTHING TO DO
CTYP.0:	CALL	.SAVE1##	;SAVE P1
	AOS	(P)		;SET TO SKIP BACK
	TLZ	F,FL$ONE	;FLAG COPY/TYPE AND NOT ONEOUT
	CALL	$GTIOL		;GET I/O LIST
	 JRST	E$$NFS		;NEED A LIST THO
	MOVEI	T1,OPNTTO	;ASSUME TYPING
	TLNN	F,FL$TYP	;ARE WE TYPEING?
	 MOVEI	T1,CKOFDB	;NO--DO DIFFERENTLY
	CALL	(T1)		;CALL THE RIGHT ROUTINE
	CALL	$GTDIR		;CREATE IN-CORE DIRECTORY
	MOVEI	T1,6		;USE SIX INPUT BUFFERS
	CALL	OLIBIN		;OPEN THE LIBRARY
	JRST	[FATAL. (0,CFL,<CAN'T FIND LIBRARY>) ;???
		PJRST	CTYP.X]	;CLEAN UP AND EXIT
	SETZM	FILCNT		;CLEAR FILE COUNT
	SETZM	NOFILR		;CLEAR REJECTED FILE COUNT
	MOVEI	T1,[ASCIZ/FILES COPIED FROM LIBRARY:
/]
	TLNN	F,FL$TYP	;UNLESS WE ARE TYPING
	 CALL	.TSTRG##	; THEN TELL USER THE FILES WE COPIED
	CALL	$MKLST		;MAKE  THE LST
	 CALL	CPYTYF		;(THIS INSTR IS XCT'D BY $MKLST--COROUTINE)
	SKIPN	FILCNT		;FIND ANY FILES?
	 CALL	WRNOFM		;TELL NO FILES MATCHED
CTYP.X:	CALL	GIVIOL		;GIVE OUTFDB AND INPUT LIST BACK
	TLZE	F,FL$TYP	;WERE WE JUST TYPEING
	 CALL	CLSTTO		;YES--CLOSE OUTPUT
	PJRST	ILBCLS		;GO CLOSE LIBRARY AND RETURN
;COROUTINE CALLED BY $MKLST TO DO THE WORK
;CALLED WITH P3=PTR TO EXT OF FILE IN INCORE DIRECTORY
;AND P4=PTR TO INPUT FDB WHICH MATCHES IT

CPYTYF:	CALL	.SAVE2##	;PRESERVE P1-2
	HRRZM	P4,IFDBAD	;SAVE FOR .SCWLD
	TLNE	F,FL$TYP!FL$ONE	;ARE WE TYPING OR "ONEOUTING"?
	 JRST	CPTF.3		;YES--SKIP SOME
	HRLZ	T1,OUTFDB	;BLOT OUTFDB TO KNOWN LOC
	TLNN	F,FL$OFG	;SEE IF OUTPUT FILE GIVEN
	 HRLZ	T1,P4		;NO--USE INPUT FDB THAT MATCHES
	HRRI	T1,OFDB
	BLT	T1,OFDB+.FXLEN-1
CPTF.3:	HRRZ	T1,IBHR+.BFADR	;SETUP TO CLEAR USE BITS
	CALL	CLRUSE		;DO IT
	 WAIT	LIBC,		;XCT'D BY CLRUSE
	HRRZ	B,(P3)		;GET BLOCK # OF LKPBLK IN FILE
	USETI	LIBC,(B)	;SET TO READ IT
	CALL	XCTIO		;READ IT
	 IN	LIBC,		;XCT'D BY XCTIO
	 JRST	CPYIFL		;INCORRECTLY FORMATTED LIB
	HRRZ	T1,IBHR+.BFPTR	;GET THE LKPBLK ADDR
	MOVSI	T1,1(T1)	;+1 AND TO LH
	HLRZ	P1,T1		;REMEMBER ADDRESS FOR LATER
	MOVEI	T2,.RBTIM	;THIS SHOULD BE IN .RBCNT
	CAME	T2,.RBCNT(P1)	;MAKE SURE IT IS
	 JRST	CPYIFL		;NO--GO DIE
	TLNE	F,FL$TYP	;ARE WE TYPEING?
	 JRST	CPTF.4		;YES--NO NEED TO CALL .SCWLD
	TLNE	F,FL$ONE	;IS THIS A "ONEOUT"?
	 JRST	CPTF.5		;YES--OUTPUT FILE IS ALREADY OPEN
	HRRI	T1,LKPBLK	;SET IN WHERE IT GOES TO
	BLT	T1,LKPBLK+.RBTIM ;ZIP IT OVER
	MOVSI	T1,'DSK'	;JUST USE DSK FOR NOW
	MOVEM	T1,OPNBLK+.OPDEV;
	MOVE	T1,SCWABL	;SETUP FOR .SCWLD
	CALL	.SCWLD##	;DO SECONDARY WILDCARDING
	 POPJ	P,		;MESSAGE ALREADY ISSUED--JUST RETURN
	MOVE	T1,DSKOPN+.OPDEV;GET THE DEVICE NAME
	DEVCHR	T1,		;GET CHARACTERISTICS
	TXNN	T1,DV.M13	;CAN IT DO BINARY MODE I/O?
	 JRST	CPYN13		;NO--GO DIE OUT
	LDB	T1,[POINTR(.RBPRV(P1),RB.MOD)] ;GET MODE OF FILE
	MOVEM	T1,DSKOPN+.OPMOD;SET THE MODE
	MOVSI	T1,OBHR		;AND THE BUFFER HEADER
	MOVEM	T1,DSKOPN+.OPBUF;...
	OPEN	OUTC,DSKOPN	;OPEN THE CHANNEL
	 PJRST	E.SCO##		;REPORT OPEN ERROR
	HRRZ	T1,.RBEXT(P1)	;GET GOOD BITS
	HRRM	T1,DSKLKP+.RBEXT;AND SET IN ENTER BLOCK
	MOVE	T1,.RBPRV(P1)	;GET PRIV WORDS
	TLZ	T1,777000	;CLEAR PROT SINCE .SCWLD SETS IT UP
	IORM	T1,DSKLKP+.RBPRV;SO JUST SET EVERYTHING ELSE
	MOVE	T1,.RBSPL(P1)	;COPY REST OF ARGS WE CAN SET
	MOVEM	T1,DSKLKP+.RBSPL
	MOVE	T1,.RBALC(P1)
	MOVEM	T1,DSKLKP+.RBALC;
				;***DON'T SET .RBEST DUE TO MON BUG
				;IF .RBEST .GT. .RBALC!!!***
	MOVE	T1,.RBNCA(P1)	;NON-PRIV CUST ARG
	MOVEM	T1,DSKLKP+.RBNCA;IN CASE ANYONE USES IT
	MOVE	T1,.RBVER(P1)	;DON'T FORGET THE VERSION
	SKIPN	DSKLKP+.RBVER	;BUT DON'T OVERWRITE IF SPECIFIED IN COMMAND
	MOVEM	T1,DSKLKP+.RBVER;...
	SKIPG	T2,S.DSUP	;PICKUP DSUPERSEDE SWITCH IF GIVEN
	 MOVE	T2,S.SUPR	;ELSE USE THE /SUPERSEDE VALUE
	SKIPG	T2		;SEE IF WE GOT A /SUPERSEDE VALUE
	MOVEI	T2,SUPDEF	;NO--USE THE DEFAULT
	SKIPE	.RBTIM(P1)	;IS CREATION DATE/TIME ZERO? (IE FROM UFLIP)
	CAIN	T2,SUPALW	;WAS IT /SUPERSEDE:ALWAYS?
	 JRST	CPTYEN		;YES--FORGET THE DATE CHECKS
	MOVE	T1,[XWD DSKOPN,TMPOPN] ;NO--MUST CHECK IF FILE ALREADY LIVES
	BLT	T1,TMPXEN	;SO MAKE A DESTROYABLE COPY
	OPEN	TMPC,TMPOPN	;OPEN THE DEVICE
	 JRST	CPTYEN		;??? JUST IGNORE THE WHOLE THING
	LOOKUP	TMPC,TMPLKP	;SEE IF FILE ALREADY LIVES
	 JRST	CPTLER		;DOESN'T OR SOME ERROR--CHECK IT OUT
CPTYCS:	CAIN	T2,SUPNEV	;IT LIVES--WAS IT /SUPERSEDE:NEVER
	 PJRST	WRNFNC		;YES--TELL USER OF /SUPERSEDE FAILURE
	MOVE	T1,TMPLKP+.RBTIM;NO--GET INTERNAL CREATION TIME
	CAML	T1,.RBTIM(P1)	;MUST BE OLDER THAN ONE IN LIBRARY
	 PJRST	WRNFNC		;NO--SAME COPY OR NEWER--IGNORE IT
CPTYEN:	ENTER	OUTC,DSKLKP	;WRITE THE FILE
	 PJRST	E.SCL##		;REPORT ENTER ERROR
	SETSTS	OUTC,.IOBIN	;BACK TO BUFFERED BINARY
	MOVEI	T1,.IOBIN	;SET IN OPEN BLOCK ALSO
	HRRM	T1,DSKOPN+.OPMOD;FOR .ALCBF
	CALL	GETNBF		;GET CORRECT # BUFFERS
	MOVE	T2,[XWD DSKOPN,OBHR] ;FOR .ALCBF
	CALL	.ALCBF##	;ALLOCATE BUFFERS FOR OUTPUT
	OUTPUT	OUTC,		;DUMMY OUTPUT TO GET HEADER RIGHT
	JRST	CPTF.5		;SKIP TTY CODE
CPTF.4:	MOVEI	T1,"["		;TELL WHAT FILE WE ARE TYPEING
	CALL	.TCHAR##	;...
	MOVEI	T1,[EXP .IODMP,'DSK   ',0];SETUP FAKE OPEN BLOCK
	MOVEI	T2,(P1)		;POINT TO THE LKPBLK IN THE BUFFER
	CALL	.TOLEB##	;TYPE OPEN LOOKUP BLOCK
	STRNG$	<]
>				;CLOSE IT OUT
CPTF.5:	MOVE	P1,.RBSIZ(P1)	;GET SIZE OF FILE IN WORDS
	ADDI	P1,177		;ROUND UP
	LSHC	P1,-7		;GET BLOCKS, SAVE REMAINDER WORDS
	LSH	P2,-35		;GET REMAINDER WORDS - 1
	AOJ	P2,		;NOW HAVE CORRECT # WORDS FOR LAST BLOCK
	AOJ	B,		;INC B TO NEXT BLOCK
;COPY THE FILE FROM THE LIBRARY OUT TO WHATEVER

CPTF.6:	SOJL	P1,CPTF.X	;WATCH FOR THE END
	CALL	XCTIO		;READ NEXT LIB RECORD
	 IN	LIBC,		;XCT'D
	 JRST	[CALL	DSKOCL	;??? CLOSE DISK FILE
		JRST	CPYIFL]	;AND GO DIE
	SKIPN	P1		;SKIP IF NOT LAST BLOCK
	MOVEM	P2,IBHR+.BFCTR	;YES--SET TO ONLY DO SO MANY WORDS
	MOVE	T1,IBHR+.BFCTR	;GET SIZE OF BUFFER DATA
CPTF.8:	MOVE	T2,OBHR+.BFCTR	;AND SIZE OF OUTPUT BUFFER
	TLNE	F,FL$TYP	;ARE WE TYPEING?
	 IDIVI	T2,5		;YES--CVT CHARS TO WORDS
	CAMLE	T1,T2		;ROOM FOR ALL?
	 MOVE	T1,T2		;NO--MOVE WHAT WE CAN
	MOVN	T2,T1		;GET - WORDS
	 ADDM	T2,IBHR+.BFCTR	;UPDATE INPUT COUNTER
	  TLNE	F,FL$TYP	;TYPEING?
	   IMULI T2,5		;YES--BACK TO CHARACTERS
	ADDM	T2,OBHR+.BFCTR	;UPDATE OUTPUT COUNTER
	HRLZ	T2,IBHR+.BFPTR	;GET INPUT POINTER
	HRR	T2,OBHR+.BFPTR	;AND OUTPUT
	AOBJP	T2,.+1		;OFF BY ONE
	ADDM	T1,IBHR+.BFPTR	;UPDATE INPUT PTR
	ADDB	T1,OBHR+.BFPTR	;AND OUTPUT AND GET END ADR OF BLT
	BLT	T2,(T1)		;MOVE THE DATA
	TLNE	F,FL$ONE	;IF THIS IS "ONEOUT"
	 SKIPG	OBHR+.BFCTR	;YES--SEE IF LAST BUFFER IS FULL BUFFER
	  SKIPA			;NOT ONEOUT OR LAST BUFFER IS FULL
	JUMPE	P1,CPTF.X	;ONEOUT AND LAST BUFFER--THEN DON'T OUTPUT IT
				;SO WE DON'T FILL BLOCK WITH ZEROS
	CALL	XCTIO		;WRITE THE BUFFER
	 OUT	OUTC,		;XCT'D
	 STOPX$			;***FULL??
	SKIPLE	T1,IBHR+.BFCTR	;ANY MORE IN THIS INPUT BUFFER?
	 JRST	CPTF.8		;YES--GO GET IT
	AOJA	B,CPTF.6	;NO--INC BLOCK COUNTER AND GET NEXT BLOCK
CPTF.X:	TLNE	F,FL$TYP!FL$ONE	;UNLESS WE ARE TYPEING OR ONEOUTING
	 JRST	CPTFX2		;YES--SKIP AHEAD SOME
	MOVE	T1,-1(P3)	;GET FILE NAME
	CALL	.TSIXN##	;TYPE IT OUT
	CALL	.TDOT		;AND A DOT
	HLLZ	T1,(P3)		;GRAB THE EXTENSION
	HRRI	T1,'=> '	;FORM RH TOO
	CALL	.TSIXN##	;TYPE IT OUT
	MOVEI	T1,DSKOPN	;GET OPEN BLOCK ADDR
	MOVEI	T2,DSKLKP	;AND LOOKUP BLOCK
	CALL	$TLBVP		;TYPE LOOKUP BLOCK, VERSION AND PROTECTION
	CALL	.TCRLF##	;NEW LINE NOW
	CALL	DSKOCL		;CLOSE OUTPUT
CPTFX2:	AOS	FILCNT		;COUNT A FILE AS DONE
	POPJ	P,		;ALL DONE

;HERE IF CAN'T DO BINARY I/O

CPYN13:	MOVEI	T1,OPNBLK	;GET OPEN BLOCK
	MOVEI	T2,DSKLKP	;AND LOOKUP BLOCK
	ERROR.	EF$LEB,CDB,<CAN'T DO BINARY I/O TO >
	POPJ	P,		;JUST RETURN
;HERE WHEN FILE IN BAD FORMAT

CPYIFL:	CALL	CTYP.X		;CLEAN UP
	PJRST	E$$IFL		;REPORT BAD FORMAT

;ARG BLOCK FOR .SCWLD

SCWABL:	XWD	4,.+1
	XWD	IFDBAD,[OFDB]	;SCAN FILE SPEC
	XWD	OPNBLK,DSKOPN	;OPEN BLOCK
	XWD	LKPBLK,DSKLKP	;LOOKUP/ENTER BLOCK
	XWD	[0],.RBTIM+1	;DEFAULT OUTPUT EXT,,LENGTH OF ENTER BLOCK

;HERE WHEN LOOKUP FOR CHECKING /SUPERSEDE FAILS

CPTLER:	RELEASE	TMPC,		;CLOSE THE CONNECTION
	HRRZ	T1,TMPLKP+.RBEXT;GET FAIL CODE
	JUMPE	T1,CPTYEN	;IF FILE NOT FOUND THEN GO AHEAD
	JRST	CPTYCS		;ELSE GO CHECK DATE/TIME STUFF

;HERE TO REPORT A FILE NOT COPIED--T2 HAS SUPXXX

WRNFNC:	AOS	NOFILR		;COUNT A FILE AS REJECTED
	SAVE$	T2		;SAVE T2
	MOVEI	T1,TMPOPN	;POINT AT OPEN BLOCK
	MOVEI	T2,TMPLKP	;AND LOOKUP BLOCK
	WARN.	EF$NCR!EF$LEB,FNC,<FILE NOT COPIED: >
	MOVE	T2,(P)		;GET SUPXXX
	CALL	TSUPSW		;TYPE /SUPERSEDE:XXXXX
X$$FNC:	POP	P,T2		;KEEP THE STACK STRAIGHT

;HERE TO RELEASE CHANNELS AND RETURN BECAUSE SUPERSEDE TEST FAILED

CPTOLD:	RELEASE	TMPC,		;CLOSE TEMP CHANNEL
	RELEASE	OUTC,		;AND OUTPUT
	POPJ	P,		;RETURN

;TYPE /SUPERSEDE:XXXXX
;ENTER WITH SUPXXX IN T2

TSUPSW:	STRNG$	</SUPERSEDE:>
	MOVE	T1,SUP.T-1(T2)	;GET SIXBIT REPRESENTATION OF IT
	CALL	.TSIXN##	;TYPE IT
	PJRST	.TCRLF##	;AND NEW LINE EXIT
SUBTTL	PROCESS DELETE COMMAND

$DELET:	TLZA	F,FL$TYP	;FLAG DELETE
$REPLA:	TLO	F,FL$TYP	;RATHER THAN A REPLACE
	JUMPNU	E$$NUC		;NEED A USE COMMAND
	JUMPCR	E$$LIE		;AND NOT CREATE
	JMPRDO	E$$IRO		;AND CERTAINLY NOT READ ONLY
	CALL	.SAVE2##	;OK--ITS COOL--SAVE REGISTERS
	AOS	(P)		;AND SET TO SKIP SO SCAN DOESN'T WIPE FLAGS
	CALL	$GTLST		;GET A FILE LIST
	 JRST	E$$NFS		;MUST HAVE A LIST
	CALL	$GTDIR		;CREATE INCORE DIR IF NOT DONE ALREADY
	SETZM	FILCNT		;CLEAR FILE COUNT
	SETZM	NOFILR		;CLEAR # FILES REJECTED
	CALL	$MKLST		;MAKE THE LIST OF FILES TO DELETE/REPLACE
	 CALL	RDLSUB		;XCT'D BY $MKLST
	SKIPE	FILCNT		;DID WE GET A LST
	 JRST	DLRP.2		;YES
	CALL	WRNOFM		;NO FILES MATCHED
	PJRST	GIVIOL		;GIVE I/O LISTS AND RETURN

DLRP.2:	MOVE	T1,LIBFDB	;GET THE LIBRARY FOR INPUT
	CALL	OPENIO		;...
	 CAI	ILIB,LBHR(.IOBIN)
	  JRST	DLRPNL		;NO LIBRARY!!!
	CALL	GETNBF		;GET BUFFER COUNT
	MOVE	T2,[XWD OPNBLK,LBHR]
	CALL	.ALCBF##
	MOVE	T1,LIBFDB	;SET TO REWRITE LIBRARY
	CALL	OPENIO
	CAI	LIBC,@OBHR(.IOBIN) ;OPEN FOR OUTPUT
	 JFCL			;SHOULD ALWAYS CPOPJ2 FOR WRITING
	CALL	GETNBF		;GET BUFFER COUNT
	MOVE	T2,[XWD OPNBLK,OBHR]
	CALL	.ALCBF##
	OUTPUT	LIBC,		;DO A DUMMY OUTPUT
	MOVEI	B,1		;INIT BLOCK COUNTER
	STRNG$	<FILES >	;SETUP HEADER
	MOVEI	T1,[ASCIZ/DELETED/]
	TLNE	F,FL$TYP	;SEE IF DELETING OR REPLACING
	MOVEI	T1,[ASCIZ/REPLACED/]
	CALL	.TSTRG##
	STRNG$	<:
>
;NOW LOOP OVER THE INPUT LIBRARY AND DELETE OR REPLACE AS NEEDED

DLRP.4:	CALL	XCTIO		;GET A LKPBLK FROM INPUT DIR
	 IN	ILIB,		;XCT'D
	JRST	DLRPDN		;EOF--WE ARE DONE
	MOVE	P1,LBHR+.BFPTR	;ADDRESS THE BUFFER
	AOJ	P1,
	MOVE	T1,.RBCNT(P1)	;GET THE COUNT
	CAIE	T1,.RBTIM	;MUST BE THIS
	 JRST	DLRIFL		;OR WE HAVE A BAD LIBRARY
	MOVE	P2,.RBSIZ(P1)	;GET FILE SIZE IN WORDS
	ADDI	P2,177		;ROUND UP
	LSH	P2,-7		;P2=# BLOCKS NEEDED TO HOLD FILE
	MOVE	T1,.RBNAM(P1)	;GET FILENAME
	HLLZ	T2,.RBEXT(P1)	;AND EXTENSION
	MOVE	T3,LSTPTR	;THIS IS WHERE THE LST IS
	CALL	IFNLST		;SEE IF THIS FILE IS DESTINED TO BE DELETED
	 JRST	DLRP.8		;NO--JUST COPY TO NEW LIBRARY
	TLNN	F,FL$TYP	;ARE WE REPLACING OR DELETING?
	 JRST	DLRP.7		;DELETING--JUST SKIP TO NEXT LKPBLK
	HRLZ	T1,(T3)		;GET FDB POINTER
	HRRI	T1,OFDB		;AND WHERE TO STORE IT
	BLT	T1,OFDB+.FXLEN-1;MAKE A COPY WE CAN SCRIBBLE ON
	MOVE	T1,.RBNAM(P1)	;GET THE FILENAME
	MOVEM	T1,OFDB+.FXNAM	;SET IN FDB
	HLLZ	T2,.FXEXT(P1)	;AND THE XTENSION
	HLLOM	T2,OFDB+.FXEXT	;SET IT AND MASK
	SETOM	OFDB+.FXNMM	;SET FILENAME MASK TO ALL ONES
	MOVEI	T1,OFDB		;POINT AT FDB FOR OPENIO
	CALL	OPENIO		;OPEN FILE FOR READING
	 CAI	INPC,IBHR(.IOBIN)
	 JRST	DLRP.8		;??? IT DISSAPPEARED
	SKIPG	T2,S.LSUP	;PICKUP/CHECK LSUPERSEDE ARG IF GIVEN...
	MOVE	T2,S.SUPR	;GET SUPERSEDE ARGUMENT
	SKIPG	T2		;DID WE GET A /SUPERSEDE?
	 MOVEI	T2,SUPDEF	;NO--SUPPLY THE DEFAULT
	SKIPE	.RBTIM(P1)	;WAS CREATE DATE 0 (IE FROM UFLIP)?
	CAIN	T2,SUPALW	;/SUPERSEDE:ALWAYS?
	 JRST	DLRP.6		;YES--GO DO IT
	MOVE	T1,LKPBLK+.RBTIM;NO--GET DISK FILE CREATION DATE/TIME
	CAMLE	T1,.RBTIM(P1)	;SEE IF NEWER THAN ONE IN LIBRARY
	 JRST	DLRP.6		;YES--GO REPLACE IT
	PUSH	P,T2		;NO--SAVE SUPXXX
	MOVEI	T1,OPNBLK	;POINT AT OPEN BLOCK
	MOVEI	T2,LKPBLK
	AOS	NOFILR		;COUNT A REJECTED FILE
	WARN.	EF$NCR!EF$LEB,FNR,<FILE NOT REPLACED: >
	MOVE	T2,(P)		;GET /SUPERSEDE VALUE
	CALL	TSUPSW		;TYPE /SUPERSEDE:XXX AND NEW LINE
X$$FNR:	POP	P,T2		;KEEP STACK STRAIGHT
	JRST	DLRP8A		;GO IGNORE THIS FILE
DLRP.6:	CALL	GETNBF		;FIND # BUFFERS TO SETUP
	MOVE	T2,[XWD OPNBLK,IBHR] ;...
	CALL	.ALCBF##
	MOVSI	T1,LKPBLK-1
	HRR	T1,OBHR+.BFPTR	;COPY LKPBLK TO NEW LIBRARY
	AOBJP	T1,.+1		;...
	MOVEI	T2,.RBTIM+1(T1)	;SET END OF BLT
	HRLI	P1,(B)		;SAVE OLD B
	CALL	DCPY.1		;REPLACE THE FILE
	CALL	DSKICL		;CLOSE OUT DISK INPUT FILE
	HLRZ	B,P1		;GET B BACK
DLRP.7:	MOVE	T1,.RBNAM(P1)	;GET FILENAME WE ARE DELETING OR REPLACING
	CALL	.TSIXN##
	CALL	.TDOT
	HLLZ	T1,.RBEXT(P1)
	CALL	.TSIXN##
	CALL	.TCRLF##
	HRRZ	T1,LBHR+.BFADR	;SETUP TO CLEAR USE BITS
	CALL	CLRUSE
	 WAIT	ILIB,		;XCT'D
	ADDI	B,1(P2)		;ADVANCE TO NEXT LKPBLK
	USETI	ILIB,(B)	;...
	JRST	DLRP.4		;GO HANDLE NEXT LIBRARY ENTRY

;HERE TO JUST COPY FROM INPUT LIBRARY TO OUTPUT LIBRARY

DLRP8A:	RELEASE	INPC,		;CLOSE OUT INPUT CHANNEL
DLRP.8:	MOVSI	T1,-1(P1)	;SETUP BLT
	AOJA	P2,DLRP10	;COUNT LKPBLK AND GO DO IT
DLRP.9:	CALL	XCTIO		;GET NEXT BLOCK FOR THIS FILE IN LIB
	 IN	ILIB,		;XCT'D
	  JRST	DLRIFL		;SNH
	HRLZ	T1,LBHR+.BFPTR	;BEGIN CTL WORD
DLRP10:	HRR	T1,OBHR+.BFPTR
	AOBJP	T1,.+1
	MOVEI	T2,200(T1)	;END OF BLT
	BLT	T1,-1(T2)	;MOVE IT
	MOVE	T1,OBHR+.BFCTR	;GET THE COUNT
	ADDM	T1,OBHR+.BFPTR	;ADJUST PTR
	SETZM	OBHR+.BFCTR	;AND COUNTER
	CALL	XCTIO		;WRITE THE BLOCK
	 OUT	LIBC,		;TO NEW LIBRARY
	 STOPX$			;SNH

	ADDI	B,1		;MOVE TO NEXT BLOCK
	SOJG	P2,DLRP.9	;GO IF WE NEED TO COPY MORE
	JRST	DLRP.4		;NO--ALL DONE

;HERE WHEN WE ARE ALL DONE

DLRPDN:	CALL	OLBCLS		;CLOSE OUTPUT LIBRARY
DLRPD0:	RELEASE	ILIB,		;CLOSE INPUT
	MOVEI	T1,LBHR		;SETUP TO FREE BUFFERS
	CALL	TSTBHR		;FREE BUFFERS
	CALL	ZAPDIR		;ZERO INCORE DIR SO WE WILL REREAD IT
	MOVE	T1,LSTPTR	;FREE LST
	CALL	GIVLST
	SETZM	LSTPTR		;MAKE SURE NO MORE
	PJRST	GIVIOL		;GIVE BACK I/O LISTS AND EXIT

;HERE IF BAD FORMAT IN INPUT LIBRARY

DLRIFL:	RELEASE	LIBC,		;MAKE ALL THE WORK DISSAPPEAR
	CALL	OLBCL2		;FREE BUFFERS
	CALL	DLRPD0		;CLOSE INPUT
	PJRST	E$$IFL		;REPORT BAD FORMAT

DLRPNL:	STOPX$			;NO LIBRARY????
;COROUTINE TO SETUP LST FOR DELETE AND REPLACE

RDLSUB:	TLNN	F,FL$TYP	;ARE WE REPLACING?
	 JRST	RDLS.2		;NO--JUST ENTER INTO LST
	MOVSI	T1,(P4)		;SETUP TO COPY FDB
	HRRI	T1,OFDB		;TO SOMEWHERE WE CAN WRITE ON IT
	BLT	T1,OFDB+.FXLEN-1;ZIP
	MOVE	T1,-1(P3)	;GET FILENAME
	MOVEM	T1,OFDB+.FXNAM
	SETOM	OFDB+.FXNMM	;SET SO STOPN DOESN'T COMPLAIN
	HLLZ	T1,(P3)		;GET EXTENSION
	HLLOM	T1,OFDB+.FXEXT
	MOVSI	T1,.FXLEN	;CONVERT TO LKPBLK
	HRRI	T1,OFDB		;...
	MOVEI	T2,OPNBLK
	MOVE	T3,[XWD .RBTIM+1,LKPBLK]
	CALL	.STOPN##	;CONVERT THEM
	 STOPX$			;SNH
	MOVEI	T1,.IODMP	;MIGHT AS WELL
	MOVEM	T1,OPNBLK+.OPMOD
	SETZM	OPNBLK+.OPBUF	;NO BUFFERS
	OPEN	INPC,OPNBLK	;GET THE DEVICE
	 JRST	RDLSOE		;CAN'T OPEN IT!
	MOVEI	T1,.RBTIM
	MOVEM	T1,LKPBLK+.RBCNT;SET COUNT
	LOOKUP	INPC,LKPBLK	;FIND THE FILE
	 JRST	RDLSLE		;CAN'T
	RELEASE	INPC,		;DONE FOR NOW
RDLS.2:	MOVE	T1,-1(P3)	;GET THE FILENAME
	HLLZ	T2,(P3)		;AND THE EXTENSION
	MOVEI	T3,LSTPTR	;AND THE LIST TO ADD IT TO
	MOVE	B,P4		;SET FDB ADDR IN RH OF EXT WORD
	CALL	AD2LST		;ADD INTO LST
	AOS	FILCNT		;COUNT FILE
	POPJ	P,		;RETURN FOR NEXT FILE

RDLSOE:	MOVEI	T1,OFDB		;POINT AT FDB
	WARN.	EF$FIL,DOE,<DEVICE OPEN ERROR ON >
	AOS	NOFILR		;COUNT A REJECTED FILE
	POPJ	P,

RDLSLE:	RELEASE	INPC,		;CLOSE CHAN
	AOS	NOFILR		;COUNT REJECTED FILE
	MOVEI	T1,OPNBLK
	MOVEI	T2,LKPBLK
		X$$RLE=$POPJ	;JUST RETURN IF /MESSAGE:PREFIX
	WARN.	EF$LEB!EF$NCR,RLE,<REPLACE LOOKUP ERROR ON >
	STRNG$	< - >
	HRRZ	T1,LKPBLK+.RBEXT;GET CODE
	MOVE	T3,LKPBLK+.RBPRV;AND PRIV BITS
	CALL	.LKERR##	;REPORT WHY
	PJRST	.TCRLF##	;NEW LINE AND EXIT
SUBTTL	PROCESS DIRECT COMMAND

$DIREC:
	JUMPNU	E$$NUC		;MUST HAVE A USE COMMAND
	JUMPCR	E$$LIE		;ERROR IF CREATE
	CALL	.SAVE2##	;SAVE REGS
	AOS	(P)		;SET TO SKIP BACK SO SCAN DOESN'T STORE
	CALL	$GTIOL		;GET I/O LIST
	 CALL	SETDFD		;SETUP A WILD DUMMY IF NONE GIVEN
	TLO	F,FL$TYP	;ASSUME TYPING DIRECTORY ON TTY
	SKIPN	T1,OUTFDB	;WAS OUTPUT SPECIFIED?
	 JRST	LDIR.0		;NO--WE ARE TYPING
	  TLZ	F,FL$TYP	;YES--FLAG WE ARE LISTING DIRECTORY TO FILE
	HRLOI	T2,'DIR'	;SETUP DEFAULT EXTENSION
	MOVX	T3,FX.NUL	;GET NULL EXTENSION BIT
	TDNE	T3,.FXMOD(T1)	;WAS AN EXTENSION SPECIFIED?
	 MOVEM	T2,.FXEXT(T1)	;NO--USE DEFAULT
	CALL	OPENIO		;OPEN DISK FILE FOR DIRECTORY
	 CAI	OUTC,@OBHR(.IOASC) ;
	  JFCL			;OPENIO RETURNS +2
	CALL	GETNBF		;SETUP # BUFFERS
	MOVE	T2,[XWD OPNBLK,OBHR];...
	CALL	.ALCBF##	;ALLOCATE BUFFERS FOR OUTPUT
	MOVEI	T1,CHROUT	;NO--SETUP CHARACTER OUTPUT ROUTINE
	CALL	.TYOCH##	;...
	SAVE$	T1		;REMEMBER WHATEVER WAS THERE BEFORE
LDIR.0:	STRNG$	<DIRECTORY OF >
	MOVE	T1,LIBFDB	;TELL LIBRARY NAME
	CALL	.TFBLK##
	STRNG$	< BY LIBMAN %>
	MOVE	T1,.JBVER	;IDENTIFY MYSELF
	CALL	.TVERW##
	TLNE	F,FL$TYP	;OUTPUTTING TO TTY?
	 JRST	LDIR0A		;YES--DON'T OVERFLOW THE LINE
	STRNG$	< ON >		;AN EXTRA ADDED BONUS..
	 CALL	.TDATN##	;TELL THE DATE AND TIME
	STRNG$	< AT >
	CALL	.TTIMN##
LDIR0A:	CALL	.TCRLF##
	CALL	.TCRLF##	;A COUPLE OF LINES
	SETZB	P2,FILCNT	;CLEAR FILE COUNT (P2 = TOTAL # BLOCKS)
	MOVEI	T1,1		;USE ONE BUFFER AND..
	CALL	OLIBIN		;OPEN LIB FOR INPUT
	 PJRST	DIRDUN		;?? CAN'T
	MOVEI	B,1		;B=BLOCK COUNTER FOR USETI
LDIR.1:	CALL	XCTIO		;READ LIB BLK
	 IN	LIBC,
	 PJRST	DIRDUN		;EOF--CLEAN UP AND RETURN
	HRRZ	P1,IBHR+.BFPTR	;POINT AT LKPBLK IN BUFFER
	AOJ	P1,		;...
	MOVE	T1,.RBCNT(P1)	;GET THE COUNT
	 CAIE	T1,.RBTIM	;MUST BE THIS
	 JRST	E$$IFL		;**BAD LIBRARY FORMAT
	MOVE	T1,.RBNAM(P1)	;SEE IF THIS ONE IN LIST TO DO
	HLLZ	T2,.RBEXT(P1)
	CALL	MKLS.F		;LOOK THROUGH INPUT FDBS
	 JRST	LDIR.X		;NO--ADVANCE TO NEXT FILE
	AOS	FILCNT		;GOT ONE--COUNT FOR SUMMARY LINE
	MOVE	T1,.RBNAM(P1)	;GET FILENAME
	CALL	.TSIXN##	;OUTPUT IT
	CALL	.TTABC##	;TAB BETWEEN THE TWO
	HLLZ	T1,.RBEXT(P1)	;EXTENSION
	CALL	.TSIXN##
	CALL	.TTABC##	;AND A TAB
	MOVE	T1,.RBSIZ(P1)	;GET FILE SIZE
	ADDI	T1,177		;ROUND UP
	LSH	T1,-7		;CVT TO BLOKS
	ADD	P2,T1		;ACCUMULATE TOTAL BLOCKS
	CALL	.TDECW##	;TYPE IT
	CALL	.TTABC##	;SPACE OVER
	LDB	T1,[POINTR(.RBPRV(P1),RB.PRV)] ;GET PROT
	CALL	.TPRIV		;SEND IT
	CALL	.TTABC##	;ANOTHER TAB
	LDB	T1,[POINTR(.RBPRV(P1),RB.CRD)] ;GET LOW 12 CREATE BITS
	LDB	T2,[POINTR(.RBEXT(P1),RB.CRX)] ;AND HIGH 3
	LSH	T2,WID(RB.CRD)	;POSITION HIGH BITS
	TRO	T1,(T2)		;FORM 15 BIT DATE
	CALL	.TDATE##	;OUTPUT IT
	SKIPN	.RBVER(P1)	;IS THERE A VERSION?
	 JRST	LDIR.9		;NO
	CALL	.TTABC##	;YES--MAKE ROOM FOR IT
	MOVE	T1,.RBVER(P1)	;GET THE VERSION
	CALL	.TVERW##	;OUTPUT IT
LDIR.9:	CALL	.TCRLF##	;NEW LINE
LDIR.X:	MOVE	T1,.RBSIZ(P1)	;GET SIZE OF FILE
	SUBI	T1,1		;WORDS-1 SO EVEN BLOCKS WORK RIGHT
	LSH	T1,-7		;CVT TO BLKS-1
	ADDI	B,2(T1)		;POSITION TO READ (POSSIBLE) NEXT LKPBLK
	USETI	LIBC,(B)	;...
	JRST	LDIR.1		;GO DO IT

;HERE WHEN DONE WITH DIRECTORY

DIRDUN:	CALL	ILBCLS		;CLOSE OUT LIBRARY
	CALL	GIVIOL		;GIVE BACK I/O LISTS
	SKIPG	FILCNT		;DID WE FIND ANY FILES?
	 JRST	DIRD.2		;NO--SKIP THE MESSAGE
	STRNG$	<
TOTAL OF >
	MOVE	T1,P2		;GET TOTAL # OF BLOCKS
	CALL	.TDECW##
	STRNG$	< BLOCKS IN >
	MOVE	T1,FILCNT
	CALL	.TDECW##
	MOVEI	T1,[ASCIZ/ FILE/] ;START PART OF FILES MESSAGE
	CALL	.TSTRG##
	MOVEI	T1,"S"		;SET IF MULTIPLE FILES
	SOSE	FILCNT
	CALL	.TCHAR##	;MULTIPLE FILES--TYPE AN S
	CALL	.TCRLF##
DIRD.2:	TLZE	F,FL$TYP	;WERE WE TYPEING OR LISTING
	 POPJ	P,		;TYPEING--WE ARE DONE
	CALL	DSKOCL		;LISTING--CLOSE DISK FILE
	RESTR$	T1		;GET OLD SCAN TYPEOUT
	PJRST	.TYOCH##	;RESTORE AND RETURN

;SETDFD -- SETUP DUMMY FDB WITH *.* IN IT

SETDFD:	CALL	$GTFDB		;GET AN FDB
	MOVE	L,T1		;POSITION PTR
	MOVSI	T1,'*  '	;SETUP *.*
	HLLZM	T1,.FXNAM(L)
	HLLZM	T1,.FXEXT(L)	;
	POPJ	P,
SUBTTL	PROCESS DVERSION COMMAND (CHANGE DISK FILE VERSIONS)

$DVERS:	CALL	.SAVE2##	;PRESERVE P1-2
	AOS	(P)		;SO SCAN DOESN'T WIPE REGISTER ZERO
	CALL	$GTLST		;GET LIST OF DISK FILES
	 JRST	E$$NFS		;MUST GOTTA HAVE A FILE LIST
	MOVE	P1,L		;MAKE A DESTRUCTIBLE COPY OF LIST
	SETZB	P2,NOFILR	;CLEAR COUNT OF FILES RENAMED AND REJECTED
	STRNG$	<DISK FILES RENAMED:
>
DVER.2:	SETZM	WLDPTR		;CLEAR TEMP STORE
DVER.4:	HRRZM	P1,WLDFIR	;SET PTR FOR .LKWLD
	MOVE	T1,LKWLDB	;SETUP FOR .LKWLD
	CALL	.LKWLD##	;FIND NEXT FILE TO RENAME
	 JRST	DVER.6		;WILD SAYS NO MORE
	OPEN	INPC,DSKOPN	;OPEN THE DEVICE
	 JRST	DVROPE		;CAN'T--IGNORE THIS ONE
	LOOKUP	INPC,DSKLKP	;FIND THE FILE
	 JRST	DVRLKE		;CAN'T
	MOVE	T1,.FXVER(P1)	;GET /VERSION
	CAME	T1,[EXP -1]	;SEE IF SPECIFIED
	 MOVEM	T1,DSKLKP+.RBVER;YES--SET FOR RENAME
	LDB	T1,[POINTR(.FXMOD(P1),FX.PRO)] ;GET /PROTECTION
	SKIPE	T1		;SEE IF SPECIFIED
	DPB	T1,[POINTR(DSKLKP+.RBPRV,RB.PRV)] ;YES--SET FOR RENAME
	RENAME	INPC,DSKLKP	;RENAME THE FILE
	 JRST	DVRNME		;TELL OF FAILURE
	MOVEI	T1,DSKOPN	;SETUP TO TYPE FILE SPEC
	MOVEI	T2,DSKLKP
	CALL	$TLBVP		;TYPE LOOKUP BLOCK, VERSION AND PROTECTION
	CALL	.TCRLF##	;KEEP LISTING PRETTY
	ADDI	P2,1		;COUNT FILE AS DONE
DVER.5:	RELEASE	INPC,		;CLOSE CHANNEL
	JRST	DVER.4		;GET NEXT FILE

;WILD SAYS NO MORE IN THIS FDB

DVER.6:	HRRZ	P1,-1(P1)	;LINK TO NEXT FDB
	JUMPN	P1,DVER.2	;GO IF MORE
	SKIPN	P2		;DID WE DO ANYTHING?
	CALL	WRNOFM		;TELL IF DIDN'T FIND ANYTHING
	MOVE	T1,L		;GIVE UP FDB LIST
	PJRST	GIVLST		;AND RETURN
;DVERSION ERRORS

DVROPE:	CALL	E.DFO##		;REPORT OPEN ERROR ON DEVICE
	AOS	NOFILR		;COUNT REJECTED FILE
	JRST	DVER.5		;GET NEXT FILE TO DO

DVRLKE:	CALL	E.DFL##		;REPORT LOOKUP ERROR
	AOS	NOFILR		;COUNT REJECTED FILE
	 JRST	DVER.5		;GET NEXT FILE

DVRNME:	WARN.	EF$NCR,FRE,<FILE RENAME ERROR ON >
	MOVEI	T1,DSKOPN	;SET TO TYPE OUT FILE.EXT
	MOVEI	T2,DSKLKP	;...
	CALL	.TOLEB##	;TYPE FILE NAME
	CALL	.TSPAC##	;SEND A SPACE
	HRRZ	T1,DSKLKP+.RBEXT;GET CODE
	MOVE	T3,DSKLKP+.RBPRV;AND PROT BITS
	CALL	.LKERR##	;TELL THE FAILURE
	CALL	.TCRLF##	;NEW LINE
X$$FRE:	AOS	NOFILR		;COUNT REJECTED FILE
	JRST	DVER.5		;NEXT FILE
SUBTTL	FILDIR COMMAND -- GET A DISK DIRECTORY

$FILDIR:CALL	.SAVE2##	;PROTECT REGISTERS
	STORE	T1,DIRECT,DIRECT+LN$DRB-1,0 ;CLEAR BUFFER
	MOVE	T1,[ASCIZ/TTY:=/] ;OUTPUT WILL BE TO TTY
	MOVEM	T1,DIRECT	;START THE TMPFILE
	MOVEI	T1,[IDPB T1,P1	;SETUP ROUTINE FOR SCAN TYPEOUT
		   POPJ  P,]	;FOR TYPING META-SYMBOLS
	CALL	.TYOCH##	;SETUP NOW
	SAVE$	T1		;REMEMBER OLD ROUTINE
	MOVE	P1,[POINT 7,DIRECT+1] ;SETUP TO STORE CHARACTERS
	JUMPLE	C,FILD.2	;JUMP IF AT EOL ALREADY
FILD.0:	CALL	.TIAUC##	;ELSE GET A CHARACTER
	JUMPLE	C,FILD.2	;JUMP IF EOL
	CAIGE	C,4000		;SEE IF GUIDE WORD
	JRST	FILD.1		;NO--JUST STORE IN BUFFER
	MOVE	T1,C		;YES--POSITION
	CALL	.TFCHR##	;TYPE GUIDE WORD INTO BUFFER
	JRST	FILD.0		;GO GET NEXT THING
FILD.1:	IDPB	C,P1		;NO--STORE IN TMPFILE BUFFER
	JRST	FILD.0		;LOOP TO EOL

;HERE AT END OF COMMAND LINE

FILD.2:	JSP	T2,RUNSTR	;ADD REST OF MESSAGE + CRLF
	ASCIZ	./RUN:LIBMAN/RUNOFF:0
.
	RESTR$	T1		;GET OLD SCAN TYPEOUT BACK
	CALL	.TYOCH##	;AND SETUP NOW
	OPEN	TMPC,[EXP .IODMP,'DSK   ',0] ;GET THE DISK IN DUMP MODE
	 JRST	E$$CWT		;CAN'T??
	CALL	MAKCCL		;MAKE NNNLIB
	HRRI	T1,'DIR'	;ONLY WE WANT DIR HERE
	MOVSI	T2,'TMP'	;NNNDIR.TMP
	SETZB	T3,T4		;WITH DEFAULT EVERYTHING
	ENTER	TMPC,T1		;WRITE THE FILE
	 JRST	E$$CWT		;CAN'T SAY WE DIDN'T TRY!
	MOVEI	T1,DIRECT	;BEGIN TO FORM IOWD
	SUBI	T1,1(P1)	;THIS GETS NEGATIVE # WORDS TO WRITE
	HRLZS	T1		;TO LH
	HRRI	T1,DIRECT-1	;IOWD IS COMPLETE
	SETZ	T2,		;TERMINATE I/O LIST
	OUTPUT	TMPC,T1		;WRITE THE TMPFILE NOW
	CLOSE	TMPC,		;CLOSE CHANNEL
	STATZ	TMPC,IO.ERR	;CHECK FOR ERRORS
	 JRST	E$$CWT		;SO NEAR AND YET SO FAR
	RELEASE	TMPC,		;FREE UP CHANNEL
	SKIPE	LIBFDB		;DO WE HAVE A LIBRARY FDB?
	 SKIPLE	S.REML		;YES AND WAS IT /NOREMEMBER?
	  SKIPA			;NO LIBRARY FDB OR /REMEMBER
	    CALL SAVF.0		;NEED TO REMEMBER LIBRARY FDB
	MOVE	T1,[XWD FW$RNL,DIRECT] ;SETUP TO BLT CODE TO LOWSEG
	BLT	T1,DIRECT+LN$RNL;MOVE IT ALL
	JRST	DIRECT		;GO DO THE RUN

FW$RNL:	;CODE BLT'D TO LOWSEG STARTS HERE
	MOVSI	T1,1		;SETUP TO REMOVE HIGH SEGMENT
	CORE	T1,		;TELL MON
	 JFCL			; (IGNORE ERROR)
	SKIPA	T3,DIRECT+.-FW$RNL+1 ;SETUP PGM NAME TO RUN
	 SIXBIT	/DIRECT/
RNLRUN==.-FW$RNL
	SETZB	T4,P1		;CLEAR REST OF BLOCK
	SETZB	P2,P3		;...
	MOVSI	T1,1		;RUN AT CCL ENTRY
	HRRI	T1,T2		;POINT AT ARGBLOCK
	MOVSI	T2,'SYS'	;SETUP DEVICE
	 RUN	T1,		;GO TO OTHER PROGRAM
	  AOSE	DIRECT+RUNFLG	;CAN'T FIND IT--SEE IF DIRECT OR LIBMAN
	   EXIT			;LIBMAN!!!--JUST EXIT
	SKIPA	T3,DIRECT+.-FW$RNL+1	;DIRECT--LOAD UP TO RUN LIBMAN
	 SIXBIT	/LIBMAN/
	JRST	DIRECT+RNLRUN
RUNFLG==.-FW$RNL		;OFFSET FOR FLAG
	EXP	-1		;WILL GET SET TO 0 IN LOWSEG IF CAN'T FIND DIRECT
LN$RNL==.-FW$RNL

;HERE IF WE CAN'T WRITE TMPFILE

E$$CWT:	ERROR.	EF$ERR,CWT,<CAN'T WRITE TMPFILE FOR DIRECT>
	RELEASE	TMPC,		;NEVER KNOW WHERE WE WERE IN PROCESS
	JRST	$POPJ1		;SKIP BACK SO SCAN DOESN'T ZAP FLAG REGISTER

;RUNSTR -- SET STRING INTO BUFFER
;CALL:	MOVE	P1,BYTPTR
;	JSP	T2,RUNSTR
;	ASCIZ	/MES/

RUNSTR:	HRLI	T2,(POINT 7)	;MAKE A PTR
RUNS.0:	ILDB	T1,T2		;GET NEXT CHAR
	JUMPE	T1,1(T2)	;RETURN IF END
	IDPB	T1,P1		;NO--STORE IN BUFFER
	JRST	RUNS.0		;AND LOOP

;MAKCCL -- RETURN NNNLIB IN T1
;CALL:	CALL	MAKCCL
;	*HERE WITH NNNLIB IN T1*

MAKCCL:	SKIPE	T1,CCLNAM	;DO WE HAVE IT ALREADY?
	 POPJ	P,		;YES--GIVE IT TO THEM
	PJOB	T1,		;NO--MAKE IT NOW
	CALL	.MKPJN##
	HRLZ	T1,T1		;POSITION NNN TO LH
	HRRI	T1,MY$PFX	;ADD IN THE PREFIX
	MOVEM	T1,CCLNAM	;SAVE IN CASE WE NEED IT AGAIN
	POPJ	P,		;RETURN
SUBTTL	PROCESS ONEOUT COMMAND

$ONEOU:
	JUMPNU	E$$NUC		;NEED A LIBRARY
	JUMPCR	E$$LIE		;WHICH ALREADY EXISTS
	CALL	.SAVE2##	;PRESERVE P1-2
	AOS	(P)		;SKIP BACK
	TLO	F,FL$ONE	;FLAG THIS IS ONEOUT COMMAND
	TLZ	F,FL$TYP	;AND NOT TYPE (COULD HAVE BEEN ON)
	CALL	$GTIOL		;GET THE I/O LIST
	 JRST	E$$NFS		;NO FILES SPECIFIED
	CALL	CKOFDB		;MAKE SURE WE HAVE AN OUTPUT SPEC
	MOVE	T2,.FXDEV(T1)	;SEE WHAT THE THING IS
	DEVCHR	T2,
	TRNN	T2,DV.M13	;CAN IT DO BINARY I/O?
	 JRST	ONECDB		;NO--QUIT BEFORE ILL DATA MODE
	CALL	$GTDIR		;MAKE SURE WE HAVE AN INCORE DIR
	CALL	GETNBF		;SETUP # BUFFERS
	MOVSS	T1		;POSITION
	CALL	OLIBIN		;OPEN IT
	 JRST	[ERROR. (EF$ERR,CFL,<CAN'T FIND LIBRARY>) ;???
		PJRST ONEO.X]	;CLEAN UP AND GET OUT
	MOVE	T1,OUTFDB	;SETUP TO OPEN OUTPUT FILE
	CALL	OPENIO		;DO IT NOW
	CAI	OUTC,@OBHR(.IOBIN) ;IN BINARY, OK?
	JFCL			;OPENIO RETURNS CPOPJ2
	CALL	GETNBF		;SETUP # BUFFERS
	MOVE	T2,[XWD OPNBLK,OBHR] ;
	CALL	.ALCBF##	;ALLOCATE THE BUFFERS
	OUTPUT	OUTC,		;DO A DUMMY OUTPUT TO SETUP OBHR
	SETZM	FILCNT		;CLEAR THE COUNT
	SETZM	NOFILR		;CLEAR REJECTED FILE COUNT
	CALL	$MKLST		;DO THE THING ON EACH FILE IN LIST
	 CALL	CPYTYF		;XCT'D BY $MKLST
	SKIPN	FILCNT		;DO ANYTHING?
	 CALL	WRNOFM		;NO FILES MATCH
ONEO.X:	CALL	GIVIOL		;GIVE BACK LISTS
	CALL	DSKOCL		;CLOSE OUTPUT FILE
	PJRST	ILBCLS		;CLOSE LIB AND RETURN

ONECDB:	ERROR.	EF$FIL,CDB,<CAN'T DO BINARY I/O TO >
	PJRST	GIVIOL		;EXIT
SUBTTL	PROCESS RENAME COMMAND

$RENAM:
	JUMPNU	E$$NUC		;JUMP IF NO USE COMMAND
	JMPRDO	E$$IRO		;CAN'T DO THIS IF READ ONLY
	JUMPCR	E$$LIE		;MUST HAVE A FILE IN THE LIBRARY!
	CALL	.SAVE1##	;PRESERVE REGS
	AOS	(P)		;SET TO SKIP SO SCAN DOESN'T STORE
	CALL	$GTIOL		;GET I/O LIST
	 JRST	E$$NFS		;NULL LIST
	JUMPE	L,E$$NFS	;NEED INPUT SIDE
	CALL	CKOFDB		;MAKE SURE OUTPUT FDB IS PRESENT
	CALL	$GTDIR		;ENSURE WE HAVE A DIRECTORY IN CORE
	SETO	T1,		;FLAG TO UPDATE, NOT APPEND
	CALL	OLIBUP		;...
	SETZM	FILCNT		;CLEAR FLAG OF FILES DONE
	SETZM	NOFILR		;CLEAR COUNT OF REJECTED FILES
	STRNG$	<FILES RENAMED:
>
	CALL	$MKLST		;WHIP THROUGH THE DIR AND CHANGE THE FILES
	 CALL	RENSUB		;BY EXECUTING THIS INSTR
	CALL	OLBCLS		;ALL DONE--CLOSE OUT THE LIBRARY
	MOVEI	T1,IBHR		;WE SHOULD FREE UP INPUT BUFFER ALSO
	CALL	TSTBHR		;...
	SKIPN	FILCNT		;SEE IF WE DID ANYTHING
	CALL	WRNOFM		;NO FILES MATCHED
	PJRST	GIVIOL		;FREE I/O FDBS AND RETURN
;ROUTINE CALLED BY $MKLST FOR EACH ITEM IN DICT THAT MATCHES INPUT
;SPEC.

RENSUB:	CALL	.SAVE2##	;PRESERVE P1-2
	MOVE	T4,OUTFDB	;POINT T4 AT OUTPUT FDB
	HRRZ	B,(P3)		;GET BLOCK # OF LKPBLK IN FILE
	USETI	LIBC,(B)	;SET TO READ IT
	CALL	XCTIO		;READ THE LKPBLK
	 IN	LIBC,
	 POPJ	P,		;QUIT EARLY IF BAD (SHOULD HAVE BEEN CAUGHT)
	HRRZ	P1,IBHR+.BFPTR	;GET INPUT BUFFER PTR
	MOVSI	T1,(P1)		;BEGIN TO FORM BLT WORD AT SAME TIME
	AOJ	P1,		;NOW POINT AT LKPBLK
	HRR	T1,OBHR+.BFPTR	;WORK ON CTL WORD SOME MORE
	AOBJP	T1,.+1		;...
	HRRZ	P2,T1		;POINT AT OUTPUT BUFFER
	MOVEI	T2,177(T1)	;SETUP TO COPY LKPBLK TO OUTPUT BUFFER
	BLT	T1,(T2)		;THERE IT GOES
	MOVE	T3,.RBNAM(P1)	;GET INPUT NAME
	TDZ	T3,.FXNMM(T4)	;CLEAR WHAT WAS SPECIFIED IN OUTPUT
	MOVE	T2,.FXNAM(T4)	;GET OUTPUT NAME
	AND	T2,.FXNMM(T4)	;ELIMINATE WILD CARDS
	XOR	T3,T2		;MAKE NEW FILENAME
	MOVEM	T3,.RBNAM(P2)	;STORE IN NEW LKPBLK
	HLLZ	T3,.RBEXT(P1)	;GET INPUT EXTENSION
	MOVE	T2,.FXEXT(T4)	;AND GET OUTPUT EXTENSION,,MASK
	TLZ	T3,(T2)		;CLEAR WHAT SHOULD BE CLEARED
	MOVSS	T2		;SWAP HALVES
	HLRZ	T1,T2		;GET EXT MASK
	ANDI	T2,(T1)		;ELIMINATE WILD CARDS
	TLO	T3,(T2)		;AND SET WHAT SHOULD BE SET
	MOVX	T1,FX.NUL	;GET THE NULL EXTENSION FLAG
	TDNE	T1,.FXMOD(T4)	;SEE IF EXPLICITLY NULL EXTENSION
	 SETZ	T3,		;YES--MAKE IT SO
	HLLM	T3,.FXEXT(P2)	;IMPROVE OUTPUT LKPBLK
	MOVE	T1,.RBNAM(P2)	;GET FILENAME WE WILL USE
	HLLZ	T2,.RBEXT(P2)	;AND EXTENSION
	CALL	IFNDIR		;SEE IF IN DIRECTORY
	 JRST	RENPRO		;NOT IN DIR
	CAIE	T3,(P3)		;THERE--ARE WE RENAMING TO SELF?
	 JRST	E$$RFE		;NO--RENAME FILE ALREADY EXISTS
RENPRO:	MOVE	T1,.RBNAM(P2)	;OK--UPDATE INCORE DIR
	MOVEM	T1,-1(P3)	;...
	HLLZ	T1,.RBEXT(P2)	;...
	HLLM	T1,(P3)		;...
	MOVE	T4,OUTFDB	;RESET T4 TO POINT AT OUTFDB
	LDB	T1,[POINTR(.FXMOD(T4),FX.PRO)] ;GET /PROT VALUE
	 SKIPE	T1		;UNLESS NOT GIVEN
	DPB	T1,[POINTR(.RBPRV(P2),RB.PRV)] ;AND SET IN
RENVER:	MOVE	T1,.FXVER(T4)	;GET /VERSION FROM OUTPUT FDB
	CAME	T1,[EXP -1]	;WAS IT DEFAULT?
	 MOVEM	T1,.RBVER(P2)	;NO--SET IN LKPBLK
	PUSH	P,.RBVER(P2)	;SAVE NEW VERSION ON PDL
	PUSH	P,.RBPRV(P2)	;AND NEW PRIV WORD
	PUSH	P,.RBEXT(P2)	;SAVE NEW EXT ON PDL
	PUSH	P,.RBNAM(P2)	;AND NEW FILENAME ALSO
	MOVE	T1,OBHR+.BFCTR	;GET THE COUNTER
	SETZM	OBHR+.BFCTR	;AND ZERO IT
	ADDM	T1,OBHR+.BFPTR	;AND UPDATE PTR SO MON WILL WRITE BUF
	USETO	LIBC,(B)	;PREPARE TO WRITE THE BLOCK
	CALL	XCTIO		;WRITE THE NEW LKPBLK TO LIBRARY
	 OUT	LIBC,		;XCT'D
	 STOPX$			;***
	AOS	FILCNT		;COUNT THE THING AS DONE
	MOVE	T1,.RBNAM(P1)	;GET OLD NAME
	CALL	.TSIXN##	;TYPE IT
	CALL	.TDOT
	HLLZ	T1,.RBEXT(P1)	;GET EXTENSION
	CALL	.TSIXN##
	LDB	T1,[POINTR(.RBPRV(P1),RB.PRV)] ;GET PROT BITS
	CALL	$TPROT		;TYPE /PROTECT:OOO
	MOVE	T1,.RBVER(P1)	;GET VERSION
	CALL	$TVRSN		;TYPE /VERSION:V
	MOVSI	T1,'=> '	;POINT TO NEW NAME
	CALL	.TSIXN##
	POP	P,T1		;GET NEW NAME BACK
	CALL	.TSIXN##
	CALL	.TDOT
	POP	P,T1		;GET EXTENSION BACK
	HLLZS	T1		;CLEAR ANY RH STUFF
	CALL	.TSIXN##
	POP	P,T1		;GET PRIV WORD BACK
	LDB	T1,[POINTR(T1,RB.PRV)] ;GET PRIV BITS
	CALL	$TPROT		;TYPE /PROT
	POP	P,T1		;GET VERSION BACK
	CALL	$TVRSN		;AND TYPE IT
	CALL	.TCRLF##	;NEW LINE
	POPJ	P,		;RETURN TO GET NEXT FILE
E$$RFE:	WARN.	EF$SIX!EF$NCR,RFE,<RENAME FILE EXISTS - >
	MOVEI	T1,"."		;GET A DOT
	CALL	.TCHAR##
	HLLZ	T1,T2		;AND EXTENSION
	CALL	.TSIXN##	;SEND IT
	STRNG$	< - IGNORING
>
X$$RFE:	AOS	NOFILR		;COUNT REJECTED FILE
	POPJ	P,
SUBTTL	PROCESS USE COMMAND

$READ:	TLO	F,FL$TYP!FL$RDO	;FLAG USE AND READ ONLY
	JRST	USE.0		;SKIP AHEAD
$CREATE:TLZA	F,FL$TYP	;FLAG CREATE
$USE:	TLO	F,FL$TYP	;FLAG USE
	TLZ	F,FL$RDO	;NOT READ-ONLY
USE.0:	CALL	CRUCLN		;CLEAN UP FROM LAST LIB
	JUMPLE	C,E$$NFS	;NEED A SPEC
	CALL	.SAVE2##	;PRESERVE REGS
	AOS	(P)		;SKIP BACK SO SCAN DOESN'T STORE
	CALL	$GTSPC		;GET A FILE SPEC FOR LIB FILE
E$$NFS:	FATAL.	0,NFS,<NO FILE SPECIFIED IN COMMAND>
	MOVEM	T1,LIBFDB	;REMEMBER WHERE IT IS
	HRLOI	T2,DF$EXT	;IN CASE NO EXT TYPED
	SKIPN	.FXEXT(T1)	;WAS ONE SPECIFIED?
	 MOVEM	T2,.FXEXT(T1)	;NO--USE THIS ONE
	MOVE	T2,.FXDEV(T1)	;GET DEV NAME
	DEVCHR	T2,		;SEE WHAT IT IS
	TLNN	T2,(DV.DSK)	;MUST BE DISK
;	 TLNE	F,FL$RDO	;UNLESS READ ONLY
;	  SKIPA			;DISK OR READ ONLY ON NON-DISK
	  JRST	E$$BDL		;**BAD DEV FOR LIBRARY
	CALL	OPENIO		;OPEN LIB TO SEE IF IT LIVES
	CAI	LIBC,0(.IOBIN)	;DON'T BOTHER WITH BUFFERS
	 JRST	CRECHK		;NOT THERE--ONLY COMPLAIN IF NOT CREATE
	MOVE	T1,LIBFDB	;IT LIVES--SETUP IN CASE CREATE AND NOT USE
	TLNN	F,FL$TYP	;CREATE?
	 WARN.	EF$FIL,LAE,<LIBRARY ALREADY EXISTS >
	TLOA	F,FL$LIB	;FLAG WE HAVE A LIBRARY
USE.1:	TLO	F,FL$LIB!FL$CRE	;FLAG LIBRARY BEING  CREATED
	TLNE	F,FL$RDO	;IS THIS READ ONLY?
	 POPJ	P,		;YES--DON'T CHECK WRITE PRIVS
	MOVSI	T2,.ACWRI	;CHECK PRIVS TO SEE IF WE CAN WRITE LIB
	LDB	T1,[POINTR(LKPBLK+.RBPRV,RB.PRV)] ;GET PROT OF FILE
	SKIPN	T1		;GET A PROT?
	 MOVEI	T1,155		;NO--USE THIS
	OR	T2,T1		;FOR CHKACC
	MOVE	T3,LKPBLK+.RBPPN;PPN WHERE FILE WAS FOUND
	MOVE	T4,.MYPPN##	;AND MY PPN
	MOVEI	T1,T2		;POINT FOR TONY
	CHKACC	T1,		;SEE WHAT THE SCOOP IS
	 JRST	SAVFDU		;ASSUME OK IF NOT IMPLEMENTED
	JUMPE	T1,SAVFDU	;JUMP IF CAN WRITE IT
E$$CWL:	MOVE	T1,LIBFDB	;CAN'T--GET FDB ADDR
	ERROR.	EF$ERR!EF$FIL,CWL,<CAN'T WRITE LIBRARY >
	PJRST	CRUCLN		;CLEAN UP AND RETURN

;HERE TO SAVE LIBFDB ON DISK IF USE OR CREATE COMMAND

SAVFDU:	SKIPG	S.REML		;ARE WE TO REMEMBER LIBRARY?
	 POPJ	P,		;NO--SAID SPECIFICALLY NOREMEMBER
SAVF.0:	OPEN	TMPC,[EXP .IODMP,'DSK   ',0] ;GET DISK IN DUMP MODE
	 POPJ	P,		;GIVE UP EARLY IF CAN'T
	CALL	MAKCCL		;GET NNNLIB
	HRRI	T1,'LRL'	;LIBMAN REMEMBER LIBRARY FILE
	MOVSI	T2,'TMP'	;EXT
	SETZB	T3,T4		;CLEAR REST
	ENTER	TMPC,T1		;PREPARE TO WRT
	 JRST	SAVF.X		;CAN'T--GO QUIT
	MOVSI	T1,-.FXLEN	;START IOWD
	HRR	T1,LIBFDB	;COMPLETE IT
	HRRI	T1,-1(T1)	;IOWDS GO TO N,,LOC-1
	SETZ	T2,		;TERMINATE I/O LIST
	OUTPUT	TMPC,T1		;WRITE THE FDB OUT
	CLOSE	TMPC,		;CLOSE FILE
SAVF.X:	RELEASE	TMPC,		;FREE CHANNEL
	POPJ	P,		;DONE
;HERE IF FILE NOT FOUND

CRECHK:	TLNN	F,FL$TYP	;SEE IF CREATE OR USE
	 JRST	USE.1		;CREATE--DON'T MOAN
	MOVE	T1,LIBFDB	;GET FDB
	TLNE	F,FL$RDO	;IS THIS READ ONLY?
	 JRST	[HRLZ	P1,LIBFDB ;YES--SETUP
		PJRST	LKENER]	;AND GO DIE
	WARN.	EF$FIL,CRE,<FILE NOT FOUND - ASSUME CREATING >
	JRST	USE.1		;GO SEE IF WE CAN WRITE IT
E$$BDL:	ERROR.	EF$ERR,BDL,<BAD DEVICE FOR LIBRARY OR NOT READING>
;	PJRST	CRUCLN		;CLEAN UP AND RETURN

;CRUCLN -- CLEAN UP FROM LAST LIBRARY

CRUCLN:	TLZ	F,FL$LIB!FL$CRE	;ZERO THE FLAGS THAT A LIB EXISTS
	SKIPE	T1,LIBFDB	;WAS THERE AN FDB?
	 CALL	.DECOR##	;YES--MAKE IT GO AWAY
	SETZM	LIBFDB		;MAKE SURE NOT THERE ANY MORE
ZAPDIR:	SKIPE	T1,DIRPTR	;WAS THERE A DIRECTORY?
	CALL	GIVLST		;YES--GIVE IT UP
	SETZM	DIRPTR		;NOT ANYMORE
	POPJ	P,		;DONE
SUBTTL	SUBROUTINES--READ LIBRARY FILE AND CREATE INCORE DIRECTORY

;$GTDIR -- CREATE IN-CORE DIRECTORY
;CALL:	CALL	$GTDIR
;	*ONLY RETURN--DIR SETUP IF POSSIBLE*

$GTDIR:	JUMPCR	$POPJ		;JUMP IF CREATE
	SKIPE	DIRPTR		;ALREADY HAVE A DIR?
	 POPJ	P,		;YES--DON'T READ IT AGAIN
	CALL	.SAVE3##
	MOVEI	T1,1		;USE ONE BUFFER
	CALL	OLIBIN		;OPEN LIB FOR INPUT
	 POPJ	P,		;NO LIB--NO DIR
	CALL	GDIR.8		;INITIALIZE
	MOVEI	P2,.RBTIM	;FOR CHECKING LIBRARY CORRECTNESS
	MOVEI	B,1		;B IS THE BLOCK PTR FOR USETIS
GDIR.0:	CALL	XCTIO		;READ BLOCK
	 IN	LIBC,
	  JRST	GDIR.9		;DONE
	MOVE	P3,IBHR+.BFPTR	;POINT TO DIR IN BUFFER (LOOKUP BLOCK)
	AOJ	P3,		;REALLY POINT AT IT
	CAME	P2,.RBCNT(P3)	;IS THIS REALLY A RIB?
	 JRST	E$$IFL		;NO--GO DIE
GDIR.1:	AOBJP	P1,GDIR.5	;NEXT ENTRY IN DIR BLOCK--JUMP IF FULL
	MOVE	T1,.RBNAM(P3)	;GET FILENXME
	MOVEM	T1,(P1)		;STORE IT
	AOBJP	P1,.+1		;ADVANCE
	HLLZ	T1,.RBEXT(P3)	;GET EXTENSION
	HRRI	T1,(B)		;SET BLOCK # IN RH
	MOVEM	T1,(P1)		;STORE IN DIR
	MOVE	T1,.RBSIZ(P3)	;FILE SIZE IN WORDS
	SUBI	T1,1		;SO ALL WILL BE WELL
	LSH	T1,-7		;CONVERT TO BLOCKS-1
	ADDI	B,2(T1)		;POSITION TO NEXT LKPBLK IN LIBRARY
	USETI	LIBC,(B)	;...
	JRST	GDIR.0		;GO READ NEXT FILE IN LIBRARY

;HERE WHEN WE NEED ANOTHER BLOCK--THIS ONE IS FULL

GDIR.5:	CALL	GDIR.6		;GET IT
	JRST	GDIR.1		;CONTINUE

;HERE IF LIBRARY IS NOT REALLY A LIBRARY

E$$IFL:	CALL	CRUCLN		;ENSURE NO LIBRARY
	CALL	ILBCLS		;CLOSE OUT NON-LIBRARY FILE
	MOVE	T1,B		;GET BLOCK #
	FATAL.	EF$DEC,IFL,<INCORRECTLY FORMATTED LIBRARY AT BLOCK >
;CALL HERE TO COPY DIRECT OUT TO CORE BLOCKS

GDIR.6:	MOVEI	T1,LN$DRB	;SIZE OF BLOCK
	CALL	.ALCOR##	;GET IT
	MOVSI	T2,DIRECT	;FORM CTL WORD
	HRRI	T2,(T1)		;...
	BLT	T2,LN$DRB-1(T1)	;ZIP DIR OUT TO IT
	MOVEI	T2,DIRPTR	;SETUP TO LINK
	CALL	LNKATN		;DO THE LINKING
GDIR.8:	STORE	T1,DIRECT,DIRECT+LN$DRB-1,0 ;ZERO DIRECT
	MOVSI	P1,-LN$DRB	;FORM AOBJ WORD
	HRRI	P1,DIRECT-1	;...
	POPJ	P,

;HERE WHEN WE HAVE READ THE WHOLE LIBRARY

GDIR.9:	CALL	ILBCLS		;CLOSE OUT LIBRARY
	SKIPN	DIRECT		;ANY NAMES LEFT OVER HERE?
	 POPJ	P,		;NO--ALL DONE
	PJRST	GDIR.6		;YES--COPY OUT AND RETURN

;OLIBIN -- OPEN LIB FOR INPUT
;CALL:	MOVEI	T1,<# BUFFERS>
;	CALL	OLIBIN
;	*FILE NOT FOUND*
;	*ALL IS WELL, BUFFERS SET UP*

OLIBIN:	SAVE$	T1		;REMEMBER # BUFFERS
	MOVE	T1,LIBFDB	;GET PTR TO FDB
	CALL	OPENIO		;LOOKUP DIR
	CAI	LIBC,IBHR(.IOBIN) ;
	 PJRST	TPOPJ		;NO LIB--NO DIR
	RESTR$	T1		;GET # BUFFERS BACK
	MOVSI	T1,(T1)		;SETUP # BUFFERS, DEFAULT SIZE
	MOVE	T2,[XWD OPNBLK,IBHR] ;
	AOS	(P)		;SET TO SKIP BACK
	PJRST	.ALCBF##	;ALLOCATE BUFFERS AND RETURN
SUBTTL	SUBROUTINES--MAKE LST FROM FILE LIST AND LIBRARY DIRECTORY

;$MKLST -- MAKE LST FROM USER'S LIST (INPUT) AND LIBRARY DIRECTORY
;CALL:	MOVEI	L,<FDBLST--USER'S LIST>
;	CALL	$MKLST
;	**ADDRESS OF ROUTINE TO CALL FOR EACH ITEM IN LST (I.E. COROUTINE)**
;	*RETURN*
;THE COROUTINE WILL BE CALLED WITH P3=PTR TO ENTRY IN INCORE DIR (EXT WORD)
;				   P4=PTR TO FDB WHICH MATCHES DIR ENTRY
;THE COROUTINE MUST NOT DESTROY P1-3; THE COROUTINE MAY USE P4

$MKLST:	MOVE	T1,0(P)		;REMEMBER WHERE INSTR IS
	CALL	.SAVE4##	;PRESERVE ACS
	AOS	0(P)		;SETUP TO SKIP BACK OVER INSTR AT END
	MOVE	P1,T1		;POINT AT LIST
	SKIPN	P2,DIRPTR	;GET DIR PTR
	JRST	E$$LDE		;WHAT CAN YOU DO IF NO DIR?

MKLS.0:	MOVEI	P3,-1(P2)	;POINT AT THE DIR BLK
	HRLI	P3,-LN$DRB	;...
MKLS.1:	AOBJP	P3,MKLS.3	;JUMP IF DONE WITH DIR BLK
	MOVE	T1,(P3)		;NO--GET A FILENAME
	AOBJP	P3,.+1		;INC TO EXT
	HLLZ	T2,(P3)		;AND PICK IT UP
	SKIPN	T1		;SEE IF NULL
	JUMPE	T2,MKLS.1	;YES--GET NEXT ENTRY (MAY HAVE BEEN DELETED)
	CALL	MKLS.F		;LOOK THRU FDBS FOR A MATCH
	 JRST	MKLS.1		;NONE HERE
	MOVE	P4,T4		;POSITION FDB ADDR
	PUSHJ	P,@(P1)		;CALL THE COROUTINE
	JRST	MKLS.1		;GET MORE LST ENTRIES
E$$LDE:	ERROR.	EF$ERR,LDE,<LIBRARY DIR EMPTY>
	POPJ	P,
;HERE AT END OF A DIR BLK

MKLS.3:	HRRZ	P2,-1(P2)	;LINK TO NEXT
	JUMPN	P2,MKLS.0	;GO IF MORE DIRS
	POPJ	P,		;NO--ALL DONE
;CALL HERE WITH FNAM.EXT IN T1.T2 AND L POINTING AT FDB CHAIN
;RETURN $POPJ1 IF WIN WITH T4 PTING AT FDB WHICH MATCHES
;RETURN $POPJ  IF LOOSE

MKLS.F:	SKIPN	T1		;DEFEND AGAINST DELETED FILES
	JUMPE	T2,$POPJ	;..
	SAVE$	<T1,T2>		;SAVE FNAM.EXT
	MOVE	T4,L		;GET PTR TO FDBS
MLSF.0:	MOVE	T2,-1(P)	;GET FILENAME
	HLLZ	T3,0(P)		;AND EXTENSION
	XOR	T2,.FXNAM(T4)	;COMPARE NAMES
	XOR	T3,.FXEXT(T4)	;AND EXTENSION + PICK UP EXT MASK
	TDNN	T2,.FXNMM(T4)	;CHECK NAME WITH MASK
	TLNE	T3,(T3)		;AND EXTENSION
	  SKIPA	T4,-1(T4)	;FAIL--ADVANCE TO NEXT FDB
	   JRST	[RESTR$	<T2,T1>	;WIN--RESTORE REGS
		JRST	$POPJ1]	;AND SKIP BACK
	HRRZS	T4		;CLEAR WORD COUNT
	JUMPN	T4,MLSF.0	;JUMP IF MORE FDBS
	RESTR$	<T2,T1>		;NO--RESTORE FILE.EXT
	POPJ	P,		;FAIL BACK

;$TPROT -- TYPE /PROTECT:OOO
;CALL:	MOVE	T1,<PROT BITS>
;	CALL	$TPROT
;ACS:T1-4

$TPROT:	PUSH	P,T1		;SAVE PROT
	STRNG$	</PROTECT:>
	POP	P,T2		;GET PROT BACK
	PJRST	TPRIV0		;GO TYPE PROTECTION AND RETURN

;$TVRSN -- TYPE /VESION:V
;CALL:	MOVE	T1,<VERSION>
;	CALL	$TVRSN
;WILL TYPE ONLY IF NON-ZERO

$TVRSN:	JUMPE	T1,$POPJ	;DON'T BOTHER IF ZERO
	PUSH	P,T1		;SAVE VERSION
	STRNG$	</VERSION:>
	POP	P,T1		;GET IT AGAIN
	PJRST	.TVERW##	;TYPE AND RETRN
SUBTTL	SUBROUTINES--SEE IF FILE IS IN LIBRARY

;IFNDIR -- SEE IF FILE IS IN LIBRARY
;CALL:	MOVE	T1,FILNAM
;	MOVE	T2,EXTNSN
;	CALL	IFNDIR
;	*NOT THERE*
;	*THERE--T3 POINTS AT EXTENSION OF ENTRY*
;ACS:	T1-2 INTACT; USES T3-4
;
;IFNLST -- SEE IF FILE IS IN A LIST
;CALL:	MOVE	T1,FILNAM
;	MOVE	T2,EXTNSN
;	MOVE	T3,<LIST HEAD ADDR>
;	CALL	IFNLST
;	*NOT IN LST*
;	*IN LST--T3 POINTS AT EXTENSION OF ENTRY*

IFNDIR:	SKIPN	T3,DIRPTR	;IS THERE A DIR?
	 POPJ	P,		;NO DIR--NOT IN FILE THEN
IFNLST:	CALL	.SAVE2##	;PRESERVE
	SKIPN	P1,T3		;COPY LST ADDR
	 POPJ	P,		;NO LST--CAN'T BE IN IT
IFND.0:	MOVEI	P2,(P1)		;POINT AT DIR
	HRLI	P2,-LN$DRB	;GET AN AOBJ WORD
IFND.1:	SKIPN	T3,(P2)		;CHECK END/PICK UP FILENAME
	 JRST	IFND.2		;COULD BE A DELETED FILE
	HLLZ	T4,1(P2)	;PICKUP EXTENSION (IGNORE RH)
	CAMN	T1,T3		;FILENAMES THE SAME?
	 CAME	T2,T4		;AND EXTENSIONS ALSO?
	  SKIPA			;NOT THE SAME
	 JRST	[MOVEI	T3,1(P2);YES--POSITION
		JRST	$POPJ1]	;AND SKIP BACK
IFND.2:	AOBJP	P2,.+1		;INC BY TWOS
	AOBJN	P2,IFND.1	;GO IF MORE IN THIS BLOCK
	HRRZ	P1,-1(P1)	;NO--LINK TO NEXT DIR BLOCK
	JUMPN	P1,IFND.0	;JUMP IF MORE
	POPJ	P,		;NO--NOT IN DIR

;CKOFDB -- SEE IF OUTFDB SETUP AND DO SO IF NOT
;CALL:	SETUP L,OUTFDB AS APPROPRIATE
;	CALL	CKOFDB
;	*RETURN--OUTFDB SETUP--T1 PTS AT OUTFDB ALSO*
;ACS: T1-2

CKOFDB:	SKIPE	T1,OUTFDB	;SEE IF ALREADY SET UP
	 TLOA	F,FL$OFG	;YES--FLAG AND SKIP
	  TLZA	F,FL$OFG	;NO--FLAG AND SKIP
	   POPJ	P,		;ALREADY SETUP--RETURN NOW
	MOVEI	T1,.FXLEN	;NO--GET CORE
	CALL	.ALCOR##	;
	MOVSI	T2,(L)		;COPY INPUT SPEC FOR OUTPUT
	HRRI	T2,(T1)		;....
	BLT	T2,.FXLEN-1(T1)	;MOVE SPEC OVER
	MOVEM	T1,OUTFDB	;SETUP OUTFDB
	POPJ	P,		;RETURN
;AD2DIR -- ADD FILE TO INCORE DIRECTORY
;CALL:	MOVE	T1,FILNAM
;	MOVE	T2,EXTNSN
;	MOVEI	B,<BLK # IN LIB>
;	CALL	AD2DIR
;ACS:	T1-4
;AD2LST -- ADD FILE TO A LIST
;CALL:	MOVE	T1,FILNAM
;	MOVE	T2,EXTNSN
;	MOVEI	T3,<LIST HEAD ADDR>
;	HRRZ	B,<INFO FOR RH OF EXTENSION WORD>
;	CALL	AD2LST

AD2DIR:	MOVEI	T3,DIRPTR	;POINT AT DIR LST
AD2LST:	 CALL	.SAVE2##	;PRESERVE
	SKIPN	P1,(T3)		;IS THERE A LST?
	 JRST	AD2D.3		;NO--GO START IT
AD2D.0:	HRRZ	P2,-1(P1)	;GET LINK TO NEXT DIR BLK OR 0
	JUMPN	P2,AD2D.2	;IF THERE IS ONE THEN SAVE SOME TIME
	MOVEI	P2,(P1)		;GET PTR
	HRLI	P2,-LN$DRB	;FORM AOBJ PTR
AD2D.1:	SKIPN	(P2)		;END OF DIR?
	 JRST	AD2D.4		;YES--GO PLUNK IN NAME
	AOBJP	P2,.+1		;BUMP PTR
	AOBJN	P2,AD2D.1	;BY TWOS
AD2D.2:	HRRZ	P1,-1(P1)	;MOVE TO NEXT DIR BLK
	JUMPN	P1,AD2D.0	;CHECK IT OUT

;HERE WHEN WE MUST GET ANOTHER BLOCK

AD2D.3:	SAVE$	<T2,T1>		;SAVE FILENAME.EXT
	MOVEI	T1,LN$DRB	;SIZE OF BLOCK
	CALL	.ALCOR##	;ALLOCATE A BLOCK
	RESTR$	<(T1)>		;PUT NAME IN
	RESTR$	<1(T1)>		;AND EXTENSION
	HRRM	B,1(T1)		;SET BLOCK # IN ALSO
	MOVEI	T2,(T3)		;SETUP 
	PJRST	LNKATN		;AND LINK AT END OF LIST

;HERE WHEN WE FOUND A FREE SLOT IN THIS DIR BLOCK

AD2D.4:	MOVEM	T1,(P2)		;STORE FILENAME
	MOVEM	T2,1(P2)	;AND EXTENSION
	HRRM	B,1(P2)		;SET BLOCK # IN
	POPJ	P,		;DONE
SUBTTL	SUBROUTINES--GET A FILE LIST

;$GTLST -- GET A FILE LIST INTO CORE BLOCKS
;CALL:	CALL	$GTLST
;	*RETURN IF NO FILES PRESENT*
;	*RETURN WITH L POINTING AT FDB CHAIN*

$GTLST:	PJUMPLE	C,$POPJ		;JUMP IF AT EOL
	SETZ	L,		;CLEAR LIST
GLST.0:	CALL	$GTSPC		;GET A SPEC
	 PJRST	[PJUMPN L,$POPJ1 ;NO MORE--POPJ1 IF GOT AT LEAST ONE
		POPJ	P,]	;NO--RETURN CPOPJ
GLST.1:	MOVEI	T2,L		;POINT T2 AT THE LIST HEAD
	CALL	LNKATN		;LINK THIS BLOCK AT END OF LIST
	JUMPG	C,GLST.0	;JUMP IF MORE FILES POSSIBLE
	JUMPN	L,$POPJ1	;JUMP IF WE FOUND A SPEC
	POPJ	P,		;ELSE POPJ BACK

;$GTIOL -- GET I/O LIST -- OUTPUT AND INPUT
;CALL:	CALL	$GTIOL
;	 *RETURN--NO FILESPECS PRESENT*
;	*RETURN--OUTFDB IS 0 OR POINTS AT FDB, L POINTS AT INPUT FDBS*

$GTIOL:	PJUMPLE	C,$POPJ		;JUMP IF AT EOL
	SKIPE	T1,OUTFDB	;IF THERE IS AN FDB
	CALL	.DECOR##	;FREE IT UP
	SETZB	L,OUTFDB	;ZERO A FEW THINGYS
	CALL	$GTSPC		;READ ONE SPECIFCATION
	 POPJ	P,		;WEREN'T ANY
	CAIE	C,"="		;WAS THIS OUTPUT SPEC?
	 JRST	GLST.1		;NO--DO INPUT
	MOVEM	T1,OUTFDB	;YES--STORE IT THERE
	JRST	GLST.0		;GO DO INPUT

;$GTSPC -- READ ONE ONE FILE SPEC INTO CORE
;CALL:	CALL	$GTSPC
;	*NO FILE GIVEN*
;	*RETURN, FDB ADDR IN T1*

$GTSPC:	CALL	.FILIN##	;READ THE SPEC
	SKIPN	F.NAM##		;CHECK FOR NULL SPEC
	 SKIPE	F.NAM##-1	;THIS IS REALLY F.DEV
	 AOSA	(P)		;GOT SOMETHING--SET TO SKIP BACK
	   POPJ	P,		;NO WE DIDN'T
	CALL	$GTFDB		;GET AN FDB
	SAVE$	T1		;SAVE ADDRESS
	MOVEI	T2,.FXLEN	;AND SIZE FOR .GTSPC
	CALL	.GTSPC##	;COPY SPEC OVER
	POP	P,T1		;GET ADDRESS BACK
	SKIPG	.FXFLM(T1)	;WAS FILE MAX LENGTH SET?
	 SETOM	.FXFLM(T1)	;NO--MAKE IT -1 SO .CHKTM IS HAPPY
	POPJ	P,		;SKIP BACK
;LNKATN -- LINK A BLOCK AT THE END OF A LINKED LIST
;CALL:	MOVEI	T1,<NEW BLOCK ADDR--1ST WORD (NOT LINK WORD)>
;	MOVEI	T2,<LIST HEAD ADDR>
;	CALL	LNKATN
;	*RETURN, NO ACS WIPED*

LNKATN:	SKIPN	(T2)		;IS THERE A LIST?
	 JRST	[MOVEM	T1,(T2)	;NO--START IT NOW
		JRST	MRKEND]	;BE SURE THE NEW BLOCK IS THE END OF THE LIST
	CALL	.SAVE2##	;NEED TWO REGISTERS
	MOVE	P1,(T2)		;COPY LIST ADDRESS
	MOVE	P2,P1		;REMEMBER FROM WHENCE WE CAME
	HRRZ	P1,-1(P1)	;LOOKY FOR THE END
	JUMPN	P1,.-2		;HAVE TO GET THERE EVENTUALLY
	HRRM	T1,-1(P2)	;PUT THIS ONE ON THE END
MRKEND:	HLLZS	-1(T1)		;MAKE SURE THIS IS REALLY THE END
	POPJ	P,		;DONE

;GIVLST -- GIVE BACK A LIST OF LINKED BLOCKS
;CALL:	MOVEI	T1,<ADDR OF FIRST BLK>
;	CALL	GIVLST

GIVLST:	JUMPE	T1,$POPJ	;JUMP IF NULL LIST
	CALL	.SAVE1##	;NO--SAVE P1
	MOVE	P1,T1		;COPY PTR
GIVL.0:	HRRZ	T1,P1		;COPY ADDR
	HRRZ	P1,-1(P1)	;CHAIN TO POSSIBLE NEXT BLOK
	CALL	.DECOR##	;FREE A BLOCK
	JUMPN	P1,GIVL.0	;JUMP IF MORE
	POPJ	P,		;DONE
;$EATLN -- SKIP TO EOL

$EATLN:	JUMPLE	C,$POPJ		;GO IF DONE
	CALL	.TIAUC##	;NO--NEXT CHARACTER
	JRST	$EATLN		;CHECK IT OUT

;GIVIOL -- GIVE BACK OUTFDB AND FDB CHAIN THAT L POINTS AT

GIVIOL:	SKIPE	T1,OUTFDB	;DO WE HAVE AN FDB?
	 CALL	.DECOR##	;YES--BUT NOW WE DON'T
	SETZM	OUTFDB
	SKIPN	T1,L		;IS THERE AN INPUT LIST?
	 POPJ	P,		;NO--RETURN
	SETZ	L,		;YES--MAKE SURE NOT ANY MORE
	PJRST	GIVLST		;AND FREE IT UP AND RETURN

;$GTFDB -- GET AN FDB
;CALL:	CALL	$GTFDB
;	*T1 PTS AT FDB*
;USE THIS SO .FXFLM GETS SET TO -1 AND .CHKTM IS HAPPY

$GTFDB:	MOVEI	T1,.FXLEN	;SIZE OF BLOCK TO GET
	CALL	.ALCOR##	;GET FROM CORE GIVER
	SETOM	.FXFLM(T1)	;ONES TO THE SIZE IN CASE NOT GIVEN
	POPJ	P,		;BACK WITH FDB ADDR IN T1

;TYPE FDB LIST POINTED TO BY L

$TYIOL:	JUMPE	L,$POPJ		;SKIP EMPTY LISTS
	CALL	.SAVE1##	;GET P1 FREE
	HRRZ	P1,L		;GET A COPY OF L
TYIO.2:	MOVE	T1,P1		;POINT AT SCAN BLOCK
	CALL	.TFBLK##	;TYPE ONE
	HRRZ	P1,-1(P1)	;CHAIN TO (POSSIBLE) NEXT
	JUMPE	P1,$POPJ	;JUMP IF ALL DONE
	MOVEI	T1,","		;NO--GET A COMMA
	CALL	.TCHAR##	;TYPE IT
	JRST	TYIO.2		;GO TYPE THE NAME NOW
SUBTTL	OPEN LIBRARY IN UPDATE MODE

;OLIBUP -- OPEN LIBRARY IN UPDATE MODE
;CALL:	MOVEI	T1,FLGVAL	;T1=0 TO APPEND, T1=-1 TO UPDATE
;	CALL	OLIBUP

OLIBUP:	CALL	.SAVE1##	;PRESERVE P1
	MOVS	P1,LIBFDB	;IN CASE OF CATASTROPHIC ERROR
	HLR	P1,T1		;REMEMBER THE FLAG VALUE
	MOVSI	T1,.FXLEN	;SETUP FOR .STOPB
	HRR	T1,LIBFDB	;...
	MOVEI	T2,OPNBLK	;...
	MOVE	T3,[XWD .RBTIM+1,LKPBLK]
	CALL	.STOPN##	;FORM OPEN/LOOKUP BLOCKS
	 JRST	WLDERR		;NO WILDCARDING OF LIBS
	MOVEI	T1,.RBTIM	;SET SIZE
	MOVEM	T1,LKPBLK+.RBCNT;FOR MON
	MOVEI	T1,.IOBIN	;BINARY
	MOVEM	T1,OPNBLK+.OPMOD
	MOVSI	T1,OBHR		;FOR OUTPUT
	TRNE	P1,-1		;SEE IF UPDATING
	 HRRI	T1,IBHR		;YES--NEED INPUT BUFFER HEADER ALSO
	MOVEM	T1,OPNBLK+.OPBUF
	OPEN	LIBC,OPNBLK	;OPEN THE CHAN
	 JRST	OPENER		;CANT
	SETO	T1,		;T1=-1 UNLESS CREATING FILE
	LOOKUP	LIBC,LKPBLK	;FIND THE FILE
	 JRST	[HRRZ	T1,LKPBLK+.RBEXT ;CAN'T--GET FAIL CODE
		JUMPN	T1,LKENER ;ALL ARE FATAL EXCEPT FILE NOT FOUND
		JRST	.+1]	;DO THE ENTER NOW
	ENTER	LIBC,LKPBLK	;ENTER TO DO  UPDATE
	 JRST	E$$CWL		;**CAN'T WRITE LIB
	HRLES	P1		;GET FLAG OUT TO FULL WORD NOW
	JUMPL	P1,LIBUPE	;JUMP IF UPDATE NOT APPEND
	SKIPE	T1		;DON'T USETI IF JUST CREATING THE FILE
	USETI	LIBC,-1		;THIS APPENDS
	MOVE	P1,T1		;COPY CREATE/APPEND FLAG
	CALL	GETNBF		;# BUFFERS
	MOVE	T2,[XWD OPNBLK,OBHR] ;
	CALL	.ALCBF##	;ALLOCATE BUFFERS
	OUTPUT	LIBC,		;DUMMY OUTPUT
	SKIPE	T2,P1		;GET FILE SIZE OR 0 IF JUST  CREATING
	 MOVE	T2,LKPBLK+.RBSIZ;IT EXISTS--GET SIZE
	LSH	T2,-7		;CONVT TO BLOCKS
	MOVEI	B,1(T2)		;SETUP B TO WHERE WE WILL APPEND
	POPJ	P,		;ALL DONE
LIBUPE:	SKIPN	T1		;FILE MUST EXIST
	 STOPX$			;OR THERE IS A BUG
	MOVSI	T1,1		;USE ONE BUFFER
	MOVE	T2,[XWD OPNBLK,OBHR] ;FOR OUTPUT
	CALL	.ALCBF##	;...
	OUTPUT	LIBC,		;DUMMY OUTPUT
	MOVSI	T1,1		;AND ONE FOR INPUT TOO
	MOVE	T2,[XWD OPNBLK,IBHR]
	PJRST	.ALCBF##	;ALLOCATE INPUT BUFFERS AND RETURN

;HERE TO CLOSE LIB WHICH WAS OPENED FOR OUTPUT

OLBCLS:	CLOSE	LIBC,		;CLOSE CHAN
	GETSTS	LIBC,T1		;CHECK FOR CLOSE ERRORS
	TRNE	T1,IO.ERR	;WERE THERE ANY?
	 WARN.	EF$OCT,ECL,<I/O ERROR CLOSING LIBRARY - >
	RELEASE	LIBC,		;GIVE IT ALL UP
OLBCL2:MOVEI	T1,OBHR		;GET BHR ADDR

;HERE TO FREE BUFFERS -- T1 POINTS AT FIRST WORD OF BUFFER HEADER

TSTBHR:	SKIPN	.BFADR(T1)	;BUFFERS USED?
	 POPJ	P,		;NO--ALL DONE
	SAVE$	T1		;YES--REMEMBER ADDR
	CALL	.FREBF##	;FREE BUFFERS
	RESTR$	T1		;GET PTR BACK
	SETZM	.BFADR(T1)	;CLEAR IT OUT
	SETZM	.BFPTR(T1)
	SETZM	.BFCTR(T1)
	POPJ	P,

;HERE TO OPEN DISK FOR INPUT -- STUFF SETUP BY WILD
;CPOPJ IF NOT FOUND--CPOPJ1 IF OK

DSKOPI:	JSP	T2,$SAVE3	;SAVE P1-3
	MOVE	P2,[Z INPC,IBHR(.IOBIN)] ;ARG FOR OPENIO
DSKIO0:	CALL	ZERLKP		;ZERO ANY OLD LKPBLK STUFF
	MOVE	T1,[XWD DSKBGN,IOXBGN] ;BLT STUFF TO OPNBLK/LKPBLK
	BLT	T1,IOXEND
	MOVE	T1,WLDFIR	;POINT TO SCAN BLOCK
	MOVE	T2,OPNBLK+.OPDEV;GET THE DEVICE
	DEVCHR	T2,		;SEE IF IT CAN
	TRNN	T2,DV.M13	;DO BINARY I/O
	 JRST	[ERROR.	(EF$ERR!EF$FIL,CDB,<CAN'T DO BINARY I/O TO >)
		POPJ	P,]	;NO--SO DON'T TRY IT
	CALL	FNDFIL		;LOOKUP/ENTER THE FILE
	 JRST	DSKIOF		;OPEN FAILURE
	 JRST	DSKIOF		;LOOKUP/ENTER FAILURE
	MOVS	T1,[XWD DSKBGN,IOXBGN] ;SETUP TO COPY LKPBLK TO DSKLKP
	BLT	T1,DSKLKP+.RBTIM ;IN CASE ANYONE EXPECTS IT TO BE THERE
	JRST	$POPJ1		;CPOPJ1 BACK
DSKIOF:	MOVEI	T1,LKPBLK	;POINT AT LKPBLK
	MOVEI	T2,.RBTIM	;THE SIZE OF THE BLOCK
	MOVE	T3,WLDFIR	;AND THE SCAN SPEC INVOLVED
	PJRST	E.LKEN##	;REPORT ERROR AND RETURN CPOPJ

REPEAT 0,<
;HERE TO OPEN DISK FOR OUTPUT -- STUFF SETUP BY WILD
;ALWAYS CPOPJ BACK

DSKOPO:	JSP	T2,$SAVE3	;SAVE P1-3
	MOVE	P2,[Z OUTC,@OBHR(.IOBIN)]
	PJRST	DSKIO0		;JOINT INPUT
>;END REPEAT 0

;HERE TO CLOSE DSK INPUT

DSKICL:	CLOSE	INPC,
	RELEASE	INPC,
	MOVEI	T1,IBHR
	PJRST	TSTBHR		;FREE BUFFERS

;HERE TO CLOSE DSK OUTPUT

DSKOCL:	CLOSE	OUTC,
	RELEASE	OUTC,
	MOVEI	T1,OBHR
	PJRST	TSTBHR

;HERE TO CLOSE LIBRARY INPUT

ILBCLS:	CLOSE	LIBC,
	RELEASE	LIBC,
	MOVEI	T1,IBHR
	PJRST	TSTBHR		;GIVE BUFFERS AND RETURN

;CHROUT -- SEND CHARACTER IN T1 TO OUTPUT FILE (ASCII MODE)

CHROUT:	SOSG	OBHR+.BFCTR	;ROOM IN DA BUFFER?
	 JRST	CHRBFO		;NO--DUMP A BUFFER
CHRO.1:	IDPB	T1,OBHR+.BFPTR	;STORE THE CHARACTER
	POPJ	P,
CHRBFO:	CALL	XCTIO		;DUMP A BUFFER
	 OUT	OUTC,		;...
	 STOPX$			;***
	JRST	CHRO.1		;GO STORE THE CHARACTER
SUBTTL	TTY OUTPUT OPEN/CLOSE ROUTINES

;CALL HERE TO OPEN TTY IN BUFFERED OUTPUT ONLY

OPNTTO:	MOVEI	T1,.IOASC	;MODE
	TXO	T1,UU.PHS	;PHYSICAL TTY PLEASE
	MOVEM	T1,OPNBLK+.OPMOD;...
	MOVSI	T1,'TTY'	;THE DEVICE
	MOVEM	T1,OPNBLK+.OPDEV
	MOVSI	T1,OBHR		;BUFFER HEADER
	MOVEM	T1,OPNBLK+.OPBUF
	OPEN	OUTC,OPNBLK	;OPEN THE TTY FOR OUTPUT
	 STOPX$			;SHOULD NEVER GET HERE!
	MOVSI	T1,6		;USE LOTS OF BUFFERS
	MOVE	T2,[XWD OPNBLK,OBHR]
	CALL	.ALCBF##	;ALLOCATE BUFFERS
	OUTPUT	OUTC,		;DUMMY OUTPUT
	POPJ	P,

CLSTTO=DSKOCL			;CAN USE SAME ROUTINE AS DISK
SUBTTL	OPEN I/O CHANNELS
;OPENIO
;CALL:	MOVEI	T1,<FDB ADDR>
;	CALL	OPENIO
;	CAI	CHANNEL,BUFADR	;@ IF OUTPUT, (MODE)
;	*FILE NOT FOUND ON LOOKUP*	;ABORT IF OPEN OR ENTER FAILS
;	*ALL IS WELL*

OPENIO:	HRL	T1,0(P)		;REMEMBER CALLER
	JSP	T2,$SAVE3	;PRESERVE REGISTERS
	MOVS	P1,T1		;COPY ARGUMENTS
	MOVE	P2,(P1)		;GET REST OF THEM
	CALL	ZERLKP		;CLEAR LKPBLK
	MOVSI	T1,.FXLEN	;SETUP FOR .STOPB
	HLR	T1,P1		;...
	MOVEI	T2,OPNBLK	;
	MOVE	T3,[XWD .RBTIM+1,LKPBLK] ;
	CALL	.STOPN##	;CONVERT TO OPEN/LOOKUP BLOCKS
	 JRST	WLDERR		;NO WILDCARDING!
	 CALL	FNDFIL		;LOOKUP/ENTER THE FILE
	  JRST	OPENER		;CAN'T OPEN DEVICE
	 SKIPA	T1,LKPBLK+.RBEXT ;CAN'T FIND/WRITE--GET CODE AND SKIP
	JRST	$POPJ2		;OK--SKIP 2
	TLNN	P2,ATSIGN	;IF WRITING
	TRNE	T1,-1		;OR OTHER THAN FILE NOT FOUND
	 JRST	LKENER		;GO BARF
	POPJ	P,		;NO--FILE NOT FOUND ON LOOKUP--RETURN CPOPJ
$POPJ2:	AOS	(P)		;SKIP 2
$POPJ1:	AOS	(P)		;SKIP 1
$POPJ:	POPJ	P,		;SKIP 0

;$SAVE3 -- SAVE P1-3 WITH ALLOWANCE FOR DOUBLE SKIP RETURNS

$SAVE3:	SAVE$	<P1,P2,P3>	;SAVE P1-3 ON PDL
	PUSHJ	P,(T2)		;CALL THE ROUTINE
	JRST	$RET3		;NO SKIP BACK
	SKIPA			;ONE SKIP BACK
	AOS	-3(P)		;TWO SKIPS BACK
	AOS	-3(P)		;AND ANOTHER
$RET3:	RESTR$	<P3,P2,P1>	;GET REGISTERS BACK
	POPJ	P,		;SKIP ONCE, TWICE, OR NOT AT ALL

;CALL HERE TO ZERO LKPBLK

ZERLKP:	STORE	T1,LKPBLK,LKPBLK+.RBTIM,0
	POPJ	P,		;THAT WAS EASY
;FNDFIL -- DO OPEN-LOOKUP/ENTER ON FILE
;CALL:	OPNBLK/LKPBLK SETUP
;	MOVE	P2,<Z CHAN,@BHDR(MODE)> ;@ IF WRITING
;	CALL	FNDFIL
;	 *OPEN FAILED*
;	 *LOOKUP/ENTER FAILED*
;	*OK*
;ACS:T1,P3

FNDFIL:	MOVEI	T1,.RBTIM	;SETUP COUNT
	MOVEM	T1,LKPBLK+.RBCNT
	LDB	T1,[POINT 4,P2,17] ;GET MODE
	MOVEM	T1,OPNBLK	;STORE IN OPEN BLOCK
	HRRZ	T1,P2		;BUFFER HEADER ADDRESS
	TLNE	P2,ATSIGN	;READ OR WRITE?
	MOVSS	T1		;WRITING, POSITON FOR IT
	MOVEM	T1,OPNBLK+.OPBUF;STORE
	LDB	P3,[POINT 4,P2,12] ;GET I/O CHANNEL
	LSH	P3,5		;POSITION
	MOVSS	P3		;IN CHANNEL POSITION
	MOVE	T1,[OPEN OPNBLK];FORM INSTR
	OR	T1,P3		;FINISH
	XCT	T1		;TRY TO OPEN DEVICE
	 POPJ	P,		;CAN'T--QUIT NOW
	MOVE	T1,P3		;REGET I/O CHANNEL
	TLNE	P2,ATSIGN	;READ/WRITE?
	 TLOA	T1,(ENTER)	;WRITE
	  TLO	T1,(LOOKUP)	;READ
	HRRI	T1,LKPBLK	;COMPLETE INSTR
	XCT	T1		;FIND/WRITE THE FILE
	 JRST	$POPJ1		;CAN'T--SKIP 1
	JRST	$POPJ2		;ALL IS WELL--SKIP 2

;GETNBF -- GET VALUE OF /BUFFER
;CALL:	CALL	GETNBF
;	*T1=#BUFFERS,,0*

GETNBF:	SKIPG	T1,S.BUFR
	 MOVEI	T1,DF$BUF	;NO--USE DEFAULT
	MOVEM	T1,S.BUFR	;SET FOR LATER
	MOVSI	T1,(T1)		;MOVE TO LH AND ZERO RH
	POPJ	P,		;RETURN
;OPENIO ERRORS

OPENER:	HLRZ	T1,P1		;COPY FDB ADDR
	FATAL.	EF$FIL,COD,<CAN'T OPEN DEVICE, FILE >

WLDERR:	HLRZ	T1,P1		;GET FDB
	FATAL.	EF$FIL,WFI,<WILDCARD FILESPEC ILLEGAL, FILE >

LKENER:	HRRZ	T1,LKPBLK+.RBEXT;GET FAIL CODE
	ERROR.	EF$ERR!EF$OCT!EF$NCR,LER,<LOOKUP/ENTER ERROR(>
	STRNG$	<) FILE >
	HLRZ	T1,P1
	CALL	.TFBLK##	;TYPE SCAN BLOCK
	CALL	.TCRLF##	;NEW LINE
X$$LER:	JRST	ERRFTL		;GO DIE

;.TPRIV -- TYPE PRIV WORD IN T1
;CALL:	MOVE	T1,9BIT PRIV WORD
;	CALL	.TPRIV


.TPRIV:	MOVE	T2,T1		;POSITION PROT
	MOVEI	T1,"<"		;GET AN ANGLE BRACKET
	CALL	.TCHAR##	;SEND IT
	CALL	TPRIV0		;TYPE PROTECTION
	MOVEI	T1,">"		;CLOSE PROTECTION
	PJRST	.TCHAR##	;AND RETURN

;HERE WITH T2 CONTAINING PROT IN LOW ORDER 9 BITS TO TYPE

TPRIV0:	ANDI	T2,777		;TRIM TO PROT
	ROT	T2,-^D9		;POSITION
	MOVEI	T3,3		;SET TO TYPE 3 DIGITS
TPRVLP:	SETZ	T1,		;CLEAR JUNK
	LSHC	T1,3		;GET AN OCTAL DIGIT
	MOVEI	T1,"0"(T1)	;MAKE IT ASCII
	CALL	.TCHAR##	;SEND THE CHARACTER
	SOJG	T3,TPRVLP	;DO ALL 3
	POPJ	P,		;DONE

;CLRUSE -- CLEAR USE BITS
;CALL:	HRRZ	T1,BHDR+.BFADR	;**THIS INSTR USED BY THIS ROUTINE
;	CALL	CLRUSE
;	 WAIT	CHAN,		;XCT'D FIRST
;	*USE BITS CLEARED*

CLRUSE:	XCT	@0(P)		;WAIT FOR IDLENESS
	MOVSI	T3,(BF.IOU)	;THE BIT TO CLEAR
	HRRZ	T2,T1		;COPY ADDR
CLRU.1:	ANDCAM	T3,0(T2)	;CLEAR ONE
	HRRZ	T2,(T2)		;CHAIN TO NEXT
	CAME	T1,T2		;THIS IS DONENESS
	JRST	CLRU.1		;NOT YET
	MOVSI	T3,(BF.VBR)	;MAKE IT A VIRGIN RING
	MOVE	T2,(P)		;GET RETURN
	IORM	T3,@-2(T2)	;SET VIRGIN BIT INTO BUFFER HEADER
	JRST	$POPJ1		;SKIP INSTR ON WAY BACK

;HERE WITH T1 PTS TO OPEN BLOCK
;T2 PTS AT LOOKUP BLOCK
;WILL TYPE FILESPEC/VERSION/PROT

$TLBVP:	PUSH	P,T2		;SAVE LOOKUP BLOCK ADDRESS
	CALL	.TOLEB##	;TYPE THE FILE SPEC
	MOVE	T1,(P)		;GET LOOKUP BLOCK ADDRESS
	LDB	T1,[POINTR(.RBPRV(T1),RB.PRV)] ;GET PRIV BITS
	CALL	$TPROT		;TYPE /PROTECT:P
	POP	P,T1		;GET LOOKUP BLOCK ADDRESS
	MOVE	T1,.RBVER(T1)	;GET THE VERSION
	PJRST	$TVRSN		;TYPE AND RETURN
SUBTTL	XCTIO EXECUTES IN/OUT UUO WITH ERROR HANDLING

;XCTIO
;CALL:	CALL	XCTIO
;	<INSTR TO XCT>	;IN/OUT UUO
;	*EOF/EOT RETURN*
;	*NORMAL RETURN*

XCTIO:	XCT	@0(P)		;DO THE INSTR
	 JRST	$POPJ2		;OK--SKIP 2 AND RETURN
	SAVE$	T1		;OOPS--SAVE T1
	MOVE	T1,@-1(P)	;GET INSTR WE FAILED ON
	AOS	-1(P)		;SKIP INSTR ON WAY BACK
	AND	T1,[17B12]	;ERROR--GET THE CHANNEL
	OR	T1,[GETSTS T2]	;GET ERRROR BITS
	XCT	T1
	TRNE	T2,IO.EOF!IO.EOT;END OF SOMETHING?
	JRST	TPOPJ		;YES
	EXCH	T1,T2		;NO--GET BITS IN RIGHT PLACE, SAVE I/O INSTR
	HRR	T2,T1		;PUT BITS IN THE INSTR
	SAVE$	T2		;SAVE I/O INSTR A SEC
	WARN.	EF$OCT,IOE,<I/O ERROR - STATUS=>
	RESTR$	T1		;GET INSTR BACK
	TRZ	T1,IO.ERR	;CLEAR ERROR BITS
	TLZ	T1,002000	;GETSTS BECOMES SETSTS
	XCT	T1
TPOPJ1:	RESTR$	T1		;GET T1 AGAIN
	AOSA	(P)
TPOPJ:	RESTR$	T1
	POPJ	P,
SUBTTL	ERROR HANDLER

;EHNDLR -- HANDLE ALL ERRORS
;THE ONLY CALL IS THRU THE ERR$ MACRO

EHNDLR:	CALL	SAVACS		;SAVE THE ACS
	MOVE	P1,@0(P)	;GET FLAGS AND ADDRESSES
	SKIPN	@.TYOCH##	;IS SCAN TTCALLING?
	 JRST	[SETZM	ERRTYX	;YES--CLEAR FLAG
		JRST	EHND.0]	;AND SKIP ON
	SETZ	T1,		;NO--SO MAKE IT
	CALL	.TYOCH##	;TELL SCAN
	MOVEM	T1,ERRTYX	;REMEMBER/SET FLAG
EHND.0:	MOVEI	T1,"?"		;ASSUME AN ERROR
	TLNE	P1,EF$WRN	;CHECK WARNING
	MOVEI	T1,"%"		;YES
	TLNE	P1,EF$INF	;IF BOTH OFF NOW THEN INFO
	MOVEI	T1,"["		;GOOD THING WE CHECKED
	CALL	.TCHAR##	;OUTPUT THE START OF MESSAGE
	MOVSI	T1,MY$PFX	;SET UP MY PREFIX
	HLR	T1,(P1)		;GET MESSAGE PREFIX
	CALL	.TSIXN##	;OUTPUT THE PREFIXES
	CALL	.VERBO##	;GET MESSAGE BITS
	TXNN	T1,JWW.FL	;SEE IF FIRST LINE
	 JRST	EHNDSH		;NO--FINISH SHORTLY
	CALL	.TSPAC##	;AND A SPACE
	HRRZ	T1,(P1)		;GET STRING ADDRESS
	CALL	.TSTRG##	;SEND IT
	MOVE	T1,SAVAC+T1	;GET ORIGINAL T1 IN CASE TYPEOUT DESIRED
	MOVE	T2,SAVAC+T2	;AND ORIGINAL T2 IN CASE .TOLEB REQUESTED
	LDB	T3,[POINT 5,P1,17] ;GET TYPED OUT DESIRED
	CAILE	T3,EF$MAX	;CHECK LEGAL
	 MOVEI	T3,0		;NOOOP
	CALL	@ERRTAB(T3)	;CALL THE ROUTINE
	TLNE	P1,EF$NCR	;IF NO CRLF THEN DON'T CLOSE INFO
	 JRST	EHND.1		;NO--DON'T CHECK
	MOVEI	T1,"]"		;PREPARE TO CLOSE INFO
	TLNE	P1,EF$INF	;CHECK FOR INFO
	CALL	.TCHAR##	;SEND INFO CLOSE
	TLNN	P1,EF$NCR	;NO CARRIAGE RETURN?
	CALL	.TCRLF##	;YES--SEND ONE
EHND.1:	SKIPN	T1,ERRTYX	;DID WE RESET SCAN?
	 JRST	EHND.2		;NO
	CALL	.TYOCH##	;AND RESTORE IT
	SETZM	ERRTYX		;CLEAR FLAG
EHND.2:	TLNE	P1,EF$FTL	;NOW CHECK FATAL
	 JRST	ERRFTL		;YES--GO DIE
	PJRST	RESACS		;RESTORE ACS AND RETURN

;HERE IF /MESSAGE:PREFIX ONLY

EHNDSH:	TLNE	P1,EF$FTL	;IS THIS FATAL?
	JRST	ERRFTL		;YES--GO DIE
	CALL	.TCRLF##	;NEW LINE
	TLNN	P1,EF$NCR	;SEE IF /NOCRLF FROM ERROR MACRO
	 JRST	RESACS		;NO--JUST GO RETURN
	MOVE	T1,1(P1)	;YES--GET X$$PFX ADDRESS
	HRRM	T1,(P)		;SET FOR RETURN TO THERE
;RESACS -- RESTORE ALL ACS FROM SAVAC AREA
;	CALL	RESACS
;	*ACS RESTORED FROM SAVAC*

RESACS:	MOVEM	17,SAVAC+17	;SAVE 17 TO RESTORE INTO IT
	MOVSI	17,SAVAC
	BLT	17,17		;REGISTERS ARE RESTORED
	POPJ	P,		;RETURN

ERRTAB:	.POPJ##			;CODE 0 -- NO ACTION
	.TDECW##		;CODE 1 -- TYPE T1 IN DECIMAL
	.TOCTW##		;CODE 2 -- TYPE T1 IN OCTAL
	.TSIXN##		;CODE 3 -- TYPE T1 IN SIXBIT
	.TPPNW##		;CODE 4 -- TYPE T1 AS PPN
	.TSTRG##		;CODE 5 -- T1 POINTS TO ASCIZ STRING
	.TFBLK##		;CODE 6 -- T1 POINTS AT FDB
	.TOLEB##		;CODE 7 -- T1 POINTS AT OPEN BLOCK
				;	-- T2 POINTS AT LOOKUP BLOCK

;HERE TO DIE--

ERRFTL:	CALL	.CLRBF##	;EAT ANY TYPEAHEAD OR WHATEVER
	SAVE$	.JBFF		;SAVE JBFF OVER RESET
	RESET			;KILL ALL FILES
	RESTR$	.JBFF		;GET JOBFF BACK
	MOVE	P,INIPDP	;RESET PDL
	PJRST	.FMSGE##	;GO FINISH UP

;SAVAC -- SAVE ALL ACS
;CALL -- PUSHJ P,SAVACS
;	*ACS SAVED IN SAVAC*	BEWARE!!

SAVACS:	MOVEM	17,SAVAC+17	;SAVE ONE
	MOVEI	17,SAVAC
	BLT	17,SAVAC+16
	MOVE	17,SAVAC+17
	POPJ	P,		;ACS ARE SAVED

E$$NUC:	FATAL.	0,NUC,<NO 'USE' OR 'CREATE' COMMAND>

;.TDOT -- TYPE A DOT

.TDOT:	MOVEI	T1,"."		;GET ONE
	PJRST	.TCHAR##	;AND TYPE IT
SUBTTL	STORAGE

	RELOC	0		;STORAGE ALL IN LOW SEGMENT

;STORAGE THAT REMAINS BETWEEN RUNS

U (ISCNVL)		;VALUE FROM .ISCAN
U (TLDVER)		;-1 WHEN TYPED VERSION TO TTY
U (OFFSET)		;STARTING OFFSET
U (FLTMPC)		;FLAG THAT WE HAVE TRIED TO READ NNNLRL.TMP

FW$ZER==.	;FIRST WORD ZEROED
U (CCLNAM)		;NNNLIB
U (PDLIST,LN$PDL)	;PUSHDOWN LIST
U (SAVAC,20)		;SAVE ACS HERE
U (DIRPTR)		;PTR TO DIR BLOCKS
U (LSTPTR)		;PTR TO LST BLOCKS
U (OUTFDB)		;PTR TO FDB FOR OUTPUT SPEC
U (LIBFDB)		;PTR TO LIB FDB
U (DIRECT,LN$DRB)	;INTERMEDIATE DIRECT BLOCK
U (WLDFIR)		;PTR TO FDB FOR .LKWLD
U (WLDPTR)		;.LKWLD STORES CURRENT FDB HERE
U (FILCNT)		;COUNT OF FILES PROCESSED
U (NOFILR)		;COUNT OF FILES REJECTED FOR ONE REASON OR ANOTHER
U (IFDBAD)		;ADDR OF INPUT FDB
U (OFDB,.FXLEN)		;OUTPUT FDB FOR .SCWLD
	;**DO NOT SEPARATE
U (DSKOPN,3)		;OPEN BLOCK FOR DISK
	DSKBGN=DSKOPN	;FOR A BLT
U (DSKLKP,.RBTIM+1)	;DISK LOOKUP BLOCK
U (OPNBLK,3)		;OPEN BLOCK
	IOXBGN=OPNBLK	;FOR A BLT
U (LKPBLK,.RBTIM+1)	;LOOKUP/ENTER BLOCK
	IOXEND=.-1	;END OF BLT
U (TMPOPN,3)		;TEMP OPEN BLOCK
U (TMPLKP,.RBTIM+1)	;TEMP LOOKUP/ENTER BLOCK
	TMPXEN==.-1	;END OF BLT FOR TEMP BLOCK
	;**END DO NOT SEPARATE
U (ERRTYX)		;FLAG FOR EHNDLR
U (IBHR,3)		;INPUT BUFFER HEADER
U (OBHR,3)		;OUTPUT BUFFER HEADER
U (LBHR,3)		;LIBRARY BUFFER HEADER
SCN$FZ==.	;FIRST WORD ZEROED AT CLRANS
SCN$LZ==.-1	;LAST WORD ZEROED AT CLRANS
SCN$FO==.	;FIRST WORD MINUS ONNED AT CLRANS
U (S.BUFR)		;/BUFFER:N ARG
U (S.DSUP)		;/DSUPERSEDE ARG
U (S.LSUP)		;/LSUPERSEDE ARG
U (S.SUPR)		;/SUPERSEDE ARG
U (S.REML)		;/REMEMBER ARG
SCN$LO==.-1	;LAST WORD ONNED AT CLRANS
LW$ZER==.-1	;LAST WORD ZEROED AT STARTUP
	RELOC			;LITERALS GO IN HIGHSEGMENT
	XLIST			;FORCE OUT LITERALS
	LIT
	LIST
LIBEND::END	LIBMAN