Google
 

Trailing-Edge - PDP-10 Archives - decuslib20-08 - decus/20-0177/uuocon.mac
There are 20 other files named uuocon.mac in the archive. Click here to see a list.
Subttl	Table of contents for Memory

;	   -- Section --					   -- Page --
;
;  1.   Table of contents............................................. 1
;  2.	 Uuocon module initialization................................. 2
;  3.	 Uuocon routine............................................... 3
;  4.	 Printing module
;	  4.1   %Print routine........................................ 5
;	  4.2   Setjfn routine and dispatch table..................... 6
;	  4.3   Special character subroutines......................... 7
;  5.	 GETJFN routine - Obtain a jfn on a file...................... 10
;  6.	 Crash routine - Handle program fatal errors.................. 12
;  7.	 Memory management
;	  7.1   Memory management symbols............................. 13
;	  7.2   Free and used block formats........................... 14
;	  7.3   %INIMEM - Memory initialization....................... 15
;	  7.4   %GETMEM - get a block of memory....................... 16
;	  7.5   %GIVMEM - return a memory chunk....................... 17
;	  7.6   Addmem - add memory to free list...................... 18
;	  7.7   General subroutines................................... 19
;  8.	 Sorting module
;	  8.1   %Sort (main routine).................................. 20
;	  8.2   Partitioning routine.................................. 21
;  9.	CMD routines
;	  9.1   Cmdini and Prompt..................................... 22
;	  9.2   Rflde, Rfield, Cfield................................. 22
;	  9.3   Noise and Confrm...................................... 23
;	  9.4   Support routines...................................... 23
;  10.	String Routines
;	  10.1   Insert............................................... 24
;	  10.2   Copy and Delete...................................... 25
;
;		     (End of table of contents)
Subttl  Uuocon module initialization

Search	Symbol			; Set up macro definitions
Sall				; Supress expansions

;Version information
Vmajor==2			; Major version
Vminor==2			; Minor version
Vedit==37			; Edit number
Vcust==4			; WCC originated

.TTN.	UUOCON,Local UUO controller

;Author: Douglas Bigelow, Wesleyan Computing Center


;We come here when we have an opcode between 0 and 37, vectored by location
;41 which contains a PUSHJ P,UUOCON.

;Set up the UUO trap

	LOC	41		; Uuo vector location
	CALL	UUOCON		; The instruction
	RELOC			; Relocate to previous context


;External storage
	Extern	UUOTAB
Subttl  Uuocon routine

;Almost all accumulators are respected in these routines, which may use freely
;ACs A-D and T1-T4.  Accumulator A is sometimes used to return arguments,
;so for those routines, A and B are smashed.  Otherwise A and B as well
;as all other ac's must be preserved.

;The following structures refer to the LUUO instruction
DEFSTR	(INSFLD,40,8,9) 	; Instruction field
DEFSTR	(ACFLD,40,12,4) 	; Accumulator field
DEFSTR	(MEMFLD,40,35,18)	; Memory address field


;Beginning of the routine
UUOCON: TRVAR	<<SAVAB,2>,<SAVCD,2>,<SAVT12,2>,<SAVT34,2>>
	DEFINE	RETPC <-1(.fp)> ; Symbol for return address
	DMOVEM	A,SAVAB 	; Save all the acs we use
	DMOVEM	C,SAVCD
	DMOVEM	T1,SAVT12
	DMOVEM	T3,SAVT34
	LOAD	B,MEMFLD	; Get the memory field
	LOAD	C,ACFLD 	; Get the calling ac
	MOVE	A,(C)		; Get the contents of the ac
	CAIN	C,B		; Ac b is special.  is it there?
	 MOVE	A,1+SAVAB	; Yes, get the value
	CAIN	C,A		; Ac a is special too
	 MOVE	A,0+SAVAB	; Get that value
	CAIN	C,C		; Finally, check for ac c
	 MOVE	A,0+SAVCD	; Get value from ac c
	LOAD	C,INSFLD	; Get instruction code
	CAIL	C,T%%MIN##	; If too low
	 CAILE	C,T%%MAX##	; Or too high?
	  JRST	ILLUUO		; Illegal value
	SUBI	C,T%%MIN##	; Convert to dispatch offset
	CALL	@UUOTAB(C)	; Call the routine

UUO.Z:	 DMOVE	A,SAVAB 	; Non-skip return means restore a and b
	DMOVE	C,SAVCD 	; Restore other acs
	DMOVE	T1,SAVT12
	DMOVE	T3,SAVT34
	RET			; And return to caller
;Here if the instruction was illegal

;If the interrupt system is enabled, this routine will generate an interrupt
;on the illegal instruction code panic channel.  Otherwise it will just cause
;an error message to print out and the call will be ignored.

ILLUUO: MOVEI	A,.FHSLF	; Our handle
	MOVX	B,II%ILI	; Illegal instruction code
	IIC%			; Initiate an interrupt
	PRGERR	(Illegal instruction code,CONT)
	JRST	UUO.Z		; Restore ACs and return


;Here for unimplemented instructions

ENTRY	%NOTIN
%NOTIN: PRGERR	(<Illegal use of non-included UUO function>,RETN)
Subttl  Printing module -- %Print routine

