Enter your search terms Submit search form
	Web pdp-10.trailing-edge.com

;<KEVIN>ORDLIB.MAC.2, 23-Aug-84 10:09:34, Edit by KEVIN
;	Bigger stack for really recursive problems (eg PSTAT)
;<KEVIN>ORDLIB.MAC.137, 28-Jun-84 13:48:33, EDIT BY KEVIN
;	Make handling of byte init blocks (code 1004) correct
;	The LINK manual says they have short counts, but actually they are long
;<KEVIN>ORDLIB.MAC.132,  1-Aug-83 13:44:32, EDIT BY KEVIN
;	We can only put about 300 characters at a time into a PTY input buffer.
;	Check on this when we are building up commands.
;****************
;		END of edit history
;******************
	Title ORDLIB - program to automatically order a REL file library.

;	Geoff Gibbs/Kevin Ashley/Paul O'Riordan June 83

;
;	This program can be used to automatically construct a library
;	in MAKLIB format which is ordered in such a way that LINK always
;	finds things in it. In other words every routine is placed after
;	any other routine in the library that references it. To use the program,
;	put all the REL files in one file (with APPEND or MAKLIB or whatever)
;	and specify as the input file. The file will then be ordered.
;	Simple !
;
	search	vtmac
	regdef
	.require K:ersub
	external error,errmes

	f==0			;global flag register
	NAMFND==1B0		;Flags name of current module seen
	NOTYP==1B1		;Suppress informational typeout

	DEFINE TYPE(text),<
	push	p,[point 7,[asciz\text\]] ;;point to arg
	push	p,[.priou]
	call	.type		;;do it
	>

	DEFINE ERROR(text),<
	jrst	[type	<%1L?'text>
		haltf%]>

	symblk==2		;Rel block type 2 is symbols
	entblk==4		;Type 4 is entry points
	endblk==5		;Type 5 is PRGEND
	namblk==6		;Type 6 is the module name

;	Maximum sizes of the various tables

	maxmod==4000		;maximum modules we will cope with
	maxent=50000		;maximum entry points we will cope with
	maxrel=50000		;maximum relations we can cope with
	maxsym=2000		;maximum global requests in one module
	wrdrow==<maxmod/^d36>+1 ;words per row of bits table
	suclen=wrdrow*maxmod 	;length of table for successors
	mxmcmd==^d10		;maximum modules/command to fit in PTY buffer

;	Locations of the tables. Note the order:
;	MODULES RELATIONS SYMBOLS ENTRY POINTS.
;	This is used in the first two passes. Once the relation table
;	is built, we overlay the symbols and entry points with the
;	successor/predecessor tables, which are square arrays of bits.
;
	pagbuf==27000		;Page buffer
	modtab=30000		;where we put module name table
	modsrt=modtab+maxmod	;table for sorted module numbers
	reltab=modsrt+maxmod	;where we store the table of relations
	symtab=reltab+maxrel	;where we store symbols for this module
	enttab=symtab+maxsym	;where tables of entry points are stored
				 ;(length = maxent*2)
	succs=reltab+maxrel	;Where to store the successor matrix

	slen=3*maxmod+^d30	;Stack length dependent on max modules, as there
				 ;is a recursive call in the program.
;
;	Table formats:
;	MODTAB - contains rad50 name for each module. During TRCMOD, top bit
;	indicates that trace chain has been followed for this module already.
;	NMODS is one greater than max slot in use (ie NMODS equals number of
;	modules for AOBJN loops, rather than max index to use.)
;
;	RELTAB - contains halfword pairs <N,,M> indicating that module number
;	N calls M directly.
;
;	MODSRT - as MODTAB
;
;	ENTTAB - entry points, pairs of words with module number and entry point
;		in rad50.
;
;	SYMTAB - global external requests in rad50 for current module

stack:	block	slen
reljfn:	0			;jfn of rel file
outjfn:	0			;jfn of temp file
blklen:	0
blktyp:	0
blockd:	block	100		;storage for REL blocks
blockl:	0			;length of current segment (within block)
nmods:	0			;number of current module in REL file
nents:	-1			;number of entry points
nsyms:	0			;number of symbols
nrels:	0			;number of relations
pass:	0			;current pass
swappd:	0			;have we swapped this time round ?
swpdun:	0			;have we swapped at all ?
modrow:	0
modcol:	0			;arguments for bit array routines

cmdlen==^d200				;length of text of commands to maklib
dirlen==^d20
extra==5				;extra pages allowed for, over size
					;   of old library.
namlen==^d20

cmdlin:	block 	cmdlen		        ;space for command line
modcmd:	0			;modules used/command
frkhnd:	z
ptyjfn:	0
ptytty:	0
modjfn:	z				;jfn of module to be expunged
newjfn:	z				;jfn of output library
tmpjfn:	0
newnam:	block	namlen			;name thereof
oldnam:	block	namlen			;name thereof
typptr:	0				;pointer to last string for .TYPE
savacs:	block	20

;
;	Define the block types
;

	DEFINE DUPL(begin,end,text,type,process),<
	$$typ==BEGIN
REPEAT <END-BEGIN+1>,<X	$$typ,<text>,type,process
			$$typ==$$typ+1>
	PURGE $$TYP>

	DEFINE DEFBLK,<
	X	0,Unused
	x	1,<Data or code>
	x	2,Symbols,,sympro
	x	3,HISEG
	x	4,<Entry points>
	x	5,<PRGEND>
	x	6,<Program name>
	x	7,<Start address>
	x	10,<One-pass compiler internal request>
	x	11,Polish
	x	12,Chain
	x	14,Index,LONG
	x	15,<Algol OWN>
	x	16,<.REQUIRE>
	x	17,<.REQUEST>
	x	20,<Labelled common>
	x	21,<Sparse data>
	x	22,<PSECT origin>
	x	23,<PSECT end>
	x	24,<PSECT header>
	x	37,<COBDDT table>
	x	100,<.ASSIGN>
	x	776,<Symbol file>,LONG
	x	777,<Universal file>,LONG
	x	1000,Ignored,LONG
	x	1001,Entry,LONG
	x	1002,<Long entry>,LONG
	x	1003,<Long title>,LONG
	x	1004,<Byte initialization>,LONG
