Google
 

Trailing-Edge - PDP-10 Archives - tops10and20_integ_tools_v9_3-aug-86 - tools/crc/browse/lbr.mac
There are no other files named lbr.mac in the archive.
;melon:<crc-subs>LBR.MAC.2, 8-Nov-85 15:34:43, edit by Geoff
;	Squeezing empty library goes bananas
;<KEVIN>LBR.MAC.22, 14-Dec-84 15:34:43, EDIT BY KEVIN
;	If you do a PUSH when no library has ever been mapped, it doesn't
;	work when you POP again.
;<KEVIN>LBR.MAC.21,  6-Aug-84 10:35:00, EDIT BY KEVIN
;	Fix STATUS command - would not work if first directory command
;<KEVIN>LBR.MAC.20,  6-Aug-84 10:24:20, EDIT BY KEVIN
;<KEVIN>NEWLBR.MAC.8, 18-Jul-84 14:14:55, EDIT BY KEVIN
;	Merge in updates from current LBR version - change version number
;<KEVIN>LBR.MAC.17, 10-Jul-84 16:32:41, EDIT BY KEVIN
;	OPen library jfn restricted
;<KEVIN>LBR.MAC.16,  5-Jul-84 15:30:07, EDIT BY KEVIN
;	(1) Further to last edit, only close/reopen when last command modified
;	library.
;	(2) Set up control-c fence during EDIT, so that lots of control-cs
;	don't leave library in parlous state.
;<KEVIN>LBR.MAC.13, 21-Jun-84 11:37:30, EDIT BY KEVIN
;	Add a new method of mapping out the library which doesn't require
;	a table rebuild and a new map when re-opening. This is to be done
;	between each command, and especially during PUSH (to catch system
;	shutdown when library is opened.) Should fix lots of problems
;	regarding strange eofs.
;<KEVIN>LBR.MAC.11, 29-May-84 11:36:05, EDIT BY KEVIN
;	Make sure control-c interrupt instruction fence set up when in GUIDE
;	mode, otherwise get strange messages from exec about instruction traps
;	in ephemerons after control-C of GUIDE.
;<KEVIN>LBR.MAC.8, 29-Mar-84 13:34:46, EDIT BY KEVIN
;	Make EDIT a lot cleverer about its output files. Don't use temporary
;	files, and check to see if a file of the same name already exists, and
;	if so, dispose of it. (Ask the user first.)
;<KEVIN>LBR.MAC.7, 23-Mar-84 14:52:01, EDIT BY KEVIN
;	When the COPY for an EDIT command fails, the edit still tries to go
;	on. Also, COPY still leaves an aborted output file if the expunge
;	fails - not so good.
;<KEVIN>LBR.MAC.6, 15-Mar-84 11:29:33, EDIT BY KEVIN
;	This one is so wierd as to be unbelievable. We must disable line number
;	checking when opening libraries, as in some cases the system seems to
;	think that, if the first IO occurs on a file containing nulls,
;	the file contains line numbers, and so starts stripping the things
;	off.
;<KEVIN>LBR.MAC.2,  8-Mar-84 18:12:13, EDIT BY KEVIN
;	When opening libraries for write, also check for Archive status
;	error.
;<KEVIN>NEWLBR.MAC.7, 18-Jul-84 13:40:34, EDIT BY KEVIN
;	Make VDIREC,FDIREC do different things.
;<KEVIN>LBR.MAC.311, 13-Dec-83 16:34:55, EDIT BY KEVIN
;	Instead of continuing an old EXEC, start it. It is bright enough to
;	know not to repeat matters
;<KEVIN>LBR.MAC.308, 13-Dec-83 10:12:11, EDIT BY KEVIN
;	Pause momentarily in PUSH when continuing old EXEC to get around problem
;	where WFORK returns instantly.
;<KEVIN>LBR.MAC.307, 13-Dec-83 09:07:58, EDIT BY KEVIN
;	Keep lower EXEC fork after PUSH.
;<KEVIN>LBR.MAC.306, 23-Nov-83 11:33:55, EDIT BY KEVIN
;	Save acs over index building in case rescanned command.
;<KEVIN>LBR.MAC.304, 23-Nov-83 10:13:58, EDIT BY KEVIN
;	Don't give INDEX option when there are no index files.
;<KEVIN>LBR.MAC.303, 22-Nov-83 19:16:09, EDIT BY KEVIN
;<KEVIN>LBR.MAC.297, 22-Nov-83 12:06:00, EDIT BY KEVIN
;	Modify USERR to check NOERR flag.
;	When in GUIDE mode, add an INDEX option for chapter listings.
;<KEVIN>LBR.MAC.295, 16-Nov-83 11:22:07, EDIT BY KEVIN
;	Problem with SET - right half bits unintentionally set.
;<KEVIN>LBR.MAC.292, 15-Nov-83 15:26:49, EDIT BY KEVIN
;<KEVIN>LBR.MAC.288, 15-Nov-83 14:13:29, EDIT BY KEVIN
;<KEVIN>LBR.MAC.286, 14-Nov-83 18:08:46, EDIT BY KEVIN
;** - V1 fix for user specifying extra pages in create + a byte size
;	Remove message about inconsistent stuff 'cos no slot found.
;	Add checking of rescan line, modify for GUIDE-style usage.
;************************ Version 2 begins here ***************************
;<KEVIN>LBR.MAC.283,  1-Nov-83 13:42:22, EDIT BY KEVIN
;<KEVIN>LBR.MAC.280,  1-Nov-83 13:10:25, EDIT BY KEVIN
;	Add a TDIRECTORY command (if we can)
;<KEVIN>LBR.MAC.278, 28-Oct-83 10:27:35, EDIT BY KEVIN
;	Improve rescanning if there is nothing to rescan (like when PCL invokes)
;<KEVIN>LBR.MAC.276,  6-Oct-83 16:56:49, EDIT BY KEVIN
;	Allow SQUEEZE to cope with zero-length modules.
;<KEVIN>LBR.MAC.275, 23-Sep-83 16:16:10, EDIT BY KEVIN
;	If rescanned command gave a library, we should not even attempt to
;	get a jfn on LIBRARY command in LBR.INIT. Just eat the command.
;<KEVIN>LBR.MAC.274, 25-Aug-83 14:33:00, EDIT BY KEVIN
;	Lack of OKINT on each pass through REPLACE-type commands meant that
;	library was left looking unsafe when in fact it was OK.
;<KEVIN>LBR.MAC.273, 24-Aug-83 10:17:17, EDIT BY KEVIN
;	Don't try to fiddle lock word in header page if access is readonly.
;<KEVIN>LBR.MAC.271, 17-Aug-83 10:12:32, EDIT BY KEVIN
;	Allow for crazy people who put mega-byte files in libraries.
;<KEVIN>LBR.MAC.269, 25-Jul-83 11:21:28, EDIT BY KEVIN
;	Not releasing control-c locks properly on type command
;<KEVIN>LBR.MAC.266, 21-Jul-83 14:18:09, EDIT BY KEVIN
;	Update help message.
;<KEVIN>LBR.MAC.264, 21-Jul-83 13:44:34, EDIT BY KEVIN
;	Change action of control-c routines from always halting to executing
;	instruction. This allows control-c during TYPE to abort typeout.
;	Reset trap instruction to be HALTF% on each command.
;<KEVIN>LBR.MAC.260, 10-Jun-83 17:17:05, EDIT BY KEVIN
;	Make LBR cope with strange end-of-file problems by expanding library.
;	Also, for append output, NEVER use temp files
;<KEVIN>LBR.MAC.258,  6-Jun-83 13:11:35, EDIT BY KEVIN
;	Allow initial creation of library to include extra pages.
;<KEVIN>LBR.MAC.256,  3-Jun-83 16:34:54, EDIT BY KEVIN
;	Add switches to directory and list for /BEFORE, AFTER etc.
;<KEVIN>LBR.MAC.253,  3-Jun-83 11:58:08, EDIT BY KEVIN
;	Don't print message of day in Batch - clutters up log files.
;<KEVIN>LBR.MAC.251,  2-Jun-83 17:16:18, EDIT BY KEVIN
;	Must not open APPEND output files more than once
;<KEVIN>LBR.MAC.250,  2-Jun-83 17:03:23, EDIT BY KEVIN
;<KEVIN>LBR.MAC.249,  2-Jun-83 16:50:00, EDIT BY KEVIN
;	Wildcard append not working correctly
;<KEVIN>LBR.MAC.248,  2-Jun-83 16:41:52, EDIT BY KEVIN
;	Forgot to change tables ; make help better.
;<KEVIN>LBR.MAC.245,  2-Jun-83 16:33:18, EDIT BY KEVIN
;	Add APPEND command, and improve MOD.
;<KEVIN>LBR.MAC.243, 19-Apr-83 14:54:15, EDIT BY KEVIN
;	PRARG format has changed with V5
;<KEVIN>LBR.MAC.242, 19-Apr-83 14:39:41, EDIT BY KEVIN
;	Add GO command to execute last load-class command on exit
;<KEVIN>LBR.MAC.240, 15-Apr-83 14:08:51, EDIT BY KEVIN
;	Add a PUSH command (and slap wrists for not doing so before)
;<KEVIN>LBR.MAC.239, 11-Apr-83 10:29:20, EDIT BY KEVIN
;	Change startup message.
;<KEVIN>LBR.MAC.238,  8-Apr-83 11:56:29, EDIT BY KEVIN
;	Problems with USERR using JRST .+1 inside a literal, as literal may
;	be nested. Use call/ret instead.
;<KEVIN>LBR.MAC.237,  6-Apr-83 17:31:39, EDIT BY KEVIN
;	Don't print "?" in front of LBR.INIT errors if in batch
;<KEVIN>LBR.MAC.235, 25-Feb-83 10:07:01, EDIT BY KEVIN
;	Change SED /READONLY
;<KEVIN>LBR.MAC.234,  1-Feb-83 18:46:11, EDIT BY KEVIN
;	Make EDIT ensure that the input file to the editor is always deleted
;	after the editor exits.
;<KEVIN>LBR.MAC.233,  1-Feb-83 18:18:37, EDIT BY KEVIN
;	Change MOD
;<KEVIN>LBR.MAC.232,  1-Feb-83 13:56:33, EDIT BY KEVIN
;	Allow INSERT command to just skip over duplicate files to
;	be inserted.
;<KEVIN>LBR.MAC.231, 31-Jan-83 14:06:53, EDIT BY KEVIN
;	Don't alter bytesize or extension if library already contains modules.
;	(So people can have a library of files with no extension.)
;<KEVIN>LBR.MAC.230, 28-Jan-83 12:03:13, EDIT BY KEVIN
;	Allow LBR to merge in an external DDT and use the unsolicted
;	breakpoint address.
;<KEVIN>LBR.MAC.229, 27-Jan-83 13:50:54, EDIT BY KEVIN
;	ABOTAK fucked up the flag bits.
;<KEVIN>LBR.MAC.226, 20-Jan-83 11:03:36, EDIT BY KEVIN
;	Make HELP talk about SET SED
;<KEVIN>LBR.MAC.224, 19-Jan-83 19:08:14, EDIT BY KEVIN
;	Add SET SED command for default editor
;<KEVIN>LBR.MAC.223, 18-Jan-83 17:19:48, EDIT BY KEVIN
;	Change HELP LIBRARY to mention rescanning command line.
;<KEVIN>LBR.MAC.222, 18-Jan-83 17:10:07, EDIT BY KEVIN
;<KEVIN>LBR.MAC.220, 18-Jan-83 16:50:56, EDIT BY KEVIN
;	 Make LBR rescan its command line for a library (NOT for a command)
;<KEVIN>LBR.MAC.218, 29-Nov-82 13:34:43, EDIT BY KEVIN
;	Make commands that accept wildcards reject invalid module names before
;	confirm.
;<KEVIN>LBR.MAC.217, 16-Nov-82 16:25:52, EDIT BY KEVIN
;	Make LBR keep subsystem stats.
;<KEVIN>LBR.MAC.216,  9-Nov-82 13:47:39, EDIT BY KEVIN
;	EDTPTR wrong
;<KEVIN>LBR.MAC.215,  8-Nov-82 17:59:26, EDIT BY KEVIN
;	Add switches to EDIT - /SED and /READONLY
;<KEVIN>LBR.MAC.210, 26-Oct-82 18:24:01, EDIT BY KEVIN
;	Try for a LBR.INIT
;<KEVIN>LBR.MAC.208, 25-Oct-82 15:02:27, EDIT BY KEVIN
;	Losing count in file positioning in DIRECT
;<KEVIN>LBR.MAC.206, 25-Oct-82 14:55:32, EDIT BY KEVIN
;	Problems with multiply define labels
;<KEVIN>LBR.MAC.202, 25-Oct-82 14:25:21, EDIT BY KEVIN
;	Add ability for LIST output to go to a named file (like LPT: !)
;<KEVIN>LBR.MAC.201, 13-Sep-82 17:19:36, EDIT BY KEVIN
;	Check whether we are in batch for control-c stuff
;<KEVIN>LBR.MAC.200, 13-Sep-82 17:13:29, EDIT BY KEVIN
;	Change MOD
;<KEVIN>LBR.MAC.199, 10-Sep-82 10:51:03, EDIT BY KEVIN
;	EXPUNGE can delete LBR output files !!
;<KEVIN>LBR.MAC.198, 26-Aug-82 19:22:13, EDIT BY KEVIN
;	Must reset TYPING flag each command
;<KEVIN>LBR.MAC.197, 26-Aug-82 19:17:39, EDIT BY KEVIN
;	Cannot use SCRATCH for filename
;<KEVIN>LBR.MAC.196, 26-Aug-82 19:10:16, EDIT BY KEVIN
;	Separate buffer needed for rescan
;<KEVIN>LBR.MAC.195, 26-Aug-82 19:04:48, EDIT BY KEVIN
;<KEVIN>LBR.MAC.194, 26-Aug-82 19:03:03, EDIT BY KEVIN
;<KEVIN>LBR.MAC.193, 26-Aug-82 18:56:39, EDIT BY KEVIN
;	Add EDIT command
;<KEVIN>LBR.MAC.192, 19-Aug-82 10:45:16, EDIT BY KEVIN
;<KEVIN>LBR.MAC.191, 19-Aug-82 10:39:34, EDIT BY KEVIN
;	Allow COPY to EXPUNGE
;<KEVIN>LBR.MAC.190, 19-Aug-82 10:11:15, EDIT BY KEVIN
;	Include UPDATE in HELP commands
;<KEVIN>LBR.MAC.188,  6-Aug-82 14:03:32, EDIT BY KEVIN
;	Make data buffer be multiple pages to speed up squeeze, etc.
;<KEVIN>LBR.MAC.187,  5-Aug-82 14:59:00, EDIT BY KEVIN
;	Change error messages to tell user about LIBRARY command if they
;	can't figure it.
;<KEVIN>LBR.MAC.186,  2-Aug-82 17:53:04, EDIT BY KEVIN
;	DIRECTORY (of modules) GARBAGE produces 2 error messages
;<KEVIN>LBR.MAC.181,  2-Aug-82 14:55:24, EDIT BY KEVIN
;	Set up to produce a UNV file too
;<KEVIN>LBR.MAC.179, 29-Jul-82 10:01:35, EDIT BY KEVIN
;	Typo in REPLACE affects non-wild replace commands
;<KEVIN>LBR.MAC.178, 27-Jul-82 12:25:27, EDIT BY KEVIN
;	SFBSZ does not affect what is returned by SIZEF. We must close and
;	reopen the file to make this work, it appears.
;	Cure: use SFPTR to EOF then RFPTR instead of SIZEF.
;<KEVIN>LBR.MAC.177, 26-Jul-82 17:44:54, EDIT BY KEVIN
;	Check for offline files before insert, etc.
;<KEVIN>LBR.MAC.174, 26-Jul-82 16:06:08, EDIT BY KEVIN
;<KEVIN>LBR.MAC.169, 26-Jul-82 14:41:09, EDIT BY KEVIN
;	Add SET EPHEMERAL, SET PERMANENT
;<KEVIN>LBR.MAC.167, 26-Jul-82 14:01:59, EDIT BY KEVIN
;	Fix problem with reading files with linenumbers.
;<KEVIN>LBR.MAC.165, 26-Jul-82 13:17:27, EDIT BY KEVIN
;	Fix bug with calculation of size of modules whose byte size does
;	not match library.
;	Change default byte size from 7 to 0
;<KEVIN>LBR.MAC.163, 26-Jul-82 11:50:48, EDIT BY KEVIN
;<KEVIN>LBR.MAC.161, 26-Jul-82 11:17:47, EDIT BY KEVIN
;	Bug in EXPDIR with page numbering
;<KEVIN>LBR.MAC.160, 23-Jul-82 13:33:48, EDIT BY KEVIN

	Universal LBR

;
;	Mapping pages
;
	datpag==100000		;data buffer
	hdrpag==200000		;page to map header to
	modules==300000		;start of TBLUK table
	squpag==datpag		;page for squeezing things
	squhdr==datpag		;page for copying directory entries
	tdlist==datpag		;Page(s) for sorted list in TDIR
	ndpag==10		;number of buffer pages (one disk track)
	idxtab==datpag+ndpag*1000 ;where to put index tables
	maxidx==100		;no more than 64 index chapters at the moment
;
;	Offsets in header block
;
	$hwih==1		;words in header
	$hext==2		;file type of modules
	$hbysz==^d10		;byte size of modules
	$hupdt==^d11		;last update
	$hnent==^d12		;number of directory entries
	$hlfre==^d13		;size of largest free block
	$hflgs==^d14		;header flags
	$htfre==^d15		;total free space
	$hwpde==^d16		;number of words in directory entry
	$hnext==^d17		;number of pages in extension directory
	$hsafe==^d18		;safety marker
	$hndel==^d19		;number of deleted entries
	$hdir==^d20		;start of directory
	unsafe==hdrpag+$hsafe	;useful mnemonic
;
;	Directory entry offsets
;
	$dmnam==0		;module name (8 words)
	$dmstrt==8		;start of module
	$dmlen==9		;length of module
	$dmupd==^d10		;insert/update time stamp
;
;	Flag bits in $HFLGs
;
	hfprm==1b0		;permanent/ephemeral bit
;
;	Definitions of current values for library header block
;
	wpde==^d11		;number of words in a directory entry
	wih==^d20	;number of words in a header block
	hdrmrk==^d17758		;Library ID word
	maxent==<<modules-hdrpag-wih>/wpde>-1	;maximum number of modules in a library
	mxpg0=<1000-wih>/wpde	;maximum entries in page 0
	mxpgn=1000/wpde		;maximum entries in continuation pages
	prgend

	Title	LBR - program to create and maintain universal libraries
;
;	This is a program to maintain universal libraries, much as they exist
;	on RSX. A universal library is a file much like a REL file library
;	made by MAKLIB, except the the files can be anything - text files,
;	command files, etc. The only restriction is that they should all
;	originally have had the same file type (extension). The library is
;	used to store many original files in one large file, thus saving space
;	with small files. Individual files can be extracted from the library
;	at any time, or deleted, updated, replaced, etc. Subroutines are
;	also available to allow user programs to access files within libraries
;	directly, without having to extract them. This can make libraries useful
;	for things like tree-structure help files, etc.

;	In version 2, the program can be used in a restricted mode to
;	access tree-structured help files. A table is maintained at
;	SPCTAB of special commands and library names. If LBR sees COMMAND
;	in the rescan buffer, it opens a specific library, and changes the
;	TYPE command to be INFO. Thus, it can be used like the GUIDE program,
;	and GUIDE PRINT will access SYS:GUIDE.LBR and extract module PRINT.
;
;
;
;	Library structure is as follows:
;
;	Page 0 is the info block, as follows:
;	0		Library header - contains 17758 (decimal)
;	1	Number of words in header before directory
;	2-9		File type of files within this library
;	10		Byte size of files within this library
;	11		Internal date and time of last library update
;	12		Number of entries in library directory
;	13		Size of largest free block in bytes
;	14		Address of largest free block in bytes
;	15		Total unused space in library in bytes
;	16		Number of words in a directory entry
;	17		Safety flag - unsafe if non-zero
;	18		Number of deleted directory entries
;	19-511		Library directory (see below)
;
;	Format of a directory entry:
;	0-7		Name of module (ASCIZ)
;	8		Starting byte in file
;	9		Length of module in bytes
;	10		Insertion or update date (internal format).(0 if a deleted entry)
;

	search	vtmac
	search	lbr
	regdef
	external	error,errmes,getddt,$bpt
	.require k:ersub
	.require k:getddt

;
;	Macro definitions.
;	NOISE (text)	-	Parse noise field with COMND.
;	CONFIRM		-	Parse end of line
;		Both the above check for errors, and issue an automatic return.
;	USERR(errmes,flag,jfn)	Type error message preceded by ? on a new line
;				if needed. If flag is JSYS or JSY, issue jsys
;				error message. If flag is FIL, type filename of
;				jfn. Return.
;				If NOERR is on, do nothing except return
;
;	QUOERR			To be placed after JSYS's that we want to cause
;				an EXPUNGE if they fail.
;	COMND(fdb,errmes,jsy)	Parse command pointed to by FDB. If parse fails,
;				issue a USERR call with the supplied params.
;	DMSG (text)		Type text if debug flag is set.
;	NOINT			Inhibit interrupts and mark library unsafe.
;	OKINT			Decrement lock nesting level, if fully
;				cleared, allow interrupts and mark library as
;				safe.
;	CHKSFE			Check safety flag. If unsafe, issue error and
;				return.

	define	noise(nse),<hrroi	t2,[asciz/nse/]
		call	skpnoi
		 ret>

	define	confirm,<call	endcom
			ret>

	define	userr(text,jsyse<>,jfn<>),<
ifidn	<jsyse> <fil>,<push	p,jfn>
	txne	f,noerr		;;error inhibit set ?
	 ret			;;yes, just return
	call	tstcol
	movei	t1,"?"		;;assume non-timeshare job
	txne	f,takini	;;executing LBR.INIT ?
	 call	[txnn	f,timesh ;;yes, in batch ?
		 movei	t1,"%"	;;yes, make it a warning
		ret]		;;and continue
	pbout%			;;output prefix
	tmsg	<'text>
ifidn	<jsyse> <jsys>,<call	puterr>
ifidn	<jsyse> <jsy>,<call	puterr>
ifidn	<jsyse> <fil>,<pop	p,t2
	movei	t1,.priou
	setzb	t3,t4
	jfns%
	 erjmp	.+1>
	call	abotak		;;abort take file if necessary
	ret>

	define	quoerr(text),<xct	errop>

	define	comand(field,erms<>,jsy<>),<
	movei	t1,cmdblk
	movei	t2,field
	comnd%
	 erjmp	cmderr
	txne	t1,cm%nop
	 jrst	[userr	<erms>,jsy]>

	define	dmsg(text),<
	hrroi	t1,[asciz\text\]
	txne	f,debug
	psout%>

	define	noint,<call	liblck>
	define	okint,<call	lunlock>

	define	chksfe,<
	skipe	unsafe		;;safety flag ok ?
	 jrst	[userr	<Command is not permitted on a library that is marked unsafe - rebuild the library>]>


	f==0		;flag ac
	w$ild==1b1	;bit indicating wild parse of module name
	typing==1b2	;bit for type/copy command
	rwild==1b3	;bit for repeated wild scan
	tempot==1b4	;output files are temporary
	debug==1b5	;print debugging info
	intsys==1b6	;1 if interrupt system set up
	ccwait==1b7	;1 if a control-c interrupt pending
	iexpunge==1b8	;inhibit auto-expunge
	alowsq==1b9	;allow auto-squeezes
	ccints==1b10	;1 if control-c can be trapped
	ronly==1b11	;library was mapped read only
	listc==1b12	;using LIST (as opposed to DIRECTORY) command
	takini==1b13	;executing LBR.INIT
	rslib==1b14	;rescan successfully got a library name
	defsed==1b15	;SED is the default editor
	timesh==1b16	;we are not a batch job
	apping==1b17	;APPEND/COPY flag
	appnxt==1b18	;Flag to say output file for append is already open
	clsnrj==1b19	;Tell UMAP not to release lib jfn
	tdirf==1b20	;First pass of TDIR (collecting matching pointers)
	tdir2==1b21	;Second pass of TDIR (outputting directory)
	guide==1b22	;LBR is pretending to be GUIDE or something
	grscom==1b23	;Exit after rescanned command (ie was GUIDE PRINT et al)
	gprint==1b24	;PRINT command used instead of INFO
	idxmod==1b25	;in guide mode, INDEX modules were found.
	noerr==1b26	;Inhibit error traps
	tabok==1b27	;flag to MAPLIB to keep old TBLUK tables
	modif==1b28	;flag set by modifying commands
	fdflg==1b29	;FDIRECTORY, so print header stuff
	vdflg==1b30	;VDIR, so print dates/times
	qdflg==1b31	;QDIRECTORY , deleted modules