;Call with A containing parameter to print, if applicable.
;B contains the address of the string to print.

;JFN storage goes into data segment
;STG	(P..JFN)		; Holds current output jfn
Extern	P..JFN			; Defined in host program

ENTRY	%PRINT
%PRINT: TRVAR	<<P..STR,100>>	; Storage for string
	MOVE	T3,A		; Save value for later use
	HRRZ	T1,B		; Get location
	HRLI	T1,(POINT 7,)	; Make a byte pointer
	BPM	T2,P..STR	; Destination byte pointer

;Loop reading and writing bytes
PR.A:	ILDB	B,T1		; Get a byte
	CAIN	B,"%"		; Is it special flag?
	 JRST	PR.B		; Nope
	IDPB	B,T2		; Deposit byte
	JUMPN	B,PR.A		; Loop until null

;Here on the end of the string
	SKIPN	A,P..JFN	; Jfn set up?
	 MOVEI	A,.PRIOU	; Nope, use primary
	HRROI	B,P..STR	; Point to string
	SETZ	C,		; End on a null
	SOUT%			; Send it
	RET			; And return

;Here when we found a percent sign
PR.B:	ILDB	B,T1		; Get following symbol
	CAILE	B,"Z"		; Lower case?
	 SUBI	B,40		; Yes, convert to upper
	SUBI	B,"A"		; Remove ascii offset
	JUMPL	B,PR.A		; Negative not allowed
	CAILE	B,"Z"		; Neither is anything too high
	 JRST	PR.A		; Reject
	CALL	@PRITAB(B)	; Call proper routine
	JRST	PR.A		; Loop
Subttl  Printing module -- Setjfn routine and dispatch table

;Setjfn - sets up the output jfn for the print routines.  Call with
;B containing the jfn to use.

ENTRY	%SETJF
%SETJF: MOVEM	B,P..JFN	; Set the jfn
	RET			; And return

;Dispatch table follows

DEFINE	DISTAB(CH..),<
	IRPC	CH..,<EXP TAB.'CH..>
>

;Sample:	(ABCDEFGHIJKLMNOPQRSTUVWXYZ)
PRITAB: DISTAB	($BCDE$$$$J$$$NOPQ$STUV$$$$)
Subttl  Printing module -- Special character subroutines

;These routines all have labels of the form TAB."X", where "X" is the
;letter which involked the routine.  All unimplemented letters trap to
;the routine TAB.$

;Unimplemented functions
TAB.$:	RET			; Return

;Type a crlf
TAB.C:	MOVEI	A,15		; Cr
	IDPB	A,T2		; Deposit it
	MOVEI	A,12		; Lf
	IDPB	A,T2		; Deposit
	RET			; Return

;Type the time of day
TAB.D:	MOVE	A,T2		; Get pointer
	SETO	B,		; Current time
	SETZ	C,		; Regular format
	ODTIM%			; Type it
	MOVE	T2,A		; Regain new byte pointer
	RET			; And return

;Print out the last error encountered by the process
TAB.E:	MOVE	A,T2		; Get pointer
	HRLOI	B,.FHSLF	; This fork
	SETZ	C,		; No limit
	ERSTR%			; Get last error
	 JFCL
	 JFCL			; Ignore error returns
	MOVE	T2,A		; Restore string pointer
	RET			; And return

;Print JFN information for a file
TAB.J:	MOVE	A,T2		; Destination
	MOVE	B,T3		; The jfn
	SETZ	C,		; Standard format
	JFNS%			; Type it
	MOVE	T2,A		; Get pointer back
	RET			; And return

;; continued on next page
;Type a number in binary [PBG 19-Jan-82]
TAB.B:	MOVEI	C,2		; Binary
	JRST	TAB.O+1 	; Jump to output routine

;Type a number in decimal
TAB.N:	MOVEI	C,12		; Decimal
	CAIA			; Skip

;Type a number in octal
TAB.O:	MOVEI	C,10		; Octal
	MOVE	B,T3		; Get the number
	MOVE	A,T2		; Get pointer
	NOUT%			; Type it
	 RET			; Can't
	MOVE	T2,A		; Restore pointer
	RET			; And return

;Type a percent sign
TAB.P:	MOVEI	A,"%"		; Get it
	IDPB	A,T2		; Deposit it
	RET			; And return

;Initialize for an error message
TAB.Q:	MOVEI	A,.CTTRM	; Controlling terminal
	CFIBF%			; Clear input buffer
	DOBE%			; Wait for output to complete
	MOVE	A,T2		; Get string pointer
	HRROI	B,[BYTE (7) 15,12,"?",40,0]
	SETZ	C,		; No limit
	SOUT%			; Append string
	MOVE	T2,A		; Get revised pointer
	RET			; Done

;Type out a sixbit word
TAB.S:	MOVEI	C,6		; Max 6 characters
	MOVE	B,[POINT 6,T3]	; Sixbit pointer
TAB.S1: ILDB	A,B		; Get a byte
	JUMPE	A,TAB.S2	; Ignore spaces
	ADDI	A,40		; Convert to ascii
	IDPB	A,T2		; Deposit it
TAB.S2: SOJG	C,TAB.S1	; Loop for all six
	RET			; And return