DUPL	1010,1017,<Right relocation>,LONG
DUPL	1020,1027,<Left/right relocation>,LONG
DUPL	1030,1037,<Thirty bit relocation blocks>,LONG
	x	1042,<Request load for SFDs>
	x	1043,<Request library for SFDs>
	x	1044,<Algol symbols>,LONG
	x	1045,<Writable links>,LONG
	x	1050,<PSECT index>,LONG
	x	1051,<PSECT attribute>,LONG
	X	1052,<PSECT end>,LONG
	x	1066,<Trace block data>,LONG
	x	1070,<Long symbols names>,LONG
	x	1072,<Long polish block>,LONG
DUPL	1100,1107,<Program data vector>,LONG
DUPL	1120,1127,<Argument descriptor blocks>,LONG
	x	1130,<Coercion block>,LONG

	>

;	Now count the number of block types
	ntyps=0
DEFINE X(n,t,l,p),<ntyps=ntyps+1>

	DEFBLK
;
;	Now store the block codes
;
	DEFINE X(num,t,l,p),<num>

TYPCOD:	DEFBLK
;
;	Now store the short/long flags, and the descriptors
;
	DEFINE X(n,text,longf,process),<
IFIDN <longf> <LONG>,<1b0![ASCIZ\text\]>
IFDIF <longf> <LONG>,<[ASCIZ\TEXT\]>>

DESCRP:	DEFBLK


entvec:	jrst	start
	jrst	start
	verno 1,,3,3

start:	reset%			;clear the world
	move	p,[iowd slen,stack] ;set the stack
	call	comndr		;process any and all commands
	call	bldrels		;make two passes through file for relations
	type	< [OK]>		;end of pass 2
	move	t1,reljfn	;we don't need this rel file any more
	closf%			;so close it
	 erjmp	.+1		;ignoring any error
	call	rejrel		;reject relations for A calls B, B calls A
	call	srtrel		;Now use Paul's routine to sort the modules
	call	srtlib		;Now geoff's one to sort the library itself
	type	<%1LAll done !>
	haltf%

	subttl	BLDREL - construct relation table
;
;	This collection of routines makes two passes through the REL file.
;	The first collects information on all known entry points.
;	The seconds collects global requests from each module, matching them
;	against the entry points. Whenever a module in the library satisfies
;	a global request from another module, the fact is recorded in table
;	RELTAB, in the form REQNUM,,DEFNUM where REQNUM is the number of the
;	requesting module, and DEFNUM is that of the defining module. We do
;	not record multiple requests by one module for the same global, nor
;	multiple requests for the same module by the same module.
;
bldrel:	move	t1,reljfn	;get filespec
	movx	t2,of%rd	;open for read
	openf%			;do it
	 ercal	error		;should not fail
	type	<%1L[Starting pass 1 (entry points)]>
pass2:
nxtblk:	call	rdblk		;read a rel block
	 jrst	eof		;all done
	call	skpblk		;skip this block if no processing routine
	 call	problk		;if there is one, do the work
	jrst	nxtblk		;do the next one
eof:	;sos	nmods		;one less module to fiddle
	skipe	pass		;end of pass 1 ?
	 ret			;yes, so all done
	aos	pass		;no, flag pass 1 starting
	type	< [OK]>
	call	chkmul		;check entry point tables
	tmsg	<
[Starting Pass 2 (external requests)]>
	move	t1,reljfn
	setz	t2,
	sfptr%			;rewind file back to start
	 ercal	error
	setzm	nmods		;Start counting modules again
	jrst	pass2		;do the next pass (symbol collection)

	subttl	REJREL - reject reflexive relations
;
;	This routine is used to reject relations of the form
;	A calls B and B calls A. These can occur in a library, and
;	be OK, as long as the routines are either both loaded, or neither,
;	by the routines which require them.
;	We inform when this happens.
;
rejrel:	movn	t1,nrels	;get number of relations negated
	movss	t1		;in left half
	hrri	t1,reltab	;make AOBJN pointer to relation table
rejlo1:	movs	t2,(t1)		;get an A,,B record, and swap to B,,A
	jumpe	t2,nxtrej	;if zero, already rejected
	move	t3,t1		;Get a copy of the AOBJN pointer to search rest
				;of the table.
	aobjn	t3,.+2		;we don't want to check it against itself
	 jrst	rejcmp		;if here, on last entry, so compress
rejlop:	camn	t2,(t3)		;is this a reflexive match ?
	 jrst	[setzm	(t3)	;yes, so zero this copy
		setzm	(t1)	;and the first copy
		hlrz	t1,t2	;get the module numbers
		type	<%1LModules %1M and %2M both call each other>
		jrst	nxtrej]	;continue
	aobjn	t3,rejlop	;no, so check the next one
nxtrej:	aobjn	t1,rejlo1	;loop for all relations

;	Here to compress the table
rejcmp:	movn	t1,nrels	;make AOBJN pointer to relations table
	aoj	t1,		;subtract one, 'cos we don't check the last ent
	movss	t1		;a laborious process
	hrri	t1,reltab	;but now completed
rejcml:	skipn	(t1)		;is this entry zero ?
	 jrst	rejzro		;yes, so must squash
	aobjn	t1,rejcml	;no, check the next
	ret			;all done
rejzro:	sos	nrels		;a zero entry, drop number of relations
	hrlz	t2,t1		;point to next word in relation table
	add	t2,[1,,0]	;like this
	hrr	t2,t1		;form a BLT pointer to copy rest up one word
	movei	t3,reltab	;point to start of relation table
	add	t3,nrels	;point to last word to write to
	blt	t2,(t3)		;slam this zero word
	add	t1,[1,,0]	;fiddle AOBJN pointer - one less to do
	jumpg	t1,[ret]	;if now positive, all done
	jrst	rejcml		;else check the next

	subttl	SRTREL - Sort the modules according to relations
;
;	This is the real core of the program. It builds a table
;	of all dependencies between modules, and sorts the module list
;	based on that info.
;
srtrel:	type	<%1L[Starting pass 3 (tracing loops)]>
	call	zertab		;zero the successor and predecessor tables
	movn	q1,nrels	;now loop for all relations
	hrlzs	q1		;making a loop pointer for the purpose
	hrri	q1,reltab	;like this