;
;	Flag bits for EDIT
;
	edtrdo==1b35	;edit /READONLY
	edtsed==1b34	;edit /SED
	copyok==1b33	;if 1, copy failed

NCHPW==5		;NUMBER OF ASCII CHARACTERS PER WORD
BUFSIZ==200		;SIZE OF INPUT TEXT BUFFER
ATMSIZ==BUFSIZ		;SIZE OF ATOM BUFFER FOR COMND JSYS
GJFSIZ==.GJRTY+2	;SIZE OF GTJFN BLOCK USED BY COMND JSYS
FDBSIZ==.CMDEF+2	;SIZE OF FUNCTION DESCRIPTOR BLOCK
PDLEN==50		;PUSH-DOWN STACK LENGTH


;INTERRUPT CHANNELS

RADIX 5+5

CHNTAB:
ccchan:	1,,ctrlc	;control c interrupts on level 1
ICH001:	BLOCK 1			;ASSIGNABLE CHANNEL 1
ICH002:	BLOCK 1			;ASSIGNABLE CHANNEL 2
ICH003:	BLOCK 1			;ASSIGNABLE CHANNEL 3
ICH004:	BLOCK 1			;ASSIGNABLE CHANNEL 4
ICH005:	BLOCK 1			;ASSIGNABLE CHANNEL 5
ICHAOV:	BLOCK 1			;ARITHMETIC OVERFLOW
ICHFOV:	BLOCK 1			;FLOATING OVERFLOW
ICH008:	BLOCK 1			;RESERVED
ICHPOV:	BLOCK 1			;PDL OVERFLOW
ICHEOF:	BLOCK 1			;END OF FILE
ICHDAE:	BLOCK 1			;DATA ERROR
ICHQTA:	2,,quota		;disk quota exceeded on level 2
ICH013:	BLOCK 1			;RESERVED
ICHTOD:	BLOCK 1			;TIME OF DAY (RESERVED)
ICHILI:	BLOCK 1			;ILLEG INSTRUCTION
ICHIRD:	BLOCK 1			;ILLEGAL READ
ICHIWR:	BLOCK 1			;ILLEGAL WRITE
ICHIEX:	BLOCK 1			;ILLEGAL EXECUTE (RESERVED)
ICHIFT:	BLOCK 1			;INFERIOR FORK TERMINATION
ICHMSE:	BLOCK 1			;MACHINE SIZE EXCEEDED
ICHTRU:	BLOCK 1			;TRAP TO USER (RESERVED)
ICHNXP:	BLOCK 1			;NONEXISTENT PAGE REFERENCED
ICH023:	BLOCK 1			;ASSIGNABLE CHANNEL 23
ICH024:	BLOCK 1			;ASSIGNABLE CHANNEL 24
ICH025:	BLOCK 1			;ASSIGNABLE CHANNEL 25
ICH026:	BLOCK 1			;ASSIGNABLE CHANNEL 26
ICH027:	BLOCK 1			;ASSIGNABLE CHANNEL 27
ICH028:	BLOCK 1			;ASSIGNABLE CHANNEL 28
ICH029:	BLOCK 1			;ASSIGNABLE CHANNEL 29
ICH030:	BLOCK 1			;ASSIGNABLE CHANNEL 30
ICH031:	BLOCK 1			;ASSIGNABLE CHANNEL 31
ICH032:	BLOCK 1			;ASSIGNABLE CHANNEL 32
ICH033:	BLOCK 1			;ASSIGNABLE CHANNEL 33
ICH034:	BLOCK 1			;ASSIGNABLE CHANNEL 34
ICH035:	BLOCK 1			;ASSIGNABLE CHANNEL 35

RADIX 8

SAVRET:	BLOCK 1			;RETURN ADDRESS OF CMDINI CALLER
SAVREP:	BLOCK 1			;SAVED STACK POINTER TO RESTORE ON REPARSE
RETPC1:	BLOCK 1			;RETURN PC FOR INTERRUPT LEVEL 1
RETPC2:	BLOCK 1			;RETURN PC FOR INTERRUPT LEVEL 2
RETPC3:	BLOCK 1			;RETURN PC FOR INTERRUPT LEVEL 3
CMDBLK:	BLOCK .CMGJB+5		;COMMAND STATE BLOCK FOR COMND JSYS
BUFFER:	BLOCK BUFSIZ		;INPUT TEXT STORED HERE
ATMBFR:	BLOCK ATMSIZ		;ATOM BUFFER FOR COMND JSYS
GJFBLK:	BLOCK GJFSIZ		;GTJFN BLOCK FOR COMND JSYS
PDL:	BLOCK PDLEN		;PUSH DOWN POINTER
NOIFDB:	BLOCK FDBSIZ		;FUNCTION DESCRIPTOR BLOCK FOR NOISE WORDS
NAMBUF:	BLOCK 8			;BUFFER FOR NAME OF INPUT FILE
INJFN:	BLOCK 1			;INPUT JFN FOR TAKE COMMAND
OUTJFN:	BLOCK 1			;OUTPUT JFN FOR TAKE COMMAND
TAKFLG:	BLOCK 1			;NON-ZERO IF PROCESSING INDIRECT FILE
eswits:	0			;flag bits for EDIT switches
havddt:	0			;-1 if DDT loaded
mapcnt:	0			;counter for waits to access library
libjfn:	0			;jfn of library file
filjfn:	0			;jfn of current module
lisjfn:	0			;jfn for LIST output
defext:	block	8		;file type of library modules (CREATE)
bysiz:	0			;byte size ""     """		""
mappd:	0			;=1 if library mapped
loklvl:	0		;lock nest level on library directory
ccxct:	0		;instruction to execute when control-c trapped
modbsz:	0			;byte size of new module
filsiz:	0
libsiz:	0
litlst:	0		;size of smallest module found
litlad:	-1			;address of best fit slot for module
squjfn:	0			;jfn of new library being "squeezed"
chdr:	0			;current directory entry for squeeze
cfil:	0			;current "eof" pointer in squeeze
dirnum:	0			;directory number of directory to be expunged
used:	0			;space used in target EXPUNGE directory
dirnam:	block ^d17		;name of target directory for EXPUNGE
errop:	nop		;instruction for execution after SOUT to lib
repjfn:	0		;jfn for input in REPLACE command
edtptr:	0			;pointer to crucial bits of edit buffer
luknam:	block	9		;name for lookup
guinam:	block	4		;prompt when in GUIDE mode
scratch:	block	20
edtbuf:	block	^d20		;filename edit buffer
copnam:	block	8	;wild module name in copy command
outnam:	block 8		;name for output in wild copys
outext:	block 8			;type "			""
outdir:	block	^d16		;structure/directory """""
prgjfn:	0			;JFN of editor file
frkhnd:	0			;inferior fork handle
excfrk:	0			;Fork for PUSH command
mptrs:	0			;pointer pointer for TDIR
wldjfn:	0		;parse only jfn for output
wldptr:	0			;pointer to directory for output
wldcnt:	0			;number of entries yet to search on wild lookup
wldblk:	gj%fou		;all wild stuff is for output files
	.nulio,,.nulio		;all is done from strings
	0			;no default device (in strings)
	0			;or directory		""
	-1,,outnam		;pointer to name
	-1,,outext		;and extension
	0			;no prot
	0			;no account
	0			;no special jfn
	subttl	Pure data

DEFINE TB(RTN,TXT)
<	[ASCIZ/TXT/] ,, RTN
>

DEFINE	ITB(RTN,TXT)
<	[CM%FW!CM%INV
	ASCIZ/TXT/],,RTN>	;INVISIBLE TABLE ENTRY

CMDTAB:	CMDSIZ-1,, CMDSIZ	;CURRENT,,MAX SIZE OF COMMAND TABLE
	TB (.APPEN,APPEND)	;APPEND (modules) mods (to file) fil
	tb (.COPY,COPY)		;extract module from library
	TB (.CREATE,CREATE)	;CREATE (Library name)
	itb (.ddt,DDT)		;enter ddt (invisible)
	TB (.DELETE,DELETE)	;Remove module from library
	TB (.DIREC,DIRECTORY)	;alternative for LIST
	TB (.EDIT,EDIT)		;EDIT (module)
	TB (.EXIT,EXIT)		;EXIT TO MONITOR
	TB (.FDIREC,FDIRECTORY)	;Full directory with header info
	TB (.GO,GO)		;GO (and execute last load-class command)
	TB (.HELP,HELP)		;OUTPUT HELP MESSAGE
	tb (.insert,INSERT)	;insert new module
	tb (.library,LIBRARY)	;select new library file
	tb (.list,LIST)		;list library directory
	tb (.push,PUSH)		;grab an EXEC
;	tb (.qdir,QDIRECTORY)	;directory of deleted
	tb (.replace,REPLACE)	;update modules
	tb (.set,SET)		;Set all sorts of things
	tb (.squeeze,SQUEEZE)	;SQUEEZE (empty space from library)
	TB (.SDIREC,STATUS)	;Print library banner
	TB (.TAKE,TAKE)		;TAKE (COMMANDS FROM) FILE-SPEC ...
	TB (.TDIR,TDIRECTORY)	;Directory sorted by time
	tb (.type,TYPE)		;type (module)
	tb (.update,UPDATE)	;REPLACE without module name
	TB(.VDIREC,VDIRECTORY)	;Directory with dates, times, etc.

	CMDSIZ== .-CMDTAB
;
;	Command table for GUIDE-style stuff
;
guicmd:	guisiz,,guisiz
	itb (.DDT,DDT)
	tb (.gexit,EXIT)
	tb (.ghelp,HELP)
	tb (.ginfo,INFO)	;INFORMATION (about subject)
	tb (.gprnt,PRINT)
	tb (.gexit,QUIT)

	guisiz==.-guicmd-1

;
;	Switches for EDIT
;
edswit:	edsiz,,edsiz
	TB (edtrdo,READONLY)
	TB (edtsed,SED)		;use SED
	edsiz==.-edswit-1

;	Tables of rescan commands/libraries to use for them.
;

 DEFINE X (CMD,LIB),<[ASCIZ/CMD/],,[ASCIZ/SYS:'LIB'.LBR/]>

SPCTAB:	spcsiz,,spcsiz
	X GUIDE,GUIDE
	[asciz/LBR/],,0
	X NAG,NAG
	X SUBS,SUBS

	SPCSIZ=.-SPCTAB-1

; LEVEL TABLE FOR INTERRUPT SYSTEM

LEVTAB:	RETPC1
	RETPC2
	RETPC3

; ENTRY VECTOR DEFINITION

ENTVEC:	JRST START		;MAIN ENTRY POINT
	JRST START		;REENTER ENTRY POINT
	verno	3,,298,3
	subttl	Main program

START:	RESET			;RESET THE UNIVERSE
	getnm%			;get our private program name
	move	t2,t1		;copy it..
	setsn%			;make into system name
	 ercal	error
	MOVE P,[IOWD PDLEN,PDL]	;SET UP STACK
	SETZM TAKFLG		;MARK THAT TAKE FILE NOT BEING PROCESSED
	HRROI T1,[asciz/LBR>/]	;GET POINTER TO PROMPT STRING
	MOVEM T1,CMDBLK+.CMRTY	;PUT RE-TYPE PROMPT POINTER IN STATE BLOCK
	HRROI T1,BUFFER		;GET POINTER TO INPUT TEXT BUFFER
	MOVEM T1,CMDBLK+.CMPTR	;SAVE POINTER TO COMMAND STRING
	MOVEM T1,CMDBLK+.CMBFP	;SAVE POINTER TO START-OF-BUFFER
	MOVE T1,[.PRIIN,,.PRIOU] ;GET PRIMARY INPUT,, OUTPUT JFN'S
	MOVEM T1,CMDBLK+.CMIOJ	;SAVE PRIMARY JFN'S
	MOVEI T1,PARSE1		;GET RE-PARSE ADDRESS
	MOVEM T1,CMDBLK+.CMFLG	;SAVE RE-PARSE ADDRESS
	SETZM CMDBLK+.CMINC	;INITIALIZE # OF CHARACTERS AFTER POINTER
	MOVEI T1,BUFSIZ*NCHPW	;GET # OF CHARACTERS IN BUFFER AREA
	MOVEM T1,CMDBLK+.CMCNT	;SAVE INITIAL # OF FREE CHARACTER POSITIONS
	HRROI T1,ATMBFR		;GET POINTER TO ATOM BUFFER
	MOVEM T1,CMDBLK+.CMABP	;SAVE POINTER TO LAST ATOM INPUT
	MOVEI T1,ATMSIZ*NCHPW	;GET # OF CHARACTERS IN ATOM BUFFER
	MOVEM T1,CMDBLK+.CMABC	;SAVE COUNT OF SPACE LEFT IN ATOM BUFFER
	call	intset		;set up interrupt system
	txo	f,tempot!iexpunge!alowsq
		;indicate temporary output files, autoexpunge, allow autosqueeze
	call	rescan		;try for a library name on the command line
	txne	f,timesh	;interactive ?
	 call	mod		;yes, type message of day
	txnn	f,guide		;in guide mode ?
	 CALL	inifil		;no, so try for LBR.INIT
	txne	f,guide		;GUIDE mode ?
	 call	idxbld		;yes, build the table of indices.
	move	t1,[jrst	cctyp] ;if in GUIDE mode, control-c trap inst
	movem	t1,ccxct	;store where it can be found
	txne	f,grscom	;GUIDE mode with module from command line ?
	 jrst	[movei	t4,.priou	;output for command
		jrst	.copy3]		;yes, so we just go straight to type
PARSE:	HRROI T1,[asciz/LBR>/]	;GET POINTER TO PROGRAM'S PROMPT STRING
	txne	f,guide		;in GUIDE mode ?
	 hrroi	t1,guinam	;yes, pick up prompt string
	CALL CMDINI		;OUTPUT THE PROMPT

PARSE1:	txz f,w$ild!rwild!typing!listc!apping!gprint!noerr!vdflg!fdflg!qdflg ;indicate no wild modules
	MOVE P,[IOWD PDLEN,PDL]	;SET UP STACK AGAIN
	SETOM T1		;INDICATE ALL JFN'S SHOULD BE RELEASED
	RLJFN			;RELEASE ALL JFN'S
	 JSERR			;UNEXPECTED ERROR
	CALL CLRGJF		;GO CLEAR GTJFN BLOCK

	move	t1,[txo	f,ccwait];instruction to execute when trapping ^C
	movem	t1,ccxct	;store where it can be found.
	MOVEI T1,GJFBLK		;GET ADDRESS OF GTJFN BLOCK
	MOVEM T1,CMDBLK+.CMGJB	;STORE POINTER TO GTJFN BLOCK
	txne	f,ronly		;Read only library ?
	 ifskp.			;if not....
	 skipn	mappd		;are we mapped ?
	 ifskp.			;if so...
	  txzn	f,modif		;did last command modify library, or could it?
	  ifskp.			;if so...
	   txo	f,clsnrj!tabok	;unmap, keep jfn, keep lookup tables
	   call	umap
	   call	maplib		;close and reopen library to keep FDB happy
	  endif.
	 endif.
	endif.			;end conditionals
	MOVEI T1,CMDBLK		;GET POINTER TO COMMAND STATE BLOCK
	MOVEI T2,[FLDDB. (.CMKEY,,CMDTAB)] ;GET FUNCTION BLOCK
	txne	f,guide		;in guide mode ?
	 movei	t2,[flddb. (.cmkey,,guicmd)] ;yes, use guide commands
	COMND			;DO INITIAL PARSE
	 erjmp cmderr		;error, go check for eof on take file
	TXNN T1,CM%NOP		;VALID COMMAND ENTERED ?
	JRST PARSE5		;YES, GO DISPATCH TO PROCESSING ROUTINE
	CALL TSTCOL		;TEST COLUMN POSITION, NEW LINE IF NEEDED
	TMSG <? LBR: No such LBR command as ">
	MOVE T1,CMDBLK+.CMABP	;GET POINTER TO ATOM BUFFER
	PSOUT			;OUTPUT STRING ENTERED BY USER
	TMSG <"
>				;OUTPUT END-OF-MESSAGE
	call	abotak		;dispose of take file if necessary
	JRST PARSE		;GO TRY TO GET A COMMAND AGAIN

PARSE5:	HRRZ T1,(T2)		;GET DISPATCH ADDRESS
	CALL (T1)		;PERFORM REQUESTED FUNCTION
	JRST PARSE		;GO PARSE NEXT COMMAND
SUBTTL	TAKE (COMMANDS FROM) FILE-SPEC (LOGGING OUTPUT ON) FILE-SPEC

.TAKE:	HRROI T2,[ASCIZ/COMMANDS FROM/] ;GET NOISE TEXT
	CALL SKPNOI		;GO PARSE NOISE FIELD
	 RET			;FAILED, RETURN FAILURE
	CALL CLRGJF		;GO CLEAR GTJFN BLOCK
	MOVX T1,GJ%OLD		;GET EXISTING FILE FLAG
	MOVEM T1,GJFBLK+.GJGEN	;STORE GTJFN FLAGS
	HRROI T1,[ASCIZ/CMD/]	;GET DEFAULT FILE TYPE FIELD
	MOVEM T1,GJFBLK+.GJEXT	;STORE DEFAULT EXTENSION
	MOVEI T1,CMDBLK		;GET ADDRESS OF COMMAND STATE BLOCK
	MOVEI T2,[FLDDB. (.CMFIL)] ;GET FUNCTION DESCRIPTOR BLOCK ADDRESS
	COMND			;PARSE INPUT FILE SPEC
	 erjmp cmderr		;error, go check for eof on take file
	TXNN T1,CM%NOP		;PARSED FILE-SPEC OK ?
	JRST TAKE10		;YES, GO ON AND SAVE INPUT JFN
	CALL TSTCOL		;ISSUE NEW LINE IF NEEDED
	TMSG <? LBR: Invalid file specification, >
	CALLRET PUTERR		;OUTPUT ERROR STRING TO TERMINAL

; HERE ON A GOOD INPUT FILE SPEC

TAKE10:	MOVEM T2,INJFN		;SAVE INPUT JFN FOR COMMANDS
	CALL ENDCOM		;GO PARSE COMMAND CONFIRMATION
	 RET			;RETURN, BAD CONFIRMATION

; OPEN INPUT AND OUTPUT FILES

	MOVE T1,INJFN		;GET INPUT JFN
	MOVE T2,[7B5+OF%RD]	;7 BIT BYTES, READ ACCESS
	OPENF			;OPEN INPUT FILE
	 JRST [	CALL TSTCOL	;ERROR, ISSUE NEW LINE IF NEEDED
		TMSG <? LBR: Cannot OPEN command file, >
		CALLRET PUTERR]	;GO ISSUE REST OF MESSAGE AND RETURN

; NOW SAVE NEW JFN'S AND RETURN TO PARSER

TAKE30:	HRLZ T1,INJFN		;GET INPUT JFN
	hllm	t1,cmdblk+.cmioj ;save new input jfn
	SETOM TAKFLG		;MARK THAT COMMANDS ARE COMING FROM FILE
	RET			;RETURN TO PARSER
	Subttl	CREATE command
;
;	This command CREATES a new library
; CREATE (Library) libfil.typ (extension) ext (byte size) n (with room for) ents
;
;	Extension and byte size default to null.
;
.create:	stkvar	<newlib,inient,dirpgn>
	noise	<new library>
	movx	t1,gj%new!gj%acc ;don't allow inferiors to meddle with jfn
	movem	t1,gjfblk
	hrroi	t1,[asciz/LBR/]
	movem	t1,gjfblk+.gjext	;store default extension
	comand	<[flddb. (.cmfil,cm%sdh,,<Name of new universal library>)]>,<Invalid library file name - >,jsy
	movem	t2,newlib	;store jfn
	noise	(extension)
	comand	<[flddb. (.cmact,cm%sdh,,<Confirm with carriage return, or file type for all files in library>,<>)]>,<Bad extension - >,jsy
	move	t1,[atmbfr,,defext]
	blt	t1,defext+7	;copy file extension
	noise	<byte size>
	comand	<[flddb. (.cmnum,cm%sdh,^d10,<Byte size for files in library>,<0>)]>,<Invalid number - >,jsy
	jumpl	t2,[userr	<Byte size must be 0-36>]
	caile	t2,^d36		;OK byte size ?
	 jrst	[userr	<Byte size must be less than 36>] ;no
	movem	t2,bysiz	;store byte size
	noise	(with room for) ;this many entries
	comand	<[flddb. (.cmnum,cm%sdh,^d10,<Initial number of files to allow for>,<0>)]>,<Invalid number - >,jsy
	jumpl	t2,[userr <Must have a positive number of files !>]
	caile	t2,maxent	;less than maximum entries ?
	 jrst	[userr	<Too many entries specified>]
	movem	t2,inient	;save initial number of entries
	noise	(entries initially)
	confirm			;get confirmation
	txo	f,modif		;flag library is modified
	call	umap		;unmap any current library
	move	t1,newlib	;get new library jfn
	movem	t1,libjfn	;make current library
	txz	f,ronly		;clear any read-only flags
	move	t1,inient	;get initial number of entries
	caig	t1,mxpg0	;at least enough for one page ?
	 movei	t1,mxpg0	;no, make it at least one page
	subi	t1,mxpg0	;subtract number of entries we can fit in 1 page
	idivi	t1,mxpgn	;and divide by number in subsequent pages
	skipe	t2		;any remainder ?
	 aoj	t1,		;yes, add one more page
	aoj	t1,		;add on page 0
	movem	t1,dirpgn	;store number of pages in directory
	setzm	hdrpag		;zero out the header page
	move	t1,[hdrpag,,hdrpag+1] ;source,,dest for BLT
	move	t2,dirpgn	;get number of pags in directory
	imuli	t2,1000		;convert to a number of words
	soj	t2,		;keep within last page
	addi	t2,hdrpag	;get address of end of directory buffer
	blt	t1,(t2)		;now zero the directory
	movei	t1,hdrmrk	;magic number for page 0 of library
	movem	t1,hdrpag	;store it
	movei	t1,wih		;number of words in current header
	movem	t1,hdrpag+$hwih	;store it
	move	t1,[defext,,hdrpag+$hext]
	blt	t1,hdrpag+$hext+7	;store default extension
	move	t1,bysiz	;get byte size for library
	movem	t1,hdrpag+$hbysz	;store
	gtad%			;get current date and time
	movem	t1,hdrpag+$hupdt	;store as time of last update
	movei	t1,wpde		;words per directory entry
	movem	t1,hdrpag+$hwpde ;store
	move	t1,dirpgn	;get number of pages in directory
	soj	t1,		;subtract one for extension pages
	movem	t1,hdrpag+$hnext ;store
	move	t1,libjfn	;get library jfn
	movx	t2,of%wr
	openf%			;open it
	 erjmp	[userr	<Cannot open new library - >,jsys]
	move	t1,libjfn	;write to new library
	move	t2,[point ^d36,hdrpag] ;from header page
	movn	t3,dirpgn	;number of pages to do (negative)
	imuli	t3,1000		;convert to words
	sout%			;write it
	 quoerr	<Cannot write to library>
	move	t1,libjfn	;now get library
	txo	t1,co%nrj
	closf%			;close, but do not release jfn
	 ercal	error		;tuff
	move	t1,libjfn	;point to file
	txo	t1,fld(.fbbyv,cf%dsp) ;word to change
	movx	t2,fb%bsz	;mask in word to alter
	move	t3,bysiz	;new byte size for library
	lsh	t3,<^d35-pos(fb%bsz)>;shifted to proper place
	chfdb%			;do it
	 ercal	error
	move	t3,bysiz	;get byte size
	skipn	t3		;is it 0 ?
	 movei	t3,^d36		;yes, make 36
	movei	t2,^d36		;number of bits in word
	idiv	t2,t3		;fidn number of bytes in word
	imuli	t2,^d512	;get number of bytes in page
	imul	t2,dirpgn	;multiply by pages in directory
	movem	t2,t3
	move	t1,libjfn	;jfn of file
	txo	t1,fld(.fbsiz,cf%dsp) ;field to modify
	seto	t2,			;modify all bits
	chfdb%			;reset eof byte pointer
	 ercal	error
	jrst	maplib		;now map new library
	subttl	LIST - list directory of library file
;
;	This command lists all modules in the library
;


;	Macro to output message to listing file

	define lmsg(text),<
	xlist
	push	p,t2
	push	p,t3
	push	p,t4			;;save some acs
	move	t1,lisjfn		;;point to output
	hrroi	t2,[asciz\text\]
	setzb	t3,t4			;;terminate on nulls
	sout%
	 ercal	error
	pop	p,t4
	pop	p,t3
	pop	p,t2
	list>