;Type a tab
TAB.T:	MOVEI	A,11		; Get it
	IDPB	A,T2		; Deposit it
	RET			; And return

;Type out a user or directory name
TAB.U:	MOVE	A,T2		; Get pointer
	MOVE	B,T3		; Get number
	DIRST%			; Type it out
	 RET			; If error
	MOVE	T2,A		; Restore pointer
	RET			; And return
;Type out the version number of the calling program
TAB.V:	MOVEI	A,.FHSLF	; Our handle
	GEVEC%			; Get entry vector
	HLRZ	A,B		; Isolate length
	HRRZS	B		; And address
	CAIGE	A,(JRST)	; Jrst means old style
	CAIGE	A,3		; Less than 3 means old style
	 SKIPA	T4,137		; So copy version
	MOVE	T4,2(B) 	; Otherwise copy new style version
	MOVE	A,T2		; Copy pointer
	LDB	B,[POINT 9,T4,11]	; Get major version
	MOVEI	C,10		; Octal
	NOUT%
	 JFCL
	LDB	D,[POINT 6,T4,17]	; Get minor version
	JUMPE	D,TAB.V1	; If no minor, don't print it
	MOVEI	B,"."		; A period
	BOUT%			; Print it
	MOVE	B,D		; Get the number
	NOUT%			; Write it
	 JFCL
TAB.V1: MOVEI	B,"("		; Seperator
	BOUT%
	LDB	B,[POINT 18,T4,35]	; Get edit
	NOUT%
	 JFCL
	MOVEI	B, ")"		; End seperator
	BOUT%
	LDB	D,[POINT 3,T4,2]	; Get cust
	JUMPE	D,TAB.V2	; Return if zero
	MOVEI	B,"-"		; Now the vcust
	BOUT%
	MOVE	B,D		; Get the number
	NOUT%
	 JFCL
TAB.V2: MOVE	T2,A		; Copy back the pointer
	RET			; Return
Subttl  GETJFN routine - Obtain a jfn on a file

;This routine finds a file in either DSK:, your login area, or both in
;either order.

ENTRY	%GETJF
%GETJF:TRVAR	<<TMPBF,30>>	; Get some storage
	LOAD	T1,ACFLD	; Get calling ac
	MOVE	T2,B		; Store the string address
	CAIN	T1,4		; Output file?
	 JRST	GTJ.2		; Yes
	CAIG	T1,1		; Code 0 or 1?
	 JRST	GTJ.1		; Yes
	CALL	GT.LOG		; 2 or 3, try login area first
	 RETSKP 		; Success
	CAIN	T1,3		; Is it log: area only?
	 JRST	GTJ.3		; Yes, quit

;Here to try DSK: first
GTJ.1:	CALL	GT.DSK		; Try disk area
	 RETSKP 		; Success
	JUMPN	T1,GTJ.3	; Return if not code 0
	CALL	GT.LOG		; Try login area
	 RETSKP 		; Success
	JRST	GTJ.3		; Failure

;Here to open an output file
GTJ.2:	CALL	GT.LOG		; Try login area only
	 RETSKP 		; Success
	JRST	GTJ.3		; Failure

;Here for failure return
GTJ.3:	SETZ	A,		; No jfn returned
	RETSKP			; Return
;Routine to test for file in default disk area
GT.DSK: MOVX	A,GJ%OLD!GJ%SHT ; Old file only
	HRRO	B,T2		; Get the string
	GTJFN%			; Get a jfn
	 RETSKP 		; Failure
	RET			; Success, jfn in a

;Routine to test for file in LOGIN area
GT.LOG: HRROI	A,TMPBF 	; Point to destination
	HRROI	B,[ASCIZ .PS:<.]	; Initial string
	SETZ	C,		; End on null
	SOUT%			; Transfer it
	MOVE	T3,A		; Save the pointer
	GJINF%			; Get our job info
	MOVE	B,A		; User number into b
	MOVE	A,T3		; Byte pointer
	DIRST%			; Write out our directory
	 RETSKP 		; Return without success
	MOVEI	B,">"		; Directory terminator
	IDPB	B,A		; Tack it on
	HRRO	B,T2		; Get filename string
	SETZ	C,		; Copy until null
	SOUT%			; Transfer it
	MOVX	A,GJ%SHT!GJ%OLD ; File flags
	CAIN	T1,4		; Output file?
	 MOVX	A,GJ%SHT!GJ%FOU ; Yes, set different flags
	HRROI	B,TMPBF 	; Point to buffer
	GTJFN%			; Get a jfn
	 RETSKP 		; Can't
	RET			; Success
Subttl  Crash routine - Handle program fatal errors

;Uses the Jsys acs, and restarts the program at the starting address
;if continued.

ENTRY	%CRASH
%CRASH: BPL	A,< Error at PC >
	ESOUT			; Type string with accompanying effects
	MOVEI	A,.PRIOU	; Primary output
	HRRZ	B,RETPC 	; Location we came from
	SUBI	B,2		; Reset to point at location in error
	MOVEI	C,10		; In octal
	NOUT%			; Type the pc
	 JFCL			; If we can't, give up
	TYPNCR	< -- >		; Spacer
	MOVEI	A,.PRIOU	; Primary output again
	HRLOI	B,.FHSLF	; This fork,,last error
	SETZ	C,		; No limit
	ERSTR%			; Type last error string
	 JFCL			; Ignore errors
	 JFCL			; Ignore errors
	TYPE	<>		; End with a crlf
	HALTF%			; Halt this fork