srtr1:	hlrz	t2,(q1)		;get a relation
	hrrz	t3,(q1)		;and get its other half
	movem	t3,modrow	;store module called
	movem	t2,modcol	;and that calling
	call	setsuc		;mark the successor relation
	aobjn	q1,srtr1	;and all relations
	call	trcmod		;trace all the successors/predecessors, check
				 ;that there are no circular calls
	type	<%1L[Sorting lists]>
	call	ordall		;now order those which have relations
	type	< [OK]%1L>
	skipe	swpdun		;any swaps ?
	 ret			;no, all done
	type	<%1LLibrary is already in order.>
	haltf%
zertab:	setzm	succs
	move	t1,[succs,,succs+1]
	blt	t1,succs+suclen-1
	setz	t1,		;get first module number
	movei	t2,modsrt	;point to sorted module table
zerta1:	movem	t1,(t2)		;store first guess as to order
	aoj	t2,		;point on a bit
	aoj	t1,		;increment module number
	camge	t1,nmods	;all done
	 jrst	zerta1		;nope
	ret			;yes

	subttl	DMPMOD
;
;	temp routine to dump sorted module list

dmpmod:	tmsg	<
>
	movn	t1,nmods
	hrlzs	t1
	hrri	t1,modsrt
dmpmo1:	move	t2,(t1)
	type	<%2M	>
	aobjn	t1,dmpmo1
	ret

	subttl	CHKMUL - check for multiply-defined entry points
;
;	This subroutine is called at the end of pass 0 to check that there
;	are no multiply-defined entry points.
;
chkmul:	trvar	<nmul>		;count number of multiple points
	setzm	nmul		;we haven't found any yet
	setz	q1,		;get an index into the entry point table
	skipge	q3,nents		;found any ?
	 ret
	lsh	q3,1		;make a double-word offset
chkmur:	move	t1,enttab(q1)	;yes, so get one
	skipge	enttab+1(q1)	;check symbol has a module
	 jrst	chkmue		;if < 0, we already know it to be muldef'd
	setz	q2,		;zero another index into table
chkmun:	camn	q1,q2		;are we checking this against itself ?
	 jrst	chkmud		;yes, skip it
	came	t1,enttab(q2)	;no, these entry points match ?
	 jrst	chkmud		;no, so look at next
	move	t2,enttab+1(q1)	;get index for first module with symbol
	move	t3,enttab+1(q2) ;get other module that defines symbol
	type <%1LModules %2M and %3M multiply define %1R>
	setom	enttab+1(q2)	;stop second symbol being used later
	aos	nmul		;increment count of bad ones

chkmud:	addi	q2,2		;bump pointer for checks on this one
	came	q2,q3		;over maximum offset ?
	 jrst	chkmun		;no, do next one
chkmue:	addi	q1,2		;yes, so bump symbol to test
	came	q1,q3		;over max offsets ?
	 jrst	chkmur		;no, do next one
	aos	nents		;make a proper count
	skipn	t1,nmul		;yes, any multiply defined ones ?
	 ret			;no, safe
	error	<Multiply defined entry points mean that library cannot be sorted.>

	subttl	SETSUC/SETPRE - set bits in successor/predecessor tables
;
;	These routines modify bits in the sucessor/predecessor tables.
;	They are called with:
;	modrow/ One module number
;	modcol/ A second module number
;		All accumulators should be preserved.
;	Also, ISSUC to test for existence of successor relationship.
;
setsuc:	push	p,t1
	push	p,t2
	push	p,t3
	move	t1,modrow	;get row number
	imuli	t1,wrdrow	 ;calculate row offset from it
	move	t2,modcol	;now work out position in row
	idivi	t2,^d36		;work out a word number
	add	t1,t2		;add in to row position
	movei	t2,1		;get a bit
	lsh	t2,(t3)		;shift to the right position
	orm	t2,succs(t1)	;set the bit
	pop	p,t3
	pop	p,t2
	pop	p,t1
	ret

issuc:	push	p,t3
	 erjmp	stkovl
	push	p,t2
	 erjmp	stkovl
	push	p,t1
	 erjmp	stkovl
	move	t1,modrow	;get row number
	imuli	t1,wrdrow	 ;calculate row offset from it
	move	t2,modcol	;now work out position in row
	idivi	t2,^d36		;work out a word number
	add	t1,t2		;add in to row position
	movei	t2,1		;get a bit
	lsh	t2,(t3)		;shift to the right position
	move	t3,succs(t1)	;get the word with the bit
	tdne	t3,t2		;is it set ?
	 aos	-3(p)		;yes, return +2
	pop	p,t1
	pop	p,t2
	pop	p,t3
	ret			;back to caller

	subttl	TRCMOD - trace calls to ensure no circular loops
;
;	This routine traces the caller/successor trees to ensure that there
;	there are no call loops.
;	It temporarily uses the top bit in the MODTAB table to indicate that
;	the call tree for a module has been searched. This is to speed up the
;	search.
;
trcmod:	setz	q1,		;zero outer module index
trcmol:	move	q3,q1		;give to trace
	Type	<%1L******Starting %5M>
	move	t1,modtab(q1)	;get module entry
	txnn	t1,1b0		;has this been traced already ?
	 call	tracer		;no, so do one trace
	aoj	q1,		;increment counter
	camge	q1,nmods	;done them all ?
	 jrst	trcmol		;no, loop
	movn	t1,nmods	;get number of modules
	hrlzs	t1
	hrri	t1,modtab	;make AOBJN pointer...
	movx	t2,^-1b0	;get all bits except bit 0 on
	andm	t2,(t1)		;flip top bit off in module name
	aobjn	t1,.-1		;loop for all
	type	< [OK]>
	ret			;all done

stkovl:	move	t1,modrow
	move	t2,modcol
	move	p,[iowd slen,stack]
	type	<Stack overflow at %1M and %2M>
	haltf%
tracer:	setz	q2,		;zero module index
	movx	t1,1b0		;flag this one traced
	orm	t1,modtab(q3)	;so we don't do it again
trcmo1:	movem	q3,modcol	;now check if this is a successor
	movem	q2,modrow	;relationship
	call	issuc		;is it ?
	 jrst	trcnxt		;no, try for another
	camn	q2,q1		;have we found a loop ?
	 jrst	[error	<Module %6M is in a calling loop>] ;yes
	push	p,q2
	 erjmp	stkovl
	push	p,q3		;no, so save our context
	 erjmp	stkovl
	move	q3,q2		;and try the next in the chain
	call	tracer
	pop	p,q3		;restore context
	pop	p,q2		;and continue