;	Macro to output message and number

	define	onum(text,value),<
	xlist
	lmsg	<
text>
	xlist
	move	t1,lisjfn
	move	t2,value
	movx	t3,^d10
	nout%
	 ercal	error
	list>

;	Switch table

afbtab:	6,,6
	[ASCIZ/AFTER:/],,aftswi
	[ASCIZ/BEFORE:/],,befswi
	[ASCIZ/FULL/],,fulswi
	[ASCIZ/OUTPUT:/],,outswi
	[ASCIZ/SORTED-BY-TIME-AND-DATE/],,srtswi
	[ASCIZ/VERBOSE/],,verswi

.list:	noise	<of modules called>
	txo	f,listc		;flag LIST command
	jrst	.dirc1

.tdir:	noise	<of modules, by time of update>
	txo	f,tdirf		;flag sorted directory
	movei	t1,tdlist	;where list begins
	movem	t1,mptrs	;initialize pointer
	jrst	.dirc1		;join common code

.FDIREC: noise	<full directory of modules>
	txo	f,fdflg!vdflg
	jrst	.dirc1
.vdirec:	noise	<verbose directory>
	txo	f,vdflg
	jrst	.dirc1
.sdirec:	noise	<of current library>
	confirm
	movei	t1,.priou		;STATUS always works to TTY:
	movem	t1,lisjfn
	call	shohed
	ret
.direc:	noise	<of modules in library>
.dirc1:	skipn	mappd		;got a library ?
	 jrst	[userr	<No library file selected - use LIBRARY command>]
	trvar	<lodate,hidate,afbtyp>
	movei	t1,.priou	;set up default output device
	movem	t1,lisjfn	;in case they typed LIST and CONFIRM
	comand	[
	flddb. (.cmact,cm%sdh,,<Modules to list, or return to list all>,<*>,)],<Invalid module name - >,jsy
	move	t1,[atmbfr,,copnam]
	blt	t1,copnam+7	;copy name of wildcard module to safe place
	txo	f,w$ild		;indicate wildcard checking must be done
	setz	t4,		;indicate no jfn getting to be done by WLDSET
	call	wldset		;check something matches the wild spec
	 ret			;bad spec
	txne	f,listc		;is this a LIST command ?
	 jrst	[call	outspc		;yes, so get output file name
		 ret		;failed
		jrst	.+1]	;succeeded
	setzm	hidate		;Assume no /BEFORE: switch
	setzm	lodate		;or /AFTER: switch
	call	prsafb		;parse any switches
	 ret			;failed, return
	setz	t4,		;indicate no jfn getting to be done by WLDSET
	call	wldset		;initialize for wildcard parse
	 ret			;bad spec
;...
;...
;	Here to actually do the listing
;
	txze	f,fdflg		;want a full directory ?
	  call	shohed		;yes, output header info
	skipn	q1		;any thing to do ?
	 ret			;no, so go back
	txne	f,vdflg		;verbose directory ?
	 jrst	[lmsg	< Module name                              Size Last update
>
		jrst	.list1]	;yes, do verbose header
.list1:	txne	f,tdir2		;second pass of TDIR ?
	 jrst	[move	q2,@mptrs ;yes, so pick up pointer from sorted list
		hlrz	t4,(q2)	;get string pointer
		jrst	.lists]	;continue - no checks needed
	move	q2,q1		;address of first module is in q1
	hlrz	t4,(q2)		;get address of module entry
	skipn	$dmupd(t4)	;deleted entry ?
	 jrst	.listd		;yes, do not list
	skipe	t1,hidate	;/BEFORE: switch given ?
	 camle	t1,$dmupd(t4)	;yes, is this module after BEFORE date ?
	skipa			;no, so list it
	 jrst	.listd		;yes, so don't list it
	skipe	t1,lodate	;/AFTER: switch given ?
	 camge	t1,$dmupd(t4)	;yes, is this module before AFTER date ?
	skipa			;no, so list it
	 jrst	.listd		;yes, so don't list it
	txne	f,tdirf		;doing first pass for TDIR ?
	 jrst	[movem	q2,@mptrs ;yes, so store the pointer for this modules
		aos	mptrs	;increment the output pointer
		jrst	.listd]	;continue
.lists:	push	p,t4		;save module pointer
	hlro	t2,(q2)		;form pointer to module name
	move	t1,lisjfn	;get out jfn
	setzb	t3,t4		;terminate string on null
	sout%			;write module name out
	pop	p,t4		;get pointer back
	txnn	f,vdflg		;verbose directory ?
	 jrst	.listn		;no, so no date/time info
	hlrz	t1,(q2)		;point to name again
	call	slen		;get string length in t2
	movn	t3,t2		;make negative
	addi	t3,^d40		;desired column pos
	movei	t2," "		;get a space
	move	t1,lisjfn	;place to write to
.list2:	bout%			;write it
	sojn	t3,.list2	;loop until squared up
	move	t2,9(t4)	;get number of bytes
	move	t1,lisjfn	;write to listing file
	movx	t3,fld(6,no%col)!no%lfl!^d10
	caml	t2,[^d1000000]	;a megabyte or more in the file ?
	 movx	t3,fld(8,no%col)!no%lfl!^d10 ;yes, what's it doing in a library?
	nout%			;write it
	 ercal	error
	lmsg	< >		;move a space
	move	t2,^d10(t4)	;get update
	move	t1,lisjfn	;write to listing
	setz	t3,		;usual format
	odtim%			;write update
	 ercal	error
.listn:	lmsg	<
>				;new line for new module
.listd:	txne	f,tdir2		;second TDIR pass ?
	 jrst	[aos	mptrs	;yes, so increment pointer to pointers (!!)
		skipe	@Mptrs	;all done yet ?
		 jrst	.list1	;no, so do the next
		jrst	.liste]	;yes, so finish up
	aoj	q2,		;improve pointer
	call	wldnxt		;step wildcard lookup
	 jrst	.liste		;all done
	jrst	.list1		;do the mext one
.liste:	txne	f,tdirf		;finished first pass for TDIR ?
	 jrst	[call	tdsrt	;yes, so sort the pointers
		txc	f,tdirf!tdir2	;first pass over, second begun
		movei	t1,tdlist ;point back to listhead (now sorted)
		movem	t1,mptrs  ;and store in pointers pointer
		jrst	.list1]	;now output the directory listing
	lmsg	<
>				;close off listing
	txz	f,tdir2		;flag TDIR done
	txnn	f,listc		;LIST command ?
	 ret			;no, so all done
	move	t1,lisjfn	;yes, so get listing file
	closf%			;and close it
	 nop
	ret			;back to caller
	subttl	SHOHED - list header info for FD and STATUS
;
;	This routine is called by the FDIRECTORY and STATUS commands
;	to print info from the library's header block.
;
shohed:	lmsg	<
Listing of universal library >
	move	t1,lisjfn
	move	t2,libjfn
	setz	t3,
	setz	t4,
	jfns%		;output library name
	 ercal	error
	lmsg	< at >
	move	t1,lisjfn
	seto	t2,
	odtim%		;and current date and time
	 ercal	error
	lmsg	<.
>
	move	t3,hdrpag+$hnent	;total modules
	sub	t3,hdrpag+$hndel	;minus deleted ones
	onum	<Modules in library: >,<t3>
	move	t2,hdrpag+$hnent
	txnn	f,w$ild		;wildcard lookup ?
	 movem	t2,q1		;no, save for later loop
	lmsg	<
Last updated: >
	move	t1,lisjfn
	move	t2,hdrpag+$hupdt
	setz	t3,
	odtim%		;and date of last update
	 ercal	error
	onum	<Byte size of modules: >,<hdrpag+$hbysz>
	lmsg	<
Type of files in library: >
	move	t1,lisjfn
	hrroi	t2,hdrpag+$hext
	setzb	t3,t4
	sout%				;output file type of modules
	move	t3,hdrpag+$hnext	;extension pages
	aoj	t3,			;add page 0
	onum	<Pages used for overhead: >,<t3>
	onum	<Number of deleted modules: >,<hdrpag+$hndel>
	onum	<Free space in bytes: >,<hdrpag+$htfre>
	lmsg	<
>
	ret
	subttl	TDSRT - sort module pointers for TDIRECTORY command
;
;	This command takes a list of TBLUK pointers created by the code
;	used for an ordinary directory. It sorts the list into date order,
;	then sets a flag to indicate to DIRECTORY to output from this list,
;	rather than from the WLDSET stuff, etc.
;	A simple bubble sort is used.
;
TDSRT:	stkvar	<nswaps>	;counter for number of swaps this pass
	setzm	@mptrs		;clean off end of list
	dmsg	<
[TDIR - beginning sort]
>
tdpas:	setzm	nswaps		;no swaps yet
	movei	t3,tdlist+1	;Point to list of modules
tdpas1:	skipn	t2,(t3)		;end of list yet ?
	 jrst	[skipn	nswaps	;yes, done any swaps ?
		 ret		;no, so list is sorted
		dmsg	<[TDIR - Starting next pass]
>
		jrst	tdpas]	;yes, so must go round again
	hlrz	t1,(t2)		;get pointer to module header
	move	t1,$dmupd(t1)	;and retrieve date of update
	move	t2,-1(t3)	;get previous pointer
	hlrz	t2,(t2)		;get address of header
	camg	t1,$dmupd(t2)	;is previous > current ?
	 jrst	tdnxt		;yes, so look at next
	aos	nswaps		;no, so increment swaps done
	move	t1,(t3)		;get current pointer
	exch	t1,-1(t3)	;swap with previous
	movem	t1,(t3)		;put previous as current
tdnxt:	aoja	t3,tdpas1	;increment pointer into list of lists
	subttl	PRSAFB - parse possible /AFTER or /BEFORE switches
;
;	This subroutine parses general switches for the directory command set.
;	It may use t1-t4 freely, and expects variables lodate,hidate
;	to be set up by TRVAR before entry.
;	A date, time or date and time are parsed, with appropriate fixups
;	for each type.
;
prsafb:	comand	[
	flddb. (.cmswi,,afbtab,,,[
	flddb. (.cmcfm)])],<Invalid switch or confirmation because: >,jsy
	hlrz	t1,t3		;get fdb supplied
	hrrz	t3,t3		;and fdb used
	came	t1,t3		;equal ?
	 retskp			;no, so confirm typed, go ahead
	hrrz	t2,(t2)		;yes, so switch typed, find out which
	call	(t2)		;yes, so parse whichever switch it was
	 ret			;failed
	jrst	prsafb		;and go get another one
;
;	AFTER/BEFORE handlers
;
aftswi:	setzm	afbtyp
	call	dattim		;parse date/time
	 ret			;failed
	movem	t2,lodate	;remember time
	retskp			;success return
befswi:	setom	afbtyp
	call	dattim		;parse date/time
	 ret			;failed
	movem	t2,hidate	;remember limit
	retskp			;success return
;
;	VERBOSE/FULL handlers
;
verswi:	txo	f,vdflg		;light the verbose flag
	retskp
fulswi:	txo	f,fdflg!vdflg	;light the full flag
	retskp			;continue
srtswi:	txo	f,tdirf		;flag sorted directory
	movei	t1,tdlist	;where list begins
	movem	t1,mptrs	;initialize pointer
	retskp
;
;	Routine to parse date, time or date and time
;
dfdb1:	flddb.(.cmtad,cm%sdh,cm%itm!cm%ida,<Date, time or date and time>,,dfdb2)
dfdb2:	flddb. (.cmtad,cm%sdh,cm%itm,,,dfdb3)
dfdb3:	flddb. (.cmtad,cm%sdh,cm%ida)

dattim:	comand	dfdb1,<Invalid date or time because: >,jsy
	hrrz	t3,t3		;get fdb used
	cain	t3,dfdb1	;date and time ?
	 retskp			;yes, use as is
	cain	t3,dfdb2	;just time ?
	 jrst	dttim		;yes, time only entered, frig the date
	caie	t3,dfdb3	;just date ?
	 jrst	[userr	<Cannot understand date/time field>]
	hllzs	t2,t2		;always reduce input to date only
	skipn	afbtyp		;was it /AFTER ?
	 add	t2,[1,,0]	;yes, make date next day for comparison
	retskp			;and return success
dttim:	gtad%			;get current date/time
	camg	t1,t2		;is time in past ?
	 sub	t2,[1,,0]	;no, it is 1 AM and they typ /AFT:11pm, so make
				; it look like yesterday.
	retskp			;and return success
	subttl	OUTSPC - parse output spec for directory
;
;	This routine parses a directory output file spec. It has two
;	entry points - one from the LIST command (OUTSPC) and one
;	from the /OUTPUT switch (OUTSWI)
;
outspc:	noise	<on output file>;yes, so grab some noise
	jrst	outsw2		;skip check for multiple output
outswi:	txoe	f,listc		;set list flag, check if already on
	 jrst	[ userr	<Illegal to specify multiple output files>]
outsw2:	movx	t1,gj%fou
	movem	t1,gjfblk
	hrroi	t1,[asciz/LST/]
	movem	t1,gjfblk+.gjext	;store default extension
	hrroi	t1,[asciz/DSK/]	;default device
	movem	t1,gjfblk+.gjdev ;point to it
	hrroi	t1,[asciz/LBR/] ;default name
	movem	t1,gjfblk+.gjnam ;store pointer
	comand	<[flddb. (.cmfil,cm%sdh,,<Name of listing output file>)]>,<Invalid name for listing file because: >,jsy
	movem	t2,lisjfn	;save the jfn
	move	t1,lisjfn	;get listing jfn
	movx	t2,fld(7,of%bsz)!of%wr ;open listing file for write access
	openf%			;open it
	 erjmp	[userr	<Cannot open listing file - >,jsy]
	retskp
	subttl	INSERT - insert new module in file
;
;	This command inserts a new module into a library file.
;
.insert:	noise	(new module)
	skipn	mappd		;got a library ?
	 jrst	[userr	<No library selected - use LIBRARY command>]	;no
	txne	f,ronly		;read only library ?
	 jrst	[userr	<Write access to library required>] ;yes, cannot do it
	chksfe			;library safe ?
	movx	t1,gj%old!gj%ifg!gj%flg ;must be an existing file, allow wild
	movem	t1,gjfblk
	hrroi	t1,hdrpag+$hext	;point to default extension
	ldb	t2,[point 7,hdrpag+$hext,6] ;check the extension
	setzm	gjfblk+.gjext	;assume no extension
	skipe	t2		;is there one yet ?
	 movem	t1,gjfblk+.gjext ;yes, so use it
	comand	<[flddb. (.cmfil,cm%sdh,,<Module to insert>)]>,<Bad module name - >,jsys
	movem	t2,q1		;save jfn
	confirm			;get confirmation
	txo	f,modif		;flag library is modified
;
;	Now loop through all files requested
;	The wild jfn is retained in q1 (with flags.) Routines that need
;	it extract it without the flags by a HRRZ.
;
.innxt:	txnn	q1,gj%dev!gj%dir!gj%nam!gj%ext!gj%ver ;wildcards used ?
	 jrst	.innx1		;no, so no filename logging
	tmsg	<
>
	movei	t1,.priou		;yes, so point to terminal
	hrrz	t2,q1		;get jfn
	setzb	t3,t4		;usual filename format
	jfns%			;write to screen
	 ercal	error		;should not fail
.innx1:	call	doins		;do an insert of one module
	 ret			;failed, so return
	hrrz	t1,q1		;get jfn
	txo	t1,co%nrj	;don't release
	closf%			;close it
	 nop			;tuff
	txnn	q1,gj%dev!gj%dir!gj%nam!gj%ext!gj%ver ;wildcards used ?
	 jrst	.innx2		;no
	tmsg	< [OK]>		;reassure the user
.innx2:	move	t1,q1		;get full file handle
	gnjfn%			;try to step the jfn
	 erjmp	.inend		;no more files in this group
	jrst	.innxt		;ok, do the next file
.inend:	ret
	SUBTTL	doins - insert a single module
;
;	This routine just inserts one module into a file. +1/+2 return format
;	Wild JFN is in q1. (for input file)
;
doins:	hrrz	t2,q1		;get jfn of module (no flags)
	hrroi	t1,luknam	;point to name for lookup
	movx	t3,fld(.jsaof,js%nam) ;output name
	jfns%			;do it
	 ercal	error
	call	lukmod		;do a lookup
	 jrst	.insec		;not found, continue
	call	tstcol		;found, so warn we will not do it
	tmsg	<%Module is already in library, not replaced: > ;type a warning
	hrrz	t2,q1		;get the jfn
	movei	t1,.priou	;point to termial
	setz	t3,
	jfns%			;and tell them what file we didn't do
	 ercal	error
	retskp			;must give successful return
.insec:	hrrz	t1,q1		;get jfn of module
	call	chkoff		;check for online file
	 ret			;not online, return
	hrrz	t1,q1		;get jfn again
	noint			;we will now meddle the directory - flag it
	call	chktyp		;verify type, set it if not already done
	hrrz	t1,q1
	call	chkbsz		;check byte size
	hrrz	t1,q1		;get jfn
	move	t2,hdrpag+$hbysz	;get library byte size
	lsh	t2,<^d35-pos(of%bsz)>	;put it in the right place
	txo	t2,of%pln!of%rd		;we want read access
	openf%				;do it
	 erjmp	[userr	<Cannot open file for read - >,jsy]
	hrrz	t1,q1		;jfn
	movem	t1,filjfn	;store jfn
	call	getsiz		;now compute the size of this file in bytes
	movem	t2,filsiz	;save that
	move	t1,libjfn
;
;	We would like to use SIZEF to read the number of bytes - however,
;	GETSIZ may have executed a SFBSZ jsys, which means that the results
;	returned by SIZEF% are incorrect until the file is closed. We use
;	SFBSZ rather than CHFDB because it means the monitor does the numbers
;	for us - let it do it again.
;
	seto	t2,
	sfptr%			;reset library pointer to eof
	 ercal	error
	rfptr%			;now read the file position
	 ercal	error
	movem	t2,libsiz	;save it
	call	bstfit		;try to find a slot to place this in
	call	updfil		;update the library data pages
	call	updtab		;update the lookup tables
	 ret			;failed
	okint			;the file is now consistent
	retskp			;return success
	subttl	UPDTAB - this routine updates library tables
;
;	Called when a new module is inserted to update the lookup
;	tables, both in memory and the library.
;	Inputs: q1/ Indexable file handle.
;
updtab:	skipl	t1,litlad	;did we get a free slot from BSTFIT ?
	 jrst	updta2		;yes, so use it
	move	t1,hdrpag+$hnent		;get number of entries
	skipn	hdrpag+$hnext		;any extension pages ?
	 jrst	[caige	t1,mxpg0	;no, will we overflow page 0 ?
		 jrst	updta1		;no, continue
		call	expdir		;yes, so expand directory
		 jrst	updtaf		;failed
		jrst	updta1]		;succeeded
	subi	t1,mxpg0	;ok, clear first page stuff
	move	t3,hdrpag+$hnext	;get number of extensions
	imuli	t3,mxpgn		;multiply by entries in a page
	camge	t1,t3		;is this page full yet ?
	 jrst	updta1		;no, so continue
	call	expdir		;yes, so expand directory
	 jrst	updtaf		;failed - probably out of space
	jrst	updta1		;succeeded - continue
updtaf:	userr	<Failed to update directory - >,jsy
updta1:	move	t1,hdrpag+$hnent	;get number of entries again
	imul	t1,hdrpag+$hwpde	;find address of next free entry
	addi	t1,hdrpag		;in memory
	add	t1,hdrpag+$hwih	;add words in header
	aos	hdrpag+$hnent	;update number of entries
	move	t2,libsiz	;get byte address in library
	movem	t2,$dmstrt(t1)		;store
updta2:	push	p,t1			;save position
	hrros	t1,t1		;make a byte pointer
	hrrz	t2,q1		;get jfn of module
	movx	t3,fld(.jsnof,js%dev)!fld(.jsnof,js%dir)!fld(.jsnof,js%typ)!fld(.jsnof,js%gen)!fld(.jsaof,js%nam)
	setz	t4,
	jfns%			;write file name out
	 ercal	error
	pop	p,t1		;get address of entry back
	move	t2,filsiz	;get size of module
	movem	t2,$dmlen(t1)	;store
	movem	t1,t2
	gtad%			;get current date
	movem	t1,$dmupd(t2)	;store
	movem	t1,hdrpag+$hupdt ;also update library header
	hrlzs	t2,t2		;make TBLUK pointer to module name
	movei	t1,modules	;point to table
	tbadd%			;enter in table
	 ercal	error
	retskp			;back to caller
	subttl	UPDFIL - update data pages when inserting new module
;
;	This routine updates the library by placing a new module in.
;	It does not alter any lookup tables.
;
updfil:	move	t3,litlad		;get address of possible entry
	seto	t2,		;assume use end of file
	skipl	t3		;did we get a free slot from BSTFIT ?
	 move	t2,$dmstrt(t3)	;yes, so get its start address
	move	t1,libjfn 	;point to end of library
	sfptr%
	 ercal	error
	move	q2,filsiz	;get size back
	movns	q2,q2		;make negative
	camle	q2,[-^d512*ndpag]	;a whole pages worth ?
	 jrst	.inse2		;no
.inse1:	hrrz	t1,q1		;get jfn of input file
	move	t2,[point ^d36,datpag] ; read as 36 bit bytes
	movni	t3,^d512*ndpag		;one page's worth
	sin%			;read a page
	 erjmp	[movx	t1,.fhslf	;check on error
		geter%
		hrrzs	t2,t2	;get just error code
		caie	t2,iox4	;end of file reached ?
		 call	error	;no, invoke error traceback
		addi	t3,1000*ndpag	;add bytes we wanted to read
		movns	t3,t3	;construct bytes actually read
		jrst	.inse3] ;continue
	move	t1,libjfn	;point to library
	move	t2,[point ^d36,datpag] ;point to data
	movni	t3,^d512*ndpag	;one page
	sout%			;write it
	 quoerr	<Cannot write to library>
	addi	q2,^d512*ndpag	;remove that number of bytes
	camg	q2,[-^d512*ndpag]	;still whole pages left ?
	 jrst	.inse1		;yes
.inse2:	move	t3,q2	;number of bytes to read
	hrrz	t1,q1		;read input file
	move	t2,[point ^d36,datpag] ;to data buffer
	sin%			;do it
	 erjmp	.+1		;igore errors
	movns	t3,t3		;how many bytes left ?
	add	t3,q2		;discover how many were read
.inse3:	move	t1,libjfn	;point to library
	move	t2,[point ^d36,datpag] ;and data
	sout%			;write it out
	 quoerr	<Cannot write to library>
	ret			;back to caller
	subttl	EXPDIR - subroutine to expand library directory
;
;	This routine is called by UPDTAB when it has discovered that the entry
;	it is about to place in the library directory will cause the current
;	page to overflow. As a result, we move the entire library up the
;	file by one page, and then go back and update the address pointers in
;	the directory to indicate the new situation.

;	Returns +1: Failure - could not allocate extra space.
;		+2: Success, library and directory are updated.

expdir:	stkvar	<frepag,dirsiz>
	call	tstcol
	tmsg	<[Expanding library directory]>
	move	t1,libjfn	;point to the library
	ffffp%			;find first free file page
	 ercal	error		;unexpected error
	jumpl	t1,[userr	<File has no free pages>]
	hrrzm	t1,frepag	;get free page number
	aos	hdrpag+$hnext	;now update number of extension pages used
;
;	Now we must loop and update all the entries in the directory.
;
	movei	t1,^d36		;number of bits in a word
	idiv	t1,hdrpag+$hbysz ;divided by bits in a byte
	imuli	t1,^d512	;eventually gives bytes in a page
	movem	t1,t2		;store this useful number
	move	t4,hdrpag+$hnent ;get number of entries
	movei	t3,hdrpag+$hdir+8 ;address of start of directory byte no.
expdi2:	addm	t2,(t3)		;update this entry
	addi	t3,wpde		;point to next entry
	sojn	t4,expdi2	;loop for all entries
	move	t1,frepag	;get that number (is number of pages in file)
	sub	t1,hdrpag+$hnext ;subtract number of extension pages allocated
;
;	t1 now contains the number of file pages used for data storage
;	We now work backwards through the file, mapping pages from the
;	end of the file out beyond the file's new end.
;
;	sos	frepag		;page numbers start at 0
	movnm	t1,t4		;save loop count( negated)