;Here if continued
	HRRZ	A,120		; Starting address
	JRST	(A)		; Go to it


;End of printer module

	PRGEND
Subttl  Memory management -- Memory management symbols

Title	Memory - Memory management section
Search	Symbol,Macsym,Monsym
Sall

;Symbol definitions used in storage management routines
Extern MEMLNK,MEMBLK		; Define in host program
LNK==T4 			; Link register
PROSIZ==3			; Size of prototype memory block
MINSIZ==4			; Minimum size of requested block
FSTFRE==121			; First free location
TAGVAL==123456			; Block used tag

;Program storage goes into data segment
;STG	(MEMLNK)		; Link to first block
;STG	(MEMBLK,PROSIZ) 	; Prototype memory block

;Structures offset by value of LNK
DEFSTR	(TAG,(LNK),17,18)	; Tag field
DEFSTR	(SIZE,(LNK),35,18)	; Size of block
DEFSTR	(LAST,1(LNK),17,18)	; Backward link
DEFSTR	(NEXT,1(LNK),35,18)	; Forward link

;Structures where offset must be added
DEFSTR	(XTAG,0,17,18)		; Tag (no index)
DEFSTR	(XSIZE,0,35,18) 	; Size (no index)
DEFSTR	(XLAST,1,17,18) 	; Backward link (no index)
DEFSTR	(XNEXT,1,35,18) 	; Forward link (no index)
Subttl  Memory management -- Free and used block formats

;			   Format of free storage block
;
;
;			  1 1 1 1 1 1 1 1 1 1 2 2 2 2 2 2 2 2 2 2 3 3 3 3 3 3
;     0 1 2 3 4 5 6 7 8 9 0 1 2 3 4 5 6 7 8 9 0 1 2 3 4 5 6 7 8 9 0 1 2 3 4 5
;    |-----------------------------------------------------------------------|
;+0  |	       Tag field (565656)	 |	     Size of block	     |
;    |-----------------------------------------------------------------------|
;+1  |		 Backward link		 |	      Forward link	     |
;    |-----------------------------------------------------------------------|
;+2  |				     Free space 			     |
;    |	 -   -	 -   -	 -   -	 -   -	 -   -	 -   -	 -   -	 -   -	 -   |
;    |				 ( M  word block )			     |
;    |-----------------------------------------------------------------------|
;+N  |	       Tag field (565656)	 |	     Size of block	     |
;    |-----------------------------------------------------------------------|
;


;			   Format of used storage block
;
;
;			  1 1 1 1 1 1 1 1 1 1 2 2 2 2 2 2 2 2 2 2 3 3 3 3 3 3
;     0 1 2 3 4 5 6 7 8 9 0 1 2 3 4 5 6 7 8 9 0 1 2 3 4 5 6 7 8 9 0 1 2 3 4 5
;    |-----------------------------------------------------------------------|
;+0  |		    (Unused)		 |	     Size of block	     |
;    |-----------------------------------------------------------------------|
;+1  |		    Free space (First location known to caller) 	     |
;    |	 -   -	 -   -	 -   -	 -   -	 -   -	 -   -	 -   -	 -   -	 -   |
;    |				 ( M  word block )			     |
;    |-----------------------------------------------------------------------|
;
Subttl  Memory management -- %INIMEM - Memory initialization

;No arguments - call when all memory manipulation is complete (all desired
;program segments have been called, etc.)

ENTRY	%INIME
%INIME: MOVEI	LNK,MEMBLK	; Prototype memory block
	MOVEM	LNK,MEMLNK	; First link
	MOVEI	A,TAGVAL	; Get free block tag
	STOR	A,TAG		; Store it
	MOVEI	A,PROSIZ	; Size of block
	STOR	A,SIZE		; Store it
	STOR	LNK,LAST	; Set back link to itself
	STOR	LNK,NEXT	; And next link too

;Now we add a chunk of memory to the end of our core image
	CALL	ADDMEM		; Add a k
	 JRST	NOMORE		; Can't, machine size exceeded
	RET			; Return to caller, restoring A and B

;Here if requested space can't be obtained
NOMORE: MOVEI	A,.FHSLF	; Our handle
	MOVEI	B,.ICMSE	; Machine size exceeded
	IIC%			; Initiate an interrupt
	PRGERR	(Machine size exceeded,CONT)
	RET			; Return if we didn't die
Subttl  Memory management -- %GETMEM - get a block of memory

;Call with B containing number of words desired.
;Returns with A containing address of block returned.

ENTRY	%GETME
%GETME: MOVEI	A,1(B)		; Real number of words requested
	MOVE	LNK,MEMLNK	; Get first link
	CAIGE	A,MINSIZ	; Minimum size of block
	 MOVEI	A,MINSIZ	; Set if necessary
	JRST	M.GE.B		; Skip first part