trcnxt:	aoj	q2,		;try the next module
	camge	q2,nmods	;done them all yet ?
	 jrst	trcmo1		;no, do the next
	ret			;yes, return to our caller

	subttl	ORDALL - order all modules which have relations
;
;	This routine fiddles all the modules which are related.
;
ordall:	setz	q2,		;starting with first module
	setzm	swappd
	move	q1,q2		;check all modules...
	aoj	q1,		;after this in the list
	caml	q1,nmods	;Attempting to test beyond end of list ?
	 ret			;yes, must all be done
ordal:	move	t1,modsrt(q1)	;get a called module
	movem	t1,modcol	;remember its number
	move	t1,modsrt(q2)	;and get a module which should be calling it
	movem	t1,modrow	;eh eh ?
	call	issuc		;check relationship is not other way round
	 jrst	orda1		;nope, OK
	call	swpmod		;they are out of order, swap them
	setom	swappd		;flag a swap has occurred
	setom	swpdun		;and flag globally
	jrst	ordall		;try again
orda1:	aoj	q1,		;next module
	camge	q1,nmods	;done all modules in inner loop ?
	 jrst	ordal
orda2:	aoj	q2,		;no, onto next module
	caml	q2,nmods	;done them all ?
	 jrst	[skipe	swappd	;yes, done a swap this time ?
		 jrst	ordall	; yes, so must try again
		ret]		;no, so all done !
	jrst	ordall+2	;no, so try the next

;	Get module position in t1 from number in q2
modpos:	movn	t1,nmods	;get number of modules
	hrlzs	t1
	hrri	t1,modsrt	;Point for AOBJN
	camn	q2,(t1)		;a match ?
	 jrst	[hlres	t1	;yes, get -ve number
		add	t1,nmods ;make positive offset
		ret]		;all done
	aobjn	t1,.-2		;no, do next
	error	<MODPOS called for non-existent module %5D>
	subttl	SWPMOD - swap two modules and their info
;
;	This routine swaps around two modules and their related position
;	info.
;	Module positions in sorted table in q1,q2
;
swpmod:	move	t1,modsrt(q1)	;get first module number
	exch	t1,modsrt(q2)	;exchange with second
	movem	t1,modsrt(q1)	;store second where first was
	ret			;all done

	subttl	RDBLK - do one rel block
;
;	Read a single REL block, and semi-interpret
;

rdblk:	move	t1,reljfn	;get jfn of REL file
	bin%			;read block type, etc.
	 erjmp	teseof		;on error, check for end of file
	hlrzm	t2,blktyp	;store block type
	hrrzm	t2,blklen	;and long or short count
	call	maklen		;work out block length and count type
	retskp			;back to caller
teseof:	movx	t1,.fhslf	;for out fork
	geter%			;get the last error
	hrrzs	t2,t2		;just the error code
	cain	t2,iox4		;end of file ?
	 ret			;yes, give +1 return
	jrst	error		;no, get a report
;
;	MAKLEN - discover the block type, leaving an index into the
;	parallel tables in p1, and real length in p2.
;
maklen:	move	t1,blktyp	;get the block type code
	call	relidx		;discover table index
	 Error	<Illegal block type %1O> ;don't understand this, mate
	move	p2,blklen	;get current block length
	move	t2,descrp(p1)	;get long/short flag for this block
	txne	t2,1b0		;long block ?
	 ret			;yes, so we have length
	idivi	p2,^d18		;no, so how many 18-word blocks ?
	skipe	p3		;any remainder ?
	 aoj	p2,		;yes, so add a part block
	add	p2,blklen	;add the number of non-relocation words
	ret			;and return
;
;	RELIDX - given a rel block type code in t1, return table
;	index in p1
;	+1 return if code not found, +2 return otherwise
;
relidx:	movni	p1,ntyps	;negative number of types
relid1:	camn	t1,typcod+ntyps(p1) ;is this a match ?
	 jrst	relid2		;yes, so return
	aojn	p1,relid1	;no, so try the next
	ret			;return failure
relid2:	addi	p1,ntyps	;construct a positive index
	retskp			;return to caller
;
;	SKPBLK - skip the contents of the current block
;
skpblk:	move	t1,blktyp	;get block type code
	skipe	pass		;pass 0 ?
	 jrst	skpbl2		;no, entry points pass 1 only
	cain	t1,entblk	;entry points ?
	 ret			;yes, process these
skpbl2:	cain	t1,namblk	;module name block ?
	 ret			;yes, process
	cain	t1,endblk	;PRGEND ?
	 ret			;yes, process
	skipn	pass		;second pass ?
	 jrst	skpbl3		;no, no symbol processing
	cain	t1,symblk	;symbol block ?
	 ret			;yes, process for external requests
skpbl3:	move	t1,reljfn	;get the rel file
	rfptr%			;read current position
	 ercal	error
	add	t2,p2		;add on the length of this rel block
	sfptr%			;and set a new position
	 ercal	error
	retskp			;indicate don't process block

	subttl	PROBLK - dispatch on the current block

problk:	move	t1,blktyp	;get the block type code
	cain	t1,namblk	;name block ?
	 jrst	setmod		;yes, set up name of current module
	cain	t1,entblk	;entry point block ?
	 jrst	setent		;yes, collect this module's entry points
	cain	t1,endblk	;PRGEND ?
	 jrst	setend		;yes, mark it
	cain	t1,symblk	;symbol block ?
	 jrst	sympro		;yes, do the code
	Error	<Invalid block type %1O for processing>

	subttl	SETENT - process entry points defined
;
;	This subroutine collects all entry points defined by the current
;	module into the entry point table.
;

setent:	move	q3,blklen	;get length of this block
setmo1:	call	rdshort		;read a chunk of it
	 ret			;failed
	movei	t4,blockd	;point to where names are
setmo2:	move	t3,(t4)		;get a module name
	aoj	t4,		;and move point to its follower
	txz	t3,17b3		;clear funny flags
	aos	t2,nents	;increment count of entry points stored
	caile	t2,maxents	;overflowed yet ?
	 error	<Library has too many entry points>
	lsh	t2,1		;make a two word offset
	movem	t3,enttab(t2)	;store this module name
	move	t3,nmods	;get current module number
	movem	t3,enttab+1(t2)	;store that too
	sose	blockl		;decrement words in current short block
	 jrst	setmo2		;more to do, read it
	jrst	setmo1		;try for more of short block
