Added support for FTP client and server.

src/ksc/nfnpar.7

@@ -0,0 +1,80 @@
+if1 ifndef %%scan,.insrt ksc;nscan >
+if2 ife %%scan,.insrt ksc;nscan >
+
+fnpard:
+fnpart=fnpard+1
+.begin fnpar		; filename parser. addr of string in 1
+			; returns dev/sname/fn1/fn2 in accs 1,2,3,4
+
+	tdca b,b		;FNPARD entry point = DDT type
+	 seto b,		;FNPART entry point = TECO type
+	movem b,fmode'		;set type
+	movem a,finstr'		;save addr of input string
+	setzm fdev'		;clear accumulated vars
+	setz b,			;fdir
+	setzb c,d		;fn1,fn2
+fnpr20:	push p,[brkchr']
+	push p,[fstr]
+	push p,[fbrktb]
+	push p,finstr
+	pushj p,scanrt
+	move a,brkchr
+	cain a,40
+	 jrst [pushj p,fcvstr ? pushj p,ffnput ? jrst fnpr20]
+	cain a,";
+	 jrst [pushj p,fcvstr ? move b,a ? jrst fnpr20]
+	cain a,":
+	 jrst [pushj p,fcvstr ? movem a,fdev ? jrst fnpr20]
+	pushj p,fcvstr		;handle EOF or foreign char
+	pushj p,ffnput
+	move a,fdev
+	popj p,
+
+ffnput:	jumpe a,[popj p,]	;nothing to deposit
+	skipn fmode		;DDT or TECO style?
+	 jrst [jumpe c,[move c,a ? popj p,]	;DDT
+		move d,a ? popj p,]
+	jumpe d,[move d,a ? popj p,]		;TECO
+	move c,d
+	move d,a
+	popj p,
+
+
+	;break table
+fbrktb:	cain a,^Q
+	 jrst scbrqt
+	cain a,":
+	 jrst scbrsk
+	cain a,";
+	 jrst scbrsk
+	cain a,40
+	 jrst scbrsk
+	cain a,^M
+	 jrst scbrsk
+	cain a,^J
+	 jrst scbrsk
+	jrst (b)
+
+.scalar fstr(2)
+
+;convert string (ptr in fstr) to sixbit wd in a
+fcvstr:	pushae p,[b,c,d]
+	setz a,
+	move c,[440600,,a]
+	hrrz d,fstr	;get cnt
+	
+fcvst5:	sojl d,fcvst9
+	ildb b,fstr+1
+	cain b,^Q	; if quoter,
+	 jrst fcvst5	; don't deposit it.
+	cail b,"a
+	 caile b,"z
+	  caia		;not lowercase
+	   subi b,40	;cvt to uppercase
+	subi b,40	;cvt to 6bit
+	idpb b,c	;deposit
+	tlne c,770000
+	 jrst fcvst5	;if sixbit word not exhausted, get more chars
+fcvst9:	popae p,[d,c,b]
+	popj p,
+.end fnpar

src/ksc/nscan.8

@@ -0,0 +1,117 @@
+IF1 %%SCAN==0		;so files .insrt'ing can do right thing; should
+IF2 %%SCAN==1		;have their .INSRT as follows:
+			; if1 ifndef %%scan, .insrt ksc;nscan >
+			; if2 ife %%scan, .insrt ksc;nscan >
+
+ifndef pushae,[
+DEFINE PUSHAE AC,LIST
+IRP LOC,,[LIST]
+PUSH AC,LOC
+TERMIN
+TERMIN
+
+DEFINE POPAE AC,LIST
+IRP LOC,,[LIST]
+POP AC,LOC
+TERMIN
+TERMIN
+]
+DEFINE SCAN ?INPUT,BRKTBL,RESULT,BRKCHR
+PUSH P,[BRKCHR]
+PUSH P,[RESULT]
+PUSH P,[BRKTBL]
+PUSH P,[INPUT]
+PUSHJ P,SCANRT
+TERMIN
+
+%BRKAD==1		;break char flag for appending to result
+SCBRAD:	TLO A,%BRKAD
+	JRST 2(B)	;return to right place in SCANRT
+%BRKSK==2		;break char flag for skip of break char
+SCBRSK:	TLO A,%BRKSK
+	JRST 2(B)
+%BRKLV==4		;break char flag for leaving on front of input
+SCBRLV:	TLO A,%BRKLV
+	JRST 2(B)
+%BRKQT==10		;break char flag for gobbling following char
+SCBRQT:	TLO A,%BRKQT
+	JRST 2(B)
+
+SCANRT:
+.begin scnblk
+define arg1
+(p)-5!termin
+define arg2
+arg1-1!termin
+define arg3
+arg2-1!termin
+define arg4
+arg3-1!termin
+
+	PUSHAE P,[A,B,C,D]
+	MOVE D,ARG1		;get addr of input string
+	MOVE C,1(D)		;get BP
+	HRRZ D,(D)		;get char cnt
+	JUMPE D,[MOVE A,[-1,,3]	;none left? Then EOS, no result string.
+		MOVEM A,@ARG4	;store -1,,3 as "break char"
+		SETZM @ARG3	;and clear 1st descriptor wd of result string (count)
+		JRST SCNR90]	;and return.
+
+SCNR20:	ILDB A,C		;get char from input string
+	JSP B,@ARG2		;execute break table.
+	SOJG D,SCNR20		;no break, continue
+	JRST SCNR70		;again none left, EOS.
+
+	;break char found! decipher flag(s) and return
+	TLNE A,%BRKQT		; quote next
+	 JRST SCNR45
+	TLNE A,%BRKSK
+	 JRST SCNR50		;skip break char.
+	TLNE A,%BRKAD
+	 JRST SCNR55		;go append break char to result
+	TLNE A,%BRKLV
+	 JRST SCNR60		;leave break char on front of input.
+	JRST SCNR20		;no flags found?! continue.
+
+	; quote next char
+SCNR45:	SOJLE D,SCNR70		; jump if none left.
+	ILDB A,C		; get it, ignore it.
+	SOJG D,SCNR20		; get next.
+	JRST SCNR70
+
+	;skip break char - goes on neither result nor input.
+SCNR50:	SOS @ARG1		;D is subtracted from this for result cnt, so ensure brkchar
+				;isn't included within result.
+
+	;append break char to result string
+SCNR55:	SUBI D,1		;D becomes new input cnt, so ensure brkchr isn't included.
+	JRST SCNR80		;and return thusly.
+
+	;retain break char on front of input string
+SCNR60:	ADD C,[70000,,0]	;must decrement bp to point back at brkchar.
+	CAIG C,
+	 SUB C,[430000,,1]	;(reset if go off wd edge)
+	JRST SCNR80
+
+	;EOS found and non-null result string.
+SCNR70:	MOVE A,[-1,,3]		;"break char".
+	MOVEM A,@ARG4
+	JRST .+2
+
+	;return result and update input as determined by count in D.
+	;if control came directly here, result string would contain everything up to
+	;break char, and input string cnt would include brk char but bp would point
+	;immediately after it.
+SCNR80:	HRRZM A,@ARG4		;store break char
+	MOVE A,ARG1		;get addr of input string again.
+	MOVE B,(A)		;get 1st wd of descriptor before clobbering.
+	HRRM D,(A)		;store updated input string count.
+	SUB B,D			;get descriptor with proper result string cnt
+	EXCH C,1(A)		;exchange bp's to update input and get bp for result.
+	MOVE A,ARG3		;get addr of result string now
+	MOVEM B,(A)		;store 1st descriptor wd
+	MOVEM C,1(A)		;and 2nd (bp).
+SCNR90:	POPAE P,[D,C,B,A]
+	SUB P,[5,,5]		;flush args and return addr
+	JRST @5(P)		;and return.
+.end scnblk

src/ksc/pagser.49

@@ -0,0 +1,879 @@
+; -*- Mode: MIDAS -*-
+.BEGIN PAGSER	; New page/core manager.
+
+IFNDEF $$PDBG,$$PDBG==0	; 1 - include debugging printout routines
+IFNDEF $$PPGS,$$PPGS==0	; 1 - include GETPAG
+
+comment |
+
+	PAGSER is a storage allocation management package.  It will
+allocate, expand, and release areas of memory in units of either pages
+or words.  All the core which PAGSER knows about is divided into
+"blocks" which are either "active" (in use by the program) or
+"unactive" (free, available for allocation requests).  At
+initialization, PAGSER will control a single large "unactive" block;
+all future allocate requests will be satisfied from this primal block.
+	Because PAGSER's data structures are themselves allocated
+dynamically, there is no space problem for them.  Because they are
+localized and distinct from the areas they refer to, page faults
+are minimized and allocation can be done with respect to the theoretical
+address space only, without implying that anything actually exists
+within a block.  This is useful for programs which need to dynamically
+hack their page map.
+
+	In PAGSER's data structures, each block (active or not) is
+described by a single node, which is $PNSIZ words long and
+has the following format:
+
+$PNPTR	0: <C-pred>,,<C-succ>	; Corelist pointers
+$PNSPP	1: <S-pred>,,<S-succ>	; Spacelist pointers (0 if active)
+$PNFLG  2: <ID> ,,<unused>	; Consistency check.
+$PNBLK	3: <# wds>,,<addr>	; Size & location of block.
+
+There are three lists composed of these nodes: the Corelist, Spacelist,
+and Freelist.
+
+The FREELIST is simply a list of all unused nodes, which describe
+no blocks at all.  When a node is required (e.g. when a new block is
+created, and needs a new node to describe it) one is procured from
+this list.  Freelist nodes use the RH of the first word to point
+to the next free node; zero implies no more.
+
+The CORELIST holds ALL nodes which represent a block, in an order
+corresponding EXACTLY to their sequence in memory.  <C-pred> points at
+the node for the block preceding this one in core, and <C-succ>
+similarly points at the node for the block immediately succeeding this
+one in core.  The Corelist is used to determine the state of blocks
+preceding and succeeding a particular block, and always completely
+describes the state of the entire section of memory entrusted to
+PAGSER.
+
+The SPACELIST is an efficiency hack.  The <S-pred> and <S-succ>
+pointers are used to string together all UNACTIVE blocks, so that when
+an allocation request is made, no time is wasted checking active
+blocks.  An "active" block is one for which the Spacelist pointer word
+($PNSPP) is zero.  The current algorithm for constructing and searching
+the Spacelist favors the most recently freed blocks.
+
+About $PNBLK, note that <# wds>,,<addr> specify the location and
+length of the core block that the node represents.  There need not
+necessarily be any actual core there, especially for the LAST block
+on the Corelist (<C-succ> zero).  The code tries to keep unmapped
+all pages in the last block, if it is unactive.
+
+$PNFLG is primarily used for verifying that a "node address",
+as furnished to some PAGSER routines by the user program,
+actually does refer to an active PAGSER node.  This helps to quickly
+catch any bugs that give invalid arguments to the core routines,
+which otherwise might be extremely hard to uncover.  It isn't
+foolproof, but is much better than nothing.
+|
+
+	; Indices into a node.
+	OFFSET -.
+$PNPTR:: 0	; <pred>,,<succ> for Corelist
+$PNSPP:: 0	; <pred>,,<succ> for Spacelist
+$PNBLK:: 0	; <# wds>,,<addr>
+$PNFLG:: 0	; <ID chk>,,<flags>	; RH not really used now.
+; $PNPGS:: 0	; <# pages included>
+$PNSIZ::	; Size of a node.
+	OFFSET 0
+
+$PVLID==:<(SIXBIT /PSR/)>	; ID value used in LH of $PNFLG.
+				; Note only used for active nodes.
+
+	; Other random parameters
+IFNDEF $PMAKN,$PMAKN==:40	; # nodes to create each time need more.
+IFNDEF $PTRIV,$PTRIV==:10	; # words OK to waste when satisfying request.
+
+	; Page size parameters
+IFNDEF PG$BTS,{	IFN OS%TNX, PG$BTS==:9.
+		IFN OS%ITS, PG$BTS==:10.
+}
+PG$SIZ==:1_PG$BTS
+PG$MSK==:PG$SIZ-1
+
+
+;;; PSRERR is an error macro which can be skipped over.
+;;; The user may define this for us, otherwise it is a .VALUE.
+;;; PSRERR is called with the PAGSER error code.
+
+IFNDEF PSRERR,[
+
+DEFINE	PSRERR CODE
+	.VALUE [CODE]
+TERMIN
+];IFNDEF PSRERR
+
+;;; Preliminary list of error codes.
+
+ERBAD==0	;Internal error
+ERARG==1	;Bad argument
+EROOM==2	;Not enough room
+
+;;; User may also supply the similar macro CORLUZ,
+;;; which is called when a CORBLK fails.
+
+
+
+subttl Initialization - PSRINI
+
+.SCALAR SPCLST	; Ptr to Spacelist
+.SCALAR CORLST	; Ptr to Corelist
+.SCALAR FRELST	; Ptr to Freelist, 0 when none left.
+.SCALAR FRESAV	; Ptr to saved node, used when getting block for more.
+.SCALAR FFPAGE	; # of first free page
+
+.VECTOR INILST($PNSIZ)	; Initial list node, set up pointing at free core.
+.VECTOR INIFSV($PNSIZ)	; Initial scratch node for FRESAV to point at.
+
+
+; PSRINI - Initialize PAGSER routines
+;	U1 - -<# pages>,,<1st page #>   defines area available for hacking.
+
+.M"PSRINI:
+.M"CORINI:
+	PUSH P,U1
+	JUMPGE U1,.+3		; If already positive skip convert hack.
+	TLC U1,-1
+	ADD U1,[1,,]		; Make count positive
+	TRNE U1,-1		; Make sure page # isn't 0.
+	 TLNN U1,-1		; Likewise make sure # pages isn't 0.
+	  PSRERR ERARG		; Ugh, zero component!
+	HRRZM U1,FFPAGE
+	LSH U1,PG$BTS		; Get in terms of words
+	MOVEM U1,$PNBLK+INILST	; Initialize count of first, unactive, node.
+	MOVSI U1,SPCLST-$PNSPP
+	MOVEM U1,$PNSPP+INILST	; and initialize spacelist pointer
+	MOVSI U1,CORLST-$PNPTR
+	MOVEM U1,$PNPTR+INILST	; and corelist pointer
+
+	MOVEI U1,INILST		; Initialize
+	MOVEM U1,SPCLST		; Spacelist, and
+	MOVEM U1,CORLST		; Corelist, and
+	SETZM FRELST		; Freelist.
+	MOVEI U1,INIFSV
+	MOVEM U1,FRESAV		; Point to extra node...
+	SETZM INIFSV		; Clear it out.
+	MOVE U1,[INIFSV,,INIFSV+1]
+	BLT U1,INIFSV+$PNSIZ-1
+
+	POP P,U1
+	POPJ P,
+
+
+;;; PSRP - See if enough space available.
+;;;	U1 - # words needed
+;;; Skips if enough space is available, does not skip if not enough.
+
+.M"PSRP:			;Bash UUO ACs with abandon!
+	SKIPN U2,SPCLST		;Get spacelist.
+	 JRST PSRP9		; If missing take failure return.
+PSRP2:	HLRZ U4,$PNBLK(U2)	;Get core spec.
+	CAILE U1,(U4)		;Loop until we find one big enough.
+	 JRST [ HRRZ U2,$PNSPP(U2)
+		JUMPN U2,PSRP2
+		JRST PSRP9 ]	; If no more left, failure return.
+	AOS (P)			;On success, skip return. 
+PSRP9:	RET
+
+
+
+subttl PSRGET - Get a block
+
+; PSRGET - Get core.
+;	U1 - # words needed
+; Returns
+;	U1 - actual # words available in block
+;	U2 - <addr of block>,,<node addr> ; COREXP -  0,,<addr of blk>
+
+.M"CORGET:
+	PUSHJ P,PSRGET
+	HLRZ U2,U2		; Return block addr only.
+	POPJ P,
+
+.M"PSRGET:
+	PUSH P,U3
+	PUSH P,U4
+	SKIPN U2,SPCLST
+	 PSRERR ERBAD		; No spacelist???
+PSRGT2:	HLRZ U4,$PNBLK(U2)	; Get core spec
+	CAIG U1,(U4)
+	 JRST PSRGT4		; Found block big enough...
+	HRRZ U2,$PNSPP(U2)	; Nope, get next
+	JUMPN U2,PSRGT2
+	PSRERR EROOM		; Failed to find big enough block?!
+
+	; Found block big enuf.  See if want to split or swallow whole.
+PSRGT4:	CAILE U4,$PTRIV(U1)	; Excess greater than some trivial value?
+	 JRST [	PUSHJ P,PSRADJ	;  Yes, split block...
+		JRST PSRGT8]
+
+	; Here when block needn't be split up.  Must remove from spacelist.
+	MOVEI U3,(U2)
+IFN OS%ITS,{			; If on ITS,
+	MOVE U4,$PNPTR(U3)	; and gobbling very last block,
+	TRNN U4,-1		; we're bypassing PSRADJ
+	 PUSHJ P,PSRCOR		; so must make sure core exists for it.
+}
+	PUSHJ P,PSRACT		; Remove from spacelist.
+
+	; All done with split or whatever, U1 still has size and U2
+	; address of node for block we want.
+PSRGT8:	HLRZ U1,$PNBLK(U2)	; Update U1 to actual size
+	HRL U2,$PNBLK(U2)	; and U2 to <block addr>,,<node addr>.
+	POP P,U4
+	POP P,U3
+	POPJ P,
+
+
+subttl GETPAG - Get pages.
+
+ifn $$ppgs,{
+
+; GETPGN - Variant of GETPAG that returns negative rather than positive
+;	count in LH, AOBJN style.
+
+.M"PAGGTN:PUSHJ P,PSRPGT
+	TLC U1,-1
+	ADD U1,[1,,]
+	POPJ P,
+
+; GETPAG - Get block of pages.
+;	U1 - # of pages desired
+; Returns
+;	U1 - <# pages>,,<1st page #>
+
+.M"GETPAG:
+.M"PSRPGT:
+	PUSH P,U2
+	PUSH P,U3
+	PUSH P,U4
+
+	LSH U1,PG$BTS		; Get # words
+	SKIPN U2,SPCLST
+	 PSRERR ERBAD		; No spacelist??
+PSRPG2:	HLRZ U4,$PNBLK(U2)
+	CAIG U1,(U4)
+	 JRST PSRPG4
+PSRPG3:	HRRZ U2,$PNPTR(U2)
+	JUMPN U2,PSRPG2
+	PSRERR EROOM		; Couldn't find enough pages!!
+
+PSRPG4:	MOVE U3,$PNBLK(U2)	; Get address core block starts at
+	ANDI U3,PG$MSK		; Find # words past page boundary it starts at
+	CAIE U3,
+	 SUBI U3,PG$SIZ		; Get -<# words to next boundary>
+	ADD U4,U3		; Thus get # wds in block past first boundary	
+	CAIGE U4,(U1)		; Compare (U4 may be neg), have enuf words?
+	 JRST PSRPG3		; Nope, keep searching.
+
+	MOVMS U3
+	CAILE U3,$PTRIV
+	 JRST [	PUSH P,U1
+		PUSH P,U4
+		MOVM U1,U3
+		PUSHJ P,PSRADJ	; Split off low end.
+		EXCH U2,U3	; Get low-end node in U3, and
+		PUSHJ P,PSRMKU	; put it on spacelist.
+		POP P,U4
+		POP P,U1
+		JRST .+1]
+
+	CAILE U4,$PTRIV(U1)	; Need to split things up at high end?
+	 JRST [	PUSHJ P,PSRADJ	; Get block of right size.
+		JRST PSRPG8]
+;IFN OS%ITS,{			; If on ITS,
+;	MOVE U4,$PNPTR(U3)	; and gobbling very last block,
+;	TRNN U4,-1		; we're bypassing PSRADJ
+;	 PUSHJ P,PSRCOR		; so must make sure core exists for it.
+;}
+PSRPG8:	TRNE U1,PG$MSK
+	 PSRERR ERARG		; Just a check...
+	LSH U1,<18.-PG$BTS>	; Before shifting # pages out into LH.
+	HRRZ U3,$PNBLK(U2)
+	ADDI U3,PG$SIZ-1
+	LSH U3,-PG$BTS
+	HRRI U1,(U3)		; Now have <# pages>,,<page # starts at>
+
+	POP P,U4
+	POP P,U3
+	POP P,U2
+	POPJ P,
+
+} ; end ifn $$ppgs
+
+subttl PSREXP - Expand block
+
+; PSREXP - Expand core block.
+;	U1 - # wds to increase by
+;	U2 - node of block to increase 	; COREXP - addr of block
+; Returns
+;	U1 - new # wds total in block
+;	U2 - <new addr of block>,,<new node> ; COREXP -  0,,<new addr of blk>
+
+comment |
+There are 4 cases possible, listed in order of optimality:
+	1) Enough room in unactive successor.
+		Merge and perhaps split.
+	2) Enough room in unactive predecessor.
+		Must copy up and perhaps split.
+	3) Enough room if both predecessor and successor combined.
+		Must copy up, then merge with following, then perhaps split.
+	4) No free blocks on either side, or not enough room.
+		Must find completely new block and copy into it.  Old
+		block must be released.
+|
+
+.M"COREXP:
+	PUSHJ P,PSREQV		; Chg blk addr to node addr for compatibility
+	PUSHJ P,PSREXP
+	HLRZ U2,U2		; Return block addr only.
+	POPJ P,
+
+.M"PSREXP:
+	PUSH P,U3
+	PUSH P,U4
+	
+	; Verify that node is kosher.
+	HLRZ U3,$PNFLG(U2)	; Get ID-check value from where it should be
+	CAIE U3,$PVLID		; and make sure it's what it should be...
+	 PSRERR ERBAD			; Yuckity yuck!
+
+	; See if enough room in successor.
+	MOVE U3,$PNPTR(U2)	; Get ptr to successor
+	TRNE U3,-1		; Not there?
+	 SKIPN $PNSPP(U3)	; or Active?
+	  JRST [HLRZS U3	; Yes, can't hack succ, check pred.
+		CAIN U3,CORLST-$PNPTR
+		 JRST PSRXP7	; Not there?
+		SKIPN $PNSPP(U3)
+		 JRST PSRXP7	; Can't hack pred either, need new block.
+		HLRZ U4,$PNBLK(U3)
+		SUBI U4,(U1)
+		JUMPL U4,PSRXP7	; If not enough words, also can't hack.
+		JRST PSRXP2]	; Can, go hack predecessor.
+	HLRZ U4,$PNBLK(U3)	; Check successor - get # words in it.
+	SUBI U4,(U1)		; Find diff.
+	JUMPGE U4,[HLRZ U4,$PNBLK(U2)
+		ADDI U1,(U4)
+		JRST PSRXP4]	; Jump if successful.
+
+	HLRZS U3		; Fooey, but see if predecessor can save day.
+	CAIE U3,CORLST-$PNPTR	; No predecessor?
+	 SKIPN $PNSPP(U3)	; or not available?
+	  JRST PSRXP7		; Ugh, must find whole new block.
+	HLRZ U3,$PNBLK(U3)	; Get # words
+	ADDI U4,(U3)
+	JUMPL U4,PSRXP7		; Again, jump if must get new block.
+
+	; Here, can win by combining pred & succ blocks.
+PSRXP2:	HLRZ U3,$PNPTR(U2)	; Get ptr to pred.
+	PUSHJ P,PSRACT		; Make U3 block active.
+	EXCH U2,U3
+	PUSHJ P,PSRCPY		; Copy into U2 from U3.
+	HLLZ U4,$PNBLK(U3)	; Get count of old block
+	ADDM U4,$PNBLK(U2)	; Add into pred block.
+	HLRZS U4		; While still have count,
+	ADDI U1,(U4)		; Find total # words required
+	PUSHJ P,PSRFRX		; Put U3 block on Freelist.
+
+	HLRZ U4,$PNBLK(U2)	; Find how much room we have now.
+	CAIG U1,(U4)
+	 JRST PSRXP6		; Aha, got enough.
+
+	; Here, can win by adding successor block.
+PSRXP4:	HRRZ U3,$PNPTR(U2)	; Get succ
+	JUMPE U3,PSRXP7
+	PUSHJ P,PSRMRG		; Merge successor in with U2 block.
+
+	; Here have block all together, see if want to split some off.
+PSRXP6:	HLRZ U4,$PNBLK(U2)	; Find total # words we have
+	CAIGE U4,(U1)
+	 PSRERR EROOM		; somehow didn't get enough???
+	CAIG U4,$PTRIV(U1)	; More than a trivial amount?
+	 JRST PSRXP8		; No, return.
+	PUSHJ P,PSRADJ		; Split them up...
+	PUSHJ P,PSRMKU		; Put split-off block in U3 on spacelist.
+	JRST PSRXP8
+
+
+	; Here, must find a whole new block.
+PSRXP7:	HLRZ U4,$PNBLK(U2)
+	ADDI U1,(U4)		; Find # words total we need.
+	MOVE U3,U2		; Save U2
+	PUSHJ P,PSRGET		; Get a block of right size (node ptr in U2)
+	PUSHJ P,PSRCPY		; Copy U3 into U2.
+	MOVEI U1,(U3)
+	PUSHJ P,PSRREL		; Free up old core.
+
+PSRXP8:	HLRZ U1,$PNBLK(U2)	; Return U1 - <# words>
+	HRL U2,$PNBLK(U2)	; Return U2 - <block addr>,,<node addr>
+	POP P,U4
+	POP P,U3
+	POPJ P,
+
+subttl PSRREL - Release Block
+
+; PSRREL - Release core block.
+;	U1 - addr of node to release. (CORREL - addr of block)
+
+.M"CORREL:
+	PUSH P,U2
+	MOVEI U2,(U1)
+	PUSHJ P,PSREQV		; Temp hack - change block addr to node addr
+	JRST PSRRL1
+
+.M"PSRREL:
+	PUSH P,U2
+	MOVEI U2,(U1)
+PSRRL1:	PUSH P,U3
+	PUSH P,U4
+
+	; Verify that node is kosher.
+	HLRZ U3,$PNFLG(U2)	; Get ID-check value from where it should be
+	CAIE U3,$PVLID		; and make sure it's what it should be...
+	 PSRERR ERBAD		; Yuckity yuck!
+
+	HLRZ U3,$PNPTR(U2)	; Get <pred>
+	CAIE U3,CORLST-$PNPTR	; Special check before taking look at "node".
+	 SKIPN $PNSPP(U3)	; Is predecessor unactive?
+	  JRST PSRRL2		; No, or not real node, don't merge.
+	EXCH U2,U3
+	PUSHJ P,PSRMRG		; Merge if so
+
+PSRRL2:	HRRZ U3,$PNPTR(U2)	; Get <succ>
+	JUMPE U3,PSRRL4
+	SKIPE $PNSPP(U3)	; Is successor unactive?
+	 PUSHJ P,PSRMRG
+	SKIPN $PNSPP(U2)	; Is block itself on spacelist by now?
+	 PUSHJ P,PSRMK2		; Make it unactive, put on spacelist.
+
+	; Could check here for freeing up pages.
+PSRRL4:
+PSRRL8:	PUSHJ P,PSRGC
+	POP P,U4
+	POP P,U3
+	POP P,U2
+	POPJ P,
+
+; PSREQV - Temporary hack which converts a block address to a node address,
+;	so as to maintain compatibility with CORSER.  In future the node
+;	address will be returned to caller of CORGET so as to eliminate this
+;	searching overhead.
+; Takes U2 - block addr
+; Returns U2 - node addr for the block
+
+PSREQV:	PUSH P,U3 ? PUSH P,U4
+	MOVEI U3,CORLST-$PNPTR
+	JRST PSREQ4
+PSREQ2:	HRRZ U4,$PNBLK(U3)
+	CAIN U2,(U4)
+	 JRST PSREQ6
+PSREQ4:	HRRZ U3,$PNPTR(U3)
+	JUMPN U3,PSREQ2
+	PSRERR ERBAD		; No block corresponds to this address!!
+PSREQ6:	MOVEI U2,(U3)
+	POP P,U4 ? POP P,U3
+	POPJ P,
+
+subttl Primitives - OS dependent page hacking
+
+; PSRGC - Frees up core from U2 block insofar as possible.
+;	U2 - block just freed
+; Clobbers U3,U4
+
+PSRGC:	MOVE U4,$PNPTR(U2)
+	TRNE U4,-1
+	 POPJ P,
+
+	MOVE U4,$PNBLK(U2)	; Get <# wds>,,<addr>
+	MOVEI U3,PG$SIZ-1(U4)
+	LSH U3,-PG$BTS		; Find 1st page # freed.
+	MOVE U4,FFPAGE
+	SUBI U4,(U3)
+	JUMPLE U4,PSRGC9
+IFN OS%ITS,{
+	IMUL U4,[-1,,]
+	HRRI U4,(U3)
+	SYSCAL CORBLK,[MOVEI 0
+		MOVEI %JSELF
+		U4]
+	 PSRERR ERARG	; Should only happen if bad args.
+}
+IFN OS%TNX,{
+	PUSH P,1 ? PUSH P,2 ? PUSH P,3
+	SETO 1,
+	MOVEI 2,(U3)
+	HRLI 2,.FHSLF
+	MOVEI 3,(U4)
+	TLO 3,(PM%CNT)
+	PMAP
+	 ERJMP .+1
+	POP P,3 ? POP P,2 ? POP P,1
+}
+	MOVEM U3,FFPAGE
+
+PSRGC9:	POPJ P,
+
+
+; PSRADJ - Splits up block of core into 2 blocks.
+;	This is the ONLY PLACE where new nodes/blocks are added to
+;	the corelist!!
+;	U1 - # words to put in active new block
+;	U2 - ptr to block to split up (unactive, on spacelist)
+; Returns
+;	U2 - ptr to active new block
+; Clobbers U3,U4
+
+PSRADJ:	MOVEI U3,(U2)		; Put big unactive node in U3
+	PUSHJ P,PSRGTN		; Get a new node in U2
+	HLRZ U4,$PNBLK(U3)
+	SUBI U4,(U1)
+	CAIG U4,		; Make sure block is big enough for split...
+	 PSRERR ERARG		; Ugh?? Caller messed up.
+	HRLM U4,$PNBLK(U3)	; Store reduced size for big unactive block
+	HRLM U1,$PNBLK(U2)	; and set desired size for new block.
+	MOVE U4,$PNBLK(U3)	; Get addr of big block,
+	HRRM U4,$PNBLK(U2)	; and store it as addr for new block
+	ADDI U4,(U1)		; and find new addr of big unactive block.
+	HRRM U4,$PNBLK(U3)	; Store away, all block-size specs done.
+
+	; Insert new block into corelist, and make it active!
+	MOVE U4,$PNPTR(U3)	; Get <pred>,,<succ> for old node
+	HRRI U4,(U3)		; <succ> for new node is old one.
+	MOVEM U4,$PNPTR(U2)	; Fix up new node...
+	HLRZS U4		; Now get <pred>,
+	HRRM U2,$PNPTR(U4)	; So as to zap predecessor to point at new.
+	HRLM U2,$PNPTR(U3)	; And zap successor also.
+	MOVEI U4,$PVLID		; Final touch to active node is ID...
+	HRLM U4,$PNFLG(U2)	; set it.
+IFN OS%ITS,{
+	MOVE U4,$PNPTR(U3)
+	TRNN U4,-1
+	 PJRST PSRCOR
+}
+	POPJ P,
+
+IFN OS%ITS,{
+
+IFDEF CORLUZ,.SCALAR CBKERR
+
+PSRCOR:	HLRZ U4,$PNBLK(U2)	; Get length of block
+	ADD U4,$PNBLK(U2)	; Find first unused addr
+	MOVEI U4,PG$SIZ-1(U4)	; Clear LH and adjust for
+	LSH U4,-PG$BTS		; finding 1st unused page #.
+	CAMG U4,FFPAGE
+	 POPJ P,
+	PUSH P,U4
+	SUB U4,FFPAGE
+	IMUL U4,[-1,,]
+	HRR U4,FFPAGE
+IFDEF CORLUZ,[
+	SETZM CBKERR
+	SYSCAL CORBLK,[	MOVEI %CBNDR+%CBNDW
+			MOVEI %JSELF
+			U4
+			MOVEI %JSNEW
+			%CLERR,,CBKERR]
+	CORLUZ
+]
+.ELSE,[
+	SYSCAL CORBLK,[	MOVEI %CBNDR+%CBNDW
+			MOVEI %JSELF
+			U4
+			MOVEI %JSNEW]
+	 PSRERR EROOM
+]
+	POP P,FFPAGE
+	POPJ P,
+
+};OS%ITS
+
+
+subttl Primitives - Merging, Freeing, Copying
+
+; PSRMKU - Make unactive, put node on spacelist.
+;	U3 - ptr to node to put on spacelist.
+; Clobbers U4
+
+PSRMK2:	MOVEI U3,(U2)
+PSRMKU:	MOVE U4,SPCLST
+	HRLI U4,SPCLST-$PNSPP
+	MOVEM U4,$PNSPP(U3)
+	TRNE U4,-1		; If successor exists,
+	 HRLM U3,$PNSPP(U4)	; zap it.
+	HRRZM U3,SPCLST		; and zap predecessor.
+	HRRZS $PNFLG(U3)	; Also zap ID check.
+	POPJ P,
+
+; PSRMRG - Merge two adjacent blocks
+;	U2 - ptr to node, 1st block (only count is changed)
+;	U3 - ptr to node, 2nd block (can be on Spacelist or Corelist)
+; Clobbers U3,U4
+
+PSRMRG:	HRRZ U3,$PNPTR(U2)	; Get addr of succ
+	CAIN U3,		; Make sure actually have a successor.
+	 PSRERR ERARG		; Caller screwed up.
+	HLLZ U4,$PNBLK(U3)	; Get # words in U3 node, and use to
+	ADDM U4,$PNBLK(U2)	; increment count of current block.
+	PUSHJ P,PSRFRE		; Free U3 node.
+	POPJ P,
+
+
+
+; PSRACT - Make U3 block active (already on corelist, just take off
+;	the spacelist)
+; Clobbers U4
+
+PSRACT:	MOVEI U4,$PVLID		; Insert ID check
+	HRLM U4,$PNFLG(U3)	; into node for future refs by user prog.
+PSRACX:	MOVE U4,$PNSPP(U3)
+	TRNE U4,-1		; Test for successor
+	 HLLM U4,$PNSPP(U4)	; Zap successor if there's one.
+	MOVSS U4
+	HLRM U4,$PNSPP(U4)	; Zap predecessor (always)
+	SETZM $PNSPP(U3)
+	POPJ P,
+
+
+; PSRFRE - Puts U3 block on Freelist.  Takes it off Spacelist/Corelist as nec.
+; PSRFRX - Ditto but assumes block isn't on Spacelist.
+; PSRFR  - Ditto but assumes block isn't on Corelist or Spacelist.
+;  All clobber U4.
+
+PSRFRE:	SKIPE $PNSPP(U3)	; On spacelist?
+	 PUSHJ P,PSRACX		; Take it off, so it's only on corelist.
+PSRFRX:	MOVE U4,$PNPTR(U3)	; Get <pred>,,<succ>
+	TRNE U4,-1
+	 HLLM U4,$PNPTR(U4)	; Zap successor if one.
+	MOVSS U4
+	HLRM U4,$PNPTR(U4)	; Zap predecessor (always)
+
+PSRFR:	MOVE U4,FRELST
+	MOVEM U4,$PNPTR(U3)
+	HRRZM U3,FRELST
+	POPJ P,
+
+; PSRCPY - Copy block from U3 to U2.  Overlap is OK as long as
+;	U2 < U3.
+; Clobbers U4
+
+PSRCPY:	PUSH P,U2
+	MOVE U2,$PNBLK(U2)	; Get <dest> address
+	HRL U2,$PNBLK(U3)	; Get <source> address
+	HLRZ U4,$PNBLK(U3)	; Get # words to copy
+	ADDI U4,-1(U2)		; Find last word to copy into
+	BLT U2,(U4)
+	POP P,U2
+	POPJ P,
+
+
+subttl Primitives - PSRGTN - Get free node.
+
+; PSRGTN - Get a node.
+;	Returns addr in U2.
+
+PSRGTN:	SKIPN U2,FRELST		; Get pointer to current free list
+	 JRST PSRGN3		; None left?  Make more.
+	HRL U2,(U2)		; Get ptr to next free node
+	HLRZM U2,FRELST		; and store it away.
+	POPJ P,
+
+	; Must make new nodes.  Requires getting new block recursively,
+	; with special hack.
+PSRGN3:	MOVE U2,FRESAV		; Make a freelist pointing to special
+	MOVEM U2,FRELST		; node saved just for this occasion.
+	PUSH P,U1		; Because PSRGET will need one...
+	MOVEI U1,$PNSIZ*$PMAKN	; Get this many words for new block
+	PUSHJ P,PSRGET		; Call recursively.
+	HLRZ U2,U2		; Get blk addr by itself
+	PUSHJ P,PSRMKF		; Make a freelist out of block.
+	HRRZ U1,(U2)		; Get ptr to second node on list,
+	MOVEM U1,FRELST		; and make that the new freelist.
+	SETZM (U2)		; While first node on list becomes the
+	HRRZM U2,FRESAV		; saved node.
+	POP P,U1
+	JRST PSRGTN
+
+
+; PSRMKF - Makes freelist out of piece of core.
+;	U1 - # words
+;	U2 - address of block
+; Clobbers U1.  U2 (same) will point to 1st node on freelist.
+
+PSRMKF:	CAIGE U1,$PNSIZ*2	; Must be able to make at least two.
+	 PSRERR ERARG		; Caller screwed up.
+	PUSH P,U2
+
+	PUSH P,U1	; First must zap whole block...
+	ADDI U1,(U2)	; addr to last wd + 1
+	HRLI U2,(U2)
+	ADDI U2,1	; addr,,addr+1
+	SETZM -1(U2)
+	BLT U2,-1(U1)	; Clear all of block.
+	POP P,U1	; restore size.
+
+	IDIVI U1,$PNSIZ	; Find # possible nodes.
+	MOVE U2,(P)	; Restore addr of block
+	MOVNI U1,(U1)
+	HRLI U2,(U1)	; Have -<# nodes>,,<addr>
+
+PSRMF2:	MOVEI U1,$PNSIZ(U2)	; Get ptr to next node
+	MOVEM U1,(U2)		; Store in current node
+	ADDI U2,$PNSIZ-1
+	AOBJN U2,PSRMF2
+
+	SETZM -$PNSIZ(U2)	; Clear out last node to terminate list.
+	POP P,U2
+	POPJ P,
+
+
+
+subttl Debugging aid - DEBCOR
+
+; Debugging printout routine.  Requires MACROS/NUUOS/OUT.
+
+IFN $$PDBG,{
+DBC==17
+
+DEBRET:	JSR DEBRST
+	POPJ P,
+
+DEBCOR:	JSR DEBSAV
+	SKIPN A,CORLST
+	 JRST [	FWRITE DBC,[[  No Corelist!!!
+]]
+		JRST DEBRET]
+	FWRITE DBC,[[Core list:]]
+DEBCR2:	FWRITE DBC,[[
+Node ],RHV,A,[ Blk ],RHV,$PNBLK(A),[/ ],LHV,$PNBLK(A),[ wds, ]]
+	HRRZ B,$PNBLK(A)
+	ANDI B,PG$MSK
+	CAIE B,
+	 SUBI B,PG$SIZ
+	HLRZ C,$PNBLK(A)
+	ADDI B,(C)
+	ASH B,-PG$BTS
+	CAIGE B,
+	 SETZ B,
+	FWRITE DBC,[N8,B,[ pgs ]]
+	SKIPN $PNSPP(A)
+	 JRST [	FWRITE DBC,[[ACTIVE]]
+		JRST DEBCR4]
+	FWRITE DBC,[[FREE, Spacelist ptrs: ],LHV,$PNSPP(A),[,,],RHV,$PNSPP(A)]
+DEBCR4:	FWRITE DBC,[[
+]]
+	; Now verify ID, if active.
+	SKIPN $PNSPP(A)		; Active?
+	 JRST [	HLRZ B,$PNFLG(A)	; Yes, get ID.
+		CAIN B,$PVLID		; See if valid.
+		 JRST .+1		; Yup.
+		FWRITE DBC,[[	Bad ID!  Should be ],RHV,[[$PVLID]],[, is ],RHV,B,[
+]]
+		JRST .+1]
+
+	; Now verify that next node points back to this node.
+	HRRZ C,$PNPTR(A)	; Get addr of successor
+	JUMPE C,DEBC60		; No successor?  Done.
+	HLRZ B,$PNPTR(C)	; Get successor's pred
+	CAIN A,(B)		; Should point back to current node.
+	 JRST DEBC40		; Yep, no sweat here.
+
+	; Ugh, list failure!!
+	FWRITE DBC,[[	Succ node has bad pred!
+	This node: ],RHV,A,[/ ],LHV,$PNPTR(A),[,,],RHV,$PNPTR(A),[
+	Next node: ],RHV,C,[/ ],LHV,$PNPTR(C),[,,],RHV,$PNPTR(C),[
+]]
+	; Probably screwed from here on, but continue anyway.
+
+	; Now verify that next node's block is successor to current block.
+DEBC40:	HRRZ D,$PNBLK(A)	; Get block addr
+	HLRZ C,$PNBLK(A)	; and # wds
+	ADDI D,(C)		; to find next addr after this block.
+	HRRZ B,$PNPTR(A)	; Get ptr to successor node
+	JUMPE B,DEBC60		; If no successor, done with corelist.
+	HRRZ C,$PNBLK(B)	; Get address next block starts at.
+	CAIN C,(D)		; Compare...
+	 JRST DEBC50		; Equal, all's well, so process next.
+
+	; Ugh, next block isn't contiguous to this one!
+	FWRITE DBC,[[	Next block not contiguous!!
+	Should start at ],RHV,D,[, but succ node claims ],RHV,C,[
+]]
+
+DEBC50:	HRRZ B,$PNPTR(A)
+	JUMPE B,DEBC60
+	MOVEI A,(B)
+	JRST DEBCR2
+
+	; Corelist done, now write out Spacelist.
+DEBC60:	FWRITE DBC,[[End of Corelist, last managed addr is ]]
+	HRRZ C,$PNBLK(A)	; Get 1st inaccessible addr
+	HLRZ D,$PNBLK(A)	; according to last node on spacelist
+	ADDI C,-1(D)		; via <blk addr>+<# wds>-1
+	FWRITE DBC,[N8,C,[
+First free page is ],N8,FFPAGE,[ at ]]
+	MOVE B,FFPAGE
+	IMULI B,PG$SIZ
+	FWRITE DBC,[N8,B,[
+-----------------------------
+Spacelist:]]
+	SKIPN A,SPCLST
+	 JRST [	FWRITE DBC,[[ 0 ??]]
+		JRST DEBRET]
+	MOVEI A,SPCLST-$PNSPP
+DEBC70:	HLRZ B,$PNSPP(A)
+	SETZ C,
+	CAIE B,
+	 HRRZ C,$PNSPP(B)
+	CAIE A,(C)
+	 JRST [	FWRITE DBC,[N8,B]
+		JRST .+1]
+	CAIN A,(C)
+	 JRST [	FWRITE DBC,[[*]]
+		JRST .+1]
+	FWRITE DBC,[[.]]
+	HRRZ A,$PNSPP(A)
+	JUMPE A,[FWRITE DBC,[[0]]
+		JRST DEBC90]
+DEBC75:	FWRITE DBC,[[* -> ],N8,A,[:]]
+	JRST DEBC70
+
+DEBC90:	FWRITE DBC,[[
+Done.
+]]
+	JRST DEBRET
+
+; Save/restore support for PAGSER debug stuff.  Requires MACROS/NUUOS/OUT.
+
+LVAR	DEBSAV:	0 ? JRST DEBSV0	; jump to pure
+LVAR	DEBACS:	BLOCK 20
+
+DEBSV0:	PUSH P,U40
+IFE $$UCAL,PUSH P,UUORPC
+	MOVEM 17,DEBACS+17
+	MOVEI 17,DEBACS
+	BLT 17,DEBACS+16	; Save ACs
+	MOVE 17,DEBACS+17
+IFN OS%ITS,[
+	.OPEN DBC,[.UAO,,'TTY]
+	 .VALUE
+	OUT(DBC,OPEN(UC$IOT))
+]
+IFN OS%TNX, OUT(DBC,OPEN(UC$IOT,[.PRIOU]))
+	JRST @DEBSAV
+
+LVAR	DEBRST:	0 ? JRST DEBRS0	; jump to pure
+
+DEBRS0:
+IFN OS%ITS,.CLOSE DBC,
+	MOVSI 17,DEBACS
+	BLT 17,17
+IFE $$UCAL,POP P,UUORPC
+	POP P,U40
+	JRST @DEBRST
+
+} ;end ifn $$pdbg
+
+.END PAGSER