;Here we get the next link and make sure that we haven't circled around
M.GE.A: LOAD	LNK,NEXT	; Get next link
	CAME	LNK,MEMLNK	; Where we started?
	 JRST	M.GE.B		; Nope, keep looking
	CALL	ADDMEM		; Yes, try adding more memory
	 JRST	NOMORE		; No more memory!
	MOVE	LNK,MEMLNK	; Restart the search
M.GE.B: LOAD	T3,SIZE 	; Get size of block
	CAMGE	T3,A		; Size big enough?
	 JRST	M.GE.A		; Nope, try again
	PUSH	P,A		; Save size for later use
	MOVE	A,LNK		; Get address in a for unlink routine
	LOAD	T1,NEXT 	; Get next link
	MOVEM	T1,MEMLNK	; Reset the memory link
	CALL	UNLINK		; Unlink the block from the chain
	CALL	CLEAR		; Clear the block
	MOVEI	A,1(LNK)	; Caller's start of block is one past real
	POP	P,T2		; Get back size requested
	LOAD	T1,SIZE 	; Get size received
	SUB	T1,T2		; Get difference
	CAIG	T1,MINSIZ	; Enough to bother with?
	 RETSKP 		; Nope, toss it in as an extra
	STOR	T2,SIZE 	; Set new size of requested block
	ADD	LNK,T2		; Point to overage
	STOR	T1,SIZE 	; Store size of new block
	PUSH	P,A		; Save info we're returning
	CALL	M.GIVX		; While we return the extra chunk
	POP	P,A		; Restore info
	RETSKP			; Return to caller with A set up
Subttl  Memory management -- %GIVMEM - return a memory chunk

;Call with B containing the block of memory to be returned.  Note that only
;a block obtained from %GETMEM can be returned via %GIVMEM, and the whole bloc
;must be returned, rather than just a part.

ENTRY	%GIVME
%GIVME: MOVEI	LNK,-1(B)	; Get true block address
M.GIVX: MOVEI	A,1(LNK)	; Also make sure a is set
	MOVE	T1,-1(LNK)	; Get contents of previous word
	HLRZ	T2,T1		; Get tag field
	CAIE	T2,TAGVAL	; Is it a free block tag?
	 JRST	M.GI.A		; Nope, check the following chunk
	SUBI	A,1(T1) 	; Point to previous block
	HLRZ	T2,(A)		; Get tag field
	CAIE	T2,TAGVAL	; Is it another tag?
	 JRST	M.GI.A		; Nope, give up
	CALL	UNLINK		; Unlink the previous block
	EXCH	LNK,A		; Make link point to previous block
	CALL	COLLAP		; Collapse the blocks

;Here we attempt to tack on the following block
M.GI.A: LOAD	A,SIZE		; Get size of block
	ADD	A,LNK		; Get address of following block
	HLRZ	T2,(A)		; Get tag field
	CAIE	T2,TAGVAL	; A tag field?
	 JRST	M.GI.B		; Nope, quit
	LOAD	T1,XSIZE,(A)	; Get size of block
	ADDI	T1,-1(A)	; Add it's address
	HLRZ	T2,(T1) 	; Get tag field
	CAIE	T2,TAGVAL	; Match?
	 JRST	M.GI.B		; Nope, give up
	CALL	UNLINK		; Unlink the block pointed to by a
	CALL	COLLAP		; Yes, collapse the blocks

;Here when we're ready to link in the new block
M.GI.B: MOVE	A,MEMLNK	; Get link word for start of list
	STOR	A,LAST		; Store as new block's last link
	LOAD	T1,XNEXT,(A)	; Get next link
	STOR	T1,NEXT 	; Store as new block's next link
	STOR	LNK,XNEXT,(A)	; Store our link as last block's next link
	STOR	LNK,XLAST,(T1)	; Store our link as next block's last link
	MOVEM	LNK,MEMLNK	; Store us as the first block in chain
	MOVEI	T1,TAGVAL	; Get tag value
	STOR	T1,TAG		; And store it
	LOAD	T1,SIZE 	; Size of block
	ADDI	T1,-1(LNK)	; Point to last word
	MOVE	T2,(LNK)	; Get block header
	MOVEM	T2,(T1) 	; Make it block trailer, too
	RET			; Finally return to caller, restoring A and B
Subttl  Memory management -- Addmem - add memory to free list

;Subroutine to add memory at the end of our core image to the free list.
;Error return is taken if no more memory available.

ADDMEM: HRRZ	A,FSTFRE	; Get first free memory location
	ADDI	A,777		; Bump up to next page (maybe)
	LSH	A,-^D9		; Convert to page number
	HRLI	A,.FHSLF	; Fork handle in left
	RPACS%			; Read page access
	TXNE	B,PA%PEX	; Existing page?
	 RET			; Yes, can't add it
	HRRZ	LNK,A		; Get page number
	LSH	LNK,^D9 	; Make into address again
	ADDI	LNK,777 	; And get to last word in page
	SETZM	(LNK)		; Clear last word
	MOVE	T1,LNK		; Get last word in block + 1
	EXCH	LNK,FSTFRE	; Set new first free word, get start of block
	SUB	T1,LNK		; Get length of block
	STOR	T1,SIZE 	; Store it in block
	CALL	M.GIVX		; Add to the free pool
	RETSKP			; And return
Subttl  Memory management -- General subroutines