expdi1:	hrlz	t1,libjfn	;get library jfn
	hrr	t1,frepag	;and page number of free page
	soj	t1,		;point to page to read
	move	t2,[.fhslf,,datpag/1000] ;page we use for mapping data
	movx	t3,pm%rd!pm%cpy!pm%pld	;load with copy-on-write
	pmap%			;do it
	 ercal	error		;not expected
	moves	datpag		;make page private
	hrlz	t2,libjfn	;get library jfn
	hrr	t2,frepag	;point to new page to use
	move	t1,[.fhslf,,datpag/1000] ;our buffer page
	movx	t3,pm%wr!pm%rd ;read and write access
	pmap%			;map the page out again
	 erjmp	[userr	<Cannot expand library - >,jsy]
	sos	frepag		;decrement page to map counter
	aojl	t4,expdi1	;loop for all data pages
;	...
;	...
	okint			;OK, make library safe (it is)
	move	t4,hdrpag+$hbysz	;get byte size before unmap
	seto	t1,		;now prepare to unmap directory
	move	t2,[.fhslf,,hdrpag/1000] ;to prepare to close the file
	move	t3,hdrpag+$hnext	;get number of directory pages
	txo	t3,pm%cnt		;flag count
	pmap%			;do so
	 ercal	error
	move	t1,libjfn	;library
	txo	t1,co%nrj	;close, but do not release jfn
	closf%			;do it
	 ercal	error		;this must succeed
	setzm	mappd		;flag not mapped
	movei	t3,^d36		;number of bits in a word
	idiv	t3,t4	 ;divide by bits in byte
	imuli	t3,1000		;get bytes in a page
	addm	t3,libsiz	;update size of library in bytes
	movx	t1,fld(.fbsiz,cf%dsp) ;modify byte count
	hrr	t1,libjfn	;of library
	seto	t2,		;change whole word
	move	t3,libsiz	;new size of library in bytes
	add	t3,filsiz	;plus size of module just inserted
	chfdb%			;do it
	 ercal	error
	push	p,q1		;save ac that may be trashed
	call	maplib		;now map library again
	pop	p,q1
	noint			;make library unsafe again (it will be)
	retskp			;return success
	subttl	BSTFIT - find best fit slot for a new module
;
;	This routine is called before an insert or update to determine
;	if there is an available deleted slot which will accomodate the current
;	module. If one exists, its address is returned for use. The directory
;	is not scanned if no deleted modules are present, and so this info must
;	be up to date. Also, a check on the largest free block size is made, and
;	if smaller than FILSIZ (size of module), the directory is not scanned.
;
bstfit:	setom	litlad		;no address initially
	skipn	hdrpag+$hndel	;any deleted slots ?
	 jrst	endfit		;no, so must slot onto end
	move	t1,filsiz	;get size of new module
	camle	t1,hdrpag+$hlfre ;is it bigger than largest free slot ?
	 jrst	endfit		;yes, so don't look for a free slot
	dmsg	<
[Scanning for best fit deleted slot]>
	move	t1,filsiz	;get module desired size
	move	t4,hdrpag+$hnent ;ok, looks good - get number of entries
	movei	t2,hdrpag	;get address of library header
	add	t2,hdrpag+$hwih	;add header length to point to directory
	setzm	litlst		;zero out found slot size
bstft1:	skipe	$dmupd(t2)	;is this entry deleted ?
	 jrst	bstft3		;no, so skip it
	camle	t1,$dmlen(t2)	;is this large enough for new module ?
	 jrst	bstft3		;no, so forget it
	move	t3,$dmlen(t2)	;looks large enough...
	skipn	litlst		;found one yet ?
	 movem	t3,litlst	;no, so find this one
	camle	t3,litlst	;is it bigger than best fit so far ?
	 jrst	bstft3		;yes, so not very interesting
	movem	t3,litlst	;no, so remember this size
	movem	t2,litlad	;and its address
bstft3:	add	t2,hdrpag+$hwpde ;point to next directory entry
	sojn	t4,bstft1	;and loop if we haven't done them all yet
	dmsg	< [OK]
>
	skipe	litlst		;ok, did we find an entry ?
	 jrst	bstset		;yes, so start fiddling with it
endfit:	setom	litlst		;indicate to append to library
	dmsg	<
[No useful slot found]>
	ret			;return to caller
	subttl	BSTSET - create new deleted entry for best fit algorithm
;
;	Come here to create a new deleted entry representing the spare space
;	available after the old one has been part used.
;
bstset:	sos	hdrpag+$hndel	;one less deleted entry
	move	t4,litlad	;get address of smallest entry
	move	t2,filsiz	;get size of module to go in
	camn	t2,$dmlen(t4)	;do they match ?
	 jrst	[dmsg	<
[Module fits slot exactly]>
		jrst	bstscn]		;yes, Hallelujah !!
	move	t1,$dmlen(t4)	;no, so get the size of the old module
	movem	t2,$dmlen(t4)	;make the old entry describe the new module
	sub	t1,t2		;construct size of new left-over part
	setom	$dmupd(t4)	;make deleted module undeleted
	move	t2,t4		;get address of entry we are using
	sub	t2,hdrpag+$hwih ;subtract directory start address
	idivi	t2,wpde		;divide by words per directory entry
	aoj	t2,		;make entry number from all this
	caml	t2,hdrpag+$hnent ;are we dealing with the last entry ?
	 jrst	bstscn		;yes, so no meddling with the next one
	skipe	<$dmlen+wpde>(t4) ;is the following entry deleted ?
	 jrst	bstscn		;no, so just let things pass for the moment
	addm	t1,<$dmlen+wpde>(t4) ;yes,so concatenate this with new entry
	dmsg	<
[Concatenating deleted entries]>
	move	t1,$dmstrt(t4)	;get start address of deleted module
	add	t1,$dmlen(t4)	;add length of new module
	movem	t1,<$dmstrt+wpde>(t4) ;make start address of next deleted module
;
;	Enter here to scan directory again to find the new largest free block.
;
bstscn:	dmsg	<
[Scanning for new largest free block]>
	move	t1,hdrpag+$hnent	;get number of entries
	movei	t2,hdrpag		;address of header
	add	t2,hdrpag+$hwih		;make address of directory
	setz	t3,			;zero size of largest free block so far
bstsc1:	skipe	$dmupd(t2)		;deleted entry ?
	 jrst	bstsc2			;no, so skip
	camge	t3,$dmlen(t2)		;this entry bigger than biggest so far ?
	 move	t3,$dmlen(t2)		;yes, so use it
bstsc2:	add	t2,hdrpag+$hwpde	;move to next directory entry
	sojn	t1,bstsc1		;loop for all entries
	movem	t3,hdrpag+$hlfre	;store new largest free block size
	dmsg	< [OK]
>
	move	t1,hdrpag+$htfre	;get total free space
	sub	t1,filsiz		;subtract size of new module
	movem	t1,hdrpag+$htfre	;replace
	ret				;return to caller
	subttl	GETSIZ - compute size of a file in user bytes
;
;	This routine is called with a jfn in t1. It computes the size of the
;	file in bytes based on the library byte size.
;
getsiz:	sizef%			;get the file size
	 ercal	error		;just doesn't happen
	move	t3,modbsz	;byte size of module
	camn	t3,hdrpag+$Hbysz ;same as library ?
	 ret			;yes, so no more to do
	movei	t3,^d36		;number of bits in a word
	idiv	t3,modbsz	;how many bytes of this file in a word ?
	idiv	t2,t3		;so how many words in this file ?
	skipe	t3		;any remainder ?
	 aoj	t2,		;yes, so add 1 word (Ok,ok I know...)
	movei	t3,^d36		;number of bits in word
	idiv	t3,hdrpag+$hbysz ;so how many bytes of lib to a word ?
	imul	t2,t3		;and how many bytes does that give us ?
	ret			;back to caller
	subttl	CHKTYP - verify the type of a new module
;
;	This subroutine is called when we are about to insert a module
;	or update it in a library. The jfn is passed in t1. A check is
;	made to see if the library has a default type already established.
;	If it has not, the type of this file is used as the default for
;	the library. If it has, we check this type against the library type,
;	making sure that they match. Issue a warning if not.
;	Only set the type if the library was empty before.
;
chktyp:	move	t2,t1
	ldb	t1,[point 7,hdrpag+$hext,6] ;get first byte of type
	jumpn	t1,chkty1	;if zero, no type, so set it
	skipn	hdrpag+$hnent	;but only if library is empty.
	 jrst	chknon		;it is, do it
chkty1:	hrroi	t1,scratch	;point to scratch buffer
	movx	t3,fld(.jsnof,js%dev)!fld(.jsnof,js%dir)!fld(.jsnof,js%nam)!fld(.jsnof,js%gen)!fld(.jsaof,js%typ)
	setz	t4,
	jfns%			;write file type out
	 ercal	error
	hrroi	t1,scratch	;point to test string
	hrroi	t2,hdrpag+$hext ;point to base string
	stcmp%			;do they match ?
	jumpn	t1,[call	tstcol ;non-zero warn user
		   tmsg	<%File type of module does not match library>
		  jrst	.+1]
	ret			;back to caller
chknon: hrroi	t1,hdrpag+$hext	;point to library type field
	movx	t3,fld(.jsnof,js%dev)!fld(.jsnof,js%dir)!fld(.jsnof,js%nam)!fld(.jsnof,js%gen)!fld(.jsaof,js%typ)
	jfns%			;write extension
	 ercal	error
	call	tstcol		;get new line
	tmsg	<[Setting library file type to >
	hrroi	t1,hdrpag+$hext	;point to new file type
	psout%			;type it
	tmsg	<]>
	ret			;back to caller
	subttl	CHKOFF - check if file for insert or update is online
;
;	This routine is called with a jfn in t1. It returns +2 if the file
;	is offline, +1 otherwise.
;
chkoff:	move	t2,[1,,.fbctl] ;get FDB control word
	movei	t3,t4		;return in t4
	gtfdb%			;do it
	 ercal	error		;failed horribly
	txne	t4,fb%off	;offline ?
	 ret			;yes, bad return
	retskp			;no, ok
	subttl	CHKBSZ - verify the byte size of a new module
;
;	This routine is called with the jfn of a new module in t1.
;	If the library has no byte size, it is set from this module's.
;	If the library has a size, it is compared against this module's.
;	If they do not match, a warning is given.
;
chkbsz:	move	t2,[1,,.fbbyv]	;get byte size only
	movei	t3,t4		;where to put it
	gtfdb%			;read the file byte size
	 ercal	error		;can't fail
	txz	t4,^-<fb%bsz>	;clear all but the byte size
	lsh	t4,-<^d35-pos(fb%bsz)> ;and shift down to right end
	movem	t4,modbsz		;save for GETSIZ
	skipn	hdrpag+$hbysz	;got a byte size ?
	 jrst	[movem	t4,hdrpag+$hbysz	;no, but we have now
		move	t1,libjfn	;get library jfn
		move	t2,t4		;get new byte size
		sfbsz%			;recompute useful pointers
		 ercal	error
		jrst	.+1]		;continue
	came	t4,hdrpag+$hbysz	;are they equal ?
	 jrst	[call	tstcol	;no....
		tmsg	<%Byte size of module does not match library>
		jrst	.+1]
	ret			;back to caller
	subttl	LIBRARY - select new library file
;
;	This command selects a new library file, unmapping the old one
;	if necessary.
;
.library:	stkvar	<tmpjfn>
	noise (is)
	movx	t1,gj%old!gj%acc	;no access to inferiors
	movem	t1,gjfblk	;assume old file
	hrroi	t1,[asciz/LBR/]	;default file type
	movem	t1,gjfblk+.gjext ;store
	txne	f,takini	;reading LBR.INIT ?
	 jrst	[txne	f,rslib	;yes, so did the rescan line provide a library ?
		 jrst	eatcmd	;yes, so eat up the comand
		jrst	.+1]	;no, so continue regardless
	comand	<[flddb. (.cmfil,cm%sdh,,<Name of library to select>)]>,<Invalid library file spec - >,jsys
	movem	t2,tmpjfn	;save jfn
	confirm			;confirm command
	txo	f,tempot	;assume temporary output again
	call	umap		;unmap old lib if required
	move	t1,tmpjfn	;get back saved jfn
	movem	t1,libjfn	;store
	txz	f,ronly		;clear any read-only flag around
	call	maplib		;map the library
	ret			;back for next command
	purge	tmpjfn
eatcmd:	comand <[flddb. (.cmtxt)]>
	confirm
	ret
	subttl	RESCAN - do a library command from the rescan buffer
;
;	This subroutine looks at the rescan buffer to see if it is of the form
;	LBR LIBNAME
;	It attempts to map the library if it exists, and sets a flag to stop
;	a LIBRARY command in LBR.INIT overriding the library specified in the
;	command line. (We have to be called before normal command parsing
;	begins.)
;	It also checks for LBR being invoked with special command names defined
;	in SPCTAB. If so, it works in guide mode.
;
RESCAN:	movei	t1,.rsini	;now make the rescan buffer...
	rscan%			;...available for reading
	 ercal	error		;which should never fail
	movei	t1,.rscnt	;return the number of characters...
	rscan%			;lying around in the rescan buffer
	 ercal	error		;which should never fail
	jumpe	t1,R		;If zero already, just return
	movn	t3,t1		;get the number of characters negated
	movei	t1,.priin	;now prepare to read it
	hrroi	t2,atmbfr	;into the command buffer (good as anywhere)
	sin%			;do it
	 ercal	error
	move	t1,[point 7,atmbfr] ;look at the command buffer
	move	t3,[point 7,buffer] ;where to output the word
	setzm	buffer		;in case rescan contains no words
rescaw:	ildb	t2,t1		;get the first character
	caige	t2,"A"		;check for alphabetic
	 jrst	rescae		;no, end of word
	caile	t2,"Z"		;more checks
	 jrst	[caige	t2,"a"	;like lowercase
		 jrst	rescae	;nope
		caile	t2,"z"  ;perhaps ?
		 jrst	rescae	;definitely nope
		jrst	.+1]	;ok, part of word
	idpb	t2,t3		;so dump out the word
	jrst	rescaw		;and continue
rescae:	setz	t4,		;get null
	idpb	t4,t3		;terminate command word with it
	push	p,t1		;save input byte pointer
	movei	t1,spctab	;Point to startup command table
	hrroi	t2,buffer	;and to command that started us
	tbluk%			;try a lookup
	 erjmp	[pop p,t1
		ret]		;if failed, give up
	txnn	t2,tl%exm	;exact match with command string ?
	 jrst	[pop	p,t1
		ret]		;no, so must be start or something
	hrrz	t2,(t1)		;ok, get table data
	movem	t2,t3		;and save the entry
	skipe	t2		;is it zero ?
	 call guidon		;no, set GUIDE-style stuff on
	pop	p,t1		;get input byte pointer back
reskp:	ildb	t2,t1		;now skip any blanks or tabs in input
	cain	t2," "		;is it a space ?
	 jrst	reskp		;yes, so get next
	cain	t2,"	"	;or a tab ?
	 jrst	reskp		;yes, so get next
	cain	t2,.chlfd	;or a linefeed perchance ?
	 ret			;yes, give up
	cain	t2,15		;or carriage return
	 ret			;give up
	jumpe	t2,r		;if it is a null, just give up
	seto	t2,		;ok, so now we must backspace
	adjbp	t2,t1		;by one byte to read the non-space again
	movem	t2,t4		;so, now save the byte pointer to the argument
	txne	f,guide		;in guide mode ?
	 jrst	guirsc		;yes, so get module name, do a type
	movei	t1,[gj%old	;so set up a GTJFN arg block for an old file
		.nulio,,.nulio ;not reading from files
		0		;no default device
		0		;or directory
		0		;no default name
		-1,,[asciz/LBR/] ;default type is .LBR
		0		;no default protection
		0		;no default account
		0]		;no special JFN
	gtjfn%			;and try for a jfn on the library
	 erjmp	[userr	<Cannot find specified library - >,jsy] ;didn't work
	movem	t1,libjfn	;now we have a jfn, store it where it belongs
	call	maplib		;and try to map the library
	txo	f,rslib		;flag we have a rescanned library available
	ret			;and return for the LBR.INIT file
	subttl	GUIDON - load the GUIDE-style library in
;
;	We come here when we have determined we are running in GUIDE-style.
;	t2 contains a pointer to the name of the library to use.
;	T1 contains the TBLUK pointer for the entry (for setting the prompt)
;
guidon:	txo	f,guide		;mark GUIDE mode
	movem	t1,guinam	;save prompt pointer
	hrro	t2,t2		;make t2  a byte pointer
	movx	t1,gj%sht!gj%old ;the library must be there
	gtjfn%			;get it
	 erjmp	[tmsg	<?Cannot find GUIDE file>
		haltf%]
	movem	t1,libjfn	;save the library jfn
	push	p,t3
	push	p,t4
	call	spromp		;set up  a prompt string
	txo	f,ronly		;ask for library read-only
	call	maplib		;Map it (the library, that is)
	pop	p,t4
	pop	p,t3
	ret			;and return

;	Sprompt - generate a prompt string from the command

spromp:	hlro	t1,@guinam	;get pointer to command name
	hrroi	t2,guinam	;write it back over the pointer
	setzb	t3,t4		;asciz
	sin%			;do it
	movei	t1,">"		;what to finish a prompt with
	idpb	t1,t2		;tidy off prompt
	setz	t1,
	idpb	t1,t2		;asciz-ize it
	ret			;done

;	Guirsc - pick up rescanned name from command line

guirsc:	hrroi	t1,buffer		;where to put a module name
	movei	t3,^d39		;maximum length of one
	movei	t4,.chlfd	;character to terminate on
	sout%			;write out the module name
	setz	t4,		;get a null
	dpb	t4,t1		;and ASCIZize it
	txo	f,grscom	;flag GUIDE got a rescanned command
	movei	t1,modules	;Point to modules
	hrroi	t2,buffer	;and to name we have
	tbluk%			;try a lookup
	 erjmp	gnscmd		;if error, no hope baby
	txne	t2,tl%nom!tl%amb ;no match or ambiguous?
	 jrst	gnscmd		;yes, complain
	movem	t1,q1		;else save the pointer
	txo	f,typing	;tell COPY that it is like TYPE
	ret			;and return
gnscmd:	tmsg	<?No such subject>
	call	umap
	haltf%
	subttl	COPY - extract a module from a library to a file
;
;	The format of this command is:
;	COPY (module) modnam (to file) filename
;
;	The filename is set up by default to have the same name as the module,
;	and the same type as the library module type.
;
;	The TYPE command also uses this code.
;	The APPEND command also uses some of this code.
.appen:	txo	f,apping	;flag APPEND command
	jrst	.copy+1		;continue with copy
.type:	txo	f,typing	;flag TYPE command
	move	t1,[jrst cctyp]	;instruction to execute on control-c
	movem	t1,ccxct	;store for trap routine
	skipa
.copy:	txz	f,typing!apping	;not a type or append command
	noise	(module)
	skipn	mappd		;got a library ?
	 jrst	[userr	<No library selected - use LIBRARY command>]	;no
	comand	<[flddb. (.cmkey,,modules,<Module, >,,[
	flddb. (.cmact,cm%sdh,,<"Wildcard" modules>)])]>,<Invalid module name - >,jsy
	hlrz	t1,t3		;get address of FDB supplied
	hrrzs	t3,t3		;and FDB used
	came	t1,t3		;are they equal ?
	 jrst	[move	t1,[atmbfr,,copnam] ;no, so wildcards were used
		blt	t1,copnam+7	;so store the filename
		movei	t2,[copnam,,0]	;point to it
		txo	f,w$ild	;flag wildcards
		setz	t4,	;clear possible jfns
		call	wldset	;and check a match for wild spec exists
		 ret		;it doesn't, so return
		jrst	.copy2]		;continue
	movem	t2,q1		;save index into table
.copy2:	txne	f,typing	;TYPE command
	 jrst	[movei	t4,.priou ;yes, point to terminal
		jrst	.type1]	;and continue
	hrroi	t1,hdrpag+$hext ;point to library module type
	movem	t1,gjfblk+.gjext ;set up default file type
	txne	f,apping	;APPEND command ?
	 jrst	[setz	t1,	;yes, so no wildcards on output
		jrst	.copya]	;continue
	hlro	t1,(t2)		;point to default filename
	movem	t1,gjfblk+.gjnam ;set up default file name
	movx	t1,gj%fou	;assume new file
	txne	f,w$ild		;wildcards used ?
	 txo	t1,gj%ofg!gj%flg ;yes, so allow "parse-only" jfns
	txne	f,tempot	;temporary output ?
	 txo	t1,gj%tmp	;yes, so force temporary jfn
.copya:	movem	t1,gjfblk
	noise	(to file)
	comand	[flddb. (.cmfil,cm%sdh,,<Name of file to place module in>)],<Invalid output file spec - >,jsy
	movem	t2,t4		;save jfn of output file
.type1:	confirm			;confirm command
	txz	f,appnxt	;flag the first appended module for OPENF
	txnn	f,w$ild		;wild output requested ?
	 jrst	.copy3		;no, so do it the simple way
	txne	f,apping	;appending ?
	 push	p,t4		;yes, we need the jfn, but don't want WLDSET
	txne	f,typing!apping	;TYPE or APPEND command ?
	 setz	t4,		;yes, no fancy stuff with jfns
	call	wldset		;yes, so check if any match occurs
	 jrst	[txne	f,apping ;appending ?
		 pop	p,t4	;yes, so clean up stack
		ret]		;return, no modules
	txne	f,apping	;appending ?
	 pop	p,t4		;retrieve output jfn if appending
	call	copwon		;output next name in wildcard stuff
;
;	Here begins the loop where we actually do the output.
;	NOTE - this is also called by EDIT with a jfn in t4 and TBLUK address
;	in q1, so watch any changes
;
.copy3:	txne	f,typing	;TYPE command ?
	 noint			;yes, inhibit interrupts
.copy4:	txz	f,copyok	;mark copy ok initially
	txne	f,typing	;TYPE command ?
	movei	t4,.priou	;reestablish output for TYPE
	move	t2,hdrpag+$hbysz ;get library byte size
	lsh	t2,<^d35-pos(of%bsz)>
	txne	f,apping	;APPEND command ?
	 jrst	[txo	t2,of%app	;yes, set append access
		jrst	.+2]
	txo	t2,of%wr	;set byte size, write access
	hrrz	t1,t4		;get jfn of output module
	txnn	f,typing!appnxt	;don't open .PRIOU for TYPE, or do multiple
				; opens for append access
	openf%			;open it
	 erjmp	[move	t1,t4	;get jfn
		rljfn%		;release it
		 nop
		txo	f,copyok	;mark copy failed
		userr	<Cannot open file for output module - >,jsy]
	txne	f,apping	;APPEND output ?
	 txo	f,appnxt	;yes, flag file already open for next append
	hlrz	t3,(q1)		;get address of library entry
	move	t2,$dmstrt(t3)	;get starting byte in library file
	move	t1,libjfn	;library jfn
	sfptr%			;set the pointer
	 ercal	error
	movn	q1,$dmlen(t3)	;get negative number of bytes
	caml	q1,[-1000*ndpag]	;more than one page ?
	 jrst	.copye		;no, so use special only
.copyc:	move	t1,libjfn	;point to library
	move	t2,[point ^d36,datpag] ;and buffer page
	movni	t3,1000*ndpag		;read 1k bytes
	sin%			;do it
	 ercal	tstlib		;if error, check for end-of-file, and try to fix
	hrrz	t1,t4		;get output jfn
	move	t2,[point ^d36,datpag] ;pointer to buffer page
	movni	t3,1000*ndpag		;1k worth
	sout%			;write it
	 ercal	copexp	;try to expunge on failure - returns above on error
	addi	q1,1000*ndpag	;drop amount left to write
	camge	q1,[-1000*ndpag];ok yet ?
	 jrst	.copyc		;yes, go on
.copye:	move	t1,libjfn	;point to input
	move	t2,[point ^d36,datpag] ;to buffer
	move	t3,q1		;amount left to read
	sin%			;do it
	 ercal	tstlib		;if error, check for bad EOF, try to fix it.
	hrrz	t1,t4
	move	t2,[point ^d36,datpag] ;buffer to output file
	move	t3,q1
	sout%			;write last buffer
	 erjmp	[move	t1,t4	;output file
		txo	t1,cz%abt	;mark abort close
		closf%		;close it
		 nop
		txne	f,typing ;TYPE ?
		 okint		;yes, allow interrupts
		txo	f,copyok	 ;mark copy failed
		userr	<Error writing output module - >,jsy]
	hrrz	t1,t4
	txnn	f,apping!typing ;don't close .PRIOU or APPEND output
	closf%			;close the output file
	 nop			;ignore errors
	txne	f,apping	;APPEND ?
	 push	p,t4		;yes, save jfn
	txnn	f,w$ild		;wildcards used ?
	 jrst	copend		;no, so clean up
	tmsg	< [OK]>		;yes, so reassure user
	call	wldnxt		;yes, so grab the next module
	 jrst	copend		;none left, clean up
	txne	f,apping	;APPEND ?
	 pop	p,t4		;yes, restore JFN
	call	copwon		;output name of this module
	jrst	.copy4		;process next module