;
;	Here to store name of current module
;
setmod:	move	q3,blklen	;get physical block length
	call	rdshort		;read a short block
	 ret			;failed
	move	t2,blockd	;get module name
	txz	t2,17b3		;clear funny bits
	move	t1,nmods	;get current module offset
	movem	t2,modtab(t1)	;store name of this module
	txo	f,namfnd	;flag name found
	ret			;done
;
;	Here to mark end of module
;
setend:	move	q3,blklen	;get block length
	call	rdshort		;try it
	 error	<Cannot read PRGEND block>
	txzn	f,namfnd	;no name seen for the next module
	error	<Module has no name> ;but this one had none, either
	skipe	pass		;pass 1 ?
	 call	makrel		;yes, discover relations for this module
	aos	t1,nmods	;increment counter for modules
	caile	t1,maxmods	;still within bounds ?
	 error	<Too many modules in library>
	ret			;yes, no more to do

	subttl	SYMPRO - collect all globals needed
;
;	This routine collects all the global symbols required by the current
;	module.
;
sympro:	move	q3,blklen	;get block length
	call	rdshort		;read a short block
	 ret			;nothing left, all done
	move	t4,blockl	;get length of this chunk
	movei	q1,blockd	;point to where the block is
sympr1:	ldb t1,[point 4,(q1),3]	;get symbol type code
	cain	t1,14		;global request ?
	 jrst	global		;yes, so add it to table
	addi	q1,2		;no, so increment past seconf word of pair
	soj	t4,
	sojg	t4,sympr1	;and loop through symbols
	jrst	sympro+1	;see if there is any more in this block
global:	move	t1,(q1)		;get the global symbol required
	txz	t1,17b3		;remove funny flags
	movn	t2,nsyms	;get current number of symbols
	jumpe	t2,glob1	;if zero, just store this symbol
	hrlzs	t2,t2		;swap halves
	hrri	t2,symtab	;else point to known symbols
globl:	camn	t1,(t2)		;do we already know we need this global ?
	 jrst	globex		;yes, so don't bother to store it
	aobjn	t2,globl	;no, so check the next
glob1:	move	t2,nsyms	;ok, get current number of symbols
	movem	t1,symtab(t2)	;store this symbol
	aos	t2,nsyms	;increment count of symbols
	caig	t2,maxsym	;too many ?
	 jrst	globex		;no, not yet
	move	t1,nmods	;yes, so get current module number
	error	<Module %1M contains too many global requests>
globex:	addi	q1,2		;skip over dependent symbol
	soj	t4,		;decrement count in block
	sojg	t4,sympr1	;and again
	jrst	sympro+1	;see if there is any more in this block

	subttl	MAKREL - construct module relations
;
;	This routine is called after each PRGEND, where we need
;	to check all the globals that this module requests, and check if
;	any other module in the library satisfies them. If so, construct
;	a relation to that effect.
;
makrel:	movn	t4,nsyms		;get number of syms in this module
	jumpe	t4,makrex		;if zero, nowt to do
	skipn	nents			;any entry points in library ?
	 jrst	makrex			;no, so done
	hrlzs	t4,t4			;else put in left half
	hrri	t4,symtab		;and point to symbol table
	move	q2,nrels		;remember where first relation this time
maknxt:	move	t3,(t4)			;get a global request
	movn	t2,nents		;get neg number of entry points
	imuli	t2,2			;*2 cos two words/entry
	hrlzs	t2,t2			;swap it
	hrri	t2,enttab		;make AOBJN pointer for entries