;Subroutine to collapse two adjacent blocks.
;Call with LNK containing address of first block, and T1 containing size
;of block being appended.

COLLAP: LOAD	T1,SIZE 	; Get size of block
	ADDI	T1,(LNK)	; Point to next
	HRRZ	T2,(T1) 	; Get size of next
	ADDM	T2,(LNK)	; Add in size of new block
	RET			; Return


;Subroutine to unlink a block from the queue.
;Call with A containing address of block to unlink.

UNLINK: LOAD	T1,XLAST,(A)	; Get last block
	LOAD	T2,XNEXT,(A)	; Get next block
	STOR	T1,XLAST,(T2)	; Store back link in forward link's back link
	STOR	T2,XNEXT,(T1)	; Store next link in backward link's next link
	CAMN	A,MEMLNK	; Have we unlinked the first block?
	 MOVEM	T2,MEMLNK	; Yes, must provide another
	RET			; Return to caller


;Subroutine to clear a memory block
;Call with LNK pointing to the block

CLEAR:	HRLI	T1,1(LNK)	; First word to clear
	HRRI	T1,2(LNK)	; Second
	SETZM	1(LNK)		; Clear it
	LOAD	T2,SIZE 	; Size of block
	ADDI	T2,-1(LNK)	; Add address to yield last word of block
	BLT	T1,(T2) 	; Clear the block
	RET			; And return


;End of memory management segment

	PRGEND
Subttl  Sorting module -- %Sort (main routine)

Title	Sorter -- Sorting module
Search	Symbol,Macsym,Monsym
Sall

;Call with parameters:
;	T1 is address of start of array
;	T2 is address of end of array
;All acs are respected
;Uses Quicksort algorithm to sort array into descending order.

ENTRY	%SORT
%SORT:	STKVAR	<<KEEP,2>,<CONT,2>>	; Storage
	DMOVEM	A,KEEP		; Store acs
	DMOVE	T1,A		; Also move them
	MOVX	A,.INFIN	; Plus infinity
	EXCH	A,-1(T1)	; Store in array start-1
	MOVX	B,.MINFI	; Minus infinity
	EXCH	B,1(T2) 	; Store in array end+1
	DMOVEM	A,CONT		; Store them
	CALL	QSORT		; Quicksort the array
	DMOVE	T1,KEEP 	; Restore acs
	DMOVE	A,CONT		; Get values
	MOVEM	A,-1(T1)	; Restore first
	MOVEM	B,1(T2) 	; And last
	RET			; Return

;Qsort - a recursive sorting algorithm

QSORT:	STKVAR	<II,JJ,KK>	; Local storage
	MOVEM	T1,II		; Store variables
	MOVEM	T2,JJ		; ...
	CAML	T1,T2		; I<j?
	 RET			; Nope, exit from qsort
	CALL	PART		; Partition the array from i to j
	MOVEM	T1,KK		; Store returned value
	SOS	T2,T1		; End point into t2
	MOVE	T1,II		; Beginning point into t1
	CALL	QSORT		; Quicksort this part of array
	AOS	T1,KK		; Get k+1 value
	MOVE	T2,JJ		; End of array
	CALL	QSORT		; Quicksort this part of array
	RET			; And return
Subttl  Sorting module -- Partitioning routine

;This algorithm partitions the data and returns an index to the array such
;that everything before the partition is greater than the partition value, and
;everything beyond is less.

PART:	MOVEI	A,1(T1) 	; First index
	MOVE	B,T2		; Second
	MOVE	C,(T1)		; Partition value

PART.1: CAMLE	A,B		; A greater than b?
	 JRST	PART.4		; Yes, end

PART.2: CAMG	C,(A)		; Compare value
	 AOJA	A,PART.2	; Loop until partition value is higher
PART.3: CAMLE	C,(B)		; Compare value
	 SOJA	B,PART.3	; Loop until partition value is exceeded

	CAML	A,B		; Low index below high index?
	 JRST	PART.4		; Nope, don't switch
	MOVE	T3,(A)		; Switch array values
	EXCH	T3,(B)		; ...
	MOVEM	T3,(A)		; ...
	AOJ	A,		; Bump low index
	SOJ	B,		; Decrement low index
	JRST	PART.1		; And loop

PART.4: MOVE	T3,(T1) 	; Now switch array values
	EXCH	T3,(B)		; ...
	MOVEM	T3,(T1) 	; ...
	MOVE	T1,B		; This is the parameter returned
	RET			; Finished


;End of sorter module

	PRGEND
Subttl	CMD routines -- Cmdini and Prompt

Title	Comand - Comnd% jsys routines
Search	Symbol,Macsym,Monsym
Sall

Extern	SBK,CMDBUF,ATMBUF,CMDACS,CJFNBK,REPARA,CMBLT1,CMBLT2
Extern	CMDPDL,CMDBLN,CMDPLN,ATMBLN

;Special definitions
;** This must match the trvar at UUOCON:.
	TRVAR	<<SAVAB,2>,<SAVCD,2>,<SAVT12,2>,<SAVT34,2>>
	DEFINE	RETPC <-1(.fp)> ; Symbol for return address