;
;	Here to clean up on append command
;
copend:	txne	f,typing	;TYPE command ?
	 okint			;yes, allow interrupts again
	txne	f,grscom	;got here from GUIDE module ?
	 jrst	.exiti		;yes, so stop fast
	txzn	f,apping	;append command ?
	 ret			;no, all done
	pop	p,t1		;yes, get output JFN back
	closf%			;close it
	 nop			;ignore errors
	ret			;all done
;
;	Here on control-c interrupt
;
cctyp:	movei	t1,cctyp1	;where to continue
	movem	t1,retpc1	;interrupt PC
	debrk%			;leave interrupt context now.
cctyp1:	okint			;allow interrupts
	txne	f,grscom	;rescanned command in guide mode ?
	 jrst	.exiti		;yes, exit fast
	tmsg	<
[Aborted]>
	okint			;allow interrupts
	jrst	parse		;get the next command
	subttl	TSTLIB - handle bad EOFS on a library.
;
;	If LBR is aborted prematurely, or something, the most likely
;	error that occurs is that on some previous run, the EOF pointer was
;	never updated to the true EOF. We come here on errors from using
;	SIN% on the library. We check for end of file, and if it has occured,
;	we search the directory to see what the maximum byte number in the
;	library ought to be. We check that against the current EOF, and if
;	greater, we reset the EOF, and continue the aborted JSYS.
;
tstlib:	push	p,t1
	push	p,t2
	push	p,t3
	push	p,t4		;Save all relevant acs
	movx	t1,.fhslf	;Point to our process
	geter%			;get the most recent error
	hrrzs	t2		;extract the error code
	caie	t2,iox4		;end of file reached ?
	 jrst	[pop	p,t4	;no, so restore the acs
		pop	p,t3
		pop	p,t2
		pop	p,t1
		jrst	error]	;and do usual error handling
	move	t1,libjfn	;yes, so read the current filesize
	rfptr%			;to find out where we are
	 ercal	error
	push	p,t2		;and save it
	move	t3,hdrpag+$hnent ;get number of entries in library
	movei	t2,hdrpag+$hdir ;point to start of directory entries
	setz	t1,		;initialize guess as to end of file
tstlop:	move	t4,$dmstrt(t2)	;get start byte of this module
	add	t4,$dmlen(t2)	;and add its length
	camle	t4,t1		;that a better idea than what we had before ?
	 move	t1,t4		;yes, update our guess as to eof
	addi	t2,wpde		;bump to next directory entry
	sojg	t3,tstlop	;and check them all
	pop	p,t4		;get back old eof pointer
	camg	t1,t4		;is our guess better than what it is ?
	 jrst	[tmsg	<?Serious problem with library: directory is corrupt>
		haltf%]		;no, cannot understand problem
	movem	t1,t3		;yes, so reset the byte count
	tmsg	< [Fixing up library EOF] >
	move	t1,libjfn	;of the library
	hrli	t1,.fbsiz	;which is in this word
	seto	t2,		;and takes up a whole word
	chfdb%			;do it
	 ercal	error
	txo	f,clsnrj	;tell UMAP to keep the JFN for us
	call	umap		;unmap the old library
	push	p,q1
	push	p,q2		;save acs that MAPLIB trashes
	call	maplib		;remap the library to see new EOF limit
	pop	p,q2
	pop	p,q1
	pop	p,t4
	pop	p,t3		;and restore all the acs
	pop	p,t2
	pop	p,t1		;so we can continue the I/O operation...
	sin%			;that was so rudely interrupted
	 ercal	error		;if this fails, brother are we in trouble
	ret			;all done !
	subttl	DELETE - delete a module or modules from the library
;
;	Command format: DELETE (modules) modnam
;
;	Wildcard module names are allowed.
;
.delete:	noise	(modules)
	skipn	mappd		;got a library ?
	 jrst	[userr	<No library selected - use LIBRARY command>]	;no
	txne	f,ronly		;read only library ?
	 jrst	[userr	<Write access to library required>] ;yes, cannot do it
	chksfe			;library safe ?
	comand	<[flddb. (.cmkey,,modules,<Module to be deleted, >,,[
	flddb. (.cmact,cm%sdh,,<"Wildcard" modules>)])]>,<Invalid module name - >,jsy
	hlrz	t1,t3		;get address of FDB supplied
	hrrzs	t3,t3		;and FDB used
	came	t1,t3		;are they equal ?
	 jrst	.del2		;no, so wildcards were used
	movem	t2,q1		;save index into table
	hlrz	q2,(q1)		;get address of directory entry
	confirm			;confirm command
	txo	f,modif		;mark modification
	movei	t1,modules	;point to TBLUK table
	move	t2,q1		;address of entry to delete
	tbdel%			;do it
	 ercal	error
	noint			;mark directory unclean
	aos	hdrpag+$hndel	;increment number of deleted directory entries
	move	t1,$dmlen(q2)	;get size of this module
	addm	t1,hdrpag+$htfre ;add to total library free space
	camle	t1,hdrpag+$hlfre ;is this larger than largest free space ?
	 jrst	[movem	t1,hdrpag+$hlfre ;yes, so update directory
		move	t1,$dmstrt(q2)	;get address of module
		jrst	.+1]		;continue
	setzm	$dmupd(q2)	;flag module deleted
	gtad%			;get current time+date
	movem	t1,hdrpag+$hupdt ;flag update occured
	okint			;show directory is now OK
	call	chksqz		;check if squeeze is useful
	ret			;and return to caller
;	...
;	... Here to do wildcard deletes

.del2:	move	t1,[atmbfr,,copnam] ;no, so wildcards were used
	blt	t1,copnam+7	;so store the filename
	movei	t2,[copnam,,0]	;point to it
	txo	f,w$ild	;flag wildcards
	setz	t4,		;indicate we don't want output jfns
	call	wldset		;initialize the wildcard stuff
	 ret			;no modules match that name
	confirm			;confirm deletion
	txo	f,modif
.delw3: tmsg	<
>				;look pretty
	hlro	t1,(q1)		;point to module name
	psout%			;write it to terminal
	hlrz	q2,(q1)		;now find address of entry in directory
	move	t2,q1		;set up to delete this
	movei	t1,modules	;from the table
	tbdel%			;do it
	 erjmp	[userr	<Tables are corrupt - >,jsy]
	noint			;mark directory unclean
	aos	hdrpag+$hndel	;increment number of deleted directory entries
	move	t1,$dmlen(q2)	;get size of this module
	addm	t1,hdrpag+$htfre ;add to total library free space
	camle	t1,hdrpag+$hlfre ;is this larger than largest free space ?
	 jrst	[movem	t1,hdrpag+$hlfre ;yes, so update directory
		move	t1,$dmstrt(q2)	;get address of module
		jrst	.+1]		;continue
	setzm	$dmupd(q2)	;flag module deleted
	gtad%			;get current time+date
	movem	t1,hdrpag+$hupdt ;flag update occured
	okint			;show directory is now OK
	tmsg	< [OK]>		;reassure user
	sos	wldptr		;reset things for wild lookup - we have removed
				;an entry, so its pointer is askew
	setz	t4,		;no jfns, thanks
	call	wldnxt		;try for the next module
	 jrst	[call	chksqz	;none left, check for squeeze
		ret]		;and go home
	jrst	.delw3		;another - go do it
	subttl	SET - set all sorts of things
;
;	This command takes a number of subcommands, notably
;	(NO) TEMPORARY - controls whether output files are temporary
;	EXTENSION text - sets default library extension
;	(NO) DEBUG     - controls debugging information
;	NOTE: The command can only set left-half bits, and cannot fiddle bit 17.
;	Therefore, bits to be controlled by SET commands must be chosen
;	appropriately.
;
	DEFINE	setent(keyword,noise,bit,inv<>),<
IFB <INV>,<tb (<1b18![[asciz\noise\],,(bit)]>,KEYWORD)>
IFNB <INV>,<itb (<1b18![[asciz\noise\],,(bit)]>,KEYWORD)>>

settab:	setsiz,,setsiz		;size of command table
	SETENT	AUTO-EXPUNGE,<on disk quota exceeded errors>,iexpunge
	SETENT	DEBUG,<mode on>,debug,inv
	tb (.setem,EPHEMERAL)	;make library default to temporary
	tb (.setex,EXTENSION)	;change extension
	tb (.setno,NO)		;NO someting or other
	tb (.setpm,PERMAMENT)	;make lib default to no temporary
	SETENT	SED,<to be the default editor>,defsed
	SETENT	SQUEEZE,<when library is 1/10 empty>,alowsq
	SETENT	TEMPORARY,<output files>,tempot
	setsiz==.-settab-1

notab:	nosiz,,nosiz		;size of no command table
	SETENT	AUTO-EXPUNGE,<on disk quota exceeded errors>,iexpunge
	SETENT	DEBUG,<mode on>,debug,inv
	SETENT	SED,<to be the default editor>,defsed
	SETENT	SQUEEZE,<when library is 1/10 empty>,alowsq
	SETENT	TEMPORARY,<output files>,tempot
	nosiz==.-notab-1

.set:	noise	(thing)
	comand	[flddb. (.cmkey,,settab)],<Invalid set option - >,jsy
	hrrz	q1,(t2)		;get the appropriate word
	txze	q1,1b18		;is bit 18 set ?
	 jrst	setbit		;yes, so this is just a bit modification
	jrst	(q1)		;no, so we must call another routine
setbit:	hlro	t2,(q1)		;point to noise word
	call	skpnoi		;parse noise
	 ret			;failed
	confirm			;make sure they want to do it
	hrlz	q1,(q1)	  ;swap the bit into the left half where it belongs
	tdo	f,q1		;do the change
	ret			;and return
.setno:	comand	[flddb. (.cmkey,,notab)],<Invalid SET NO option - >,jsy
	hrrz	q1,(t2)		;get address of descriptor
	txz	q1,1b18		;remove flag bit
	hlro	t2,(q1)		;get noise
	call	skpnoi		;parse it
	 ret			;failed
	confirm			;confirm the command
	hrlz	q1,(q1)		;get the bit to fiddle
	tdz	f,q1		;zero the flag
	ret			;back for next command
.setex:	noise (for output files to)
	skipn	mappd		;got a library ?
	 jrst	[userr	<No library selected yet - use LIBRARY command>] ;no
	txne	f,ronly		;read only library ?
	 jrst	[userr	<Write access to library required>] ;yes, cannot do it
	chksfe			;library safe ?
	comand [flddb. (.cmact,cm%sdh,,<Default extension for output from this library>)],<Bad extension - >,jsy
	move	t1,[atmbfr,,defext]
	blt	t1,defext+7		;save the entered extension
	confirm				;confirm the command
	move	t1,[defext,,hdrpag+$hext]
	blt	t1,hdrpag+$hext+7	;now copy into the library header
	ret				;back for next command
.setem:	noise	(default for library)
	skipn	mappd		;got a library ?
	 jrst	[userr	<No library selected yet - use LIBRARY command>] ;no
	confirm
	move	t1,hdrpag+$hflgs	;get header flags word
	txz	t1,hfprm		;zero permanent bit
	movem	t1,hdrpag+$hflgs	;put it back
	txo	f,tempot		;set temporary output
	ret
.setpm:	noise	(default for library)
	skipn	mappd		;got a library ?
	 jrst	[userr	<No library selected yet - use LIBRARY command>] ;no
	confirm
	move	t1,hdrpag+$hflgs	;get header flags word
	txo	t1,hfprm		;set permanent bit
	movem	t1,hdrpag+$hflgs	;put it back
	txz	f,tempot		;set no temporary output
	ret
	subttl	REPLACE - routine to update existing modules
;
;	This command is called to insert new versions of modules into
;	the library, removing the old ones. If the new module is the same
;	size as the old, the same slot is re-used. Otherwise, the new one is
;	first deleted, and then a call is made to insert the new one at the best
;	fit.
;
.replace:	noise	(existing modules)
	skipn	mappd		;got a library ?
	 jrst	[userr	<No library selected yet - use LIBRARY command>]
	txne	f,ronly		;read only library ?
	 jrst	[userr	<Write access to library required>] ;yes, cannot do it
	chksfe			;library safe ?
	comand	[flddb. (.cmkey,,modules,<Module name,>,,[
		flddb. (.cmact,cm%sdh,,<"Wildcard" module name>)])],<Invalid module name - >,jsy
	movem	t3,q1		;save FBD address
	hrrzs	t3,t3		;get fdb used
	hlrz	t1,q1		;fdb supplied
	came	t1,t3		;are they the same ?
	 jrst	[move	t1,[atmbfr,,copnam] ;no, wildcard module name
		blt	t1,copnam+7	;save wild module name
		movei	q1,[copnam,,0]
		txo	f,w$ild		;flag wild name
		setz	t4,	;ask for no fancy jfns
		call	wldset	;check a match with the spec exists
		 ret		;it doesn't, return
		jrst	.repl2]	;continue
	movem	t2,q1		;save TBLUK address
.repl2:	hlro	t1,(q1)		;point to default filename
	movem	t1,gjfblk+.gjnam;store it
	hrroi	t1,hdrpag+$hext	;point to default extension
	movem	t1,gjfblk+.gjext ;store it
	movx	t1,gj%old	;files must exist
	txne	f,w$ild	;were wildcards used ?
	 txo	t1,gj%ifg	;yes, so allow them for filenames
	movem	t1,gjfblk	;store GTJFN flags
	noise	<with files>
	comand	[flddb. (.cmfil,cm%sdh,,<Files to use to replace modules in library>)],<Invalid input file name - >,jsy
	movem	t2,repjfn	;store returned jfn
	confirm			;confirm the command
	txo	f,modif
;...
;...
;	We now have the command - replace all requested modules.
;
	txNn	f,w$ild		;wild module parse ?
	 jrst	repnrm		;no , handle differntly
	setz	t4,		;make sure no jfn
	call	wldset		;set up for wildcard lookup
	 ret			;bad spec
.repcon:
repnrm:	hlrz	t1,(q1)		;get address of directory entry
	noint			;mark library unsafe
	setzm	$dmupd(t1)	;delete old module entry
	aos	$hndel+hdrpag	;increment number of deleted modules
	move	t3,$dmlen(t1)	;get size of old module
	addm	t3,hdrpag+$htfre ;add in to total free space
	camle	t3,hdrpag+$hlfre ;larger than largest free space ?
	 movem	t3,hdrpag+$hlfre ;yes, so update header stats
	movei	t1,modules	;point to module name lookup table
	move	t2,q1		;address of entry for this module
	tbdel%			;delete it
	 erjmp	[userr	<Lookup tables are corrupted - >,jsy]
	hrrz	t4,repjfn		;jfn of new module file
	txne	f,w$ild		;wildcard replace ?
	 call	copwon		;yes, type out the file name
	hrrz	q1,repjfn	;jfn of input file for insert
	call	.insec		;insert the new module
	 jrst	repend		;failed, so return
	okint			;Mark library safe again
	hrrz	t1,repjfn	;get jfn of input file
	txo	t1,co%nrj
	closf%			;close, but do not release handle
	 erjmp	.+1		;ignore errors
	txnn	f,w$ild		;wild insert ?
	 jrst	repend		;no, so return now
	tmsg	< [OK]>		;reassure user
	setz	t4,		;make sure we don't want a jfn
	call	wldnxt		;step the wild module
	 jrst	repend		;no more modules to replace
	move	t1,repjfn	;get the wild input jfn
	gnjfn%			;step it also
	 erjmp	[userr	<Number of modules does not match number of files: >,fil,repjfn]
	jrst	.repcon		;do next module
repend:	okint			;allow interrupts again
	call	chksqz		;check if a squeeze is needed
	ret			;and return for next commdn
	subttl	UPDATE - replace modules by filename only
;
;	This command is used to update a lot of modules when you have all the
;	files in one place, but it is difficult to specify a useful module
;	name for the REPLACE command. It gets the module name from the filename.
;
.update:	noise	(library using files)
	skipn	mappd			;got a library ?
	 jrst	[userr	<No library selected yet - use LIBRARY command>] ;no
	txne	f,ronly		;read only library ?
	 jrst	[userr	<Write access to library required>] ;yes, cannot do it
	chksfe			;library safe ?
	movx	t1,gj%old!gj%ifg	;allow wildcards
	movem	t1,gjfblk		;store for COMND
	hrroi	t1,hdrpag+$hext		;point to library extension
	movem	t1,gjfblk+.gjext	;store for input file
	comand	[flddb.	(.cmfil,cm%sdh,,<File(s) to update library with>)],<Invalid input file name - >,jsy
	movem	t2,q1		;save jfn
	confirm			;confirm command
	txo	f,modif		;flag modification
.upd1:	txnn	q1,gj%dev!gj%dir!gj%nam!gj%ext!gj%ver ;wildcards used ?
	 jrst	.upd2		;no, so no filename logging
	tmsg	<
>
	movei	t1,.priou		;yes, so point to terminal
	hrrz	t2,q1		;get jfn
	setzb	t3,t4		;usual filename format
	jfns%			;write to screen
	 ercal	error		;should not fail
.upd2:	call	.doupd		;do an update of one module
	 ret			;failed, so return
	okint
	hrrz	t1,q1		;get jfn
	txo	t1,co%nrj	;don't release
	closf%			;close it
	 nop			;tuff
	txnn	q1,gj%dev!gj%dir!gj%nam!gj%ext!gj%ver ;wildcards used ?
	 jrst	.upend		;no
	tmsg	< [OK]>		;reassure the user
	move	t1,q1		;get full file handle
	gnjfn%			;try to step the jfn
	 erjmp	.upend		;no more files in this group
	jrst	.upd1		;ok, do the next file
.upend:	call	chksqz		;check if a squeeze is needed
	ret
;...
;
;	Do a single update
;
.doupd:	hrrz	t2,q1		;get jfn of module (no flags)
	hrroi	t1,luknam	;point to name for lookup
	movx	t3,fld(.jsaof,js%nam) ;output name
	jfns%			;do it
	 ercal	error
	call	lukmod		;do a lookup
	 jrst	[userr	<Module does not exist: >,fil,q1] ;inform user
	noint			;we are about to fiddle
	movem	t1,t2		;save address of entry
	hlrz	t3,(t2)		;get pointer to directory entry
	movei	t1,modules	;TBLUK table
	tbdel%			;delete module
	 erjmp	[userr	<Tables are corrupt - >,jsy]
	setzm	$dmupd(t3)	;mark module deleted
	aos	$hndel+hdrpag	;increment number of deleted modules
	move	t1,$dmlen(t3)	;get size of old module
	addm	t1,hdrpag+$htfre ;add in to total free space
	camle	t1,hdrpag+$hlfre ;larger than largest free space ?
	 movem	t1,hdrpag+$hlfre ;yes, so update header stats
	call	.insec		;try to put the module in
	 ret			;failed, return
	retskp			;succeeded, ok
	subttl	EDIT command - edit a module and replace in library
;
;	This command accepts a single module name, and extracts it into
;	a temporary file. It then starts up EDITOR: (if found) and causes
;	it to be read into the editing buffer. On exit, the output file
;	(whose name we have supplied) is updated into the library, and the
;	original file expunged.
;
.edit:	noise	(module)
	skipn	mappd		;got a library ?
	 jrst	[userr	<No library selected yet - use LIBRARY command>]
	chksfe			;library safe ?
	comand	[flddb. (.cmkey,,modules,<Module name,>)],<Invalid module name - >,jsy
	movem	t2,q3		;save index
	txz	f,edtrdo!edtsed!copyok ;clear flag bits
	txne	f,ronly		;library mapped readonly ?
	 txo	f,edtrdo	;yes, so edit must be readonly
	txne	f,defsed	;SED the default editor ?
	 txo	f,edtsed	;yes, so light the SED bit
.edswi:	comand	<[flddb. (.cmswi,,edswit,,,[
		flddb. (.cmcfm)])]>,<Invalid switch - >,jsy
	ldb	t1,[point <wid(cm%fnc)>,(t3),<pos(cm%fnc)>] ;get function code
	cain	t1,.cmcfm	;was it confirm ?
	 jrst	.edcfm		;yes, so continue
	hrrz	t2,(t2)		;no, so get the flag for this switch
	tdo	f,t2		;light the appropriate bit
	jrst	.edswi		;and try for another switch, or confirm
;
;	Here when edit command is confirmed
;
.edcfm:	txo	f,modif		;flag modified
	hlro	t2,(q3)		;point to filename
	hrroi	t1,edtbuf	;and filename buffer
	setzb	t3,t4
	sout%			;copy the filename out
	 ercal	error
	movei	t2,"."		;get a dot
	idpb	t2,t1		;place that out
	hrroi	t2,hdrpag+$hext ;point to default extension
	sout%			;write that out in the buffer
	 ercal	error
	movem	t1,edtptr	;save this pointer for later
	call	chkedt		;check to see file does not already exist
	hrroi	t2,edtbuf	;point to constructed temporary name
	movx	t1,gj%sht!gj%fou
	gtjfn%			;grab a jfn on an output file
	 ercal	error		;woops - shouldn't happen
	movem	t1,t4		;place jfn where COPY expects it
	move	q1,q3		;and table index too
	txo	t1,<fld(.fbbyv,cf%dsp)> ;we want to change the generation ret
	movx	t2,fb%ret	;count in word .fbbyv of the FDB
	movx	t3,fld(1,fb%ret) ;to 1 (override normal stuff)
	chfdb%			;do it
	 erjmp	.+1
	call	.copy4		;copy the module out
	txne	f,copyok	;did it work ?
	 ret			;no, so don't run the editor
	hrroi	t2,edtbuf	 ;temporary output file
	movx	t1,gj%sht!gj%old
	gtjfn%			;get the jfn again (COPY disposed of it)
	 ercal	error		;woops - shouldn't happen
	movem	t1,q2		;save this for a mo
	call	edcmd		;construct EDIT command
	call	getedt		;get the editor, start it up
	 ret			;failed, no editor
	move	t2,edtptr	;pointer to end of filename in edit buffer
	setz	t1,		;get a null
	idpb	t1,t2		;remove temporary attribute
	hrroi	t2,edtbuf	;point to edit filename buffer
	movx	t1,gj%sht!gj%old ;old file
	gtjfn%			;grab jfn on editor output
	 erjmp	[userr	<Cannout find any output from editor>]
	movem	t1,q2		;save it
	txne	f,edtrdo	;read only ?
	 jrst	ednrep		;yes, don't replace
	movem	q2,repjfn	;store jfn where replace expects it
	move	q1,q3		;and table index too
	call	repnrm		;replace the edited module
	hrroi	t2,edtbuf	 ;temporary output file
	movx	t1,gj%sht!gj%old
	gtjfn%			;get the jfn again (REPLACE disposed of it)
	 ercal	error		;woops - shouldn't happen
ednrep:	txo	t1,df%exp	;mark expunge and delete
	delf%			;do it
	 jrst	[userr	<Cannot delete temporary file - library is OK>,jsy]
	txnn	f,edtrdo	;Readonly edit ?
	 ret			;no, so return
	txne	f,edtsed	;SED used as editor ?
	 ret			;yes, so it's already told 'em
	tmsg	<%Edit was /READONLY - no update done> ;no, so remind them
	ret			;that no update was done.
	subttl GETEDT - get the editor, and run the thing
;
;	This gets the editor in an inferior fork, hands it the rescan
;	buffer, and starts it.
;
getedt:	movx	t1,gj%sht+gj%old	;insist file exists
	hrroi	t2,[ASCIZ/EDITOR:/] ;editor logical name
	txne	f,edtsed	;SED requested ?
	 hrroi	t2,[asciz/SYS:SED.EXE/] ;yes
	gtjfn%			;try and find it
	 erjmp	[userr	<Cannot find EDITOR: >,jsys]
	movem	t1,prgjfn	;remeber JFN on prog
	movx	t1,cr%cap	;give inferior our capabilities
	cfork%			;create a fork for it
	 erjmp	[userr	<Cannot create editor fork - >,jsys]
	movem	t1,frkhnd	;remember fork handle
	hrlz	t1,frkhnd	;fork handle in left half
	hrr	t1,prgjfn	;and JFN in left
	get%			;map process to file
	 erjmp	[userr	<Cannot map editor - >,jsys]
	hrroi	t1,scratch	;point to new command line
	rscan%			;load buffer
	 ercal	error
	getnm%			;read our system name
	push	p,t1		;save it
	movx	t1,<sixbit/TV/> ;assume TV
	txne	f,edtsed	;using SED ?
	 movx	t1,<sixbit/SED/> ;yup
	setnm%			;set up SYSTAT name
	move	t1,frkhnd	;handle of inferior
	setz	t2,		;start at START
	sfrkv%			;start at entry vector
	 ercal	error
	move	t1,frkhnd
	wfork%			;wait for it to finish
	 ercal	error
	pop	p,t1		;get our system name
	setnm%			;set it back
	move	t1,frkhnd
	kfork%			;kill inferior
	 ercal	error
	retskp			;return OK
	subttl	EDCMD - construct command for editor