makrll:	camn	t3,(t2)			;global match an entry point ?
	 jrst	makrem			;yes, record the match, step global
	aobjn	t2,.+2			;two words/entry in ENTRY table
	 jrst	makngl			;done (shouldn't really get here...)
	aobjn	t2,makrll		;else check next entry
	jrst	makngl			;when entries done, check next global
makrem:	hrlz	t1,nmods		;get module number of this module
	hrr	t1,1(t2)		;and module number of that defining glob
	call	duprel			;make sure relation is not a duplicate
	 jrst	makngl			;it is, so don't record it
	move	t2,nrels		;get current number of relations
	movem	t1,reltab(t2)		;store this relation
	aos	t2,nrels		;increment total relations
	caile	t2,maxrel		;check for out-of-bounds
	 error	<Too many inter-module relations>
makngl:	aobjn	t4,maknxt		;check next global request
makrex:	setzm	nsyms			;clear count of symbols for this module
	ret				;and return
;
;	Here to check current relation is not a duplicate of a known
;	one. Q3 contains the address of the earliest relation to check.
;	T1 contains the relation. T2 may be used, all others preserved.
;	Return +1 if relation is a duplicate, else +2
;
duprel:	move	t2,nrels		;get current relation number
	camn	t2,q2			;checking first relation ?
	 retskp				;yes, must be ok
dupre1:	soj	t2,			;don't point to the current relation
	camn	t1,reltab(t2)		;check a relation
	 ret				;it matched, so it's a copy - reject
	camg	t2,q2			;have we done them all ?
	 retskp				;yes, so return success
	jrst	dupre1			;no, so check the next

	subttl	IO routine for block processors
;
;	These routines are used to read short and long blocks in.
;	They expect to find the block length left in q3 initially, which
;	they will update themselves. The data is left in blockd,
;	and the number of words read in blockl.
;	For short blocks, the relocation word for this segment is left
;	in q1.
;	A +2 return is given on success, a +1 return indicates block is done.
;
rdshort:	skipg	q3		;anything left in this block ?
	 ret				;no, so give +1 return
	move	t1,reljfn		;point to REL file
	bin%				;read the current relocation word
	movem	t2,q1			;save it for later
	move	t2,[point 36,blockd]	;point to REL block buffer
	move	t3,q3			;get number of words left to read
	caile	t3,^d18			;18 or less ?
	 movei	t3,^d18			;no, just read 18 this time tho'
	movem	t3,blockl		;store amount we will read
	movns	t3,t3			;make negative count for SIN
	sin%				;read this REL block in
	 ercal	error
	subi	q3,^d18			;decrement counter for this block
	retskp				;return to caller

	subttl	Get input file and output file

comndr:	tmsg	<
Input REL file: >
	movx	t1,gj%sht!gj%fns!gj%old!gj%cfm
	move	t2,[.priin,,.priou]
	gtjfn%			;grab a jfn
	 erjmp	[call	errmes
		jrst	comndr]
	movem	t1,reljfn
	tmsg	<Output REL file: >
	movx	t1,gj%sht!gj%fou!gj%msg!gj%cfm!gj%fns
					;get the required output library
	move	t2,[.priin,,.priou]	;from the terminal
	gtjfn%				;try and find it
	 erjmp	[call	errmes
		jrst	comndr]
	movem	t1,newjfn	        ;remember JFN of output library

;	Now construct TOPS-10 style name string for input library

	move	t1,reljfn	;Jfn of input
	hrroi	t3,oldnam	;where to put name
	call	ppnam		;write a TOPS-10 name
	move	t1,newjfn	;now do the same for the output
	hrroi	t3,newnam
	call	ppnam
	ret
;
;	Subroutine to construct a TOPS-10 name string.
;	Input: t1/ JFN
;		t3/ Byte pointer for output
;
ppnam:	movem	t1,q1
	stppn%			;translate to PPN
	 ercal	error
	push	p,t2		;save the PPN
	move	t1,t3		;get output pointer
	hrrz	t2,q1		;get input jfn
	movx	t3,fld(.jsaof,js%dev)!js%paf ;write out device name
	setz	t4,		;no prefix string supplied
	jfns%			;get the filename string
	 ercal	error
	movei	t2,"["		;get start of PPN
	idpb	t2,t1		;put it out
	pop	p,t4		;get PPN back
	hlrz	t2,t4		;get first half
	movx	t3,8		;write in octal
	nout%			;do that
	 ercal	error
	movei	t2,","		;get a comma
	idpb	t2,t1
	hrrz	t2,t4		;get second half of PPN
	nout%			;write that
	 ercal	error
	movei	t2,"]"		;close of PPN
	idpb	t2,t1
	move	t2,q1		;get jfn back
	movx	t3,fld(.jsaof,js%nam)!fld(.jsaof,js%typ)!js%paf	;dev + dir
	setz	t4,		;no prefix string supplied
	jfns%			;get the filename string
	 ercal	error
	ret			;all done !

	SUBTTL	SRTLIB - Actually sort the library physically
;
;	Local macros
;

; simulate the input of the text

	DEFINE	BILD (place,text),<
	Push	p,[point 7,[asciz\text\]] ;;point to arg
	push	p,[point 7,place] 	;;create pointer for output
	call	.type			;;do it
	>

;	BILDA is like BILD except that it appends to the last string
;	output.

	DEFINE	BILDA (text),<
	push	p,[point 7,[asciz\text\]] ;;point to pseudotext
	push	p,typptr		;;and old output pointer
	call	.type			;;do it
	>

	DEFINE	SIMTXT (text)<
	move	t3,[point 7,[asciz\text
\]]
	call	simt3			;send the text to maklib
>

	DEFINE	SIMLIN (text)<
	bild	cmdlin,<text'%15C>	;build the command line
	call	siminp			;send the text to maklib
>
xmod:	asciz\xmodul.REX\		;file name for extracted module
tmpnam:	asciz\XLIBRX.REX\		;Temp file name to build lib in

srtlib:	call	runmak			;run maklib
;
; now maklib is running, get it to do something
;
	hrroi	q1,oldnam		;input library
	hrroi	q2,tmpnam		;output library
	movn	q3,nmods		;Get number of modules
	hrlzs	q3
	hrri	q3,modsrt		;table of sorted numbers
	move	q4,(q3)			;Get number of first module
	aobjn	q3,.+1
	simlin	<%6A=%5A/extract:(%10M)>	;get the first module
	hrroi	t2,tmpnam		;point to name for temp lib
	movx	t1,gj%old
	gtjfn%				;grab a jfn on it
	 erjmp	[Error <Cannot find output from MAKLIB>]
	movem	t1,tmpjfn		;Get jfn of new library
	movx	t2,of%app		;open for append
	openf%
	 erjmp	[Error	<Cannot open new library>]
loop:	move	q4,(q3)			;get next module number
        bild	cmdlin,<xmodul.rex=%5A/extract:(%10M>	;get the next module
	movei	t1,mxmcmd		;reset counter of mods in command
	movem	t1,modcmd		;store it
loopts:	move	t1,1(q3)		;look at next number
	camg	t1,q4			;do they follow in order ?
	 jrst	loopno			;no, so must produce a command
	aobjn	q3,.+1			;ok, so step to next module
	move	q4,(q3)			;get the module number
	bilda	<,%10M>			;add on the new name
	sose	modcmd			;subtract number of mods allowed/command
	 jrst	loopts			;still OK, check the next one
	movei	t1,mxmcmd		;reset counter
	movem	t1,modcmd		;store it
;
;	Now feed command to MAKLIB
;
loopno:	bilda	<)%15C>			;finish command with cr
	call	siminp			;poke it at MAKLIB
;
; get jfn here for later expunging of module
;
	movx	t1,gj%sht!gj%old	;get hold of module file
	hrroi	t2,xmod
	gtjfn%
	 ercal	error
	hrrzm	t1,modjfn		;save module jfn for later expunging
	call	appmod			;Append module to library
	hrr	t1,modjfn		;get module jfn
	txo	t1,df%exp		;...expunge it
	delf%
	 ercal	error

	hrrzs	t1
	rljfn%
	 ercal	error
	aobjn	q3,loop
;
;	When here, library is in correct order, and mus be indexed
;
	move	t1,newjfn		;Point to input lib jfn
	rljfn%				;release jfn
	 erjmp	.+1
	move	t1,tmpjfn		;get temp file
	txo	t1,co%nrj		;don't release jfn
	closf%				;but close the file
	 erjmp	.+1
	hrroi	q2,newnam		;Point to library name
	hrroi	q3,tmpnam		;and to temp name we have it stored as
	simlin	<%6A=%7A/index>		;index the library
	move	t1,tmpjfn		;point to temp lib again
	txo	t1,df%exp		;expunge temp library
	delf%
	 ercal	error
;
; knock maklib on the head
;
	simtxt	</exit>			;simulate input	to maklib, trash t1-t3
	call	wforit			;get rid of maklib when finished
	ret

	subttl	APPMOD - Append the current module to the library
;
;	This routine appends the current module to the extant library.
;
appmod:	push	p,q1			;save non-temp register
	move	t1,modjfn		;Get jfn of module
	movx	t2,of%rd		;open for read
	openf%				;do it
	 ercal	[error	<Cannot read temporary file>]
	sizef%				;Discover size in bytes
	 ercal	error
	movem	t2,q1			;Save byte count
applop:	caig	q1,1000			;more than one page ?
	 jrst	applst			;no, just do last page
	move	t1,modjfn		;read from module
	move	t2,[point ^d36,pagbuf]	;Point to our page buffer
	movni	t3,1000			;read one page
	sin%				;do it
	 ercal	error
	move	t1,tmpjfn		;Point to output library
	move	t2,[point ^d36,pagbuf]  ;where to read from
	movni	t3,1000			;write one page
	sout%				;do it
	subi	q1,1000			;drop count of bytes to do
	jrst	applop			;try again
applst:	move	t1,modjfn		;read from module
	move	t2,[point ^d36,pagbuf]	;into page buffer
	movn	t3,q1			;whatever is left
	sin%
	 ercal	error
	move	t1,tmpjfn		;Point to output
	move	t2,[point ^d36,pagbuf]	;to bit of file
	movn	t3,q1			;whatever there is left
	sout%				;write it
	move	t1,modjfn		;Point to module
	txo	t1,co%nrj		;don't release jfn
	closf%				;close it
	 erjmp	.+1			;ignore errors
	pop	p,q1			;restore trashed ac
	ret				;return

	subttl	SIMINP - Simulate terminal input.
;
; Set up to simulate input from the terminal with text in cmdlin
; loop through the text string character by character
;	Don't return until job is in TT I/O wait
;
siminp:	dmovem	t1,savacs		;save accumulators
	dmovem	t3,savacs+2
        move	t3,[point 7,cmdlin]	;generate byte pointer
	call	simt3			;do the actual input
;
; wait for fork to wait for i/o
;
done:	call	wstar			;wait for the prompt again
	dmove	t1,savacs		;restore accumulators
	dmove	t3,savacs+2
	ret			        ;yes, return success
;
; do the actual input of text pointed to by t3
;
simt3:  move	t1,ptyjfn		;pty
	move	t2,t3			;get pointer to text
	setzb	t3,t4			;terminate on null
	sout%				;write it out
	ret
;
;	WSTAR - read output from PTY and return when it prompts again
;	(we use this because MTOPR function .MOPIH only seems to work for
;	PTYs when they are a job's controlling terminal.)
;
wstar:	movei	t1,^d500		;wait for half a second
	disms%
	move	t1,ptytty		;first get I/O as it comes
	sobe%				;any there ?
	 skipa				;yes, read it
	jrst	wstar			;no output, sleep a bit
	skipg	t2			;decent number ?
	 movei	t2,^d15			;no, bug in monitor
	movn	t3,t2			;make a negative count for SIN%
wstarl:	move	t1,ptyjfn		;read from PTY
	bin%				;a single character
	txz	t2,^-177		;make it 7 bits (!!????!)
	cain	t2,"*"			;a prompt ?
	 jrst	wstar1			;yes, ok to return
	move	t1,t2			;no, so get the character
	pbout%				;copy to terminal
	aojn	t3,wstarl		;loop for all characters waiting
	jrst	wstar			;and wait some more - no prompt yet
wstar1:	ret			;prompt seen

	subttl	RUNMAK - Start MAKLIB in inferior fork
;
; get maklib and start it running
;
runmak:	movx	t1,cr%cap	        ;give inferior our capabilities
	cfork%			        ;create a fork for it
	 ercal	error
	movem	t1,frkhnd	        ;remember fork handle
	movx	t1,gj%sht+gj%old	;insist file exists
	hrroi	t2,[asciz\sys:maklib.exe\];point to filname to pick up
	gtjfn%				;try and find it
	 erjmp	[error	<Cannot find SYS:MAKLIB.EXE>]
	hrl	t1,frkhnd	        ;fork handle in left half
	get%			        ;map process to file
	 ercal	error
	call	getpty			;try for a pseudo terminal
	 error	<No pseudo-terminals available>
	move	t1,frkhnd		;point to MAKLIB
	hrlz	t2,ptytty		;its input is the TTY on the PTY
	hrr	t2,ptytty		;so is its output
	spjfn%
	 ercal	error
	move	t1,frkhnd	        ;handle of inferior
	setz	t2,		        ;start at START
	sfrkv%			        ;start at entry vector
	 ercal	error
	call	wstar			;Wait for first prompt
	ret
;
; wait for maklib to finish and get rid of it
;
wforit:	move	t1,frkhnd
	wfork%			;wait for it to finish
	 ercal	error		;should never fail
	move	t1,frkhnd	;get fork handle
	kfork%			;kill it
	 ercal	error		;should never fail
	call	nopty		;throw away the pty
	ret			;back to caller

	subttl	Get a pseudo terminal
;
;	Grabs a pseudo terminal for maklib, store jfn in ptyjfn,
;	store jfn of associated tty in ptytty.
;
getpty:	movx	t1,.ptypa		;system PTY table
	getab%			;read number, start of PTYs
	 ercal	error
	hlrzm	t1,t4		;get number of PTYs in system
	hrrzm	t1,q2		;TTY number of first PTY
	setzm	q1		;start with PTY 0
getpt1:	movsi	t1,.dvdes+.dvpty	;PTY designator
	add	t1,q1		;add PTY number
	dvchr%			;get device chars
	 ercal	error
	txne	t2,dv%av	;device available ?
	 jrst	getpt2		;yes, device is available
	aoj	q1,		;no, bump PTY number
	sojn	t4,getpt1	;loop through all PTYs
	 ret			;failed
getpt2:movem	t1,t2		;save device designator
	hrroi	t1,cmdlin	;now get the PTY name
	devst%			;with this JSYS
	 ercal	error
	hrrzs	t2		;get PTY unit number
	add	t2,q2		;add unit number of first PTY as TTY
	addi	t2,.ttdes	;make TTY desig
	movem	t2,ptytty	;remember
	movei	t2,":"		;no colons are provided
	idpb	t2,t1		;so we must supply one ourselves
	setz	t2,		;together with a trailing null
	idpb	t2,t1		;to make an ASCIZ string
	hrroi	t2,cmdlin	;which we can then give to GTJFN%
	movx	t1,gj%sht!gj%old ;in order to get a JFN for OPENF%
	gtjfn%			;grab JFN
	 ercal	[Error	<Cannot gtjfn PTY>]
	movx	t2,fld(7,of%bsz)!of%rd!of%wr ;now open for read
	openf%
	 ercal	[error	<Cannot OPENF PTY>]
	movem	t1,ptyjfn	;store JFN for interrupt routines
	move	t2,ptytty	;now get designator of PTY as TTY
	hrroi	t1,cmdlin	;turn to a string
	devst%
	 ercal	error
	movei	t2,":"		;get a colon
	idpb	t2,t1		;dump on the end
	setz	t2,
	idpb	t2,t1		;and a null too
	hrroi	t2,cmdlin	;so we can get jfn on that too
	movx	t1,gj%old
	gtjfn%			;grab it
	 erjmp	[error	<Cannot GTJFN PTY's TTY>]
	movem	t1,ptytty	;store for primary jfn fiddling
	movx	t2,fld(7,of%bsz)!of%rd!of%wr	;open for read/write for the job
	openf%			;do it
	 erjmp	[error	<Cannot open PTY's TTY>]
	retskp			;all done

;
;	Routine to release PTY and deassign interrupts
;
nopty:	move	t1,ptyjfn		;get PTY jfn
	closf%				;close and release (dispose of links)
	 ercal	error
	move	t1,ptytty		;get this jfn
	rljfn%				;release it
	 erjmp	.+1			;ignore errors
	ret				;and return to caller

	subttl	Typeout processor
;
;	Text processor for messages
;

.type:	movem	t1,savacs		;save first ac
	move	t1,[2,,savacs+1]	;where to put the acs
	blt	t1,savacs+10		;save 11 acs
	move	q1,-2(p)		;get string description
	move	t1,-1(p)		;get output byte pointer
.typel:	ildb	t2,q1			;get a character
	cain	t2,"%"			;escaper ?
	 jrst	.types			;yes, check code+arg
	jumpe	t2,.typer		;if null, return
	bout%				;else output and continue
	jrst	.typel
.typer:	movem	t1,typptr		;save pointer for possible append
	setz	t2,			;get a null
	idpb	t2,t1			;put on end of string
	move	t1,[savacs+1,,2]	;set up to restore acs
	blt	t1,11			;like this
	move	t1,savacs		;restore the last one
.ntype:	pop	p,savacs		;save return address
	pop	p,savacs+1		;throw away argument
	pop	p,savacs+1		;and other argument
	hrrzs	savacs			;throw away flags from pc
	jrst	@savacs			;go home
;
;	Come here to process a special typeout thingummy
;
.types:	setz	q2,			;zero value
	ildb	t2,q1			;get part of value
	caige	t2,"0"			;part of an AC pointer ?
	 jrst	.typs1			;no, so get action code
	caile	t2,"7"			;definitely a number ?
	 jrst	.typs1			;no, get action code
	subi	t2,"0"			;yes, make numeric
	imuli	q2,10			;shift up old value
	add	q2,t2			;and add new one in
	jrst	.types+1		;get next part
.typs1:	jrst	@typtab-"A"(t2)		;vector on action code

typstr:	move	t2,savacs-1(q2)		;get byte pointer
	setzb	t3,t4			;terminate on null
	sout%				;copy extra string
	jrst	.typel			;go for next

typbin:	move	t2,savacs-1(q2)		;get value
	movei	t3,2			;in rad 2
	nout%				;do it
	 nop				;ignoring errors
	jrst	.typel			;get next

typchr:	move	t2,q2			;get character code
	bout%				;output it
	jrst	.typel

typdec:	move	t2,savacs-1(q2)		;get value
	movei	t3,^d10			;in rad 10
	nout%				;do it
	 nop				;ignoring errors
	jrst	.typel			;get next

typfil:	move	t2,savacs-1(q2)		;get value
	setz	t3,			;no options
	jfns%				;write filename
	 erjmp	.+1
	jrst	.typel			;continue

typmod:	move	t2,savacs-1(q2)		;get index into table
	move	t3,modtab(t2)		;Get module name
	jrst	typr5i			;out in rad50

typnop:	jrst	.typel

typnl:	hrroi	t2,[asciz/
/]					;get cr/lf
	setzb	t3,t4
	sout%				;send a new line
	sojn	q2,.-1			;loop for a few times
	jrst	.typel			;continue

typoct:	move	t2,savacs-1(q2)		;get value
	movei	t3,8			;in rad 8
	nout%				;do it
	 nop				;ignoring errors
	jrst	.typel			;get next

typquo:	ildb	t2,q1			;get character to be quoted
	bout%				;drop it
	jrst	.typel			;continue

typr50:	move	t3,savacs-1(q2)		;get rad50 word
typr5i:	movei	t2,6			;for six characters
typr51:	idivi	t3,50			;drop out one rad-50 character
	push	p,t4			;save the character
	sojn	t2,typr51		;do all six
	movei	t4,6			;now another six
typr52:	pop	p,t3			;get a character back
	move	t2,radtab(t3)		;translate to ASCII
	bout%				;output it
	sojn	t4,typr52		;loop for six chars
	jrst	.typel			;continue

;
;	Action table for type routine
;
	xlist
typtab:	typstr				;A - ac is byte pointer to string
	typbin				;B - type binary
	typchr				;C - type character whose code is stored
	typdec				;D - type decimal number
	typnop				;E - unused
	typfil				;F - do a JFNS
	typnop				;G - unused
	typnop				;H - unused
	typnop				;I - unused
	typnop				;J - unused
	typnop				;K - unused
	typnl				;L - New line n times
	typmod				;M - Module name
	typnop				;N - unused
	typoct				;O - type octal number
	typnop				;P - unused
	typquo				;Q - quote next character
	typr50				;R - type radix 50 word
	typnop				;S - unused
	typnop				;T - unused
	typnop				;U - unused
	typnop				;V - unused
	typnop				;W - unused
	typnop				;X - unused
	typnop				;Y - unused
	typnop				;Z - unused
;
;	Radix 50 to ascii table
;
radtab:	byte (36) " ","0","1","2","3","4","5","6","7","8","9","A","B","C","D"
	byte (36) "E","F","G","H","I","J","K","L","M","N","O","P","Q","R","S"
	byte (36) "T","U","V","W","X","Y","Z",".","$","%"
	list

	end	<3,,entvec>