;Initial state block for cmdini
inisbk: z,,repars		; .cmflg -- no flags,, where to reparse
	.priin,,.priou		; .cmioj -- i/o
	point 7,[z]		; .cmrty -- default is null prompt
	point 7,cmdbuf		; .cmbfp -- where our buffer is
	point 7,cmdbuf		; .cmpnt -- first input field
	cmdbln*5		; .cmcnt -- max number of chars
	z			; .cminc -- no unparsed chars yet
	point 7,atmbuf		; .cmabp -- where atom buffer is
	atmbln*5		; .cmabc -- size of atom buffer
	cjfnbk			; .cmgjb -- location of gtjfn block


;Cmdini -- initialize CMD package
;Argument is IOWD pointer to stack.
;(Must be reinitialized if a new stack is used.)

ENTRY	%CMDIN
%CMDIN: move	a,[inisbk,,sbk] ; Blt pointer
	blt	a,sbk+.cmgjb	; Copy initial state block to state block
	ifn.	b		; Is there an argument?
	 move	a,(b)		; Yes, get argument
	else.			; Nope, make a best guess
	 move	a,.fp		; By assuming that stack bottom
	 sub	a,[2,,2]	; Was the calling address
	endif.
	hlre	b,a		; Get the size field
	movns	b		; Negate it
	caig	b,cmdpln	; Is there enough room?
	ifskp.			; Nope, time to complain
	 movei	a,.fhslf	; Cause an interupt on the push-down
	 movx	b,ii%pov	; Overflow panic channel
	 iic%			; If continued, exlain
	 prgerr (CMDPLN too small to save stack,EXIT)
	endif.
	movsi	b,1(a)		; We're ok, make blt pointer
	hrri	b,cmdpdl	; stak,,cmdpdl
	movem	b,cmblt1	; Our first pointer
	movni	b,(a)		; Now figure how stack to save
	addi	b,cmdpdl	; -<stak-1>+cmdpdl
	hrli	b,p		; 1-stak+cmdpdl(p)
	movem	b,cmblt2	; Which is our second pointer
	ret			; Done

;Prompt -- start new command line
;Possible arguments in memory field
;	address of asciz string to use as prompt, or
;	0 for no prompt at all (null string), or
;	-1 to reuse previous prompt (same as 0 if first call)

ENTRY	%PROMP
%PROMP: skipn	b		; If argument is zero
	 movei	b,[z]		; Then prompt is a null string
	caie	b,-1		; If argument isn't minus one
	 hrrom	b,sbk+.cmrty	; Then it's the new prompt's address
	dmove	a,savab 	; Get saved a and b
	move	c,savcd 	; Get saved c
	dmovem	f,cmdacs+f	; Save two acs
	move	a,[b,,cmdacs+b] ; Blt pointer
	blt	a,cmdacs+16	; Save most of the acs
	movei	a,retpc 	; Get address of top of stack
	movem	a,cmdacs+p	; Save last ac
	move	a,cmblt1	; Save the stack
	blt	a,@cmblt2
	move	a,retpc 	; Get called address
	movem	a,repara	; This is our reparse address
	movei	b,[flddb. .cmini]
	call	field		; Go type the prompt
	 jfcl			; Shouldn't happen
	ret			; Done

Subttl	CMD routines -- Rflde, Rfield, Cfield

;Field parsing routines
;Argument is address of function discriptor block.
;Returns with these results in acs 1 and 2
;ac1/	LH:	flags from cmd state block.
;	RH:	address of function block used to parse command.
;ac2/		data returned by COMND% jsys,
;		or error code if rflde is returning an error.

;rflde -- parse a field, skip iff successful

ENTRY	%RFLDE
%RFLDE: call	field		; Try to parse
	ifskp.	(aos retpc)	; Pass skip down the line
	hrr	a,c		; Copy func block pointer
	retskp			; Return, keep new a and b


;rfield -- parse a field, proccess any errors.
;	Returns only on success.

ENTRY	%RFIEL
%RFIEL: call	field		; Parse the field
	 jrst	cmderr		; Failed, go proccess error
	hrr	a,c		; Copy function block pointer
	retskp			; Return, keep new a and b

;cfield -- same as rfield, but confirm afterwards

ENTRY	%CFIEL
%CFIEL: call	field		; Parse the field
	 jrst	cmderr		; Failed, go process error
	dmovem	a,savab 	; Store returned values
	call	%confr		; Confirm
	ret			; Done
Subttl	CMD routines -- Noise and Confrm

;noise -- parse (generate) a noise word
;Argument is address of string to type

ENTRY	%NOISE
%NOISE: move	t2,b		; Get the string address
	tlo	t2,-1		; Convert to pointer
	movx	t1,fld(.cmnoi,cm%fnc)
	movei	b,t1		; Function block is t1-t2
	call	field		; Go parse (type) the string
	 jfcl			; This shouldn't happen
	ret			; Done

;confrm -- get confirmation
;No argument

ENTRY	%CONFR
%CONFR: movei	b,[flddb. .cmcfm]
	call	field		; Get confirmation
	 jrst	cmderr		; Didn't confirm, go complain
	ret			; Done


subttl	CMD routines -- Support routines