;
;	This routine constructs the command that will be loaded into
;	the rescan buffer for the editor.
;	It makes different commands if the editor is SED, and also does some
;	jfn massaging. On input, q2 contains the jfn of the input editor file.
;	On return, this is no longer valid.
;
edcmd:	hrroi	t1,scratch	;point to rescan buffer
	hrroi	t2,[asciz/EDIT /] ;start of command
	txne	f,edtsed	;using SED ?
	 hrroi	t2,[asciz "SED "] ;yes, so change rescan buffer
	setzb	t3,t4
	sout%			;write beginning of rescan buffer for editor
	 ercal	error
	move	t2,q2		;get the jfn again
	movx	t3,fld(.jsssd,js%dev)!fld(.jsssd,js%dir)!fld(.jsaof,js%nam)!fld(.jsaof,js%typ)!js%paf		;write out all but generation number
	jfns%			;write out the filename
	 ercal	error
	hrroi	t2,[asciz/ /]	;space between the two filenames
	txne	f,edtsed	;using SED ?
	 jrst	edcsed		;yes, cannot specify out=in type of command
	setzb	t3,t4
	sout%			;write the space
	 ercal	error
	move	t2,q2		;get the output filename again
	movx	t3,fld(.jsssd,js%dev)!fld(.jsssd,js%dir)!fld(.jsaof,js%nam)!fld(.jsaof,js%typ)!js%paf		;write out all but generation number
	jfns%			;write that to the buffer
	 ercal	error
	hrroi	t2,[asciz/.-1/] ;new generation
	setzb	t3,t4
	sout%			;write that too
	 ercal	error