;field -- parsing routine, does actual COMND% jsys
;b/	address of function block
field:	movei	a,sbk		; Get address of state block
	comnd%			; The real thing!
	 erjmp	r		; Single return on errors
	txne	a,cm%nop	; Did it parse?
	 ret			; Nope, single return
	retskp			; Success, skip return

;cmderr -- handles cmd errors
cmderr: hrroi	a,asc(Command error -- )
	esout%
	movei	a,.priou	; To primary output
	hrloi	b,.fhslf	; Most recent error
	setz	c,		; Any length
	erstr%			; Standard error message
	 jfcl
	 jfcl
	sos	repara		; Make reprompt happen
				; (fall into repars)

;repars -- where COMND% jsys jumps to for reparse
repars: move	p,cmdacs+p	; Get old stack pointer
	movs	a,cmblt1	; Restore the stack
	blt	a,(p)
	movsi	16,cmdacs	; Restore rest of the acs
	blt	16,16
	jrstf	@repara 	; Go reparse or reprompt

	PRGEND			; End of comand module
Subttl	String Routines -- Insert

Title	String - String manipulation routines
Search	Symbol,Macsym,Monsym
Sall

Extern	S1,S2			; External string pointer storage

ENTRY	%Inser

; Here we insert either AC B blanks into S1, or B characters from the pointer
; specified in A into S1.  If B is zero, we just insert spaces.
; The string in S1 is assumed to end in a null.

%Inser: move	t1,s1+1 	; Get the pointer to the string
	move	p1,a		; The counter is in p1
	move	p2,@b		; Save the possible pointer
	move	p3,s1		; Save the current pointer

; Now loop, looking for the string end:
	ildb	a,t1		; Get a character
	jumpn	a,.-1		; If not the null, get the next one

; Now we're at the end of the string, insert AC A blanks into the string
	move	a,p1		; Get the character count
	adjbp	a,t1		; Adjust our byte pointer that many...into a
	movem	a,s1		; And save it as our returned pointer
	movei	c,40		; Put a space into c
.inlup.:movem	a,t2		; Now t1 has the old end, t2 has the new end
	camn	t1,p3		; Are we at the word for insertion?
	 jrst	.inin.		; Yes, do the insertion
	ldb	a,t1		; Get a character from the end
	dpb	c,t1		; Write over it with a space
	dpb	a,t2		; Deposit it to the new end
	seto	a,		; Get a negative one
	adjbp	a,t1		; Move the pointer back one
	move	t1,a		; Get the pointer back into t1
	seto	a,		; Negate a again
	adjbp	a,t2		; Move the new end back one
	jrst	.inlup. 	; And loop

; Here when we've inserted the proper number of spaces into the string.
; If we have a pointer, copy the characters, if not, return:
.inin.: skipn	p2		; Do we have a pointer to string to insert?
	 ret			; No, just return then
	ildb	a,p2		; Yes, get a character
	idpb	a,p3		; And move it
	sojg	p1,.-2		; Loop until done
	ret			; When done transfering, just return
Subttl	String Routines -- Copy and Delete

ENTRY	%Copy

; Copy loops, copying from S1 to S2, stopping when it reaches the character in
; B or the number of times in A.

%Copy:	ildb	c,s1		; Get a char from the source string
	idpb	c,s2		; No, copy the character to the destination
	camn	b,c		; Is it the one we're looking for?
	 ret			; Yes, return, restoring all AC's
	jumpl	a,%copy 	; If counter is negative, get the next char
	sojg	a,%copy 	; Decriment counter...if still positive, loop
	ret			; If zero, we've done enough...return


ENTRY	%Delet

; Here to delete the number of characters in ac B starting at the char pointed
; to by S1, or until we come to the character in ac A:

%Delet: move	t3,b		; Get the number of characters to copy
	jumpe	a,.dnum.	; If the character to stop on is null, just
				; copy the specified number

; Here to delete until we reach a specified character.	First we see how many
; characters from the current pointer the specified character is:
	setz	t3,		; Clear our char counter
	move	t4,s1		; Copy the pointer
	ildb	t1,t4		; Get a character
	aos	t3		; Increment our counter
	caml	t3,a		; Are we still below the max given?
	 jrst	.+3		; No, stop looking
	came	t1,b		; Is it the character we're looking for?
	 jrst	.-5		; No, look at the next one

; Here when we've found the character.	Delete the number of chars in t3:
.dnum.: setz	d,		; Put a null in D
	adjbp	t3,s1		; Point to the next character to keep
	move	t4,s1		; Now get the original
.delch.:ldb	a,t3		; Get the next character to keep
	idpb	d,t3		; Write over it with a null
	dpb	a,t4		; Save it in t4
	skipe	a		; A null?
	 ret			; Yes, return, deletion complete
	ibp	t4		; Increment the byte pointer
	jrst	.delch. 	; Loop until we reach a null

ENTRY	%FIND

;  Find The letter C in the string pointed to by Ac. The pointer
;    is set to char found, or if not found, pointer is at end of
;    string.  The pointer is returned in A, and last character is
;    in B:

%Find:	ildb   t1,a		; Get a character
	camn   b,t1		; Is it the one we're looking for?
	 retskp 		; Yes, return to caller
	jumpn  t1,%find 	; If not a null, look at the next character
	retskp			; If it is a null, return


;End of subroutine package
	END			; No start address specified