edcsed:	hrroi	t2,[asciz/
/]				;get a carriage return
	txne	f,edtrdo	; /READONLY specified ?
	 hrroi	t2,[asciz " /READONLY
"]				;yes, so plant the switch for SED
	setzb	t3,t4
	sout%			;round off the command
	 ercal	error
	move	t1,q2		;get jfn of temp file
	rljfn%			;release it
	 ercal	error
	ret
	subttl	CHKEDT - make sure output for editor is safe.
;
;	This routine checks to ensure that, before we write an output file
;	for an editor, no files of that name already exist in the directory.
;	If they do, warn the user.
;
chkedt:	hrroi	t2,edtbuf		;Point at filename we will use
	movx	t1,gj%sht!gj%old	;ask for old file
	gtjfn%				;grab a jfn
	 erjmp	r			;if failure, no problem
	movem	t1,t4			;else BIG problem - we might overwrite
	call	tstcol
	tmsg	<%A file already exists in this directory called >
	movei	t1,.priou		;write name to terminal
	move	t2,t4			;jfn of file
	setz	t3,			;default name format
	jfns%				;do it
	 ercal	error
	tmsg	<
It will be deleted before the editor is entered, to avoid confusion with
the library module you are editing.
>
	movei	t1,^d2500		;wait 2 1/2 seconds
	disms%				;in case they panic
	move	t1,t4			;get jfn of file
	delf%				;delete it
	 erjmp	.+1			;ignore failure (probably offline...)
	ret				;done
	subttl	THONG command
;
;	Enter here for commands which we know about really, but don't
;	feel like doing.
;
.know:	jrst	.direc
	confirm			;wait for confirm
	tmsg	<?I don't understand ">
	hrroi	t1,atmbfr	;point to the atom buffer
	psout%			;and tell 'em what we don't understand.
	tmsg	<". Use "DIRECTORY" or "LIST" if you want a directory listing.>
	ret
	subttl	PUSH command - down to an inferior exec
;
;	This command runs an exec beneath us, without giving it LOG
;	capability, to prevent our library being left hanging in the air.
;
.push:	noise	(to TOPS-20 EXEC)
	confirm			;confirm the command
	skipe	excfrk		;got an EXEC yet ?
	 jrst	havexc		;yes, start it again
	movx	t1,gj%sht+gj%old ;insist file exists
	hrroi	t2,[asciz/SYSTEM:EXEC.EXE/] ;where the EXEC lives
	gtjfn%			;try and find it
	 erjmp	[userr <Cannot find EXEC because: >,jsys]
	movem	t1,prgjfn	;remeber JFN on prog
	setz	t1,		;give inferior no capabilities
	cfork%			;create a fork for it
	 erjmp	[userr	<Cannot create EXEC fork - >,jsys]
	movem	t1,excfrk	;remember fork handle
	movei	t1,.fhslf	;now, read our capabilities word
	rpcap%			;like this
	 ercal	error		;should never fail
	txz	t2,sc%log	;disable LOG capability
	txz	t3,sc%log	;make it impossible to enable it
	move	t1,excfrk	;get handle of EXEC fork
	epcap%			;give it everything we have except LOG
	 ercal	error
	hrlz	t1,excfrk	;fork handle in left half
	hrr	t1,prgjfn	;and JFN in left
	get%			;map process to file
	 erjmp	[userr	<Cannot map EXEC - >,jsys]
havexc:	getnm%			;read our system name
	push	p,t1		;save it
	move	t1,excfrk	;handle of inferior
	setz	t2,		;start at START
	sfrkv%			;start at entry vector
	 ercal	error
	skipn	mappd		;are we mapped ?
	ifskp.			;if so...
		txo	f,clsnrj!tabok	;ask to keeo library, but unmap it
		call	umap
		seto	t3,	;note we need to remap
	else.
		setz	t3,	;else note we don't remap
	endif.
	move	t1,excfrk
	wfork%			;wait for it to finish
	 ercal	error
	pop	p,t1		;get our system name
	setnm%			;set it back
	skipe	t3		;test if there was a library mapped
	call	maplib		;reopen library
	ret			;return OK
	subttl	SQUEEZE command - remove empty space from library
;
;	This command creates a new version of the library which contains
;	no deleted modules or any empty space. It actually creates a new
;	generation of the library - it is impossible to do this operation
;	in place. The routine which does the work can also be called from the
;	DELETE, UPDATE and REPLACE commands if they detect that the library
;	is more than one tenth empty.
;
.squeeze:	noise	(library to remove empty space)
	skipn	mappd		;got a library to squeeze ?
	 jrst	[userr	<No library selected yet - use LIBRARY command>] ;no
	txne	f,ronly		;read only library ?
	 jrst	[userr	<Write access to library required>] ;yes, cannot do it
	chksfe			;library safe ?
	confirm			;confirm the command
;
;	Internal entry point from other commands is here.
;
sqzint:	skipe	unsafe		;library safe ?
	 jrst	[userr	<Cannot (or rather WILL not) squeeze an unsafe library>]
	call	getnlib		;get jfn on new library, and open it
	 ret			;failed, return to caller
	move	q3,hdrpag+$hnent	;get number of entries
	sub	q3,hdrpag+$hndel	;subtract deleted entries
	dmsg	<
[Squeezing headers]>
	setzm	chdr		;mark initialization call
sqzin1:	call	sqhdr		;squeeze one header across
	 ret			;failed, so return
	sojg	q3,sqzin1	;loop for all modules; n=>g GPG **
	dmsg	<[OK]
[Squeezing data pages]>
	move	q3,hdrpag+$hnent
	sub	q3,hdrpag+$hndel	;subtract deleted entries
	setzm	chdr		;mark init entry
sqzin2:	call	sqmod		;squeeze one module's data across
	 ret			;failed, so return
	sojg	q3,sqzin2	;loop for all modules; n=>g GPG **
	call	maksaf		;now set the new library safe
	dmsg	<[OK]
[Unmapping old library]>
	call	umap		;unmap the old library
	dmsg	< [OK]>
	move	t1,squjfn	;get jfn of new copy
	txo	t1,co%nrj	;set to close but keep jfn
	closf%			;close new one
	 ercal	error
	move	t1,squjfn	;get jfn on new library
	movem	t1,libjfn	;make jfn of current library
	dmsg	<
[Mapping new library]>
	call	maplib		;and map the new squeezed copy
	dmsg	< [OK]>
	ret			;back to caller
	subttl	Copy one module from old library to new
;
;	This routine is called to copy one module from the old library to the
;	new library. It walks through the directory in the same order that
;	SQHDR does, thus putting all files in the right place for their headers.
;	On the first call (spotted by CHDR being non-zero), we reset the byte
;	size of the library to its own size (this does not modify the FDB)
;
sqmod:	skipe	chdr		;first call ?
	 jrst	sqmodc		;no, continue as normal
	move	t1,hdrpag+$hnent ;yes, so get number of entries
	sub	t1,hdrpag+$hndel ;subtract number of deleted ones
	imul	t1,hdrpag+$hwpde ;multiply by words per entry
	add	t1,hdrpag+$hwih ;and add words in fixed header
	idivi	t1,1000		;divide by words in page to get pages in
	skipe	t2		;directory....
	 aoj	t1,		;and add one if any remainder
	movem	t1,t4		;save this for a mo
	movei	t2,^d36		;get bits in a word
	idiv	t2,hdrpag+$hbysz ;divide by bits in a byte
	imul	t1,t2		;now get bytes in directory
	imuli	t1,1000		;multiply by words in a page
	movem	t1,cfil		;this is the start byte for new data writes
	movei	t1,hdrpag	;point to header page
	add	t1,hdrpag+$hwih	;add number of words in a header
	movem	t1,chdr		;this points to the current header
	move	t1,squjfn	;get jfn of squeezed library
	move	t2,t4		;and pages in directory
	lsh	t2,9		;make pages into word-size bytes
	sfptr%			;and set pointer for new writes
	 ercal	error
	move	t2,hdrpag+$hbysz ;get byte size for data
	sfbsz%			;set file byte size...
	 ercal	error		;failed
	move	t1,hdrpag+$hnent ;get number of entries
	sub	t1,hdrpag+$hndel ;subtract number of deleted ones
	skipg	t1		;do we have any left ?
	 retskp			; no, so don't do any
sqmodc:	move	t1,chdr		;point to current header
	skipe	$dmupd(t1)	;delete module ?
	 jrst	sqmod1		;no, so do it
	add	t1,hdrpag+$hwpde ;yes, so add words per entry
	movem	t1,chdr		;store as new entry pointer
	jrst	sqmodc		;try the next one...
sqmod1:	move	q1,chdr	;get current header
	move	t1,libjfn	;point to input library
	move	t2,$dmstrt(q1)	;get starting byte for this module
	sfptr%			;point there
	 ercal	error
	move	q2,$dmlen(q1)	;get length of this module
	caig	q2,1000*ndpag	;more than 512 bytes ?
	 jrst	[movns	q2,q2	;no, so make this a negative count
		jrst	sqmod3] ;and do it simply
	movns	q2,q2		;make byte count negative
sqmod2:	move	t1,libjfn	;point to library
	move	t2,[point ^d36,datpag] ;and buffer page
	movni	t3,1000*ndpag	;read 1k bytes
	sin%			;do it
	 ercal	error
	move	t1,squjfn	;get new library jfn
	move	t2,[point ^d36,datpag] ;pointer to buffer page
	movni	t3,1000*ndpag	;1k worth
	sout%			;write it
	 quoerr			;let expunge handle this
	addi	q2,1000*ndpag	;drop amount left to write
	camge	q2,[-1000*ndpag];ok yet ?
	 jrst	sqmod2		;yes, go on
sqmod3:	move	t1,libjfn	;point to input
	move	t2,[point ^d36,datpag] ;to buffer
	move	t3,q2		;amount left to read
	jumpe	t3,sqmod4	;if zero remainder, don't do any work
	sin%			;do it
	 ercal	error
	move	t1,squjfn	;point to new library
	move	t2,[point ^d36,datpag] ;buffer to output file
	move	t3,q2
	sout%			;write last buffer
	 quoerr		;let QUOTA trap any errors
sqmod4:	move	t1,chdr		;get current header
	add	t1,hdrpag+$hwpde ;update for next call
	movem	t1,chdr		;store as new entry pointer
	retskp			;return success
	subttl	Copy one header from old library to new
;
;	This routine is called to copy across one header from the old
;	library to the new. Current pointers are kept in chdr,cfil
;
sqhdr:	skipe	chdr		;initialized yet ?
	 jrst	sqhdrc		;yes, just do the next one
	move	t1,hdrpag+$hnent ;no, so get number of entries
	sub	t1,hdrpag+$hndel ;subtract number of deleted ones
	imul	t1,hdrpag+$hwpde ;multiply by words per entry
	add	t1,hdrpag+$hwih ;and add words in fixed header
	idivi	t1,1000		;divide by words in page to get pages in
	skipe	t2		;directory....
	 aoj	t1,		;and add one if any remainder
	movei	t2,^d36		;get bits in a word
	idiv	t2,hdrpag+$hbysz ;divide by bits in a byte
	imul	t1,t2		;now get bytes in directory
	imuli	t1,1000		;multiply by words in a page
	movem	t1,cfil		;this is the start byte for new data writes
	movei	t1,hdrpag	;point to header page
	add	t1,hdrpag+$hwih	;add number of words in a header
	movem	t1,chdr		;this points to the current header
	move	t1,hdrpag+$hnent ;get number of entries
	sub	t1,hdrpag+$hndel ;subtract number of deleted ones
	skipg	t1		;do we have any left ?
	 retskp			; no, so don't do any
sqhdrc:	move	t1,chdr		;get address of next directory entry
	skipe	$dmupd(t1)	;this entry deleted ?
	 jrst	sqhdr1		;no, so do it
	move	t1,hdrpag+$hwpde ;yes, get words per entry
	addm	t1,chdr		;update current entry pointer
	jrst	sqhdrc		;and try the next one
sqhdr1:	hrlz	t1,chdr		;get current header pointer
	hrri	t1,squhdr	;point to temp area for squeeze headers
	movei	t2,squhdr	;address of header start
	add	t2,hdrpag+$hwpde ;add words in an entry
	soj	t2,		;less one
	blt	t1,(t2)		;now copy the directory entry
	move	t1,cfil		;get current "eof" pointer
	movem	t1,squhdr+$dmstrt ;this is the new module start address
	move	t1,squjfn	;point to "squeezing library"
	move	t2,[point ^d36,squhdr] ;byte pointer to area
	movn	t3,hdrpag+$hwpde ;number of words in an entry
	sout%			;write them
	 quoerr
	move	t1,squhdr+$dmlen ;get bytes in this module
	addm	t1,cfil		;update "eof" pointer
	move	t1,hdrpag+$hwpde ;words per directory entry
	addm	t1,chdr		;update header pointer
	retskp			;return to caller
	subttl	Get jfn on new library and open for write access
;
;	This routine initializes the new library file - sets up a header,
;	etc. and establishes the start page for normal writes to take
;	place.
;
getnlib:	hrroi	t1,scratch	;point to scratch buffer
	move	t2,libjfn		;get jfn of library
	movx	t3,fld(.jsaof,js%dev)!fld(.jsaof,js%dir)!fld(.jsaof,js%nam)!fld(.jsaof,js%typ)!js%paf ;write out STR:<DIR>NAME.TYP (no generation)
	jfns%			;write out current library name
	 ercal	error
	movx	t1,gj%sht!gj%fou
	hrroi	t2,scratch		;now prepare to get a jfn on new generation
	gtjfn%				;do it
	 erjmp	[userr	<Cannot get jfn on new library - >,jsy] ;failed
	movem	t1,squjfn		;save the jfn
	setzm	squpag		;zero out the header page
	move	t1,[squpag,,squpag+1]
	blt	t1,squpag+777	;now do it
	movei	t1,hdrmrk	;magic number for page 0 of library
	movem	t1,squpag	;store it
	move	t1,hdrpag+$hwih	;number of words in old header
	movem	t1,squpag+$hwih	;store it
	move	t1,[hdrpag+$hext,,squpag+$hext]
	blt	t1,squpag+$hext+7	;store default extension
	move	t1,hdrpag+$hbysz	;get byte size for library
	movem	t1,squpag+$hbysz	;store
	gtad%			;get current date and time
	movem	t1,squpag+$hupdt	;store as time of last update
	move	t1,hdrpag+$hwpde ;get number of words per directory entry
	movem	t1,squpag+$hwpde ;store
	move	t1,hdrpag+$hnent	;get number of entries
	sub	t1,hdrpag+$hndel	;subtract deleted ones
	movem	t1,squpag+$hnent	;this is how many will be in new lib
	caile	t1,mxpg0		;do they all fit in page 0 ?
	 jrst	[subi	t1,mxpg0	;no, so how many extension pages
		idivi	t1,mxpgn	;are there ?
		skipe	t2		;remainder in final page ?
		 aoj	t1,		;yes, add another page on
		movem	t1,squpag+$hnext ;set extension page count
		jrst	.+1]		;and continue
	setom	squpag+$hsafe		;mark new library unsafe
	move	t1,squjfn	;get library jfn
	movx	t2,of%wr
	openf%			;open it
	 erjmp	[userr	<Cannot open new library - >,jsys]
	move	t1,squjfn	;write to new library
	move	t2,[point ^d36,squpag] ;from header page
	movni	t3,1000		;one page worth
	sout%			;write it
	 quoerr	<Cannot write to library>
	move	t1,squjfn	;now get library
	txo	t1,co%nrj
	closf%			;close, but do not release jfn
	 ercal	error		;tuff
	move	t1,squjfn	;point to file
	txo	t1,fld(.fbbyv,cf%dsp) ;word to change
	movx	t2,fb%bsz	;mask in word to alter
	move	t3,hdrpag+$hbysz	;new byte size for library
	lsh	t3,<^d35-pos(fb%bsz)>;shifted to proper place
	chfdb%			;do it
	 ercal	error
	move	t1,squjfn
	movx	t2,of%wr!of%rd	;open for update
	openf%			;do it
	 ercal	error
	move	t2,hdrpag+$hwih ;number of words in header
	sfptr%			;set up to write beyond header
	 ercal	error
	retskp			;return to caller
	subttl	GUIDES - command parses for GUIDE mode
;
;	These parsers handle the HELP INFO PRINT and EXIT commands when in
;	GUIDE mode. They don't do any real work.
;
.gexit:	noise	(from this program)
	confirm
	call	umap		;get rid of the library
	haltf%			;stop

.ghelp:	noise	(with this program)
	confirm
	hrroi	t1,hlpgui
	psout%
	ret

.GIDXT:	1,,1
	[asciz/INDEX/],,-1

.ginfo:	noise	(on subject)
	txo	f,typing
	jrst	.ginf2
.gprnt:	noise	(info on the printer about)
	txo	f,gprint	;flag PRINT-style output

.ginf2:	movei	t1,cmdblk
	movei	t2,[flddb. (.cmkey,,.gidxt,,,[
		flddb. (.cmkey,,modules,<Subject for help, >)])]
	txnn	f,idxmod	;any INDEX modules found ?
	 movei	t2,[flddb. (.cmkey,,modules,<Subject for help, >)] ;no, don't allow
	comnd%		;Parse the field
	 erjmp	cmderr
	txne	t1,cm%nop	;Parse ok ?
	 jrst	[userr	<Unknown subject - >,jsy]	;no
	hrre	t1,(t2)		;get data from TBLUK
	jumpge	t1,.ginf3	;if non-negative, not INDEX
	noise	(on chapter name)	;They have typed INDEX
	comand	<[flddb. (.cmkey,,idxtab,<Index chapter name, >)]>,<Unknown chapter - >,jsy

.ginf3:	movem	t2,q1		;save TBLUK index
	confirm			;confirm command
	txnn	f,gprint	;PRINT command ?
	 jrst	[movei	t4,.priou
		jrst	.copy3]	;no, so just go straight for TYPE
	hrroi	t2,[asciz/LPT:/] ;yes, so grab LPT jfn
	movx	t1,gj%sht!gj%fou ;must exist
	gtjfn%
	 erjmp	[userr	<Cannot find line printer - >,jsy]
	movem	t1,t4		;save output jfn
	jrst	.copy3		;continue with ordinary TYPE
	subttl	IDXBLD - build table for INDEX command in GUIDE mode.
;
;	This routine is called at initialization when in GUIDE mode. It
;	searches the library for modules whose name are of the form *-INDEX.
;	If any are found, flag IDXMOD is set, and a TBLUK table of the modules
;	is built.
;
idxbld:	saveac	q1
	hrroi	t1,copnam		;where WLDSET expects filename
	hrroi	t2,[asciz/*-INDEX/]
	setzb	t3,t4			;string is ASCIZ
	sout%				;copy match pattern for index modules
	txo	f,noerr			;inhibit errors
	call	wldset			;Try for any modules of this type
	 ret				;no index modules present
	txz	f,noerr			;allow errors
	movei	t1,maxidx		;OK, get max number of index chaps
	movem	t1,idxtab		;and store in index table
	movei	q2,1			;where we are in table
idxlop:	move	q1,(q1)			;so get the entry
	movem	q1,idxtab(q2)		;store into TBLUK table
	call	wldnxt			;try for next match
	 jrst	idxend			;no more
	aoj	q2,			;ok, bump the index
	cain	q2,maxidx		;too many ?
	 jrst	[tmsg	<
?Too many index modules in guide file>
		HALTF%]
	jrst	idxlop			;and continue
idxend:	hrlm	q2,idxtab		;store number of modules used
	txo	f,idxmod		;indicate an index is present
	ret				;and return
	subttl	MOD - type any message for this verson of LBR
;
;	This routine types any warnings or cajolings for users of LBR.
;
mod:	txne	f,guide		;guide mode ?
	 ret			;yes, none of this stuff then
	tmsg	<
	The DIRECTORY commands in LBR are now different. DIRECTORY just prints
a list of filenames in the library ; VDIRECTORY prints all files, together with
date + time of last update, and FDIRECTORY prints the full information like the
old directory command. The STATUS command prints just the header of the old
DIRECTORY command. The switches /FULL,/VERBOSE,/OUTPUT and /SORTED are now
also usable with any flavour of the DIRECTORY command.
>
	ret
	repeat 0,<
	tmsg	<
	LBR now has a TDIRECTORY command, like the EXEC, which prints the
	directory sorted by order of date and time, rather than alphabetically.
	The /AFTER and /BEFORE swiches still work with TDIR, and you can use
	other feature of DIR (like TDIR S* for a sorted list of all modules
	beginning with S.)
>
	ret
>
	repeat 0,<
	TMSG	<
	If you control-C during a type command, this will now just stop
	the typeout and return the LBR prompt, rather than getting out of
	LBR altogether. This can be useful for stopping long typeouts.>
	TMSG	<
		When you create a new library, you can now specify the minimum
	space to allow for files. This makes it quicker to create the library
	if you know it will contain more than 40 modules, as it does not need
	to be expanded later.>
	TMSG	<
		The DIRECTORY command now has a BEFORE and AFTER switch, for
	listing files between certain dates and/or times.
>
	RET
	>
REPEAT 0,<
	Tmsg	<
	The /READONLY switch now works with SED.
	LBR now has a PUSH command, like the EXEC.
	The GO command exits from LBR, and reexecutes your last COMPILE,
EXECUTE or DEBUG command.
	There is now an APPEND command to append to an output file when
	you copy from a library.
	>
	tmsg	<
	You can now type SET SED to make SED your default LBR editor.

You can now type a command like INSERT A* without worrying if something
called A* already exists in your library. If it does, it will be skipped.
>
	ret>
	subttl	SLEN - get string length
;
;	This routine is called with an address in t1. It returns a number of
;	characters in t2.
;
slen:	push	p,t3		;save an ac
	hll	t1,[point 7,]	;make a byte pointer
	setz	t2,		;zero the count
slen1:	ildb	t3,t1		;get a byte
	jumpe	t3,[pop	p,t3	;if zero, restore ac
		ret]		;and return
	aoja	t2,slen1	;else increment count and get next byte
	subttl	MAKSAF - make new library safe and CHKSQZ
;
;	This resets the UNSAFE flag in the new squeezed library, set
;	while we were actually writing to it.
;
maksaf:	move	t1,squjfn		;point to new library
	movei	t2,^d36			;set for 36 bit bytes
	sfbsz%				;do it
	 ercal	error
	move	t1,squjfn		;point to new library again
	setz	t2,			;we want to write a zero
	movei	t3,$hsafe		;into the safety byte
	rout%				;do that
	 ercal	error
	move	t1,squjfn		;point to library yet again
	move	t2,hdrpag+$hbysz	;and get real byte size
	sfbsz%				;reset this so close works OK
	 ercal	error
	ret				;back to caller
;
;	This routine is called to see if an auto squeeze would be
;	useful.
;
chksqz:	txnn	f,alowsq		;is AUTO-SQUEEZE permitter ?
	 ret				;no, so return now
	move	t1,libjfn		;it is, so get library..
	sizef%				;size in bytes
	 ercal	error
	idivi	t2,^d10			;and get 10% of that figure
	camle	t2,hdrpag+$htfre	;is it less than total free space ?
	 ret				;no, so don't bother right now
	call	tstcol			;yes, so get a new line
	tmsg	<[Performing automatic SQUEEZE...>
	call	sqzint			;enter squeeze at internal entry point
	tmsg	<OK]>			;reassure user
	ret				;back to caller
	subttl	WLDSET - routine called to commence a wildcard lookup
;
;	This routine is called when one wants to initiate a wildcard module
;	lookup. The wild module string should be in COPNAM.
;	If one is using this to perform output to files, a parse-only
;	jfn should be supplied in t4 for constructing individual jfns
;	for output files. If t4 contains 0 on entry, no jfns will be
;	constructed.
;	If QDFLG is set, only deleted modules will be returned for matches.
;	Returns: +1/ Failure, no matching modules.
;		 +2/ Success, pointer to tbluk entry for module
;		in q1, jfn for output file in t4, saved wildcard jfn in
;		wldjfn
;
;	Things are also set up for WLDNXT to pick up the next wild
;	module.
;
wldset:	movem	t4,wldjfn	;save the parse-only jfn (for directory, etc.)
	hlrz	t4,modules	;number of undeleted entries in lib
	txne	f,qdflg		;doing deleted stuff ?
	 move	t3,hdrpag+$hndel ;yes, so get deleted number instead
	jumpe	t4,[userr	<Library is empty>] ;if none, return
	movei	q3,modules+1	;point to TBLUK table
wldse1:	hlrz	t1,(q3)		;get address of this entry
	skipn	$dmupd(t1)	;deleted entry ?
	 jrst	wldsel		;yes, so ignore it
	movx	t1,.wlstr ;wild string match desired
	hrroi	t2,copnam	;point to name of wild module
	hlro	t3,(q3)		;make byte pointer to module name
	wild%			;try for a match
	 ercal	error		;should not receive JSYS error
	txnn	t1,wl%nom	;get a match ?
	 jrst	wldsem		;yes, so return the info
wldsel:	aoj	q3,		 ;no, so bump the pointer to the directory
	sojn	t4,wldse1	;and loop through the modules
	userr	<No modules match that specification> ;if we reach here, there is no match
;
;	We have found the first match
;
wldsem:	movem	t4,wldcnt	;save counter for loop
	movem	q3,wldptr	;and pointer to directory
	skipn	wldjfn		;were we given a jfn ?
	 jrst	wldse3		;no, so don't try to construct one
	hllz	t3,(q3)		;destination...
	hrri	t3,outnam	;and source....
	blt	t3,outnam+7	;for copying output filename
	txne	f,rwild		;is this a repeated wild scan ?
	 jrst	wldse2		;yes, the setup has already been performed
	movx	t1,gj%fou	;assume output use for file
	txne	f,tempot	;want temporary output ?
	 txo	t1,gj%tmp	;yes, so set flag for GTJFN
	movem	t1,wldblk	;store flags in GTJFN block
	move	t1,[hdrpag+$hext,,outext]
	blt	t1,outext+7	;set up default extension to be that of library
	move	t2,wldjfn	;now get jfn used for output
	hrroi	t1,outext	;area to write extension to
	movx	t3,fld(.jsaof,js%typ) ;only output extension
	txnn	t3,gj%ext	;wildcards in extension ?
	 jfns%			;no, so use it
	  ercal	error		;should not occur
	hrroi	t1,outdir	;point to area for output directory
	move	t2,wldjfn	;get output parsing jfn
	movx	t3,fld(.jsaof,js%dev)!fld(.jsaof,js%dir)!js%paf
	jfns%			;now output structure and device to use
	 ercal	error
wldse2:	movei	t1,wldblk	;point to GTJFN block for wild stuff
	hrroi	t2,outdir	;point to structure/directory
	gtjfn%			;try for a jfn
	 erjmp	[userr	<Cannot open output file - >,jsy]
	movem	t1,t4		;put jfn where it is expected
wldse3:	move	q1,q3		;return TBLUK address for this entry
	retskp			;return success
	subttl	WLDNXT - step a wildcard module lookup
;
;	this routine is called after one call has already been made to
;	WLDSET to initialize wild-card scanning of the library. WLDSET has
;	returned the first matching entry, and it is our job to find the next
;	one. We can use much of the same code that is used in WLDSET - some
;	of it is omitted not because ti would make things go wrong, but because
;	it would be a waste of time setting up things that have already been
;	done.
;
wldnxt:	txo	f,rwild		;indicate repeated wild scan
	move	t4,wldcnt	;retrieve stored counter
	move	q3,wldptr	;and pointer
	soje	t4,[ret]	;decrement - if zero, none left
	aoj	q3,		;some left, step to next entry
wldnx1:	hlrz	t1,(q3)		;get entry address
	skipn	$dmupd(t1)	;is entry deleted ?
	 jrst	wldnxl		;yes, so ignore it
	movx	t1,.wlstr ;wild string match desired
	hrroi	t2,copnam	;point to name of wild module
	hlro	t3,(q3)		;point to name of library module to match
	wild%			;try for a match
	 ercal	error		;should not receive JSYS error
	txnn	t1,wl%nom	;get a match ?
	 jrst	wldsem		;yes, so return the info
wldnxl:	aoj	q3,		;no, so bump pointer to lookup table
	sojn	t4,wldnx1	;and loop through the modules
	ret			;if here, no matches left
	subttl	COPWON - output name of destination in wild copy
;
;	This routine is called when doing a wildcard copy command.
;	It outputs the name of the current destination file on the terminal.
;	All acs are preserved.
;	If appending, the name of the source module is output instead.
;
copwon:	txne	f,typing	;TYPE command ?
	 ret			;yes, do nothing
	push	p,t1
	push	p,t2
	push	p,t3
	push	p,t4		;save all acs used
	tmsg	<
>				;pretty new line
	txne	f,apping	;appending ?
	 jrst	[hlro	t1,(q1)	;yes, point to module name
		psout%		;type it
		jrst	copwor]	;continue
	move	t2,t4		;jfn of output file
	movei	t1,.priou	;terminal
	setzb	t3,t4		;usual filename format
	jfns%			;write it out
	 ercal	error		;should not happen
copwor:	pop	p,t4
	pop	p,t3
	pop	p,t2
	pop	p,t1
	ret
	subttl	DDT - enter ddt
;
;	This command is here for us to put a breakpoint on with DDT.
;
.ddt:	noise	(enter DDT - beware !)
	confirm
	txo	f,modif
	skipe	havddt		;have we got DDT yet ?
	 jrst	.ddt1		;yes, so just breakpoint
	call	getddt		;no, so merge and breakpoint
	setom	havddt		;and remember we have DDT already
	ret			;back for next command
.ddt1:	jsr	@$bpt		;go for unsolicited breakpoint
	ret			;and back for next command
	subttl	LUKMOD - lookup a module in the library
;
;	Name of a module is in LUKNAM, we check to see if it exists.
;	It attempts to do a lookup on the module specified, and returns
;	+1 if not found, +2 if found. If the +2 return is taken, a pointer
;	to the directory entry is returned. This routine is not used most
;	of the time - its only use is for updates and inserts, which have
;	to check that the module is NOT there.
;
lukmod:	hrroi	t2,luknam	;now point to the name
	movei	t1,modules	;point to module list
	tbluk%			;do a lookup
	 erjmp	[userr	<Library directory is corrupt - >,jsy]
	txne	t2,tl%exm	;exact match ?
	 retskp			;yes, return success
	ret			;no, return failure
	subttl	Map and unmap libraries
;
;	These routines either map or unmap the current library.
;
umap:	skipn	mappd		;mapped ?
	 ret			;no, so do nothing
	seto	t1,		;yes, so set up to unmap
	move	t2,[.fhslf,,hdrpag/1000] ;unmap header page from this fork
	movei	t3,1		;remove 1 page
	add	t3,hdrpag+$hnext ;plus any extra pages
	txo	t3,pm%cnt	;flag count present
	pmap%			;do it
	 ercal	error
	move	t1,libjfn	;now get the library
	txne	f,clsnrj	;keep the jfn, did they say ?
	 txo	t1,co%nrj	;yes, so keep it
	closf%			;and close it
	 ercal	error
	txzn	f,clsnrj	;keep the jfn, did they say ?
	 setzm	libjfn		;no, so forget we ever had it
	setzm	mappd		;and clear the mapping status
	ret			;back to caller
maplib:	setom	mapcnt		;counter for multiple access attempts
mapint:	skipe	mappd		;mapped ?
	 jrst	[call	umap	;unmap us
		userr	<Library already mapped>]
	move	t1,libjfn	;look at the library
	move	t2,[1,,.fbbyv]	;get the byte size
	movei	t3,t4		;where to put it
	gtfdb%			;read the file byte size
	 ercal	error		;can't fail
	txz	t4,^-<fb%bsz>	;clear all but the byte size
	lsh	t4,-<^d35-pos(fb%bsz)> ;and shift down to right end
	move	t2,t4		;get the byte size
	lsh	t2,<^d35-pos(of%bsz)> ;put in place for OPENF
	move	t1,libjfn	;open up the library
	txo	t2,of%rd!of%wr!of%pln	;for read and write access, no SOS numbers
	txne	f,ronly		;read-only lit ?
	 txz	t2,of%wr	;yes, no write access ta
	openf%			;do it
	 erjmp	[cain	t1,opnx9	;invalid simul access ?
		 jrst	mapwt		;yes, so maybe we can wait a bit...
		cain	t1,opnx4	;do we need write access ?
		 jrst	lbrrdo		;yes, so do read only
		caie	t1,opnx30	;or is it archived ?
		 jrst	[userr	<Cannot open library - >,jsys] ;no, some other error
	lbrrdo:	dmsg	<
[Opening library read-only]>
		txo	f,ronly ;flag read-only
		jrst	maplib]	;continue
	hrlz	t1,libjfn	;get the library, map page 0
	move	t2,[.fhslf,,hdrpag/1000] ; to set page in our process
	movx	t3,pm%rd!Pm%wr!pm%pld
	txne	f,ronly		;read-only library ?
	 txz	t3,pm%wr	;yes, no write access
	pmap%			;do it
	 erjmp	[move	t1,libjfn	;get library
		closf%		;close it
		 nop		;tuff
		setzm	libjfn	;forget it
		userr	<Cannot map library - >,jsys]
	setom	mappd		;indicate mapped, in case of error
	movei	t1,hdrmrk	;special marker
	came	t1,hdrpag	;is it set ?
	 jrst	[call	umap
		userr	<File is not a library>]
	move	t3,hdrpag+$hnext ;any extension pages ?
	jumpn	t3,[hrlz	t1,libjfn ;ok, point to library
		  hrri	t1,1		;start mapping at page 1 of file
		  move	t2,[.fhslf,,<hdrpag/1000>+1] ;map to extension area
		  txo	t3,pm%rd!pm%wr!pm%pld!pm%cnt
		txne	f,ronly	;read only library ?
		 txz	t3,pm%wr ;yes, no write access ta
		  pmap%
		   erjmp [call	umap
			userr	<Cannot map library extension - >,jsy]
		  jrst	.+1]
	skipe	unsafe		;library look OK ?
	 jrst	[call	tstcol	;nope, it don't
		tmsg	<%Library directory appears inconsistent - rebuild>
		jrst	.+1]
	txzn	f,tabok		;tables will be the same ?
	 call	bldtab		;no, so build lookup table
	move	t1,hdrpag+$hflgs	;get flag words
	txne	t1,hfprm	;permanent library ?
	 txz	f,tempot	;yes, so clear temporary stuff
	ret			;ok, back to caller
mapwt:	hrroi	t1,[asciz/
[Waiting for access to library]/]
	aosn	t2,mapcnt	;increment wait time
	 psout%			;type message on first attempt
	cain	t2,5		;waited too long ?
	 jrst	[userr	<Library is being written to by another user>] ;yes
	movei	t1,^d5000	;ok, wait 5 seconds
	disms%			;like this
	jrst	mapint		;and try again
	subttl	BLDTAB - build lookup table from library info
;
;	This routine is called whenever a new library is mapped to build
;	the TBLUK table that will be used to walk through the library module
;	name list. Once the library is open, both the lookup table and
;	the library table are updated together, so this never needs to be
;	written back.
;
bldtab:	move	t1,hdrpag+$hnent ;get number of entries
	movem	t1,q1			;save
	movei	t1,maxent	;get maximum number of modules
	camge	t1,q1		;not overflowed ?
	 jrst	[userr	<Library contains too many modules>]
	movem	t1,modules	;store size of TBLUK% table
	skipn	q1		;any modules there ?
	 ret			;no, so back to caller
	movei	q2,hdrpag	;address of start of header
	add	q2,hdrpag+$hwih	;add number of words in header to point to dir
	movei	t1,modules	;point to TBLUK% table
	hrlz	t2,q2		;point to this entry
bldmn1:	skipe	$dmupd(q2)	;if deleted, do not add
	tbadd%			;add to table
	 erjmp	[userr	<Error constructing module name table - >,jsy]
	add	q2,hdrpag+$hwpde ;point to next directory entry
	hrlz	t2,q2		;make TBLUK entry
	movei	t1,modules	;get address of table again (fouled by TBADD)
	sojn	q1,bldmn1	;loop for all modules
	ret
	subttl	Text for HELP commands
hlpgen:	asciz	\	The LBR program maintains and creates what are known as "universal"
libraries. These are files in your directory that contain many other files, most
of which were originally quite short (only a few pages). LBR conserves disk
space both in your directory, and in the system overhead area, by compressing
lots of small files into one large file. You can extract these small files
whenever you want, or replace them inside the library with new versions, or
remove them altogether, or type them, or get a directory. All of these things
are done with the LBR prorgam.
		Two assumptions are made about the libraries you use. First, it
is assumed that all the files will be of a similar type. Second, as a result
of this, it is assumed that all have the same byte size, and all have the same
extension. These are not required, but when you insert a file into the library,
its name is remembered, but its extension is not. When you extract it, the
extension used by default is one set up for the whole library. Similarly, the
output file will be written with the byte size of the library. For most purposes
this presents no problem. However, it means it may not be easy to mix (say)
binary files and text files in one library, unless you are willing to treat
them all as binary.
		The space savings that can be made are dramatic. We picked just
one user on our system who had 65 1-page files in his directory (mainly files
of commands to a statistical package). They took up, of course, 65 pages
in his directory, and 65 more pages of overhead (from system directories). In
a library, they took up just 12 pages !
	Type HELP FILESPEC for help on the syntax of file and module
specifications in LBR.

\
hlpedt:	ASCIZ	\	The EDIT command allows you to specifiy a module in the
library which you wish to edit. It starts up the system editor, places the file
in its text buffer, and then automatically replaces the edited module back into
the library when you exit from the editor.
		If you wish to use SED as your editor, type /SED after the
module name. To use SED always, you can type SET SED, which makes LBR
always use SED for the EDIT command. You might want to put this in your LBR.INIT
file. If you only want to use the editor to review a file (ie you do
not wish to change it), type /READONLY after the module name. This will prevent
any accidental changes you make being incorporated into the library.

\
hlpfsp:	ASCIZ	\	File specifications in LBR commands such as COPY, INSERT
LIBRARY, etc. follow the standard TOPS-20 pattern for their names. Both names
and extensions can be upto 39 characters long, and directory specs can be given
which are also 39 characters long. When more than one file can be operated on
by one command, a "wildcard" spec is allowed, where * and % characters are
used in the filename. "*" stands for any combination of characters, "%" for any
single character. Thus A% means all two-character names beginning with A, and
A* means all names beginning with A (including just A, if it exists.)
		Module names follow the same rules, except that they are just
names, with no directories or extensions.
	When wildcards are used for an output filename, they may not work as
expected. If you specify a wildcard in any field in the output filename, it
means "use the value of the input field here". If you do not, that part of the
output filename is used. Thus
COPY A* (to) <Work-directory>BA*.DAT
does NOT add the letter B to the beginning of all your filenames, It copies
the modules specified to directory <WORK-DIRECTORY>, and gives them the
extension DAT. This is the case with all programs that use output wildcards.

\
hlpcre:	asciz \
The CREATE command makes a new library, and makes it the current library for
following commands. The format is:
CREATE (library) LIBNAM.LBR (type) extension (byte size) n (with room for) N

	A file of this name must not already exist. This prevents you
accidentally overwriting an existing library. To create a new library to
supersede an old one, you must DELETE the old library first.

	Only the name of the library need be type, all the rest defaults.
The extension of the library defaults to .LBR, the default extension for
inserts and extracts to null, and the byte size to 0 (all suitable for
text files.) The number of entries defaults to the minimum possible (which is
around 40 at present). The library is expanded as necessary if room is needed
for more. As the expansion is a lengthy process for large files, if you are
creating a library which you know will contain more than 40 modules, it is worth
your while to allocate more space initially. Each 40 modules of directory space
takes about 1 page of disk space.
 The type will be set when the first file is inserted, as will
the byte size, using those supplied by the first file.

Examples:
CREATE GLIM-COMMANDS
CREATE BINARY-DATA (type) BIN (byte size) 36
\
hlpdel:	asciz	\
The DELETE command deletes modules from a library. Format:
DELETE (modules) name
You can either specify the name of a single module, or a wildcard spec
using * and %. % matches a single character, * any combination of chars.
Thus A* means all modules whose name begins with A ; A% means all modules
whose name begins with and habe 2-letter names. Combinations such as
A%B* are acceptable. Recognition with escape can be used on single names,
but not with wildcard names. You can also use question mark to get a list
of modules.
\
hlpdir:	asciz	\
	The DIRECTORY-class commands are used to list the names of modules in
the library. Optionally, information such as the size and date and time of last
update can also be included. The basic directory command lists all modules ;
typing DIR A* would list all modules beginning with A. The following switches
may be used at the end of the command to modify it:

/AFTER:date+time, or date, or time	Only list modules altered after
					the specified date or time
/BEFORE:...				Like after, but lists only those
					modifed before the specified time.
/FULL					Prints a header before the directory
					like the STATUS command.
/VERBOSE				Includes the size of each module,
					and the date and time of last update.
/OUTPUT:file				Places the directory output in the named
					file.
/SORTED-BY-DATE-AND-TIME		Sorts the output listing so that the
					newest modules are at the top of the
					listing (usually the listing is alpha-
					betical)
	The TDIRECTORY command is like directory with a /SORTED switch
assumed. The FDIRECTORY command assumes the /FULL switch, and the VDIRECTORY
command assumes the /VERBOSE switch. The LIST command requires an output file
name.
	If you want a compact listing of filenames and nothing else, it
may be easiest to type
TYPE ?
	which will give a list of all modules in a compact tabular form.
\
hlpins:	asciz	\
The INSERT command places new files into a library. Note that when in the
library, we refer to the files as "modules", to distinguish them from real
files. The format of the command is
INSERT (files) filename.type
You can type the name of a single file, or a wildcard file spec. The type
defaults to the default type for the current library. The files are inserted one
by one into the library, with their names typed as it happens, if you ask for
more than one to be inserted. Note that if a file is encountered which clashes
with a module already present, the file is not inserted, and LBR proceeeds to
the next file in the list.

\
hlprep:	asciz	\
The REPLACE command is used to update a module in a library which is out of
date. A new copy of the file is written into the library. Command:
REPLACE (modules) modnames (with files) filename
You may use wildcards. The filenames default to the module names used. You
should not attempt to override this unless you have to, as you may not have
as many files as there are modules to replace if you use different names.
	You may find the UPDATE command easier to use than REPLACE. They both
perform a similar function.\
hlptyp:	asciz	\
The  TYPE command types files from a library. This is only useful with
text-file libraries. Format:
TYPE (modules) name
\
hlpcop:	asciz	\
The COPY command copies modules from the library to TOPS-20 files so that
you can use them with another program. Format:
COPY (modules) modnames ( to files) filenames
	The filenames default to the module names, the extension to the
library default extension. You may use wildcards. By default, the output files
are temporary files, and will be expunged when you logout. They will still be
in the library. See the SET NO TEMPORARY command to override this.

\
hlpupd:	asciz	\
	The UPDATE command replaces exisiting modules in the library with
new versions from ordinary TOPS-20 files. The format is
UPDATE (modules) modnam
where modnam is either a single module name or a wildcarded name. This command
assumes that the new versions of the files have the same name as their
corresponding module, and the same type as the library, which is the usual state
of affairs. To do more complex updating, see the REPLACE command.\
hlplib:	asciz	\
The LIBRARY command selects a new library to work with. You must give this
command before attempting to use an existing library. format:
LIBRARY (to use is) libnam
The type defaults to .LBR.
			You can also specify the library to be used with
the TOPS-20 command you use to run LBR. Example:

@LBR FRED

	starts LBR running, and makes it use FRED.LBR automatically. This will
override any LIBRARY command that you may have in your LBR.INIT file.
\
hlpset:	asciz	\
The SET command is used to change various defaults. Arguments are:
SET [NO] AUTO-EXPUNGE
		This controls whether or not LBR will expunge your directory
when it becomes full when writing to the library. By default, if an INSERT or
UPDATE operation on a library causes the directory to become full, the directory
containing the library will be expunged. A failing COPY command will also
cause this to happen. SET NO AUTO-EXPUNGE prevents this.
	LBR then pauses to allow you to create space yourself, selectively.

SET EXTENSION file-extension
			This alters the default file extension used in
INSERT, REPLACE and COPY commands. It permanently alters this in the library
for future use.

SET [NO] SQUEEZE
		By default, every time the library becomes more than one tenth
empty space, LBR performs a "squeeze" operation, which creates a new version
of the library without any deleted space in it. This is usually desirable, but
may not be if you are about to perform a stream of updates to a large library,
when you may mot have enough disk space for the old and new versions of the
library to coexist. This command controls this feature.

SET [NO] TEMPORARY
		This turn on or off the feature whereby output files are
made temporary, so that they are expunged at logout. By default, files
extracted with COPY are made temporary.

SET EPHEMERAL,SET PERMANENT
		These commands allow you to permanently override the SET
[NO] TEMPORARY commands for a particular library. Typing SET PERMANENT means
that every time you use the current library from now on, all output files
will no be temporary, without you having to type SET NO TEMPORARY.

SET SED
		When you use the EDIT command in LBR, your default editor
(usually TV) is used, unless you type EDIT/SED. The SET SED command makes LBR
use SED at all times for the EDIT command.

\
HLPSQU:	ASCIZ	\
	The SQUEEZE command compresses your library into its most compact form
removing all deleted space and deleted directory entries. When you delete or
update modules, LBR attempts to find a free space that best fits the new
module in the library. If none is found, the new module goes at the end.
Eventually the library accumulates some small patches of unusable space, the
amount of which is typed on a directory listing as "Free space in bytes:".
The SQUEEZE command creates a new copy of the library with this space removed.
	A SQUEEZE is performed automatically if, after a command has been
executed, more than 10% of the library is empty space. You can suppress this
action with SET NO SQUEEZE. It may be desirable to do so if you are in the
process of updating a large library, as you may not have enough space to keep 2
copies of the library (the old one being squeezed, and the new one being
created.)

\
hlpgo: asciz/
	The GO command exits from LBR, just like the EXIT command, but then asks
TOPS-20 to re-perform your last LOAD-class command (ie LOAD, EXECUTE, COMPILE,
DEBUG.) This is useful if you have just edited a program in a LBR-library and
wish to recompile or execute it.

/
hlpapp:	asciz/
	The APPEND command works just like the COPY command, except that
it appends the modules to the specified output file, instead of creating new
output files. The exception is that you cannot use wildcards for the output of
the append command - APPEND A* FRED appends all modules beginning with A to
file FRED.??? (where ??? is the filetype of your library.)

/
hlpgui:	asciz\
	This program can be used to list selected bits of info about the system
or the subroutine libraries. The GUIDE program lists info on system commands
and programs ; the SUBS program on the CRC subroutine library ; the NAG program
on the NAG library.
	The INFO command lists info on a particular subject, for instance
INFO TYPE tells you about the TYPE command for typeing files. Type INFO ?
for a list of things you can get info on. The PRINT command is like info,
but prints the information on the lineprinter for later reference.
	The EXIT or QUIT commands get you out of the program. If you want
just info on one thing, you can type the whole command on one line to
the TOPS20 "@" prompt:
@GUIDE TYPE
	for instance, tells you about the TYPE command.

\
hlpsts:	Asciz \
	The STATUS command prints information about the current library,
the default filetype, the default bytesize, the number of modules in the
library, and the amount of deleted space. This information is also printed
in an FDIRECTORY or DIRECTORY/FULL command.
\
hlptab:	hlpsiz,,hlpsiz
	TB	(HLPAPP,APPEND)
	TB	(HLPCOP,COPY)
	tb	(HLPCRE,CREATE)
	TB	(HLPDEL,DELETE)
	TB	(HLPDIR,DIRECTORY)
	TB	(HLPEDT,EDIT)
	TB	(HLPDIR,FDIRECTORY)
	TB	(HLPFSP,FILESPECS)
	TB	(HLPGEN,GENERAL)
	TB	(HLPGO,GO)
	TB	(HLPINS,INSERT)
	TB	(HLPLIB,LIBRARY)
	TB	(HLPDIR,LIST)
	TB	(HLPREP,REPLACE)
	TB	(HLPSET,SET)
	TB	(HLPSQU,SQUEEZE)
	TB	(HLPSTS,STATUS)
	tb	(HLPDIR,TDIRECTORY)
	TB	(HLPTYP,TYPE)
	TB	(HLPUPD,UPDATE)
	TB	(HLPDIR,VDIRECTORY)
	HLPSIZ==.-HLPTAB-1
SUBTTL	HELP AND EXIT COMMANDS

; HELP COMMAND

.HELP:	HRROI T2,[ASCIZ/with subject/]	;get noise
	CALL SKPNOI		;GO PARSE NOISE FIELD
	 RET			;FAILED, RETURN FAILURE
	comand	[flddb. (.cmkey,,hlptab,<Subject you want help for,>,<GENERAL>)],<Invalid HELP command, try just HELP - >,jsy
	hrrz	q1,(t2)		;get index to table
	confirm			;confirm command
	move	t1,q1		;point to text
	psout%			;output it
	ret			;back to caller

; EXIT COMMAND

.EXIT:	HRROI T2,[ASCIZ/from LBR/] ;noise
	CALL SKPNOI		;GO PARSE NOISE FIELD
	 RET			;FAILED, RETURN FAILURE
	CALL ENDCOM		;GO PARSE END OF COMMAND
	 RET			;BAD CONFIRMATION, RETURN
.exiti:	call	umap		;unmap and close current library
	SETOM T1		;INDICATE ALL FILES SHOULD BE CLOSED
	CLOSF			;CLOSE ALL OPEN FILES
	 JSERR			;UNEXPECTED ERROR
	HALTF			;RETURN TO MONITOR
	JRST START		;IF CONTINUE'D, START OVER

;	GO command - exit and do last load-class command
.go:	noise	(exit from LBR and execute last load-class command)
	confirm			;they want to ?
	call	umap		;yes, so unmap and close the library
	seto	t1,		;mark to close
	closf%			;anything left over
	 erjmp	.+1		;who cares ?
	move	t1,[.prast,,.fhslf] ;set up a PRARG block
	movei	t2,[1		;number of argument lists
		  400740,,2	;pointer to list
			0]	;list itself
	movei	t3,3		;length of PRARG block
	prarg%			;do it
	 ercal	error
	haltf%			;stop
	jrst	start		;and restart
SUBTTL	COMMAND ERROR SUBROUTINES

; INVALID END-OF-COMMAND

CFMERR:	CALL TSTCOL		;TEST COLUMN POSITION
	TMSG <? LBR: Garbage at end-of-command
>				;OUTPUT ERROR MESSAGE
	RET			;RETURN TO WHENCE WE CAME ...


; SUBROUTINE TO TEST COLUMN POSITION AND OUTPUT CRLF IF NEEDED

TSTCOL:	MOVEI T1,.PRIOU		;GET PRIMARY OUTPUT DESIGNATOR
	RFPOS			;READ FILE POSITION
	HRRZ T2,T2		;KEEP JUST THE COLUMN POSITION
	JUMPE T2,R		;IF AT COLUMN 1 DO NOT OUTPUT CRLF
	TMSG <
>				;NO, OUTPUT A CRLF
	RET			;RETURN TO WHENCE WE CAME ...


; ROUTINE TO OUTPUT THE JSYS MESSAGE ON AN ERROR FROM A GTJFN OR OPENF
;
; CALL:		CALL PUTERR
; RETURNS: +1 ALWAYS

PUTERR:	MOVX T1,.PRIOU		;GET PRIMARY OUTPUT JFN
	HRLOI T2,.FHSLF		;OUR FORK, LAST ERROR CODE
	SETZM T3		;
	ERSTR			;OUTPUT ERROR STRING
	 JFCL			;IGNORE
	 JFCL			;IGNORE
	TMSG <
>				;OUTPUT NEW LINE
	RET			;RETURN TO WHENCE WE CAME ...
;PUTATM - ROUTINE TO TYPE THE CONTENTS OF THE ATOM BUFFER
;
;ACCEPTS IN T1/	POINTER TO ASCIZ PREFIX STRING TO BE TYPED
;		CALL TYPATM
;RETURNS: +1 ALWAYS

TYPATM:	STKVAR <ATOMPT>
	MOVEM T1,ATOMPT		;SAVE ATOM POINTER
	CALL TSTCOL		;ISSUE NEW LINE IF NEEDED
	TMSG <? LBR: >	;OUTPUT INITIAL PART OF MESSAGE
	MOVE T1,ATOMPT		;RESTORE ATOM POINTER
	PSOUT			;OUTPUT THE STRING
	TMSG < ">		;OUTPUT PUNCTUATION
	HRROI T1,ATMBFR		;GET POINTER TO THE ATOM BUFFER
	PSOUT			;OUTPUT THE TEXT ENTERED
	TMSG <"
>				;OUTPUT END OF LINE
	RET			;RETURN
	subttl	Initialize interrupt system
;
;	This subroutine enables control-c capabilities if present, then
;	sets up the interrupt system and puts control-c s on channel 0
;	If running under batch, don't enable control-c interrupts.
;
intset:	setom	loklvl		;initialize directory lock nest level
	seto	t1,		;indicate current job
	hrroi	t2,t4		;one word in t4
	movei	t3,.jibat	;get batch flag
	getji%			;do it
	 ercal	error
	jumpl	t4,intse1	;if negative, we are in batch
	txo	f,timesh	;flag no batch
	txo	f,ccints	;assume control-c is available
	movx	t1,.fhslf	;point to this fork
	rpcap%			;read out capabilities
	 ercal	error
	txnn	t2,sc%ctc	;got control c ?
	 jrst	[call	badint
		jrst	intse1] ;no, so warn user
	txo	t3,sc%ctc	;enable control-c
	epcap%			;do it
	 ercal	badint
intse1:	movx	t1,.fhslf	;point to this fork
	move	t2,[levtab,,chntab] ;addresses of level and channel tables
	sir%			;declare to monitor
	 erjmp	badint		;cannot do it
	eir%			;enable interrupt system
	 erjmp	badint
	txo	f,intsys	;flag we have an interrupt system
	movx	t1,.fhslf	;point to this fork
	movx	t2,1b<.icqta>	;get channel for quota exceeded
	aic%			;activate quota channel
	 ercal	error
	ret			;back to caller
badint:	call	tstcol
	tmsg	<%Cannot enable control-c interrupts, be sure to let all commands finish>
	txz	f,ccints	;flag no control-c stuff available
	ret
;
;	routines to turn control-c on and off
;
liblck:	txnn	f,ronly		;if library is read-only, cannot lock it
	 setom	unsafe		;mark library unsafe
	aos	loklvl		;increment lock level
	txnn	f,ccints	;got an interrupt system ?
	 ret			;no, so return
	skipe	loklvl		;was library already locked ?
	 ret			;was already locked, nothing to do
	push	p,t1
	push	p,t2		;save acs that we will trash
	hrlzi	t1,.ticcc	;control-c on channel 0
	ati%			;assign the code
	 ercal	error
	movx	t1,.fhslf	;now point to this process
	movx	t2,1b0
	aic%			;and activate channel 0
	 ercal	error
	dmsg	<
[Locking library]>
	pop	p,t2
	pop	p,t1		;restore save acs
	ret			;and return to mainline code
lunlock:	sosl	loklvl		;decrement lock level
	 ret			;not yet fully unlocked
	setom	loklvl		;cope with excessive unlocks
	txnn	f,ronly		;if library is readonly ,cannot unlock
	 setzm	unsafe		;mark library safe to fiddle with
	txnn	f,ccints	;got an interrupt system ?
	 ret			;no, so return
	push	p,t1
	push	p,t2		;save some acs
	dmsg	<
[Unlocking library]>
	txzn	f,ccwait	;is there a pending control-c ?
	 jrst	unlnrm		;no, just disable interrupts
	call	tstcol		;yes, so make a new line
	tmsg	<^C>		;display the control-c
	hrlz	t1,libjfn	;get jfn of library
	movx	t2,1000		;number of pages to update (assume enormous)
	txnn	f,ronly		;if read only, cannot do this
	 ufpgs%			;force disk to be updated before we exit
	  ercal	error
	haltf%			;and halt
unlnrm:	movx	t1,.ticcc
	dti%			;deassign control-c
	 ercal	error
	movx	t1,.fhslf	;point to this process
	movx	t2,1b0
	dic%			;deactivate channel 0
	 ercal	error
	pop	p,t2
	pop	p,t1		;restore saved acs
	ret			;return to caller
;
;	Come here on control-c
;
ctrlc:	xct	ccxct		;do whatever caller wants on control-c
	push	p,t1
	dmsg	<
[Control-C received]>
	pop	p,t1
	debrk%			;dismiss interrupt
	subttl	Quota exceeded when writing to library - do something
;
;	SOUTS to the library do not have ERCALS or ERJMPs after them.
;	We trap them with this routine instead, which will attempt to perform
;	an expunge, then DEBRK from the interrupt, allowing the write to
;	continue.
;
quota:	push	p,t1		;save all acs
	push	p,t2
	push	p,t3
	push	p,t4			;that we will use
	txne	f,iexpunge		;inhibit expunge ?
	 jrst	expunge			;no, so do it
	tmsg	<
?Disk quota exceeded or disk full. DELETE and EXPUNGE some files, then
type CONTINUE to allow the operation to proceed. If you do not do so, the
library will be corrupted and must be rebuilt.>
	haltf%				;allow him to do something
	jrst	quoback			;leave interrupt context
;
;	Here to really expunge
;
expunge:	tmsg	<
[Disk quota exceeded or disk full, expunging > ;type out prefix of message
	move	t2,libjfn		;supply library jfn
	call	getdir			;find out which directory we're writing
	movx	t1,.priou
	move	t2,dirnum		;number of destination directory
	dirst%				;type name to user
	 ercal	error
	tmsg	<...>			;
	move	t1,dirnum		;directory number of suspect dir
	gtdal%				;find allocation
	 ercal	error
	movem	t2,used			;save count of used pages
	movx	t1,dd%dnf	;delete deleted files
	move	t2,dirnum		;from this directory
	deldf%				;do it
	 erjmp	[tmsg	<[NOT OK]
?>
		call	puterr		;type JSYS error
		jrst	quodie]		;join fail code
	move	t1,dirnum		;now look at directory again
	gtdal%				;how much used ?
	 ercal	error
	caml	t2,used			;less than before expunge ?
	 jrst	[tmsg	<[NOT OK]
?No space released by expunge, you must DELETE and EXPUNGE files, then
type CONTINUE.>				;nope, must do it by hand
		jrst	quodie]
	tmsg	<[OK]>			;everything appears fine
quoback: move	t1,[nop]		;instruction to execute on return
	movem	t1,errop		;store for mainline code to pick up
quob1:	pop	p,t4		;so restore the acs
	pop	p,t3
	pop	p,t2
	pop	p,t1			;that we used
	debrk%				;and leave interrupt context
quodie:	tmsg	<
The library will be corrupt unless you correct the disk space problem
and continue the program.>
	haltf%				;wait for action....
	jrst	quoback			;and leave interrupt context
;
;	Here to find directory number of directory corresponding to
;	a jfn passed in T2. Usually the library, sometimes an output file.
;
getdir:	hrroi	t1,dirnam		;where to put name
	movx	t3,fld(.jsaof,js%dev)!fld(.jsaof,js%dir)!js%paf ;write dir + device
	jfns%				;in ASCIZ
	 ercal	error
	hrroi	t2,dirnam		;now point to this directory name
	movx	t1,rc%emo		;allow only exact match of name
	rcdir%				;translate to directory number
	 ercal	error
	txne	t1,rc%nom		;get a match ?
	 jrst	[tmsg	<
?Internal error - cannot match directory name>
		haltf%]			;no, this should not happen
	movem	t3,dirnum		;store for caller's use
	ret				;return to caller
	subttl	COPEXP - expunge for COPY command
;
;	This routine performs an expunge as the result of a failing COPY
;	command. Things work slightly different with this one, as we
;	don't give horrific error messages if the expunge fails. Also,
;	the directory number must be obtained from the target of the COPY,
;	not from the library jfn.
;
copexp:	push	p,t1
	push	p,t2
	push	p,t3
	push	p,t4		;save all necessary acs
	txnn	f,iexpunge	;auto-expunge allowed ?
	 jrst	coperr		;no, issue error and return two levels
	tmsg	<
[Disk quota exceeded or disk full, expunging > ;type out prefix of message
	move	t2,t4		;get jfn of output file
	call	getdir			;find out which directory we're writing
	movx	t1,.priou
	move	t2,dirnum		;number of destination directory
	dirst%				;type name to user
	 ercal	error
	tmsg	<...>			;
	move	t1,dirnum		;directory number of suspect dir
	gtdal%				;find allocation
	 ercal	error
	movem	t2,used			;save count of used pages
	movx	t1,dd%dnf		;delete deleted files
	move	t2,dirnum		;from this directory
	deldf%				;do it
	 erjmp	[tmsg	<[NOT OK]
>
		jrst	coperr]		;join fail code
	move	t1,dirnum		;now look at directory again
	gtdal%				;how much used ?
	 ercal	error
	caml	t2,used			;less than before expunge ?
	 jrst	[tmsg	<[NOT OK]
%No space released by EXPUNGE>
		jrst	coperr]
	tmsg	<[OK]>			;everything appears fine
	pop	p,t4		;so restore the acs
	pop	p,t3
	pop	p,t2
	pop	p,t1			;that we used
	movem	t1,dirnum		;save one register for a mo
	pop	p,t1		;get return PC
	subi	t1,2		;and make it point to the failing SOUT
	push	p,t1		;put it back
	move	t1,dirnum	;get back real t1
	ret			;and return to rexecute SOUT jsys
coperr:	pop	p,t4
	pop	p,t3
	pop	p,t2
	pop	p,t1		;restore all acs
	move	t1,t4	;input file
	txo	t1,cz%abt	;mark abort io so leave no output
	closf%		;close it
	 nop
	pop	p,t1		;get return address from stack and discard
	txo	f,copyok	;mark copy failed
	userr	<Error writing output module - >,jsy
SUBTTL	PARSING SUBROUTINES

; ROUTINE TO PARSE AN END-OF-COMMAND
;
; CALL:		CALL ENDCOM
; RETURNS: +1	 BAD CONFIRMATION, MESSAGE ALREADY ISSUED
;	   +2	SUCCESS, COMMAND CONFIRMED

ENDCOM:	MOVEI T1,CMDBLK		;GET ADDRESS OF COMMAND STATE BLOCK
	MOVEI T2,[FLDDB. (.CMCFM)] ;GET FUNCTION BLOCK FOR CONFIM
	COMND			;PARSE CONFIRMATION
	 erjmp cmderr		;error, go check for eof on take file
	TXNE T1,CM%NOP		;VALID END-OF-COMMAND SEEN ?
	JRST [ CALLRET CFMERR ]	;NO, ISSUE ERROR MESSAGE AND RETURN
	CALL TAKTST		;OUTPUT COMMAND LINE IF DOING TAKE COMMAND
	RETSKP			;SUCCESS, RETURN


; ROUTINE TO PARSE NOISE PHRASE
;
; CALL:	T2/ POINTER TO NOISE PHRASE
;		CALL SKPNOI
; RETURNS: +1	 ERROR, INVALID NOISE PHRASE
;	   +2 	SUCCESS, NOISE PHRASE PARSED OK

SKPNOI:	MOVE T1,[NOIFDB,,NOIFDB+1] ;SET UP TO CLEAR FUNCTION DESCRIPTOR BLOCK
	SETZM NOIFDB		;CLEAR FIRST WORD OF BLOCK
	BLT T1,NOIFDB+FDBSIZ-1	;CLEAR FUNCTION DESCRIPTOR BLOCK
	MOVX T1,.CMNOI		;GET FUNCTION TO PERFORM
	STOR T1,CM%FNC,NOIFDB	;STORE FUNCTION CODE IN FDB
	MOVEM T2,NOIFDB+.CMDAT	;STORE POINTER TO NOISE PHRASE IN FDB
	MOVEI T1,CMDBLK		;GET ADDRESS OF COMMAND STATE BLOCK
	MOVEI T2,NOIFDB		;GET ADDRESS OF FUNCTION BLOCK
	COMND			;PARSE NOISE WORD
	 erjmp cmderr		;error, go check for eof on take file
	TXNN T1,CM%NOP		;NOISE PHRASE PARSED OK ?
	RETSKP			;YES, RETURN SUCCESS
	CALL TSTCOL		;ISSUE NEW LINE IF NEEDED
	HRROI T1,[ASCIZ/Invalid guide phrase/]
	callret typatm		;output the text entered and return
;
;	Routine to get hold of LBR.INIT if it exists, and try to
;	execute it.
;
inifil:	seto	t1,		;this job
	hrroi	t2,t4		;store in t4...
	movei	t3,.jilno	;our logged-in directory number
	getji%			;do it
	 ercal	error
	move	t2,t4		;get this number
	hrroi	t1,dirnam		;and write it out
	dirst%			;like so
	 ercal	error
	hrroi	t2,[asciz/LBR.INIT/] ;follow up with name of .INIT file
	setzb	t3,t4
	sout%			;do that too
	 ercal	error
	hrroi	t2,dirnam		;now point at the filename
	movx	t1,gj%sht!gj%old ;must exist
	gtjfn%			;try for INIT file
	 erjmp	[ret]		;if failure, no sweat, they don't have one
	movx	t2,fld(7,of%bsz)!of%rd ;but if it's there, open it
	openf%			;for read
	 ercal	error		;if this fails, it's bad
	movem	t1,injfn	;save input jfn
	hrlzm	t1,cmdblk+.cmioj ;store for COMND%
	movei	t1,.nulio	;send output to NUL:
	hrrm	t1,cmdblk+.cmioj ;tell COMND to do this
	setom	takflg		;mark a take command
	txo	f,takini	;mark LBR.INIT
	ret			;back to caller
;CMDINI - ROUTINE TO INITIALIZE COMMAND STATE BLOCK AND OUTPUT PROMPT
;
;ACCEPTS IN T1/	POINTER TO ASCIZ PROMPT STRING
;		CALL CMDINI
;RETURNS: +1 ALWAYS,	WITH THE REPARSE ADDRESS SET TO THE ADDRESS OF THE
;			CALL TO CMDINI.


CMDINI:	MOVEM T1,CMDBLK+.CMRTY	;SAVE POINTER TO PROMPT STRING IN STATE BLOCK
	POP P,SAVRET		;SET UP RETURN ADR FROM CMDINI AND FROM REPARSE
	MOVEM P,SAVREP		;SAVE STACK POINTER TO BE RESET ON REPARSE
	MOVEI T1,REPARS		;GET ADDRESS OF REPARSE ROUTINE
	MOVEM T1,CMDBLK+.CMFLG	;SAVE ADDRESS OF REPARSE ROUTINE IN STATE BLOCK
	MOVEI T1,CMDBLK		;GET ADDRESS OF COMMAND STATE BLOCK
	MOVEI T2,[FLDDB. (.CMINI)] ;GET FUNCTION DESCRIPTOR BLOCK
	COMND			;INITIALIZE COMMAND SCANNER JSYS
	 ERJMP CMDERR		;ERROR, GO SEE IF END OF "TAKE FILE"
	JRST @SAVRET		;RETURN


; HERE TO PROCESS A REPARSE

REPARS:	MOVE P,SAVREP		;RESET STACK POINTER
	JRST @SAVRET		;RETURN TO CALLER OF CMDINI
SUBTTL	GENERAL SUBROUTINES

; ROUTINE TO CLEAR GTJFN BLOCK USED BY COMND JSYS
;
; CALL:		CALL CLRGJF
; RETURNS: +1 ALWAYS

CLRGJF:	MOVE T1,[GJFBLK,,GJFBLK+1] ;SET UP TO CLEAR GTJFN BLOCK
	SETZM GJFBLK		;CLEAR FIRST WORD OF BLOCK
	BLT T1,GJFBLK+GJFSIZ-1	;CLEAR GTJFN BLOCK
	RET			;RETURN TO WHENCE WE CAME ...


; ROUTINE TO OUTPUT COMMAND LINE TO TERMINAL IF PROCESSING TAKE FILE
;
; CALL:		CALL TAKTST
; RETURNS: +1	ALWAYS, COMMAND LINE OUTPUT IF NEEDED

TAKTST:	call	tstcol		;get new line if needed
	HRROI T1,BUFFER		;GET POINTER TO COMMAND LINE
	SKIPn TAKFLG		;COMMANDS COMING FROM FILE ?
	 ret			;no, go back
	txnn	f,takini	;yes, so LBR.INIT ?
	PSOUT			;no, OUTPUT COMMAND LINE
	RET			;RETURN


;	Routine to abort current take file - called by error routines
;	to check if a take file is being used, and if so, kill it.
;	CALL:	call	abotak
;	Returns:	+1 always, command file aborted and message to user
;			if required.
;
abotak:	skipn	takflg		;using take file ?
	 ret			;no, return
	call	tstcol		;get new line if needed
	hrroi	t1,[asciz/?Error in command file, command file aborted/]
	txne	f,takini	;doing LBR.INIT ?
	 jrst	[hrroi	t1,[asciz/?Error in LBR.INIT, file aborted/]
		txnn	f,timesh	;yes, in batch ?
		 hrroi	t1,[asciz/%Error in LBR.INIT, file aborted/] ;yes
		jrst	.+1]
	psout%			;type informative message
	move	t1,injfn	;get command file jfn
	closf%			;close it
	 nop
	txz	f,takini	;clear initialization flag
	setzm	injfn		;remove command file
	setzm	takflg		;flag no take file
	MOVE T1,[.PRIIN,,.PRIOU] ;GET PRIMARY INPUT,, OUTPUT JFN'S
	MOVEM T1,CMDBLK+.CMIOJ	;SAVE PRIMARY JFN'S
	ret

;CMDERR - ROUTINE TO PROCESS ERRORS ON EXECUTING A COMND JSYS
;	  IF END OF FILE REACHED ON A TAKE FILE, THE NEXT COMMAND
;	  IS SIMPLY PROCESSED.  ELSE AN ERROR MESSAGE IS ISSUED AND
;	  THE PROGRAM IS RESTARTED.
;
; CALL:		JRST CMDERR

CMDERR:	SKIPN TAKFLG		;PROCESSING A TAKE FILE ?
	JRST CMER10		;NO, GO ISSUE ERROR MESSAGE
	HlRZ T1,CMDBLK+.CMIOJ	;GET INPUT FILE JFN FOR TAKE FILE
	GTSTS			;GET THE FILE'S STATUS
	TXNN T2,GS%EOF		;AT END OF FILE ?
	JRST CMER10		;NO, GO ISSUE ERROR MESSAGE
	MOVE T1,[.PRIOU,,.PRIIN] ;YES, GET STANDARD PRIMARY JFN'S
	MOVEM T1,CMDBLK+.CMIOJ	;RESET INPUT AND OUTPUT JFN'S
	SETZM TAKFLG		;MARK THAT TAKE FILE NOT BEING PROCESSED
	move	t1,injfn	;get command file jfn
	closf%			;close it
	 nop			;ignore errors
	TXZ	F,takini	;no LBR.INIT
	JRST PARSE		;GO PROCESS NEXT COMMAND

CMER10:	CALL TSTCOL		;ISSUE NEW LINE IF NEEDED
	call	puterr		;output an error
	TMSG < LBR: Unexpected COMND JSYS error, restarting...
>				;OUTPUT MESSAGE
	JRST ENTVEC+1		;GO SIMULATE A "REENTER"

	end	<3,,entvec>