Google
 

Trailing-Edge - PDP-10 Archives - steco_19840320_1er_E35 - 10,5676/teco/newsrc/tecmem.mac
There are 3 other files named tecmem.mac in the archive. Click here to see a list.
	SUBTTL	Introduction

; Copyright (c) 1979, 1980, 1981 Stevens Institute of Technology,
; Hoboken, New Jersey   07030.

; This software may be used and copied provided that this copyright notice
;is included, and provided that copies of all modifications are sent to:
;
;	TECO Project
;	Computer Center
;	Stevens Institute of Technology
;	Castle Point Station
;	Hoboken, New Jersey    07030
;
;
; The information in this software is subject to change without notice
; and should not be construed as a commitment by Stevens Institute of
; Technology.

  ; Search needed universals

	SEARCH	TECUNV		; TECO universal file

  ; Generate the prologue


	TECVER==200		; Major version number
	TECMIN==1		; Minor version number
	TECEDT==1150		; Edit level
	TECWHO==0		; Last editor


	PROLOGUE(MEM,<TECO Memory management>)	; Generate the TITLE and other stuff
	SUBTTL	Table of Contents

;+
;.pag.lit

;		Table of Contents for TECMEM - Memory management
;
;
;			   Section			      Page
;   1. Introduction . . . . . . . . . . . . . . . . . . . . .    1
;   2. Table of Contents. . . . . . . . . . . . . . . . . . .    2
;   3. Revision History . . . . . . . . . . . . . . . . . . .    3
;   4. M$INIT - Initialize the memory management. . . . . . .    4
;   5. M$ZBLK - Allocate a zero block of core . . . . . . . .    5
;   6. M$GBLK - Routine to allocate a core block. . . . . . .    6
;   7. M$GTXT - Routine to get a text block . . . . . . . . .    7
;   8. M$RBLK - Return a core block . . . . . . . . . . . . .    8
;   9. M$XPND - Expand the end of the editing buffer. . . . .    9
;  10. M$SRNK - Routine to shrink a buffer. . . . . . . . . .   13
;  11. M$INSS - Routine to insert a string into a buffer. . .   14
;  12. M$USEB - Routine to add a user to a block. . . . . . .   15
;  13. M$RELB - Routine to delete a user from a block . . . .   16
;  14. M$CFRE - Check the free counts of text blocks. . . . .   17
;  15. FNDBLK - Routine to find a given size block. . . . . .   18
;  16. M$CBLK - Routine to create a block of the given size .   19
;  17. M$GC - Perform a garbage collection. . . . . . . . . .   20
;  18. M$MSTR - Routine to move a string. . . . . . . . . . .   23
;  19. FIXPTR - Routine to fix up text buffer pointers. . . .   25
;  20. Low segment. . . . . . . . . . . . . . . . . . . . . .   26
;  21. End of TECMEM. . . . . . . . . . . . . . . . . . . . .   27

;.end lit.pag
;-
	SUBTTL	Revision History
COMMENT	|

1000	Start of this version

1022	By: Nick Bush		On: 14-August-1980
	Fix M$XPND to avoid overwriting the block after the one being
	expanded (yet again). Also really avoid this problem by putting
	in the code for a POP loop when inserting multiples of 5
	characters.
	Modules: TECMEM

1032	By: Robert McQueen		On: 22-August-1980
	Make TECMEM assemble for KI-10s.
	Modules: TECUNV,TECMEM

1045	By: Robert McQueen		On: 15-October-1980
	Output files where getting 1b35 on.  M$XP.8 (POP loop) moved too many words
	and was moving the text buffer header into the editing buffer.  If the
	number of characters that were being inserted were then less then 20. the
	bit (1B35) would not be cleared.
	Modules: TECMEM

1106	By: Nick Bush		On: 13-May-1981
	Improve screen updating for times when the new screen has portions which
	are identical with the old.  This will also fix most cases of wrapped
	around lines on the top of the section of the screen.
	Also fix some random /MODE:DUMP bugs.
	Modules: TECUNV,TECVID,TECCMD,TECECM,TECUUO,TECMEM

1111	By: Nick Bush		On: 9-July-1981
	Don't do 18-bit arithmetic on memory sizes, so we don't turn a request
	for 1000000 words into something less, and thereby miss the error.
	Modules: TECMEM

1125	By: Robert McQueen		On: 29-September-1981
	- Make symbol table entries movable blocks.
	- Use the new linked list processing.
	- Initial work to make TECSYM run in non-zero section.
	Modules: TECUNV,TECECM,TECSYM,TECMEM

Start of Version 200A(1126)

1127	By: Nick Bush@SIT, Robert C. McQueen@SIT		On: 15-October-1981
	Add the following new features:
	- String arguments.  {...} is a string argument.
	- Make I take them, = and == return them.
	- Implement the FC command to define immediate command tables
	- Implement the E? command to return various items.
	- Start doing some work so that TECO will work on TOPS-20
	- Start doing some work so that TECO some day may run in a section
	  besides zero.
	Modules: TECUNV,TECERR,TECPRS,TECCMD,TECSRH,TECMEM,TECUUO,TECECM,TECMVM,TECCOM,TECINI

1132	By: Nick Bush		On: 10-December-1981
	1) Add Q-register data types for the sake of FC(Q-reg)SAVE$ and
	FC(Q-reg)RESTORE$ commands.
	2) Fix FC(q-reg)REPLACE$ to correctly replace the ALWAYS and OTHER options.
	Modules: TECUNV,TECCMD,TECECM,TECMEM,TECPRS,TECMVM

1150	By: Nick Bush		On: 23-March-1982
	Fix CPYCTB to correctly handle copying only one CND.  It was returning
	the new CND it had created when it returned.
	Modules: TECMEM
|
	SUBTTL	M$INIT - Initialize the memory management

	$CODE			; Code PSECT

;+
;.hl1 M$INIT
;This routine will initialize the memory management.  It assumes that it is
;one of the first routines called on start up.
;.literal
;
; Usage:
;	PUSHJ	P,M$INIT	; Initialize memory management
;	(Return)		; Always return
;.end literal
;-

M$INIT:	MOVE	T2,.JBFF	; Get the first free location
	MOVEM	T2,FSTBLK	; Save it for the get-a-block routines
	ADDX	T2,.BKLEN+1+D.MINC ; Need at least one dummy block
	CAMG	T2,.JBREL	; Have enough already?
	 JRST	M$IN.0		; Yes, don't need more
	MOVE	T1,.JBFF	; Get this again
	ADR2PG	T1		; Convert this to a page number
	ADR2PG	T2		; And this too
	SUB	T2,T1		; Compute the number of pages needed
	ADDI	T1,1		; First page to do
	PUSHJ	P,M$CPGS	; Create the pages
	 ERROR	E.COR		; Can't, give up
M$IN.0:	MOVE	T1,.JBREL	; Get the end of core
	AOJ	T1,		; Bump it
	MOVEM	T1,.JBFF	; And save it for expansion
	MOVE	T1,FSTBLK	; Get the pointer back
	ZERO.	T2,BLKFLG,(T1)	; Clear the flags
	ZERO.	T2,BLKNXT,(T1)	; And the next field
	MOVE	T2,.JBREL	; Get the end of core
	SUB	T2,T1		; And get the number of words in this block
	AOJ	T2,		; Plus one
	STOR.	T2,BLKSIZ,(T1)	;  .  .  .
	STORI.	.BTJNK,T2,BLKTYP,(T1) ; Store the block type
	BITON	T2,BF.LST,.BKFLG(T1) ; Flag this is the last block
	MOVX	T1,D.CMDS	; Get the default size of the command buffer
	PUSHJ	P,M$GTXT	; Get the block
	XMOVEI	T2,CMDBUF	; Get the address we want to point to this one
	PUSHJ	P,M$USEB	; And set the pointer
	BITON	T1,QR$UPD,$QRFLG+CMDBUF ; Flag this will need forced update first time
	ZERO.	,QRGPDB,+CMDBUF	; No previously displayed buffer
	MOVEI	T1,5		; Get 5 chars
	PUSHJ	P,M$GTXT	; Get the buffer
	MOVEI	T2,TTIBUF	; Get the QRg address
	PUSHJ	P,M$USEB	; Point to the buffer
	MOVEI	T1,5		; Get 5 chars
	PUSHJ	P,M$GTXT	; Get the buffer
	MOVEI	T2,ERRQRG	; Get the QRg address
	PUSHJ	P,M$USEB	; Point to the buffer
	BITON	T1,QR$UPD,$QRFLG+ERRQRG ; Flag this will need forced update first time
	ZERO.	,QRGPDB,+ERRQRG	; No previously displayed buffer
	BITON	T1,QR$UPD,$QRFLG+TXTBUF ; Flag this will need forced update first time
	BITON	T1,QR$UPD,$QRFLG+QRGIDX(.) ; Flag this will need forced update first time
	ZERO.	,QRGPDB,+TXTBUF	; No previous buffer
	ZERO.	,QRGPDB,+QRGIDX(.) ; No previous here either
	MOVX	T1,$DTTXT	; Get the type of the Q-reg's
	STOR.	T1,QRGDTP,+TXTBUF ; And store it
	STOR.	T1,QRGDTP,+QTAB+QRGIDX(.) ; Here also
	STOR.	T1,QRGDTP,+CMDBUF ; And here
	STOR.	T1,QRGDTP,+ERRQRG ; And here
	STOR.	T1,QRGDTP,+TTIBUF ; And for the terminal input buffer
	MOVX	T1,$DTNUM	; Have a value in COMMAND-PROMPT initially
	STOR.	T1,QRGDTP,+CPMQRG ; Store the data-type
	MOVX	T1,"*"		; Get the value of an asterisk
	STOR.	T1,QRGVAL,+CPMQRG ; And store it

	MOVX	T1,D.TXTS	; Get the initial size of the text buffer
	PUSHJ	P,M$GTXT	; Get a block
	MOVEI	T2,$QRTPT+TXTBUF ; Get the address
	PUSHJ	P,M$USEB	; Set the reference
	MOVEI	T2,QTAB+QRGIDX(.) ; Get the address of Q-reg .
	MOVEM	T2,CUREDT	; Save the current QRG
	PJRST	M$USEB		;  .  .  .
	SUBTTL	M$MCOR - Move a section of core up or down

;+
;.hl1 M$MCOR
;This routine will move a section of memory up or down a specified number
;of words.
;.literal
;
; Usage:
;	T1/ Number of words to move
;	T2/ Starting address
;	T3/ Ending address
;	PUSHJ	P,M$MCOR
;	(Return)
;
;.end literal
;-

IFN FTXADR,<
M$MCOR:	JUMPE	T1,.POPJ		; If nothing just return
	EXTEND	T1,[XBLT]		; Very simple
	POPJ	P,			; Return to the caller
>; End of IFN FTXADR

IFE FTXADR,<
M$MCOR:	JUMPE	T1,.POPJ		; Moving nothing?
	JUMPL	T1,MCOR.0		; Moving down, must POP
	HRL	T3,T2			; Build the BLT pointer
	ADDI	T1,-1(T3)		; Compute the final address
	BLT	T3,(T1)			; Move the core
	POPJ	P,			; Return to the caller

; Here if we have to move the memory up the hard way.  We will use a POP
; loop to move the information

MCOR.0:	SUB	T3,T2			; Get the offset from the source to the destination
	SOJ	T2,			; Get the last word we are interested in
	MOVN	T1,T1			; Get the magnitude of the count
	SOJ	T1,			; Minus one for the correct POP loop count
	HRL	T2,T1			; Get the count
	HRLI	T3,(POP T2,(T2))	; Build the instruction to execute
	TXCN	T2,1B0			; Turn on the sign bit
	 XCT	T3			; Move a word
	JUMPL	T2,.-1			; Loop until done
	POPJ	P,			; Return with the block moved
>; End of IFE FTXADR
	SUBTTL	M$ZBLK - Allocate a zero block of core

;+
;.HL1 M$ZBLK
;This routine will allocate a core block for the caller.  It will then
;clear the block for the caller.  This is mainly used for the video
;processing routines that require a null block of core.
;.literal
;
; Usage:
;	MOVE	T1,Number.of.words
;	MOVEI	T2,.BTxxx	; The block type
;	PUSHJ	P,M$ZBLK	; Allocate the core block
;	(Return)		; Always return here
;
; Returns:
;	T1 - Address of the core block
;.end literal
;-

IFE FTXADR,<
M$ZBLK:	$SAVE	<P1>		; Save P1
	MOVE	P1,T1		; Copy the number of words
	PUSHJ	P,M$GBLK	; Allocate the block
	MOVEI	T2,1(T1)	; Start building the BLT
	HRLI	T2,(T1)	 	; . . .
	ADD	P1,T1		; Compute the final address
	SETZM	(T1)		; Clear the first word
	BLT	T2,-1(P1)	; Clear the block
	POPJ	P,		; Return to the caller
>; End of IFE FTXADR
IFN FTXADR,<
M$ZBLK:	$SAVE	<P1,P2,P3>	; Save a few registers
	MOVE	P1,T1		; Copy the size of the block
	SOJ	P1,		; Decrement
	PUSHJ	P,M$GBLK	; Allocate a block of memory
	MOVE	P2,T1		; Get the address of the block
	AOS	P3,P2		; Get the address to move to
	SETZM	(P2)		; Clear the first word
	EXTEND	P1,[XBLT]	; Clear the block of memory
	POPJ	P,		; Return to the caller
>; End of IFN FTXADR
	SUBTTL	M$GBLK - Routine to allocate a core block

;+
;.Hl1 M$GBLK
;This routine will allocate a core block for the caller.  It may move core
;around.
;.literal
;
; Usage:
;	MOVE	T1,Number.of.words
;	MOVEI	T2,.BTxxx	; The block type
;	PUSHJ	P,M$GBLK	; Allocate the core block
;	(Return)		; Always return if core block gotten
;
; Returns:
;	T1 - Address of the core block
;.end literal
;-

M$GBLK:	$SAVE	<P1,P2>		; Save some ac's
IFN FTDEBUG,<
	SKIPE	T1		; Zero words?
	 TXNE	T1,LH.ALF	; Too many words?
	  STOPCD TMW,<Too many words requested>
	SKIPL	T2		; Bad block type?
	 CAXLE	T2,.BTMAX	;  .  .  .
	  STOPCD BBR,<Bad block type requested>
> ; End of IFN FTDEBUG
	ADDX	T1,.BKLEN	; Add the overhead
	DMOVE	P1,T1		; Move the args to a safe place
	PUSHJ	P,FNDBLK	; Go find a block large enough
	 JRST	M$GB.1		; Found it
	PUSHJ	P,M$GC		; Go garbege collect
	PUSHJ	P,FNDBLK	; Try again
	 JRST	M$GB.1		; Got one
	MOVE	T1,P1		; Get the size
	PUSHJ	P,M$CBLK	; Create a block

M$GB.1:	STOR.	P2,BLKTYP,(T1)	; Store the type
	LOAD.	P2,BLKSIZ,(T1)	; Get the size of the block we found
	STOR.	P1,BLKSIZ,(T1)	; Store the new size
	SUB	P2,P1		; Get the size of what's left
	ADD	P1,T1		; Get the new block address
	JUMPE	P2,M$GB.2	; If nothing, just return
	BITOFF	T2,BK.FLG,.BKFLG(P1) ; Clear the flags
	STORI.	.BTJNK,T2,BLKTYP,(P1) ; Flag this is a junk block
	STOR.	P2,BLKSIZ,(P1)	; Store the size
	LOAD.	T2,BLKNXT,(T1)	; Get the old next pointer
	STOR.	T2,BLKNXT,(P1)	; And store it
	ZERO.	T2,BLKNXT,(T1)	; Clear the old one
	MOVX	T2,BF.LST	; Get the flag to copy
	TDNE	T2,.BKFLG(T1)	; Last page?
	 IORM	T2,.BKFLG(P1)	; Yes, flag it
	ANDCAM	T2,.BKFLG(T1)	; Clear the old flag
M$GB.2:
IFN FTDEBUG,<
IFE FTXADR,<
	HRLI	T2,.BKLEN(T1)	; Set up the BLT pointer
	HRRI	T2,.BKLEN+1(T1)	; To clear the block
	SETZM	-1(T2)		; Clear the first word
	CAIE	P1,(T2)		; Only one word
	 BLT	T2,-1(P1)	; Clear the block
>; End of IFE FTXADR
IFN FTXADR<
	$SAVE	<P3>		; Need another register
	XMOVEI	P2,.BKLEN(T1)	; Get the first address
	AOS	P3,P2		; Get the address of the next
	SETZM	(T2)		; Clear the first
	CAMN	P1,P3		; Finished?
	  JRST	M$GB.3		; Yes, skip this
	SUB	P1,P3		; Determine the number of words
	EXTEND	P1,[XBLT]	; Clear the block
M$GB.3:
>; End of IFN FTXADR
>; End of IFN FTDEBUG
	ADDX	T1,.BKLEN	; Point to first data word
IFN FTDEBUG,<
	CFXE.	T2,BLKTYP,-.BKLEN(T1),.BTTXT ; Don't check if this is a text block
	 PUSHJ	P,M$CFRE	; Check the free blocks and junk
>; End of IFN FTDEBUG
	POPJ	P,		; No, return the address
	SUBTTL	M$GTXT - Routine to get a text block

;+
;.Hl1 M$GTXT
; This routine will allocate a text core block. It calls M$GBLK to
;do the actual work.
;.b
;.literal
;	MOVEI	T1,Number.of.chars
;	PUSHJ	P,M$GTXT
;	 (Return, T1= address of buffer)
;
;.end literal
;.b
; Note:	M$USEB must be called with the buffer and pointer addresses after
;this to set up the pointer list properly.
;-

M$GTXT:	IDIVI	T1,5		; Make it the number of words we need
	JUMPE	T2,.+2		; Need a partial?
	 AOJ	T1,		; Yes, count it
	MOVX	T2,.BTTXT	; Get the block type
	ADDX	T1,.BKTLN-.BKLEN ; Add the overhead in
	PUSHJ	P,M$ZBLK	; Get the block
	SUBX	T1,.BKLEN	; Point to the real first word
	LOAD.	T2,BLKSIZ,(T1)	; Get the size
	SUBX	T2,.BKTLN	; Minus the header
	IMULI	T2,5		; Make it the number of chars
	STOR.	T2,BLKFRE,(T1)	; Store the number
	ZERO.	T2,BLKTFL,(T1)	; Clear the flags
	ZERO.	,BLKADR,(T1)	; Clear the pointer word
	ZERO.	,BLKPT,(T1)	; And the "PT" offset
	ZERO.	,BLKEND,(T1)	; And "Z"
	STORI.	.INFIN,T2,BLKFST,(T1) ; Flag nothing modified
	STORI.	.MINFI,T2,BLKLST,(T1) ;  .  .  .
	ZERO.	,BLKOED,(T1)	; And the old end is zero
	XMOVEI	T2,.BKTLN(T1)	; Get the address of the first data word
	TXO	T2,<POINT 7,>	; Build the byte pointer
	STOR.	T2,BLKPTR,(T1)	; And store it
	POPJ	P,		; And return
	SUBTTL	M$RBLK - Return a core block

;+
;.HL1 M$RBLK
;This routine will return a core block to the free core storage.
;.literal
;
; Usage:
;	MOVE	T1,Address.of.core.block(first data word)
;	PUSHJ	P,M$RBLK
;	(Return)
;.end literal
;-

DELBLK:	$SAVE	<P1,P2,P3>	; Save a few registers
	JRST	DBLK.0		; Enter the common loop

M$RBLK:	$SAVE	<P1,P2,P3>	; Save some working room
	SUBX	T1,.BKLEN	; Take off the header
DBLK.0:	MOVE	P1,T1		; And get the address
	LOAD.	P2,BLKSIZ,(P1)	; Get the size
	MOVE	P3,T1		; Copy the address here also
	MOVX	T1,BF.LST	; Is this the last block on a page?
	TDNE	T1,.BKFLG(P1)	;  .  .  .
	 JRST	M$RB.1		; Yes, don't check for next block
IFN FTDEBUG,<
	JUMPG	P2,.+2		; Skip if length okay
	 STOPCD	RZB,<M$RBLK found a zero length block>
> ; End of IFN FTDEBUG
	ADD	P3,P2		; No, get the address of the next block
	CFXE.	T1,BLKTYP,(P3),.BTJNK ; Is it a junk block?
	 JRST	M$RB.1		; No, can't concatenate them
	LOAD.	T1,BLKSIZ,(P3)	; Yes, concatenate this one with the new one
	ADD	T1,P2		;  .  .  .
	STOR.	T1,BLKSIZ,(P1)	; Store the new size
	LOAD.	T1,BLKNXT,(P3)	; Get the next page pointer
	STOR.	T1,BLKNXT,(P1)	; Store it
	LOAD	T1,.BKFLG(P3),BF.LST ; Get the last flag
	STOR	T1,.BKFLG(P1),BF.LST ; Store it

M$RB.1:	STORI.	.BTJNK,T1,BLKTYP,(P1) ; Save the block type
IFN FTDEBUG,<
	PUSHJ	P,M$CFRE	; Check the text blocks
>; End of IFN FTDEBUG
	POPJ	P,		; And return
	SUBTTL	M$XPND - Expand the end of the editing buffer

;+
;.HL1 M$XPND
;This routine will expand the end of the editing buffer by N characters.
;It will allocate more core if the core is required.
;.literal
;
; Usage:
;	MOVE	T1,Address.of.buffer
;	MOVEI	T2,Number.of.characters
;	MOVEI	T3,Offset.of.pointer
;	PUSHJ	P,M$XPND
;	(Return)
;.end literal
;-

M$XPND:
IFN FTDEBUG,<
	PUSHJ	P,M$CFRE	; Check the text blocks out
>; End of IFN FTDEBUG
	JUMPE	T2,.POPJ	; Just return if nothing to insert
	$SAVE	<P1,P2,P3,P4>	; Save some ac's
	DMOVE	P1,T1		; Get the args
	MOVE	P3,T3		;  .  .  .
	LOAD.	T1,BLKFRE,(P1)	; Get the number of free characters
	CAML	T1,P2		; Have enough free?
	 JRST	M$XP.2		; Yes, go make the room in the buffer
	MOVE	T2,P2		; Get the number of characters being added
	SUB	T2,T1		; And determine the actual additonal needed
	ADDX	T2,5		; Plus a little working room
	IDIVX	T2,5		; Get the number of words
	MOVE	T1,P1		; Get the address of the block to expand
	PUSHJ	P,M$APPD	; Add the space to this block
	 JRST	M$XP.1		; It was moved, we need to copy the data
	IMULX	T2,5		; Get the number of characters we added
	LOAD.	T1,BLKFRE,(P1)	; And get the previous free
	ADD	T1,T2		; Get the amount free now
	STOR.	T1,BLKFRE,(P1)	; Store it back
	JRST	M$XP.2		; And go move the text down
; Here if the block had to be moved somewhere else in order to expand it.
;We must copy the text.
;Enter with:
;	T1/ Address of old buffer
;	T2/ Number of words just appended to the buffer
;	T3/ Address of new buffer
;	P2/ Number of characters we need to insert
;	P3/ Offset to where to insert first character
;

M$XP.1:	MOVE	P1,T1		; Get the address of the old block(may have moved)
	MOVE	P4,T3		; Get the address of the new block
	LOAD.	T2,BLKSIZ,(P4)	; Get the new block size
	SUBX	T2,.BKTLN	; Compute the amount that is really text
	IMULX	T2,5		; Compute the number of characters in that
	SUB	T2,.BKEND(P1)	; Minus were the text ends
	SUB	T2,P2		; And minus the amount needed gives the new free
	STOR.	T2,BLKFRE,(P4)	; Store the number free in the new block
	LOAD.	T2,BLKPTR,(P1)	; Get the old byte pointer
	SUB	T2,P1		; Make it a relative pointer
	ADD	T2,P4		; And back to the new absolute pointer
	STOR.	T2,BLKPTR,(P4)	; And save the new pointer
	XMOVEI	T1,.BKTLN(P1)	; Get the source pointer
	TXO	T1,<POINT 7,>	; Make into a byte pointer
	XMOVEI	T2,.BKTLN(P4)	; Get where to put the string
	TXO	T2,<POINT 7,>	; Set up the pointer
	MOVE	T3,P3		; Get the number of characters to move
	PUSHJ	P,M$MSTR	; Move the string
	LOAD.	T1,BLKPT,(P1)	; Get the old point
	STOR.	T1,BLKPT,(P4)	; And store it
	LOAD.	T1,BLKEND,(P1)	; Get the old end
	ADD	T1,P2		; Get the number of chars total
	STOR.	T1,BLKEND,(P4)	; Store it
	MOVE	T1,P3		; Get the place the caller wants a gap
	BLDBPT	(T1,(P1))	; Build the byte pointer
	MOVE	T2,P2		; Get the place to put it
	ADD	T2,P3		;  .  .  .
	BLDBPT	(T2,(P4))	; Build the destination byte pointer
	LOAD.	T3,BLKEND,(P1)	; Get the old end
	SUB	T3,P3		; Get the number to move
	PUSHJ	P,M$MSTR	; Move the rest of the string
	LOAD.	T1,BLKTFL,(P1)	; Get the old flags
	STOR.	T1,BLKTFL,(P4)	; Store them
	LOAD.	T1,BLKFDI,(P1)	; Get the input FDB address
	STOR.	T1,BLKFDI,(P4)	; Store it
	LOAD.	T1,BLKFDO,(P1)	; Get the output FDB address
	STOR.	T1,BLKFDO,(P4)	; Store it
	LOAD.	T1,BLKTMP,(P1)	; Get the rename FDB address
	STOR.	T1,BLKTMP,(P4)	; Store it
	LOAD.	T1,BLKCOL,(P1)	; Get the old column
	STOR.	T1,BLKCOL,(P4)	; And copy it
	LOAD.	T1,BLKOED,(P1)	; Get the old end
	STOR.	T1,BLKOED,(P4)	; Save it
	LOAD.	T1,BLKFST,(P1)	; And the first
	STOR.	T1,BLKFST,(P4)	;  .  .  .
	LOAD.	T1,BLKLST,(P1)	; And the last change
	STOR.	T1,BLKLST,(P4)	;  .  .  .

	XMOVEI	T1,.BKLEN(P1)	; Get the address of the first word past the header
	PUSHJ	P,M$RBLK	; And return the old block
	MOVE	T1,P4		; Get the address of the new block

IFN FTDEBUG,<
	PUSHJ	P,M$CFRE	; Check the number free
>; End of IFN FTDEBUG
	POPJ	P,		; And return it to the caller
; Here if we can leave the string where it is.

M$XP.2:	CFMN.	,BLKEND,(P1),P3	; Expanding from the end of the buffer?
	 JRST	M$XP.4		; Yes, skip this
	MOVE	T1,P2		; Get the amount being
	IDIVI	T1,5		; Check if inserting multiple of 5 chars
	JUMPE	T2,M$XP.8	; If so, we can use the POP loop
	MOVX	T1,<POINT 0,-1(T3),^D34> ; Get the initial byte pointer
	MOVEM	T1,XPNPTR	; Store it
	XMOVEI	P4,1(P)		; Get the address of the code
IFN FTKL,ADJSP	P,NEXLP		; Make room on the stack for the routine
IFN FTKI,ADD	P,[XWD NEXLP,NEXLP] ; Adjust the stack
	HRLI	T1,EXLP		; Get the address
	HRRI	T1,(P4)		; And where to put it
	BLT	T1,(P)		; Put the code on the stack
	HRRM	P4,EXLP.5(P4)	; Store the address for the loop
	MOVE	T3,P3		; Get the pointer
	IDIVI	T3,5		; Make word/char index
	ADDI	T3,.BKTLN(P1)	; Make it an abs address
	HRRM	T3,EXLP.1(P4)	; Save the address
	MOVNI	T4,-5(T4)	; Make the size for the final store
	IMULI	T4,7		; Mul by the number of bits per character
	STOR	T4,XPNPTR,BP.SFL ; Store the item in the size field
	MOVE	T1,P2		; Get the amount to move
	IDIVI	T1,5		; Make it the number of words/chars
	IMULI	T2,-7		; remainder times seven for number of bits
	HRRM	T2,EXLP.2(P4)	; Store the amount to shift
	ADDI	T2,^D35		; Get the amount left to shift the rest
	MOVN	T2,T2		; Make it positive
	HRRM	T2,EXLP.4(P4)	; Store it
	ADDI	T1,1(T3)	; Increment
	HRRM	T1,EXLP.3(P4)	; Store the address to store to
; Now calculate the number of times we must loop

	LOAD.	T3,BLKEND,(P1)	; Get the end
	IDIVI	T3,5		; Convert to word/char
	MOVE	T1,P3		; Get the address of the first one
	IDIVI	T1,5		; Make it the word address
	SUB	T3,T1		; And make the number of words to move
	LOAD.	T1,BLKEND,(P1)	; Get the end back
	ADD	T1,P2		; Make the new end
	IDIVI	T1,5		; And check if we are rotating out of the last word
	JUMPN	T2,M$XP.7	; Zero chars extra here?
	MOVEI	T2,5		; Yes, make that five as well
	JUMPN	T4,M$XP.7	; Also zero chars left after old end?
	SOJ	T3,		; Yes, need one less loop iteration

M$XP.7:	CAILE	T4,(T2)		; Will we be shifting it out?
	 ADDI	T3,1		; Yes, need one more
	MOVE	T2,@EXLP.1(P4)	; Compute the address
	JRST	EXLP.5(P4)	; Enter the loop
; The following is the code used to move characters up.
;
;LP:	MOVE	T1,<PT/5>(T3)	; Get a word
;	ROT	T1,-1		; Get rid of the extra bit
;	ROTC	T1,-7*<# chars to insert>/5 ; Move chars down into T2
;	MOVEM	T2,<<PT/5>+<# chars to insert>/5>(T3)
;	ROTC	T1,-<35-7*<# chars to insert>/5>
;	SOJGE	T3,LP		; Loop for <<END/5>-<PT/5>> + 1 if
;				;  REM(<<# to insert>+END>/5) > REM(PT/5)
;

EXLP:	PHASE	0		; Code for moving text up

EXLP.1:!MOVE	T1,.-.(T3)	; Get the low order portion
	ROT	T1,-1		; Shift to get rid of the extra bit
EXLP.2:!ROTC	T1,.-.		; Move into the other word
	TXZ	T2,1		; Make sure the random bit is off
EXLP.3:!MOVEM	T2,.-.(T3)	; Store the word
EXLP.4:!ROTC	T1,.-.		; Rotate the rest of the way
EXLP.5:!SOJGE	T3,.-.		; Loop until done
	JRST	M$XP.3		; Continue on

	DEPHASE			; Back to real addresses
NEXLP==.-EXLP			; Length of the loop
; Here to use the POP loop to move the text. This is only when
;a multiple of 5 characters are being inserted. Enter with the
;number of words being inserted in T1.

M$XP.8:	HRLI	T1,(POP T2,(T2)) ; Get the instruction into the AC
	LOAD.	T2,BLKEND,(P1)	; Get the old end
	SOJ	T2,		; Minus one
	IDIVI	T2,5		; Convert to word offset
	MOVE	T3,P3		; Get the PT where the insert is
	SOJ	T3,		; Account for starting at 0
	IDIVI	T3,5		; And make the word offset to it
	MOVE	T4,T2		; Get a copy of the address
	SUB	T4,T3		; Get the number of words we are moving
	ADDI	T2,.BKTLN(P1)	; Point to the first word to move
	HRLI	T2,(T4)		; Set up counter portion of stack pointer
	TXCN	T2,1B0		;  .  .  .
	XCT	T1		; And move the text
	JUMPL	T2,.-1		;  .  .  .
	JRST	M$XP.4		; All done, go fix up the header
M$XP.3:	PORTAL	.+1		; In case of EXO
	HRRZ	T3,EXLP.2(P4)	; Get the number
	ROTC	T1,^D35(T3)	; Move the characters around
	HRRZ	T3,EXLP.3(P4)	; Get the address to deposit into
	DPB	T1,XPNPTR	; Store the information
IFN FTDEBUG,<
	SETZM	XPNPTR		; Clear the pointer to prevent MUP stopcodes
> ; End of IFN FTDEBUG
	ADJSP	P,-NEXLP	; Fix the stack pointer
M$XP.4:	LOAD.	T1,BLKEND,(P1)	; Get the end
	ADD	T1,P2		; Plus the new char
	STOR.	T1,BLKEND,(P1)	; And store the new end
	MOVE	T1,P1		; Get the address of the buffer back
	LOAD.	T2,BLKFRE,(P1)	; Fix up the number free
	SUB	T2,P2		;  .  .  .
	STOR.	T2,BLKFRE,(P1)	;  .  .  .
IFN FTDEBUG,<
	PUSHJ	P,M$CFRE	; Check the text blocks
>; End of IFN FTDEBUG
	POPJ	P,		; And return it to the caller
	SUBTTL	M$XMOV - Routine to expand a movable block

;+
;.hl1 M$XMOV
; This routine is called to expand a general movable block.  This type
;of block is only pointed to be the TPT list, and contains no data which
;is address dependent.  Therefore it can be easily moved if necessary in order
;to expand it.
;.lit
;
; Usage:
;	LOAD.	T1,TPTADR,address.of.TPT to block
;	MOVE	T2,Number of words to expand
;	MOVE	T3,Index to first word to move down
;	PUSHJ	P,M$XMOV
;	 (return here always, T1= address of block (may have changed))
;
;.end lit
;-

M$XMOV:	JUMPE	T2,.POPJ	; All done if nothing
IFN FTDEBUG,<
	PUSHJ	P,M$CFRE	; Check things out
> ; End of IFN FTDEBUG
	$SAVE	<P1,P2,P3,P4>	; Save some ac's to use
	MOVE	P1,T1		; Get the address of the block
	DMOVE	P2,T2		; Get how much to expand and where
	LOAD.	P4,BLKSIZ,(T1)	; Get the size of the block
	LOAD.	T4,BLKFRW,(T1)	; And the number of free words
	SUB	P4,T4		; Get the actual size of the block
	PUSHJ	P,M$APPD	; Append some space to the block
	 JRST	MXMO.M		; Block was moved, we must move the contents
	CAML	P3,P4		; Have something to move?
	 POPJ	P,		; No, all done
	MOVE	P1,T1		; Get the new address
	MOVE	T2,P4		; Get the size of the block
	ADD	T2,P1		; Point to the last word
	MOVE	T1,P3		; Get the offset to the insertion point
	SUB	T1,P4		; And get the number of words to move (negative)
	MOVE	T3,T2		; Get a copy of the old address
	ADD	T3,P2		; And determine the new address
	PUSHJ	P,M$MCOR	; Move the data

	MOVE	T1,P1		; Get the address of the buffer back
	POPJ	P,		; And return
; Here if the call to M$APPD caused the block to be moved.
; Ac usage on entry:
;	T1/ Old.block.address
;	T2/ Number of words being inserted
;	T3/ New.block.address
;	P3/ Offset to insertion

MXMO.M:	DMOVE	P1,T1		; Get the returned values
	MOVE	P4,T3		;  .  .  .
	MOVE	T1,P3		; Get the offset to the first word
	SUBX	T1,.BKMLN	; Minus the overhead
	XMOVEI	T2,.BKMLN(P1)	; Get the starting address
	XMOVEI	T3,.BKMLN(P4)	; And the new address
	PUSHJ	P,M$MCOR	; Move the data
	LOAD.	T1,BLKSIZ,(P1)	; Get the size of the old block
	LOAD.	T2,BLKFRW,(P1)	; And the number of free words
	SUB	T1,T2		; Determine the size that was in use
	SUB	T1,P3		; And the amount past the insert position
	XMOVEI	T2,.BKMLN(P1)	; Get the starting address
	ADD	T2,P3		;  .  .  .
	XMOVEI	T3,.BKMLN(P4)	; And the new address
	ADD	T3,P3		;  .  .  .
	ADD	T3,P2		;  .  .  .
	PUSHJ	P,M$MCOR	; Move the data

	XMOVEI	T1,.BKLEN(P1)	; Get the address of the first word past the header
	PUSHJ	P,M$RBLK	; And return the old block

	MOVE	T1,P4		; Get the new address
	POPJ	P,		; And return
	SUBTTL	M$APPD - Routine to append to a movable block

;+
;.hl1 M$APPD
; This routine will append space to a movable block.  It may be called
;for any type of movable block.
;.lit
;
; Usage:
;	T1/ Address of block
;	T2/ Number of words to expand
;	T3/ Data to be passed to subroutine in ac P3
;	PUSHJ	P,M$APPD
;	 (non-skip return, block was moved, new address in T1)
;	(skip return, block was not moved, block address still in T1)
;
;.end lit
; On the non-skip return, the ac's will be as follows:
;.lit
;
;	T1/ Address of old block
;	T2/ Number of words being expanded
;	T3/ Address of new block
;
;.end lit
;-

M$APPD:	JUMPE	T2,.POPJ	; Just return if nothing to add
	$SAVE	<P1,P2,P3>	; Save some ac's
	DMOVE	P1,T1		; And copy the arguments
IFN FTDEBUG,<
	PUSHJ	P,M$CFRE	; Check out the block list
> ; End of IFN FTDEBUG

MAPP.0:	LOAD.	T2,BLKFRW,(P1)	; Get the amount free in this block
	CAMGE	T2,P2		; Have enough?
	 JRST	MAPP.1		; No, must look for more
	SUB	T2,P2		; Yes, decrement the count of free words
	STOR.	T2,BLKFRW,(P1)	; Store it back
	ADD	T2,P2		; Get the old amount free back
	LOAD.	T3,BLKSIZ,(P1)	; And get the size
	SUB	T3,T2		; Get the amount actually used
	MOVE	T1,P2		; Get the amount to clear
	MOVE	T2,P1		; And get the address to start at
	ADD	T2,T3		;  .  .  .
	PUSHJ	P,.ZCHNK	; Clear it out

	DMOVE	T1,P1		; Get the address back
	PJRST	.POPJ1		; And give the skip return

; Here if the block does not contain enough free space to allow for
;expansion.  Check if the next block is free, and try again.

MAPP.1:	MOVX	T3,BF.LST	; Check if the last block here
	TDNE	T3,.BKFLG(P1)	; Is it?
	 JRST	MAPP.L		; Yes, go handle it
	LOAD.	T1,BLKSIZ,(P1)	; No, get the size of this block
	ADD	T1,P1		; And determine the address of the next
	CFXE.	T3,BLKTYP,(T1),.BTJNK ; Is it junk?
	 JRST	MAPP.2		; No, must do things the hard way
	LOAD.	T3,BLKSIZ,(T1)	; Yes, get the size
	ADD	T2,T3		; Determine the new amount free
	LOAD.	T4,BLKSIZ,(P1)	; Get the size of the current block
	ADD	T3,T4		; And make the new total
	STOR.	T3,BLKSIZ,(P1)	; Store in the new size
	STOR.	T2,BLKFRW,(P1)	; And number of free words
	LOAD.	T3,BLKNXT,(T1)	; Get the next page address
	STOR.	T3,BLKNXT,(P1)	; Copy it
	LOAD	T3,.BKFLG(T1),BF.LST	; Get the last block flag
	STOR	T3,.BKFLG(P1),BF.LST	; Store it
	JRST	MAPP.0		; And check if we have enough

; Here if the block is at the end of core.  We can just add the memory to
;our address space (maybe), and make it part of this block.

MAPP.L:	LOAD.	T1,BLKSIZ,(P1)	; Get the size of the block
	LOAD.	T2,BLKFRW,(P1)	; And the amount free
	SUB	T1,T2		; Get the number of words in use
	ADD	T1,P2		; Get the number we will want
	ADD	T1,P1		; And get the new final address +1
	MOVE	T2,T1		; Get a copy
	SOJ	T2,		; Minus one to be the address we really want
	CAMG	T2,.JBREL	; Need to expand at all?
	 JRST	MAPP.M		; No, go do it
	CAIL	T2,HIGH##	; Will this overlap with the high segment?
	  ERROR	E.COR		; Yes, punt
	ADR2PG	T2		; Make this a page number
	LOAD.	T1,BLKSIZ,(P1)	; Get the size of the block
	ADD	T1,P1		; Point to the end of the block
	SUBI	T1,1		; Point to the last word in the block
	ADR2PG	T1		; Make this a page number
	SUB	T2,T1		; Compute the number of pages to allocate
	ADDI	T1,1		; Point to the first page we are allocating
	PUSHJ	P,M$CPGS	; Create the pages
	  ERROR	E.COR		; Failed
	MOVE	T1,.JBREL	; Get the new end of core
	AOJ	T1,		; Plus one to point at first free past end
MAPP.M:	MOVEM	T1,.JBFF	; No, store new first free
	SUB	T1,P1		; Get the new size of the block
	LOAD.	T2,BLKSIZ,(P1)	; Get the old size
	STOR.	T1,BLKSIZ,(P1)	; And store the new size
	SUB	T1,T2		; Get the amount we are adding
	LOAD.	T2,BLKFRW,(P1)	; Get the current number free
	ADD	T2,T1		; Get the new amount
	STOR.	T2,BLKFRW,(P1)	; Store it
	JRST	MAPP.0		; Go try again
; Here if we need to move the block somewhere else in order to expand it.
;Get a new block large enough for the entire amount needed.

MAPP.2:	ADJSP	XS,$XSCLN	; Allocate the pointer
	STORI.	$XEMEM,T1,XSBTYP,(XS) ; Store the type
	XMOVEI	T2,$XSBUF(XS)	; Get the address of the pointer
	MOVE	T1,P1		; And of the buffer
IFN FTDEBUG,SETZM (T2)		; Clear the point so we don't punt
	PUSHJ	P,M$USEB	; Set up the pointer
	LOAD.	T1,BLKSIZ,(P1)	; Get the current size of the block
	LOAD.	T2,BLKFRW,(P1)	; And the amount free
	SUB	T1,T2		; Get the actual size
	ADD	T1,P2		; And determine the amount we need
	LOAD.	T2,BLKTYP,(P1)	; Get the correct block type
	SUBX	T1,.BKLEN	; Take off the overhead (M$GBLK adds it back)
	PUSHJ	P,M$ZBLK	; And get a block
	SUBX	T1,.BKLEN	; Get the actual address
	MOVE	P3,T1		; Get the address of the new block
	LOAD.	P1,TPTADR,+$XSBUF(XS) ; And the address of the old
	XMOVEI	T1,$XSBUF(XS)	; Get the address of the pointer
	PUSHJ	P,M$RELB	; Release the pointer
	ADJSP	XS,-$XSCLN	; Remove the junk from the stack
	MOVE	T1,P3		; Get the address of the new block
	LOAD.	T2,BLKADR,(P1)	; Get the address of the TPT's
	STOR.	T2,BLKADR,(T1)	; Store in the new block
	PUSHJ	P,FIXPTR	; Fix them up
	ZERO.	,BLKADR,(P1)	; Clear the TPT address in the old block
	DMOVE	T1,P1		; Get the return values
	MOVE	T3,P3		;  .  .  .
	POPJ	P,		; And return
	SUBTTL	M$SRNK - Routine to shrink a buffer

;+
;.HL1 M$SRNK
; This routine will shrink a text buffer by removing a number of characters
;from just after the pointer.  It will move the characters from the end of the
;buffer down.
;.b
;.literal
; Usage:
;	MOVE	T1,Text.buffer.address
;	MOVE	T2,Number.of.characters
;	MOVE	T3,Offset.for.pointer
;	PUSHJ	P,M$SRNK
;	(return here)
;.end literal
;-

M$SRNK:
	JUMPE	T2,.POPJ	; Just return if nothing to do
IFN FTDEBUG,<
	PUSHJ	P,M$CFRE	; Check the text blocks
>; End of IFN FTDEBUG
	$SAVE	<P1,P2,P3,P4>	; Save some room to work
	DMOVE	P1,T1		; Copy the address and number of chars
	MOVE	P3,T3		; Get the pointer
	ADD	T2,T3		; Get the destinaion
	IDIVI	T2,5		; And make the byte pointer
	HLL	T2,BTAB-1(T3)	;  .  .  .
	ADDX	T1,.BKTLN	; Point to the text
	ADD	T1,T2		; Make the byte pointer
	MOVE	T2,P3		; And the pointer to start at
	IDIVI	T2,5		; Convert to index plus byte number
	HLL	T2,BTAB-1(T3)	; Make the byte pointer
	ADDI	T2,.BKTLN(P1)	; Point to the place to move to
	LOAD.	T3,BLKEND,(P1)	; Get the end pointer
	SUB	T3,P3		; Get the number of chars to move
	SUB	T3,P2		; Don't need to move the ones we are deleting
	PUSHJ	P,M$MSTR	; Move the string
	LOAD.	T1,BLKEND,(P1)	; Calculate the new end
	SUB	T1,P2		;  .  .  .
	STOR.	T1,BLKEND,(P1)	; And save it
	LOAD.	T1,BLKFRE,(P1)	; Get the number of free chars already there
	ADD	T1,P2		; Plus the number deleted
	STOR.	T1,BLKFRE,(P1)	; Save the new free char count
IFN FTDEBUG,<
	PUSHJ	P,M$CFRE	; Check the text blocks
>; End of IFN FTDEBUG
	CAXGE	T1,D.MXFR	; More than the max we want to leave here?
	 POPJ	P,		; Return if not too many free
	IDIVI	T1,5		; Get the number of words we can steal
	STOR.	T2,BLKFRE,(P1)	; Save the new free count
	LOAD.	T2,BLKSIZ,(P1)	; Get the size
	SUB	T2,T1		; Make the new size
	STOR.	T2,BLKSIZ,(P1)	; Store the size
	ADD	T2,P1		; Point to the new block
	STORI.	.BTJNK,T3,BLKTYP,(T2) ; Store the block type
	STOR.	T1,BLKSIZ,(T2)	; Save the size
	LOAD.	T1,BLKNXT,(P1)	; Get the next pointer
	STOR.	T1,BLKNXT,(T2)	; Store it
	ZERO.	T1,BLKFLG,(T2)	; Clear the flags
	MOVX	T1,BF.LST	; Get the last in page bit
	TDNE	T1,.BKFLG(P1)	; Is the old one the last?
	 IORM	T1,.BKFLG(T2)	; Yes, now the new one is
	ANDCAM	T1,.BKFLG(P1)	; Clear the last bit in case
IFN FTDEBUG,<
	PUSHJ	P,M$CFRE	; Check the text blocks
>; End of IFN FTDEBUG
	POPJ	P,		; Return
	SUBTTL	M$ACHR - Subroutine to append a character to a buffer

;+
;.hl1 M$ACHR
; This routine is used to append a single character to the a buffer.
;.lit
;
; Usage:
;	MOVEI	CH,Character
;	MOVEI	T1,TPT.address
;	PUSHJ	P,M$ACHR
;	 (Return here)
;
;.end lit
;-


M$ACHR:	$SAVE	<P1,P2>		; Save P1/2
	MOVE	P1,T1		; Get the address of the TPT
	LOAD.	P2,TPTADR,(P1)	; Get the address of the buffer
	SOSGE	.BKFRE(P2)	; Any characters free
	 JRST	MACH.1		; No, need to expand it first
	INCR.	,BLKPT,(P2)	; Increment the count of characters
	LOAD.	T1,BLKEND,(P2)	; Get the current end
	INCR.	,BLKEND,(P2)	; And increment it
	BLDBPT	(T1,(P2))	; Build a byte pointer
	IDPB	CH,T1		; Store the character
	POPJ	P,		; And return

; Here if the block needs to be expanded.

MACH.1:	ZERO.	,BLKFRE,(P2)	; Reset the free count
	MOVE	T1,P2		; Get the address of the buffer
	MOVEI	T2,1		; One character
	LOAD.	T3,BLKEND,(P2)	; At the end of the buffer
	PUSHJ	P,M$XPND	; Expand it
	LOAD.	T2,BLKEND,(T1)	; Get the new end
	STOR.	T2,BLKPT,(T1)	; Fix up PT
	SOJ	T2,		; Make it the previous character
	BLDBPT	(T2,(T1))	; Build the pointer
	IDPB	CH,T2		; Store the character
	POPJ	P,		; And return
	SUBTTL	M$INSS - Routine to insert a string into a buffer

;+
;.Hl1 M$INSS
; This routine will copy a string into a buffer.
;.b
;.literal
; Usage:
;	MOVE	T1,Source.byte.pointer
;	MOVE	T2,Source.byte.count
;	MOVE	T3,Text.buffer.address
;	MOVE	T4,Address.of.TPT.pointer.for.source (or zero if source will not move)
;	PUSHJ	P,M$INSS
;	 (return here, T1=Offset to end of new string within buffer)
;.end literal
;-

M$INSS:	$SAVE	<P1,P2,P3,P4>	; Save the Px ac's
	DMOVE	P1,T1		; And copy the args
	DMOVE	P3,T3		;  .  .  .
	JUMPE	P4,M$IN.1	; Source may move?
	LOAD.	T1,TPTADR,(P4)	; Yes, get the address of the buffer
	SUBI	P1,(T1)		; And make the byte pointer relative to the start of the buffer
M$IN.1:	MOVE	T1,T3		; Set up to expand the buffer
	LOAD.	T3,BLKPT,(P3)	; Get the place to insert the string
	PUSHJ	P,M$XPND	; Do it
	MOVE	P3,T1		; Update the buffer address
	JUMPE	P4,M$IN.2	; Need to fix the byte pointer back?
	LOAD.	T1,TPTADR,(P4)	; Yes, get the address
	ADDI	P1,(T1)		; And fix it
M$IN.2:	MOVE	T1,P1		; Get the source byte pointer
	LOAD.	T2,BLKPT,(P3)	; Get the place to insert at
	IDIVI	T2,5		; Convert to word index and position within word
	ADDI	T2,.BKTLN(P3)	; Make the address
	HLL	T2,BTAB-1(T3)	; Set the other half of the byte pointer
	MOVE	T3,P2		; Get the character count
	PUSHJ	P,M$MSTR	; Move the string
	LOAD.	T1,BLKPT,(P3)	; Get the pointer
	ADD	T1,P2		; Plus the string length gives new pointer
	POPJ	P,		; Return it
	SUBTTL	M$USEB - Routine to add a user to a block

;+
;.Hl1 M$USEB
; This routine is called to add a pointer to a block.
;.b
;.literal
; Usage:
;	MOVE	T1,Text.buffer.address
;	MOVE	T2,Pointer.address
;	PUSHJ	P,M$USEB
;	 (return here)	; Pointer now pointing at the text buffer
;.end literal
;-

M$USEB:	$SAVE	<P1>		; Save P1
IFN FTDEBUG,<
	SKIPE	(T2)		; Have something here already?
	 STOPCD	MUP,<Multiple use of text pointer>
> ; End of IFN FTDEBUG
	STOR.	T1,TPTADR,(T2)	; Save the buffer address in the pointer
	LOAD.	P1,BLKADR,(T1)	; Get the address of the pointer list
	STOR.	T2,BLKADR,(T1)	; Store the new one
	STOR.	P1,TPTNXT,(T2)	; And store the next pointer
	POPJ	P,		; Return
	SUBTTL	M$RELB - Routine to delete a user from a block

;+
;.Hl1 M$RELB and M$RTPT
; These routines are called to remove a pointer to a block.  M$RELB
;will also delete the block if there are no pointers left that point
;to it.
;.b
;.literal
; Usage:
;	MOVE	T1,Pointer.address
;	PUSHJ	P,M$RELB
;	 (return here)	; Pointer now zero
;.end literal
;-

M$RTPT:	TDZA	T2,T2		; Flag to not return the block
M$RELB:	 SETO	T2,		; Flag to return the block if no one left
	$SAVE	<P1,P2,P3>	; Save P1/P2
	MOVE	P3,T2		; Save the flag
	MOVE	P1,T1		; Save the args
	LOAD.	P2,TPTADR,(P1)	; Get the address of the text buffer
	LOAD.	T1,BLKADR,(P2)	; Get the address of the first block
	SETZ	T2,		; Clear the last pointer

M$RE.1:	CAMN	T1,P1		; Is this the right pointer?
	 JRST	M$RE.2		; Yes
	MOVE	T2,T1		; Remember the last pointer
	LOAD.	T1,TPTNXT,(T1)	; And get the next one
IFE FTDEBUG,JRST M$RE.1		; Loop until we find it
IFN FTDEBUG,<
	JUMPN	T1,M$RE.1	; Check if pointer is okay
	STOPCD	PTZ,<Text pointer pointing to zero>
> ; End of IFN FTDEBUG

M$RE.2:	LOAD.	T1,TPTNXT,(P1)	; Get the next pointer from the callers
	ZERO.	,TPTADR,(P1)	; Clear the pointer
	ZERO.	,TPTNXT,(P1)	;  .  .  .
	JUMPE	T2,M$RE.3	; Need to fix the block itself?
	STOR.	T1,TPTNXT,(T2)	; No, fix the next pointer on the previous one
	POPJ	P,		; Return

; Here if the pointer in the text block needs to be fixed. Check if we can
;delete this block.

M$RE.3:	STOR.	T1,BLKADR,(P2)	; Update the block pointer
	JUMPN	T1,.POPJ	; If we have a real pointer, just return
	JUMPE	P3,.POPJ	; Return if M$RTPT entry point
	MOVE	T1,P2		; Get the address to delete
	LOAD.	T2,BLKTYP,(P2)	; Get the block type
	PJRST	@RLBTBL(T2)	; And return the block

; Table of routines to return blocks

TABDEF	RLB,.BT,<IFIW DBLK.0>
 TABENT	SYM,<IFIW DSYM.0>	; Delete a symbol table entry
 TABENT	TXT,<IFIW DTXT.0>
 TABENT	CND,<IFIW DCND.0>
 TABENT	CTB,<IFIW DCTB.0>
TABEND
	SUBTTL	Linked list -- M$ULNK - Routine to unlink a block

;+
;.hl1 M$ULNK
;This routine will unlink a block from a linked list.  It will return the
;address of the block that was unlinked.
;.literal
;
; Usage:
;	T1/ Address of the block to unlink
;	T2/ Offset to the LNK pointers
;	PUSHJ	P,M$ULNK
;	(Return)
;
; On return:
;	T1/ Address of the block that was unlinked.
;
;.end literal
;-

M$ULNK:	PUSHJ	P,UNLINK		; Unlink the block
	LOAD.	T2,BLKTYP,(T1)		; Get the block type
	PJRST	@RBKTBL(T2)		; Go release the block

; Table of routines to return blocks

TABDEF	RBK,.BT,<IFIW DELBLK>
 TABENT	SYM,<IFIW DELSYM>		; Delete a symbol table entry
 TABENT	TXT,<IFIW DELTXT>		; Delete a text block
 TABENT	CND,<IFIW DELCND>
 TABENT	CTB,<IFIW M$DCTB>
TABEND
	SUBTTL	Linked list -- M$MLNK - Move an item from one list to another

;+
;.hl1 M$MLNK
;This rutine will move a block rom one linked list to another.  It will
;first unlink the block from the first list then it will link it into the
;other.
;.literal
;
; Usage:
;	T1/ Address o the block to move
;	T2/ Offset of the LNK pinter to unlink from
;	T3/ Address of block to link in before
;	T4/ Offset of the new LNK pointers
;	PUSHJ	P,M$MLNK
;	(Return)
;
; On return:
;	- Block linked in
;
;.end literal
;-

M$MLNK:	PUSHJ	P,UNLINK		; Unlink this block from the list
	MOVE	T2,T4			; Get the new LNK offset
	FALL	M$LINK			; Fall into M$LINK
	SUBTTL	Linked list -- M$LINK - Routine to add a block to a linked list

;+
;.HL1 M$LINK
; This routine will link in a block into a linked list.  It will set up
;the forward and back pointers correctly.
;.literal
;
; Usage:
;	T1/ Address of block to link in
;	T2/ Offset to the LNK pointers
;	T3/ Address of block to link in before
;	PUSHJ	P,M$LINK
;	(Return)
;
; On return:
;	T1/ Address of the blocked listed in
;
;.end literal
;-

M$LINK:	MOVE	T4,T1			; Copy this address
	ADD	T4,T2			; Point to the link pointers
	STOR.	T3,LNKPRV,(T4)		; Store the pointer to the previous
	ADD	T3,T2			; Point to the link pointers
	PUSH	P,T3			; Save the address of the pointer
	LOAD.	T3,LNKNXT,(T3)		; Get the address of the next
	STOR.	T3,LNKNXT,(T4)		; Point to that too
	POP	P,T4			; Get the pointer address back
	STOR.	T1,LNKNXT,(T4)		; And store the new next pointer
	JUMPE	T3,.POPJ		; Return if end of list
	ADD	T3,T2			; Point to the LNK word
	STOR.	T1,LNKPRV,(T3)		; Store the pointers
	POPJ	P,			; Return to the caller
	SUBTTL	Linked list -- UNLINK - General unlink this block routine

;+
;.hl1 UNLINK
;This routine will unlink a block from the list that it currently is attached
;to.  It will not smash any registers.
;.literal
;
; Usage:
;	T1/ Block address
;	T2/ LNK pointers offset
;	PUSHJ	P,UNLINK
;	(return)
;
; On return:
;	- Block unlinked, all registers preserved.
;
;.end literal
;-

UNLINK:	$SAVE	<T1,T2,T3,T4>		; Save Tn over this call
	ADD	T1,T2			; Get the address of the pointers
	LOAD.	T3,LNKPRV,(T1)		; Get the address of the previous block
	JUMPE	T3,[STOPCD PBH,<Previous block is the header>]
	ADD	T3,T2			; Point to the links
	LOAD.	T4,LNKNXT,(T1)		; Get the address of the next block
	STOR.	T4,LNKNXT,(T3)		; Store the pointer to the next
	ZERO.	,LNKNXT,(T1)		; Clear out the old info
	ZERO.	,LNKPRV,(T1)		;  .  .  .
	JUMPE	T4,.POPJ		; Just return if no next to fix
	ADD	T4,T2			; Point to the offset
	SUB	T3,T2			; Get the address we are supposed to store
	STOR.	T3,LNKPRV,(T4)		; No, Store the pointer this way too
	POPJ	P,			; Return to the caller
	SUBTTL	M$CFRE - Check the free counts of text blocks

;+
;.HL1 M$CFRE
;This routine will check the text blocks to see if they contain valid
;character counts.
;.literal
;
; Usage:
;	PUSHJ	P,M$CFRE
;	(Return)
;
;.end literal
;-

IFN FTDEBUG,<
M$CFRE:	PUSH	P,[EXP	M$CF.2]	; Save the exit routine address
	$SAVE	<T1,P1,P2,P3,P4> ; Save some ac's
	MOVE	P1,FSTBLK	; Get the address of the first block
	MOVEI	T1,FSTBLK	; Flag we are working from first block

M$CF.1:	SKIPN	(P1)		; Bad block?
	 STOPCD	BLS,<Block list screwed up>
	LOAD.	P2,BLKTYP,(P1)	; Get the block type
	CAXLE	P2,.BTMAX	; Reasonable value?
	 STOPCD	BTO,<Block type out of range>
	CAXE	P2,.BTTXT	; Is this a text block?
	 JRST	M$CF.0		; No - Skip to the next block
	LOAD.	P2,BLKFRE,(P1)	; Get the number of characters that are free
	LOAD.	P3,BLKEND,(P1)	; Get the number at the end
	ADD	P2,P3		; Add to get the total in the block
	LOAD.	P3,BLKSIZ,(P1)	; Get the size of the block
	SUBX	P3,.BKTLN	; Minus the overhead words
	LOAD.	P4,BLKFRW,(P1)	; Get the number of free words here as well
	SUB	P3,P4		; And get the amount actually in use
	IMULX	P3,5		; Mul by 5 to get the number of characters
	CAME	P2,P3		; Which should match the calculated
	 STOPCD	BSM,<Block size messed up>

M$CF.0:	MOVX	P2,BF.LST	; Check for the last block
	TDNE	P2,.BKFLG(P1)	; Is this the last block ?
	 POPJ	P,		; And return
	LOAD.	P2,BLKSIZ,(P1)	; Get the block size again
	SKIPN	P2		; Is it ok?
	 STOPCD	CFB,<M$CFRE found a zero block>
	MOVE	T1,P1		; Remember this block in case it messes up next
	ADD	P1,P2		; Point to the next block
	JRST	M$CF.1		; Loop for the next block

; Here when we have done the whole list.  This means that everthing is fine
;and we should remember where we came from.  We will save the entire stack
;context to make back tracking easier (a little expensive in space, but it
;should save some debugging time).

M$CF.2:	MOVEM	0,CFRSAC	; Save ac 0
	MOVE	0,[XWD 1,CFRSAC+1] ; And set up to save the rest
	BLT	0,CFRSAC+17	; Save them all
	MOVE	0,P		; Get the current stack pointer
	SUBI	0,PDL		; Make it the offset
	ADDI	0,CFRPDL	; And convert to our saved copy
	MOVEM	0,CFRSAC+P	; Save it that way
	MOVE	0,[XWD PDL,CFRPDL] ; Set up to copy the stack
	BLT	0,CFRPDL+D.PDLL-1 ; Copy the whole stack
	MOVE	0,CFRSAC	; Restore 0
	POPJ	P,		; And return
>; End of IFN FTDEBUG
	SUBTTL	FNDBLK - Routine to find a given size block

;+
;.hl1 FNDBLK
; This routine will find a junk block of at least the given size.
;.b
;.literal
; Usage:
;	MOVEI	P1,Number.of.words
;	PUSHJ	P,FNDBLK	; Find the block
;	 (Return with T1= address of block)
;
;.end literal
;-

FNDBLK:	MOVE	T1,FSTBLK	; Get the pointer to the first block
FNDB.0:	CFXE.	T2,BLKTYP,(T1),.BTJNK ; Junk block?
	 JRST	FNDB.1		; No, try the next
	LOAD.	T2,BLKSIZ,(T1)	; Yes, get the size
	CAML	T2,P1		; Large enough?
	 POPJ	P,		; And return

; Here to advance to the next block

FNDB.1:	MOVX	T3,BF.LST	; Is this the last block on a page?
	TDNE	T3,.BKFLG(T1)	;  .  .  .
	 JRST	FNDB.2		; No, get next block on this page
	LOAD.	T2,BLKSIZ,(T1)	; Get the size
IFN FTDEBUG,<
	JUMPG	T2,.+2		; Size okay?
	 STOPCD	FZB,<FNDBLK found a zero length block>
> ; End of IFN FTDEBUG
	ADD	T1,T2		; Point to the next block
	JRST	FNDB.0		; And try this one

FNDB.2:	LOAD.	T1,BLKNXT,(T1)	; Yes, get the next page number
	JUMPE	T1,.POPJ1	; Give not found return
	PG2ADR	T1		; Convert to an address
	JRST	FNDB.0		; Go try this block
	SUBTTL	M$CBLK - Routine to create a block of the given size

;+
;.Hl1 M$CBLK
; This routine will request core from the monitor and create a block
;of the given size. Any extra core will be made into a junk block.
;.b
;.literal
; Usage:
;	MOVEI	P1,Number.of.words
;	PUSHJ	P,M$CBLK
;	 (return, T1= address of block)
;
;.end literal
;-

M$CBLK:	MOVE	T1,FSTBLK	; Get the address of the first block
	MOVX	T2,BF.LST	; Get the last on page flag
M$CB.0:	TDNE	T2,.BKFLG(T1)	; Is this the last block before a hole?
	 JRST	M$CB.1		; Yes, get the next block
	LOAD.	T3,BLKSIZ,(T1)	; No, get the size
IFN FTDEBUG,<
	JUMPG	T3,.+2		; Skip if size is valid
	 STOPCD	CZB,<M$CBLK found a zero length block>
> ; End of IFN FTDEBUG
	ADD	T1,T3		; And point to the next
	JRST	M$CB.0		; Loop

M$CB.1:	LOAD.	T3,BLKNXT,(T1)	; Get the next page number
	JUMPE	T3,M$CB.2	; No next page, this is the last block
	PG2ADR	T3		; Convert to an address
	MOVE	T1,T3		; And copy it
	JRST	M$CB.0		; Go through this page

M$CB.2:	PUSH	P,T1		; Save the block address
	CFXE.	T2,BLKTYP,(T1),.BTJNK ; Is this a junk block?
	 MOVE	T1,.JBFF	; No, use the end of core
	MOVE	T2,T1		; Copy the address of the block
	ADD	T1,P1		; Get the final address we need
	ADDX	T1,.BKLEN	;  .  .  .
	CAMG	T1,.JBREL	; Can we already address this?
	 JRST	M$CB.3		; Yes, just go use it
IFE FTXADR,<
	TXNE	T1,LH.ALF	; Falling into left half?
	  ERROR	E.COR		; Yes, give up
>; End of IFE FTXADR
	PUSH	P,T2		; Save this register
	ADR2PG	T1		; Make this a page number
	MOVE	T2,.JBREL	; Get the end of core
	ADR2PG	T2		; Convert this to a page number
	EXCH	T1,T2		; Move this into each other
	SUB	T2,T1		; Compute the number of pages
	ADDI	T1,1		; Account for the boundary
	PUSHJ	P,M$CPGS	; Create the pages
	  ERROR	E.COR		; Punt
	POP	P,T2		; Get the block address back

M$CB.3:	EXCH	T2,(P)		; Save on the stack
	BITOFF	T1,BF.LST,.BKFLG(T2) ; Clear the last block bit
	POP	P,T2		; And restore T2
	ZERO.	T1,BLKNXT,(T2)	; Clear the next pointer
	ZERO.	T1,BLKFLG,(T2)	; And the flags
	MOVE	T1,P1		; Get the size
	AOJ	T1,		; Bump it
	STOR.	T1,BLKSIZ,(T2)	; Store the size
	EXCH	T1,T2		; Swap the size and address
	ADD	T2,T1		; Get the address of the next block
	MOVE	T3,.JBREL	; Get the end of core
	AOJ	T3,		; Plus one
	MOVEM	T3,.JBFF	; Save as first free
	SUB	T3,T2		; Get the number left
	JUMPL	T3,M$CB.4	; Any left?
	STOR.	T3,BLKSIZ,(T2)	; Yes, store it
	ZERO.	T3,BLKFLG,(T2)	; clear the flags
	ZERO.	T3,BLKNXT,(T2)	; And the next pointer
	BITON	T3,BF.LST,.BKFLG(T2) ; Flag this is the last page
	STORI.	.BTJNK,T3,BLKTYP,(T2) ; Flag this is free
	POPJ	P,		; And return

M$CB.4:	BITON	T2,BF.LST,.BKFLG(T1) ; Flag this is the last block
	POPJ	P,		; Return
	SUBTTL	M$GC -- Main loop

;+
;.hl1 M$GC
;This routine will garbage collect all of the junk blocks into one position.
;This routine is hell on a paging system.
;.literal
;
; Usage:
;	PUSHJ	P,M$GC
;	(Return)
;
;.end literal
;-

M$GC:	$SAVE	<P1,P2,P3>		; Save a few registers
IFN FTDEBUG,PUSHJ	P,M$CFRE	; Make sure all is ok
	MOVE	P3,FSTBLK		; Start with the first block
	SETZB	P1,P2			; No junk block and size

; The following is the main loop in the GC processor

M$GC.0:	LOAD.	T1,BLKTYP,(P3)		; Get the block type of this
	JUMPN	P1,M$GC.1		; Have a junk block already?

; Here if we don't have a previous junk block.  Just dispatch on the block
; type to determine what we should do.

	SKIPE	T2,GCTBL(T1)		; Have a routine to call?
	  PUSHJ	P,(T2)			; Call the routine
	JRST	M$GC.N			; Advance to the next routine

; Here if there was a junk block before this block.

M$GC.1:	SKIPN	T2,GCJTBL(T1)		; Have a routine to call
	 MOVE	T2,[EXP IFIW!GCJOTH]	; No, use the default
	PUSHJ	P,(T2)			; Call the processing routine
	FALL	M$GC.N			; Advance to the next block

; Here to determine if there is a next block to process

M$GC.N:	MOVX	T1,BF.LST		; End of this list?
	TDNE	T1,.BKFLG(P3)		; . . .
IFE FTDEBUG,POPJ	P,			; Yes, All done
IFN FTDEBUG,PJRST	M$CFRE		; When done, check things out again
	LOAD.	T1,BLKSIZ,(P3)		; Get the size of the block
	ADD	P3,T1			; Point to the next block
	JRST	M$GC.0			; Loop and process
	SUBTTL	M$GC -- Dispatch tables

; The following dispatch table is for the processing of a block if the
; previous block was not a junk block.

TABDEF	GC,.BT
 TABENT	TXT,<IFIW GCTXT>		; Text blocks
 TABENT	JNK,<IFIW GCJNK>		; Junk blocks
 TABENT	CTB,<IFIW GCCTB>		; Command tables
 TABENT	CND,<IFIW GCCND>		; Command nodes
 TABENT	MOV,<IFIW GCMOV>		; General movable block
 TABENT	SYM,<IFIW GCSYM>		; Symbol table entries
TABEND

; The following dispatch table is for the processing of a block if the
; previous block was a junk block

TABDEF	GCJ,.BT
 TABENT	TXT,<IFIW GCJTXT>		; Text blocks
 TABENT	JNK,<IFIW GCJJNK>		; Junk blocks
 TABENT	CTB,<IFIW GCJCTB>		; Command tables
 TABENT	CND,<IFIW GCJCND>		; Command nodes
 TABENT	MOV,<IFIW GCJMOV>		; General movable block
 TABENT	SYM,<IFIW GCJSYM>		; Symbol table entries
TABEND
	SUBTTL	M$GC -- Previous not junk -- GCJNK - Junk block

;+
;.hl2 GCJNK
;This routine will process a junk block if the previous block was not a
;junk block.
;-

GCJNK:	MOVE	P1,P3			; Point to the junk block
	LOAD.	P2,BLKSIZ,(P1)		; Get the size of it
	POPJ	P,			; Return so that we can advance to the
					;  next block
	SUBTTL	M$GC -- Previous not junk -- GCMOV - General movable block
	SUBTTL	M$GC -- Previous not junk -- GCCTB - Command table
	SUBTTL	M$GC -- Previous not junk -- GCCND - Command node
	SUBTTL	M$GC -- Previous not junk -- GCSYM - Symbol table entry

;+
;.HL1 GCMOV, GCCTB, GCCND, GCSYM
;This routines are all the same.  They will create a junk block after the
;current block if possible.
;-

GCMOV:
GCCTB:
GCCND:
GCSYM:	LOAD.	T2,BLKFRW,(P3)		; Get the number of words free
	CAXL	T2,D.MXFW		; Too many free?
	  JRST	GCSPLT			; Yes, split the block
	TXNE	F,F.ECMD		; EC command ?
	 SKIPG	T2			; And at least one word?
	  POPJ	P,			; No, Just return
	JRST	GCSPLT			; Split the block
	SUBTTL	M$GC -- Previous not junk -- GCTXT - Text block

;+
;.hl2 GCTXT
;This routine will process a text block if the previous block was not a
;junk block.  This routine will determine if we should split the block
;into two different blocks because of a large number of characters free.
;-

GCTXT:	LOAD.	T2,BLKFRE,(P3)		; Get the number of characters free
	LOAD.	T3,BLKFRW,(P3)		; Get the number of free words
	IMULX	T3,5			; Compute the numbe of characters
	ADD	T2,T3			; . . .
	CAXL	T2,D.MXFR		; Too many?
	  JRST	GCTX.0			; Yes, split the block
	TXNE	F,F.ECMD		; Process an EC command?
	 CAIGE	T2,5			; More than one word free?
	  POPJ	P,			; Don't split this block

; Here if we are going to split this block.

GCTX.0:	IDIVI	T2,5			; Yes, T3 has number chars free
	STOR.	T3,BLKFRE,(P3)		; Store the new free count

; Here to split the blocks

GCSPLT:	ZERO.	,BLKFRW,(P3)		; Clear this
	LOAD.	T1,BLKSIZ,(P3)		; Get the oodl size
	SUB	T1,T2			; Make the new size
	STOR.	T1,BLKSIZ,(P3)		;  .  .  .
	ADD	T1,P3			; Make the pointer to the new block
	STORI.	.BTJNK,T3,BLKTYP,(T1)	; Store the type
	STOR.	T2,BLKSIZ,(T1)		; Store the size
	LOAD.	T2,BLKNXT,(P3)		; Get the old next pointer
	STOR.	T2,BLKNXT,(T1)		; And save it
	ZERO.	T2,BLKFLG,(T1)		; Clear the flags
	MOVX	T2,BF.LST		; Get the flag to check
	TDNE	T2,.BKFLG(P3)		; Was this the last block on the page?
	 IORM	T2,.BKFLG(T1)		; Yes, flag it
	ANDCAM	T2,.BKFLG(P3)		; And clear the old flag
	ZERO.	T3,BLKNXT,(T1)		; Clear the old next pointer
	POPJ	P,			; Return
	SUBTTL	M$GC -- Previous junk -- Junk block

;+
;.hl2 GCJJNK
;This routine will combine two junk blocks into one.  We have found two
;junk blocks back to back.
;-

GCJJNK:	LOAD.	T1,BLKFLG,(P3)		; Get the flags
	STOR.	T1,BLKFLG,(P1)		; Store the flags
	LOAD.	T1,BLKSIZ,(P3)		; Get the size
	ADD	P2,T1			; Compute the new size
	STOR.	P2,BLKSIZ,(P1)		; Store it back
	LOAD.	T1,BLKNXT,(P3)		; Get the pointer to the next
	STOR.	T1,BLKNXT,(P1)		; Store it
	MOVE	P3,P1			; Start at this junk block to advance
	POPJ	P,			; Return to the caller
	SUBTTL	M$GC -- Previous junk -- Text block

;+
;.hl2 GCJTXT
;This routine will handle the case of a junk block before a text block.  The
;text block will be moved over top of the junk block and the junk block
;recreated behind the junk block.
;-

GCJTXT:	MOVN	T1,P2			; Get the size
	ADDM	T1,.BKPTR(P3)		; Update the byte pointer
	PUSHJ	P,MOVBLK		; Move the blocks
	JRST	GCTXT			; Determine if we should split it
	SUBTTL	M$GC -- Previous block junk -- Command table

;+
;.hl2 GCJCTB
;This routine will process the finding of a command table after a junk
;block.
;-

GCJCTB:	MOVE	T1,P1			; Get the new address
	MOVE	T2,P3			; Get the link address
	MOVX	T3,$CTCTB		; Get the offset to the pointers
	PUSHJ	P,FIXLNK		; Fix up the linked list
	MOVE	T2,P3			; Get the next linked list
	MOVX	T3,$CTSTK		; Get the offset
	PUSHJ	P,FIXLNK		; FIx it up too
	ADDX	T1,$CTCND-$CNCND	; Point to the right place
	XMOVEI	T2,$CTCND-$CNCND(P3)	; And the command node list
	MOVX	T3,$CNCND		; Get the offset to the pointer
	PUSHJ	P,FIXLNK		; . . .
	XMOVEI	T1,$CTCMD(P1)		; Get the new address for the TPT
	XMOVEI	T2,$CTCMD(P3)		; Get the TPT pointer
	PUSHJ	P,FIXTPT		; Fix up that address
	XMOVEI	T1,$CTTPT(P1)		; Get the new address
	XMOVEI	T2,$CTTPT(P3)		; Get the always pointer
	PUSHJ	P,FIXTPT		; Yes, fix it up
	PUSHJ	P,MOVBLK		; Move the block up
	POPJ	P,			; Return to the caller
	SUBTTL	M$GC -- Previous block junk -- Command node

;+
;.hl2 GCJCND
;This routine will handle the case of finding a command node block before
;a junk block.  This routine will move the command node block down over
;the junk block and recreate the junk block after the command node block.
;This routine will adjust the pointers in the command node block.
;-

GCJCND:	$SAVE	<P4>			; Save a register
	MOVE	T1,P1			; Get the new address
	MOVE	T2,P3			; Point to the linked list word
	MOVX	T3,$CNCND		; Get the offset
	PUSHJ	P,FIXLNK		; Fix the linked list pointer
	MOVSI	P4,-^D128		; Get the AOBJN pointer
	XMOVEI	T4,$CNBYT(P3)		; Get the address of the information
	TXO	T4,<POINT 9,>		; Build the byte pointer
	PUSH	P,T4			; Save it on the stack
	MOVE	T2,P3			; Get the old address
GCJC.1:	ILDB	T4,(P)			; Get the information type
	TXNN	T4,CB$TRN		; Is this a transition?
	 JRST	GCJC.0			; No, skip this
	PUSHJ	P,GCJC.C		; Check for previous pointers
	 JRST	GCJC.0			; There was one, skip this
	XMOVEI	T1,$CNINF(P1)		; Get the new address
	XMOVEI	T2,$CNINF(P3)		; Get the address of the info
	ANDX	T4,CB$IDX		; Keep only the index
	IMULX	T4,$CILEN		; Mult by the length of each item
	ADD	T1,T4			; Make the actual new address
	ADD	T2,T4			; Plus the offset
	LOAD.	T3,TPTADR,(T2)		; Get where this points
	PUSHJ	P,FIXTPT		; Defined and a transition
GCJC.0:	AOBJN	P4,GCJC.1		; Loop for all the items
	POP	P,(P)			; Remove the byte pointer
	PUSHJ	P,MOVBLK		; Move this memory block
	POPJ	P,			; Return to the caller

; Here to check for previous items with the same info

GCJC.C:	XMOVEI	T1,$CNBYT(P3)		; Set up a pointer
	TXO	T1,<POINT 9,>		; Make the pointer

GCJC.2:	ILDB	T2,T1			; Get the byte
	CAMN	T1,-1(P)		; Hit the last byte we want to see yet?
	 PJRST	.POPJ1			; Yes, give no match return
	CAME	T2,T4			; Same index?
	 JRST	GCJC.2			; No, try again
	POPJ	P,			; Yes, return
	SUBTTL	M$GC -- Previous junk -- Symbol table entry

;+
;.hl2 GCJSYM
;This routine will handle moving a symbol table entry.
;-

GCJSYM:	MOVE	T1,P1			; Get the new address
	MOVE	T2,P3			; Get the LNK field
	MOVX	T3,$SYLNK		; Get the offset to the pointer
	PUSHJ	P,FIXLNK		; Fix up the pointers
	MOVE	T2,P3			; Get the LNK field
	MOVX	T3,$SYNXT		; Get the offset to the link pointers
	PUSHJ	P,FIXLNK		; Fix up the pointers here too
	XMOVEI	T1,$SYTPT(P1)		; Get the new TPT address
	XMOVEI	T2,$SYTPT(P3)		; Get the TPT address
	PUSHJ	P,FIXTPT		; No, fix up the TPT pointers also
	PUSHJ	P,MOVBLK		; Move the symbol table entry
	POPJ	P,			; Return to the caller
	SUBTTL	M$GC -- Previous junk -- General movable block

;+
;.hl2 GCJMOV
; This routine will handle a general movable block after a junk block.  It will
;move the block over the junk block.
;-

GCJMOV:	PUSHJ	P,MOVBLK		; Move the block
	POPJ	P,			; And return



	SUBTTL	M$GC -- Previous junk -- All others

;+
;.hl2 GCJOTH
;This routine will handle the other process for having a junk block
;before a non-movable block.
;-

GCJOTH:	SETZB	P1,P2			; Clear the pointers
	POPJ	P,			; And forget about moving this
	SUBTTL	M$GC -- MOVBLK - Move a block up

;+
;.hl2 MOVBLK
;This routine will move a block of memory up.  It will then create a junk
;block after the block that was moved up.
;.lit
;
; Usage:
;	MOVE	P1,New.address
;	MOVE	P2,Distance being moved
;	MOVE	P3,New.address
;	PUSHJ	P,MOVBLK
;	 (return here always)
;
;.end lit
;-

MOVBLK:
IFN FTXADR,<
	LOAD.	T1,BLKSIZ,(P3)		; Get the size to move
	MOVE	T2,P1			; Get the address to move to
	MOVE	T3,P3			; Get the from address
	EXTEND	T1,[XBLT]		; Move the memory
>; End of IFN FTXADR
IFE FTXADR,<
	HRR	T1,P1			; Build the BLT pointer
	HRL	T1,P3			; Build From,,To addresses
	LOAD.	T2,BLKSIZ,(P3)		; Get the number of words to move
	ADDI	T2,-1(P1)		; Compute the final address
	BLT	T1,(T2)			; Move the block
>; End of IFE FTXADR
	MOVE	T1,P1			; Get the new address
	LOAD.	T2,BLKADR,(T1)		; Get the address of the list
	PUSHJ	P,FIXPTR		; Fix all the TPT pointers
	LOAD.	T2,BLKSIZ,(P1)		; Determine the address of the new junk
	ADD	T2,P1			;  block
	STORI.	.BTJNK,T1,BLKTYP,(T2)	; Note that it is a junk block
	STOR.	P2,BLKSIZ,(T2)		; Store the size of the block
	SETZ	T1,			; Clear this so we can move fields
	LOAD.	T3,BLKNXT,(P1)		; Get the next pointer
	STOR.	T1,BLKNXT,(P1)		; Zero old field
	STOR.	T3,BLKNXT,(T2)		; Update new block
	STOR.	T1,BLKFLG,(T2)		; Clear out the flags in the junk block
	MOVX	T3,BF.LST		; Get the last on page flag
	TDNE	T3,.BKFLG(P1)		; Is it on?
	 IORM	T3,.BKFLG(T2)		; Yes, flag in new junk block
	ANDCAM	T3,.BKFLG(P1)		; And turn off the flag
	MOVE	P3,P1			; Point to this as the current block
	SETZB	P1,P2			; Clear the 'junk' block address and size
	POPJ	P,			; Return to the caller
	SUBTTL	M$GC -- Subroutines -- FIXTPT - Fix up TPTNXT pointer

;+
;.hl2 FIXTPT
;This routine will fixup a TPT next pointer.  It will loop through the list
;of TPTs until it finds the block that points at the block we just moved.
;It will then update the pointer to the new address of the block.
;.literal
;
; Usage:
;	T1/ Address of new TPT
;	T2/ Address of the old TPT
;	PUSHJ	P,FIXTPT
;	(return)
;
; On return:
;	- TPTNXT pointer to this block updated.
;-

FIXTPT:	LOAD.	T4,TPTADR,(T2)		; Get the address of the start
	JUMPE	T4,.POPJ		; Nothing to fix if no pointer
	LOAD.	T4,BLKADR,(T4)		; Get the address of the first TPT
	SETZ	T3,			; Set up the previous address

FIXT.0:	CAMN	T4,T2			; Is this the block?
	  JRST	FIXT.1			; Yes, update the pointer
	MOVE	T3,T4			; Update the old pointer
	LOAD.	T4,TPTNXT,(T3)		; Get the address of the next block
	JUMPN	T4,FIXT.0		; Loop until we find it
	STOPCD	MTN,<Missing TPT next pointer>

FIXT.1:	JUMPE	T3,FIXT.2		; Are we pointed at by the BLK?
	STOR.	T1,TPTNXT,(T3)		; Update the pointer to the new address
	POPJ	P,			; Return to the caller

FIXT.2:	LOAD.	T3,TPTADR,(T2)		; Get the address of the data
	STOR.	T1,BLKADR,(T3)		; And store the new address
	POPJ	P,			; And return
	SUBTTL	M$GC -- Subroutines -- FIXLNK - Fix up linked list pointers

;+
;.hl2 FIXLNK
;This routine will fix up the linked list pointers for a block.
;.literal
;
; Usage:
;	T1/ New block address
;	T2/ Address of the LNK block in the block
;	T3/ Offset to link pointers within block
;	PUSHJ	P,FIXLNK
;	(return)
;
; On return:
;	- Linked list pointers point to the new block
;
;.end literal
;-

FIXLNK:	PUSH	P,T3			; Save the offset
	MOVE	T4,T2			; Get the old address
	ADD	T4,T3			; And point to the old block
	LOAD.	T3,LNKPRV,(T4)		; Get the previous block address
	JUMPE	T3,FLNK.1		; If nothing to fix, skip it
	ADD	T3,(P)			; Point to the link block
	STOR.	T1,LNKNXT,(T3)		; Point to the new block
FLNK.1:	LOAD.	T3,LNKNXT,(T4)		; Get the next pointer
	JUMPE	T3,FLNK.2		; Is there one?
	ADD	T3,(P)			; Point to the link block
	STOR.	T1,LNKPRV,(T3)		; Make sure it points to the previous
FLNK.2:	POP	P,T3			; Remove the offset
	POPJ	P,			; Give a good return
	SUBTTL	M$MSTR - Routine to move a string

;+
;.Hl1 M$MSTR
; This routine will move a string.  It will move the string as fast as
;possible, by doing some special checks.
;.b
;.literal
; Usage:
;	MOVE	T1,Source.byte.pointer
;	MOVE	T2,Destination.byte.pointer
;	MOVE	T3,Byte.count
;	PUSHJ	P,M$MSTR
;	(Return)
;.end literal
;-

M$MSTR:
	JUMPE	T3,.POPJ	; Return if there is nothing to move
	$SAVE	<P1,P2,P3,P4,CH> ; Save the Px ac's
	LOAD	T4,T2,BP.PFL	; Get the position of the destination
	CAXN	T4,^D36		; Word aligned?
	 CAXGE	T3,4*5		; Enough to make it worth it??
	  JRST	.+2		; No, move by LDB/DPB
	   JRST	MVST.1		; Yes, go check for BLT
MVST.2:	ILDB	CH,T1		; Get a char
	IDPB	CH,T2		; Store it
	SOJLE	T3,.popj	; Return if done
	TXNE	T2,<INSVL.(74,BP.PFL)> ; Word aligned yet?
	 JRST	MVST.2		; No, loop
	CAXGE	T3,4*5		; Have at least 4 words to do?
	 JRST	MVST.2		; No, not worth the set up time
	JRST	MVST.3		; Go move the text
; Here for special case of destination being on a word boundary

MVST.1:	HRLI	T2,(POINT 7,,34) ; .  .  .
	SOJ	T2,		;  .  .  .
	LOAD	T4,T1,BP.PFL	; Get the other position
	CAXE	T4,^D36		; Special position?
	 JRST	MVST.3		; No
	HRLI	T1,(POINT 7,,34) ; Yes, fix it as well
	SOJ	T1,		;  .  .  .

; Here when destination byte pointer has been word aligned

MVST.3:	DMOVE	P1,T1		; Get the byte pointers in a safer place
	MOVE	T1,T3		; Set up for full word move
	IDIVI	T1,5		; Compute the number of full words to moe
	MOVE	T3,T2		; Store the remainder of characters

	LOAD	P3,P1,BP.PFL	; Get the position field now
	CAXN	P3,1		; Source also on word boundary ?
	 JRST	MVST.4		; Yes - Go do BLT

; Here if we must do the move/rotate/movem loop

	MOVN	P4,P3		; Get the negative
	SUBI	P3,1		; P3 = P-1
	ADDI	P4,^D36		; P4 = 36-P
	ADDM	T1,P2		; Update the pointers
	ADDM	T1,P1		; . . .
	MOVN	T4,T1		; Set up negative count for loop
	MOVEI	T2,1(P)		; Get the address of the next free stack word
IFN FTKL,ADJSP	P,NMVLP		; Allocate stack space for the loop
IFN FTKI,ADD	P,[XWD NMVLP,NMVLP] ; Move the stack down
	MOVSI	T1,MVLP		; Copy move loop onto the stack
	HRR	T1,T2		; . . .
	BLT	T1,(P)		; Move it

	HRRM	P1,MVLP0(T2)	; Store the source address
	HRRM	P2,MVLPA(T2)	; Store the destination address
	HRRM	T2,MVLPC(T2)	; Fill in loop address to AOJL
	MOVE	T1,@MVLP0(T2)	; Get first partial source word
	LSH	T1,-1		; Right justify it
	JRST	MVLPC(T2)	; Jump into the loop

; Full word character move loop.  This is moved onto the stack and addresses
; are then filled in

MVLP:	PHASE	0		; Phased code
MVLP0:!	MOVE	T2,.-.(T4)	; Get the first part of the source word
	ROTC	T1,(P4)		; Shift left to complete destination word
	LSH	T1,1		; Left justify destination characters
MVLPA:!	MOVEM	T1,.-.(T4)	; Store te destination word
	ROTC	T1,(P3)		; Shift the remainder of the source word
MVLPC:!	AOJLE	T4,.-.		; Count words and loop
	JRST	MVST2		; Loop done, jump off stack
	DEPHASE			; End of the phased code

NMVLP==.-MVLP			; Number of words in loop

; The loop returns here from stack when done

MVST2:	PORTAL	.+1		; EXO entry back from stack
	ADJSP	P,-NMVLP	; Remove the stack space
	JUMPLE	T3,.POPJ	; Continue processing if any characters left
	DMOVE	T1,P1		; Reset the byte pointers
	JRST	MVST.2		; And move the rest of the characters

; Here to do the special case of moving aligned source and destination

MVST.4:	HRLZ	T2,P1		; Get the source address

	HRR	T2,P2		; And the destination
	ADDX	T2,<XWD 1,1>	; Make both to point first word
	ADDM	T1,P1		; Update the sorce pointer
	ADDM	T1,P2		; And the destination pointer
	BLT	T2,(P2)		; Move the words until last word of destination
	DMOVE	T1,P1		; Reset into T1/T2
	JUMPG	T3,MVST.2	; If any character remaining, go do them
	POPJ	P,		; Else return
	SUBTTL	TXT routines -- DELTXT - Delete a text block

;+
;.HL2 DELTXT
; This routine will delete a text block.  It will close all files assocaiated
;with it and return all memory associated with the block.
;.lit
;
; Usage:
;	T1/ Address of block
;	PUSHJ	P,DELTXT
;	 (return)
;
;.end lit
;-

DELTXT:	$SAVE	<P1>		; Save P1
DTXT.0:	MOVE	P1,T1		; Get a copy of the block address

DTXT.1:	MOVE	T1,P1		; Get the address back
	SETZ	T2,		; Do an EX type close
	SETO	T3,		; No reenter's allowed.
	PUSHJ	P,CLSFIL	; Close any files from it
	 JRST	DTXT.1		; No reenter's, try again
	MOVE	T1,P1		; get the address again
	PUSHJ	P,S$TAGC	; And clean up the tags for this buffer
	MOVE	T1,P1		; Get the address back
	ADDX	T1,.BKLEN	; Make it the data word address
	PJRST	M$RBLK		; And return the block
	SUBTTL	Delete block routines -- DELSYM - Delete a symbol table entry

;+
;.hl2 DELSYM
;This routine will check to see if a symbol table entry can be deleted.
;-

DELSYM:	$SAVE	<P1,P2,P3>		; Save a few registers
DSYM.0:	MOVE	P1,T1			; Copy the block address
	CFXE.	T1,BLKADR,(P1),0	; Anyone point at this at all?
	  POPJ	P,			; Yes, Can't return it
	CFXE.	,LNKPRV,+$SYNXT(P1),0	; Still in a linked list?
	  POPJ	P,			; Yes, Can't return it
	CFXE.	,LNKNXT,+$SYNXT(P1),0	; . . .
	  POPJ	P,			; . . .
	CFXE.	,LNKPRV,+$SYLNK(P1),0	; . . .
	  POPJ	P,			; Return
	CFXE.	,LNKNXT,+$SYLNK(P1),0	; . . .
	  POPJ	P,			; Return
	CFXE.	T1,TPTADR,+$SYTPT(P1),0	; Still point at something?
	  POPJ	P,			; Yes, Can't return this yet
	MOVE	T1,P1			; Get the address back
	PJRST	DBLK.0			; Return the block
	SUBTTL	CND/CTB routines -- M$DCTB - Delete a command table

;+
;.hl2 M$DCTB
;This routine will delete the current command table.  All memory blocks
;associated with the current command table will be returned to memory
;management.
;.literal
;
; Usage:
;	T1/ Address of a command table
;	PUSHJ	P,M$DCTB
;	(Return)
;
; On return:
;	- Command table returned
;
;.end literal
;-

M$DCTB:	$SAVE	<P1>			; Save a register
DCTB.0:	MOVE	P1,T1			; Copy for the moment
	CFXE.	T1,BLKADR,(P1),0	; Anyone point at this at all?
	 POPJ	P,			; Yes, can't return it
	CFXE.	,LNKPRV,+$CTSTK(P1),0	; This zero?
	  POPJ	P,			; No, Just return someone else points to it
	CFXE.	,LNKNXT,+$CTSTK(P1),0	; This zero?
	  POPJ	P,			; No, We are pointing to someone else
	CFXE.	,LNKPRV,+$CTCTB(P1),0	; This zero too?
	  POPJ	P,			; No, still in a command table
	CFXE.	,LNKNXT,+$CTCTB(P1),0	; Really returnable?
	  POPJ	P,			; No, Just return
	FRAME.	<<DELTPT,$TPLEN>>	; Allocate a temp TPT
	MOVE	T1,P1			; Get the address of the CTB back
	XMOVEI	T2,DELTPT		; Point to it
IFN FTDEBUG,SETZM DELTPT		; Clear the pointer out
	PUSHJ	P,M$USEB		; Make sure it doesn't go away
	XMOVEI	T1,$CTTPT(P1)		; Point to the TPT for the text buffer
	PUSHJ	P,M$RELB		; Release the block
	LOAD.	P1,TPTADR,+DELTPT	; Get the CTB address again
	XMOVEI	T1,$CTCMD(P1)		; Point to the first command CND
	PUSHJ	P,M$RELB		; Release it

; Here to delete the CNDs

DCTB.3:	LOAD.	P1,TPTADR,+DELTPT	; Get the CTB address again
	LOAD.	T1,LNKNXT,+$CTCND(P1)	; Get the address of the first CND
	JUMPE	T1,DCTB.1		; Finished if nothing else
	MOVX	T2,$CNCND		; Get the offset
	PUSHJ	P,M$ULNK		; Unlink this item
	JRST	DCTB.3			; Loop for all of the CNDs

DCTB.1:	LOAD.	T1,TPTADR,+DELTPT	; Get the address of the block
	ADDX	T1,.BKLEN		; Advance the pointer to something RBLK likes
	PJRST	M$RBLK			; Return the block
	SUBTTL	CND/CTB routines -- DELCND - Delete a CND block

;+
;.HL2 DELCND
;Delete a command node block.  This routine will loop through all of the
;pointers and call M$RELB for all the text pointers.
;.literal
;
; Usage:
;	T1/ Address of the CND block
;	PUSHJ	P,DELCND
;	(Return)
;
;.end literal
;-

DELCND:	$SAVE	<P1,P2,P3>		; Save P1 to P3
DCND.0:	MOVE	P1,T1			; Copy the address
	CFXE.	T1,BLKADR,(P1),0	; Anyone still pointing at this?
	 POPJ	P,			; Return
	CFXE.	,LNKNXT,+$CNCND(P1),0	; Is this block still linked?
	  POPJ	P,			; Yes, Can't return it yet
	CFXE.	,LNKPRV,+$CNCND(P1),0	; . .. 
	  POPJ	P,			; Something points to this, return

	XMOVEI	P2,$CNBYT(P1)		; Get the address of the start of the
					;  bytes of information
	TXO	P2,<$POINT (9)>		; Build the byte pointer
	MOVX	P3,^D128		; Max number of bytes

DCND.2:	ILDB	T1,P2			; Get a byte from the table
	TXNN	T1,CB$TRN		; Is this a transition?
	 JRST	DCND.1			; No, try the next
	ANDX	T1,CB$IDX		; Yes, keep the index
	IMULX	T1,$CILEN		; Make this the info index
	ADD	T1,P1			; Point to the address
	ADDX	T1,$CNINF+$CITRN	; . . .
	SKIPE	(T1)			; If already remove, forget it
	 PUSHJ	P,M$RELB		; Release the pointer
DCND.1:	SOJG	P3,DCND.2		; Loop for all bytes
	MOVE	T1,P1			; Get the address again
	ADDX	T1,.BKLEN		; Advance to normal position
	PUSHJ	P,M$RBLK		; Return the block
	POPJ	P,			; Return to the caller
	SUBTTL	CND/CTB routines -- CPYCTB - Copy the command table

;+
;.hl2 CPYCTB
;This routine will copy the current command table.  It will return the address
;to the start of the command table.  The command table that is copied will
;be given on the call to the routine.
;.literal
;
; Usage:
;	T1/ Address of the command table to copy
;	PUSHJ	P,CPYCTB
;	(Return)
;
; On return:
;	T1/ Address of the new command table.
;
;.end literal
;.hl1 M$CPCN
; This routine will copy only the marked set of CND's in a CND list.
;This routine has much code in common with CPYCTB.
;.lit
;
; Usage:
;	T1/ Address of a CND in the list
;	PUSHJ	P,M$CPCN
;	 (return)
;
; On return:
;	T1/ Address of new CND corresponding to CND routine was called with
;.end lit
;-

DEFINE	PSHTPT(ADDRESS)<
IFIDN <ADDRESS><T1><PUSH P,T1>	;; Save T1
	ALCXSB	(MEM,CLN)	;; Allocate the space
    IFN FTDEBUG,<
	SETZM	$XSBUF+$TPADR(XS) ;; Clear the address
    >;; End of IFN FTDEBUG
IFIDN <ADDRESS><T1><POP P,T1>	;; Restore it
IFDIF <ADDRESS><T1><LOAD T1,ADDRESS> ;; Get the item
	XMOVEI	T2,$XSBUF(XS)	;; Get the address
	PUSHJ	P,M$USEB	;; Link this in
>; End of PSHTPT macro definition


DEFINE	POPTPT(REG)<
IFNB <REG><
	LOAD.	REG,TPTADR,+$XSBUF(XS)	;; Get the address into the register
    IFIDN <T1><REG><PUSH P,T1>		;; Save the register if needed
>;; End of IFNB <REG>
	XMOVEI	T1,$XSBUF(XS)		;; Point to the pointer
	PUSHJ	P,M$RTPT		;; Release the pointer
IFNB <REG><
    IFIDN <T1><REG><POP	P,T1>		;; Restore the register
>;; End of IFNB <REG>
	$ADJSP	XS,-$XSCLN		;; Unwind the stack
>; End of POPTPT
CPYCTB:	TDZA	T2,T2			; Flag to do all CND's
M$CPCN:	 MOVX	T2,CN$MRK		; Flag to do only marked CND's
	$SAVE	<P1,P2,P3,P4,A1>	; Save a few registers
	MOVE	A1,T2			; Copy the flag
	STKTPS	(<<T1,SAVCTB>,<,SAVCT1>>) ; Save the CTB
	XMOVEI	P4,SAVCTB		; Get the address to it
	LOAD.	P1,TPTADR,+SAVCTB	; Get the address of the CTB (or CND)
	JUMPE	A1,CPYC.C		; If we already have the CTB, go start
	XMOVEI	P4,SAVCT1		; Get the address of the address of the CTB

CPYC.D:	LOAD.	T1,LNKPRV,+$CNCND(P1)	; Otherwise, back up to the previous
	JUMPE	T1,[ADDX P1,$CNCND-$CTCND	; Fix the offset to point at the CTB
		MOVE	T1,P1			; Get a copy
		XMOVEI	T2,SAVCT1		; And get a copy of the pointer
		PUSHJ	P,M$USEB		; Set it up
		JRST	CPYC.C]			; And go join common code
	MOVE	P1,T1			; Otherwise copy the address
	JRST	CPYC.D			; And try again

CPYC.C:	PSHTPT	(<$LKNXT+$CTCND(P1),LK$NXT>) ; Save the address of the first CND
	SETZM	NUMCND			; Clear the CND count

; Make a copy of all the CNDs.

CPYC.0:	LOAD.	T1,TPTADR,+$XSBUF(XS)	; Get the address of the saved CND
	TDNN	A1,$CNFLG(T1)		; Want this block?
	 JUMPN	A1,CPYC.7		; Maybe not, unless all wanted
	AOS	NUMCND			; Count the CND
	LOAD.	T1,CNDEND,(T1)		; Get the size of the block
	SUBX	T1,.BKLEN		; Remove the header from the length
	MOVX	T2,.BTCND		; Allocate a CND
	PUSHJ	P,M$ZBLK		; Allocate a zero block
	SUBX	T1,.BKLEN		; Point to the header
	MOVE	P1,T1			; Copy the address
	LOAD.	P2,TPTADR,+$XSBUF(XS)	; Get the old address again
	XMOVEI	T1,$XSBUF(XS)		; Point to the TPT
	PUSHJ	P,M$RELB		; Release the block
	MOVE	T1,P1			; Get the address
	XMOVEI	T2,$XSBUF(XS)		; Point to the area again
	PUSHJ	P,M$USEB		; Make a TPT to this block
	LOAD.	T1,LNKNXT,+$CNCND(P2)	; Get the addrss of the next item
	JUMPE	T1,CPYC.1		; Jump if this is zero
	PSHTPT	(<T1>)			; Save the TPT address on the stack
	JRST	CPYC.0			; Loop back

; Here to skip this CND and go on to the next

CPYC.7:	MOVE	P2,T1			; Get the address of the CND
	XMOVEI	T1,$XSBUF(XS)		; And the address of the pointer
	PUSHJ	P,M$RELB		; Release the pointer
	LOAD.	T1,LNKNXT,+$CNCND(P2)	; Advance to the next CND
	JUMPE	T1,CPYC.8		; If none left, remove last XS item
	XMOVEI	T2,$XSBUF(XS)		; Otherwise set up XS again
	PUSHJ	P,M$USEB		; To point at this CND
	JRST	CPYC.0			; And try again

CPYC.8:	$ADJSP	XS,-$XSCLN		; Remove the pointer

; Here when all the CNDs have a new copy on the XS stack.

CPYC.1:	JUMPN	A1,CPYC.9		; Skip the text and CTB if only some CND's
	LOAD.	T1,TPTADR,(P4)		; Get the address of the block
	LOAD.	T1,TPTADR,+$CTTPT(T1)	; Get the address of the text block
	LOAD.	T1,BLKEND,(T1)		; Get the number of characters inuse
	PUSHJ	P,M$GTXT		; Get me a virgin text buffer
	PSHTPT	(T1)			; Save the TPT
	MOVE	T3,T1			; Copy the address
	LOAD.	T1,TPTADR,(P4)		; Get the address of the block
	XMOVEI	T4,$CTTPT(T1)		; Get the TPT address
	LOAD.	T1,TPTADR,+$CTTPT(T1)	; Get the text block address
	LOAD.	T2,BLKEND,(T1)		; Get the number of characters
	ADDX	T1,.BKTLN		; Point to the start of the text
	TXO	T1,<$POINT (7,,)>	; Fill in the byte pointer
	PUSHJ	P,M$INSS		; Move the string over

; Make a copy of the CTB

	MOVX	T1,$CTLEN		; Get the length of a CTB
	MOVX	T2,.BTCTB		; Get the block type
	PUSHJ	P,M$ZBLK		; Allocate a zero block
	SUBX	T1,.BKLEN		; Point to the block header
	MOVE	P2,T1			; Copy this to a safer place
	LOAD.	P3,TPTADR,(P4)		; Get the old CTB address
	POPTPT	(T1)			; Restore the TPT from the stack
	XMOVEI	T2,$CTTPT(P2)		; Point to the place to line it in
	PUSHJ	P,M$USEB		; Link it in

DEFINE	STICK(A)<
	LOAD.	T1,'A',(P3)		;; Get the old item
	STOR.	T1,'A',(P2)		;; Store into the new item
>; End of STICK macro definition

	STICK	CTBFLG			; Copy the flags
	STICK	CTBATY			; Copy the ALWAYS command type
	STICK	CTBALN			; Copy the ALWAYS command length
	STICK	CTBALW			; Copy the ALWAYS character address
	STICK	CTBOTY			; Copy the OTHER command type
	STICK	CTBOLN			; Copy the OTHER command length
	STICK	CTBOTH			; Copy the OTHER character address

; Now make two lists of the CND addresses on the main stack
; unwinding the information that was pushed on the XS stack.

CPYC.9:	MOVE	T1,NUMCND		; Get the number of CND's
	LSH	T1,1			; Multiply by two
	XMOVEI	T2,1(P)			; Get the start of the address
IFN FTKL,<
	ADJSP	P,(T1)			; Allocate the space on the stack
>; End of IFN FTKL
IFN FTKI,<
	HRL	T1,T1			; Make this length,,length
	ADD	P,T1			; Allocate the space
	JUMPGE	P,[MOVEI T1,.			; Mark the place
		JRST	TRPPDL]			; Handle the stack trap
	HRRZS	T1			; Clear the length half
>; End of IFN FTKI
	PUSHJ	P,.ZCHNK		; Clear the stack
IFE FTXADR,<
	TXO	T2,<INSVL.(P1,IW.IDX)>	; Build the index
>; End of IFE FTXADR
IFN FTXADR,<
	TXO	T2,<INSVL.(P1,GW.IDX)>	; Build the index
>; End of IFN FTXADR
	MOVEM	T2,OLDCND		; Store the old CND pointer
	ADD	T2,NUMCND		; Add in the number of CNDs
	MOVEM	T2,NEWCND		; Store that pointer two

; Now we have the space allocated for the old CND list and the new CND lists.
; The first thing that we must do is to copy the old CNDs into the block.

	LOAD.	T1,TPTADR,(P4)		; Get the old CND address
	LOAD.	T1,LNKNXT,+$CTCND(T1)	; Get the address of the first CND
	SETZ	P1,			; Initialize the index

CPYC.2:	TDNN	A1,$CNFLG(T1)		; Want this one?
	 JUMPN	A1,CPYC.A		; No, unless doing all of them
	MOVEM	T1,@OLDCND		; Store the address
	AOJ	P1,			; Point to the next one
CPYC.A:	LOAD.	T1,LNKNXT,+$CNCND(T1)	; Get the address of the next
	JUMPN	T1,CPYC.2		; Loop for all the items

; How build the new CND lists.

	MOVE	P1,NUMCND		; Get the number of CNDs

CPYC.3:	SOJL	P1,CPYC.4		; Finished?
	POPTPT	(T4)			; No, Remove a TPT from the stack
	MOVEM	T4,@NEWCND		; Store the new CND address
	JRST	CPYC.3			; Loop for all the CNDs

; Here when the lists of CNDs have been created.
; Now copy from one to another.

CPYC.4:	MOVN	P1,NUMCND		; Get minus the number of CNDs
	MOVSI	P1,(P1)			; Make this a local AOBJN pointer
	MOVE	T1,@OLDCND		; Get the OLD CND address
	MOVE	T2,@NEWCND		; Get the new CND address
	PUSHJ	P,CPYCND		; Copy the CNDs

; Here to loop for all of the CNDs

	MOVE	T2,@NEWCND		; Get the new CND address again
CPYC.5:	MOVE	P4,T2			; Copy the CND address
	AOBJP	P1,CPYC.6		; Finished?
	MOVE	T1,@OLDCND		; No, Get the next old CND
	MOVE	T2,@NEWCND		; And the next new CND
	PUSHJ	P,CPYCND		; Copy from the old to the new
	MOVE	T2,@NEWCND		; Get the address again
	STOR.	T2,LNKNXT,+$CNCND(P4)	; Store the pointer
	STOR.	P4,LNKPRV,+$CNCND(T2)	; . . .
	JRST	CPYC.5			; Loop for all the CNDs

; Here after all the CNDs have been copied.  Now find the address of the
; first CND in the old CND list and fix up the item into the new list.

CPYC.6:	JUMPN	A1,CPYC.B		; If only specific CND's, skip this
	LOAD.	T1,LNKNXT,+$CTCND(P3)	; Get the address of the first
	PUSHJ	P,FNDCND		; Find the matching CND
	STOR.	T1,LNKNXT,+$CTCND(P2)	; Store it
	XMOVEI	T2,$CTCND-$CNCND(P2)	; Get the address
	STOR.	T2,LNKPRV,+$CNCND(T1)	; Store the address of the previous
	LOAD.	T1,TPTADR,+$CTCMD(P3)	; Get the address of the first
	PUSHJ	P,FNDCND		; Find the new CND address
	XMOVEI	T2,$CTCMD(P2)		; Place to store this
	PUSHJ	P,M$USEB		; Make this pointer in use
	MOVE	T1,NUMCND		; Get the number of CNDs
	LSH	T1,1			; Double this, we have twice that many
IFN FTKL,<
	MOVNS	T1			; Negate this
	ADJSP	P,(T1)			; Remove the space on the stack
>; End of IFN FTKL
IFN FTKI,<
	HRL	T1,T1			; Make this length,,length
	SUB	P,T1			; Remove the space from the stack
>; End of IFN FTKI
	MOVE	T1,P2			; Return the CTB address
	POPJ	P,			; Return to the caller

; Here if we have only copied specific CTB's. We must find out the address
;of the copy of the CND we were given as an argument

CPYC.B:	LOAD.	T1,TPTADR,+SAVCTB	; Get the address of the CND
	PUSHJ	P,FNDCND		; And determine the new address
	MOVE	P1,T1			; Save it for a moment
	XMOVEI	T1,SAVCTB		; Release the original CND
	PUSHJ	P,M$RELB		;  .  .  .

	LOAD.	P2,LNKPRV,+$CNCND(P1)	; Get the previous CND address
	JUMPE	P2,CPYC.G		; If none, all is fine

CPYC.F:	LOAD.	T3,LNKPRV,+$CNCND(P2)	; Get the previous address
	JUMPE	T3,CPYC.E		; Have one?
	MOVE	P2,T3			; Yes, get the address
	JRST	CPYC.F			; And try again

CPYC.E:	MOVX	T2,$CNCND		; Otherwise get the offset
	MOVE	T3,P2			; Get the address of the block to link in before
	MOVX	T4,$CNCND		; And get the address
	PUSHJ	P,M$MLNK		; And move the CND to the start of the list

CPYC.G:	MOVE	T1,NUMCND		; Get the number of CND's we copied
	ASH	T1,1			; Mult by two
IFN FTKL,<
	MOVN	T1,T1			; Get the amount to remove
	ADJSP	P,(T1)			; And do it
> ; End of IFN FTKL
IFN FTKI,<
	HRL	T1,T1			; Set up the amount to subtract
	SUB	P,T1			; And do it
> ; End of IFN FTKI
	MOVE	T1,P1			; Get the address of the new CND
	POPJ	P,			; And return
	SUBTTL	CND/CTB routines -- CPYCND - Copy a node block

;+
;.hl2 CPYCND
;This routine will copy a node block.  This is a routine that is used in
;the command tables.
;.literal
;
; Usage:
;	T1/ Old CND
;	T2/ New CND
;	PUSHJ	P,CPYCND
;	(Return)
;
; On return:
;	- New CND information filled in from the old CND.
;
;.end literal
;-

CPYCND:	$SAVE	<P1,P2,P3>		; Save three registers
	DMOVE	P1,T1			; Copy the arguments
	MOVEI 	T1,$CNINF-$CNEND	; Number of words to copy
	XMOVEI	T2,$CNEND(P1)		; Old address
	XMOVEI	T3,$CNEND(P2)		; New address
	PUSHJ	P,M$MCOR		; Copy CND blocks
	XMOVEI	T4,$CNBYT(P1)		; Get address of info
	TXO	T4,<POINT 9>		; Build a byte pointer
	MOVX	P3,^D128		; Get the number of times to loop
CCND.0:	ILDB	T3,T4			; Get the info type
	TXNN	T3,CB$TRN		; Is this a transfer?
	 JRST	CCND.1			; No, might be an execute
	ANDX	T3,CB$IDX		; Keep only the index
	IMULX	T3,$CILEN		; No. of bytes from block
	PUSH	P,T3			; Save no. for later
	ADD	T3,P1			; Compute old address
	LOAD.	T1,TPTADR,+$CITRN+$CNINF(T3)	; Get floating pointer
	PUSHJ	P,FNDCND		; Make new floating pointer
	POP	P,T3			; Get no. of bytes
	XMOVEI	T2,$CNINF+$CITRN(P2)	; Get address
	ADD	T2,T3			; Plus no. of bytes offset
	SKIPN	$TPADR(T2)		; Has this already been done?
	  PUSHJ	P,M$USEB		; Copy info
	JRST	CCND.2			; Get more bytes

CCND.1:	TXNN	T3,CB$XCT		; Execute?
	 JRST	CCND.2			; No, not defined
	ANDX	T3,CB$IDX		; Keep only the index
	IMULX	T3,$CILEN		; No. of bytes from block
	MOVE	T2,T3			; Copy it
	ADD	T3,P1			; Old address
	ADD	T2,P2			; New address
	LOAD.	T1,CINCAD,+$CNINF(T3)	; Copy from oLOADd
	STOR.	T1,CINCAD,+$CNINF(T2)	; Copy to new
	LOAD.	T1,CINCTY,+$CNINF(T3)	; Copy from old
	STOR. 	T1,CINCTY,+$CNINF(T2)	; Copy to new
	LOAD.	T1,CINCLN,+$CNINF(T3)	; Copy from old
	STOR.	T1,CINCLN,+$CNINF(T2)	; Copy to new
CCND.2:	SOJG	P3,CCND.0		; Loop for all items in $CNBYT
	POPJ	P,			; Return to caller
	SUBTTL	CND/CTB routines -- FNDCND - Find a CND

;+
;.hl2 FNDCND
;This routine will find an old CND in the lists and return the address
;of the new CND.
;.literal
;
; Usage:
;	T1/ Address of the OLD CND
;	PUSHJ	P,FNDCND
;	(Return)
;
; On return:
;	T1/ Address of the new CND
;
;.end literal
;-

FNDCND:	$SAVE	<P1>			; Save a register
	MOVN	P1,NUMCND		; Get the number of CNDs
	MOVSI	P1,(P1)			; Make this an AOBJx pointer

	CAME	T1,@OLDCND		; Is this the old CND?
	 AOBJN	P1,.-1			; No, Loop until found
	JUMPGE	P1,[STOPCD LCN,<Lost a CND>]
	MOVE	T1,@NEWCND		; Return the new CND
	POPJ	P,			; Return to the caller
	SUBTTL	FIXPTR - Routine to fix up text buffer pointers

;+
;.hl1 FIXPTR
; This routine will change all of the pointers to a text buffer to a new
;value. It is used when a buffer is moved.
;.b
;.literal
; Usage:
;	MOVE	T1,New.buffer.address
;	MOVE	T2,Address of pointer list
;	PUSHJ	P,FIXPTR
;	 (Return)
;.end literal
;-

FIXPTR:	JUMPE	T2,.POPJ	; Nothing to fix if no pointer

FIXP.0:	STOR.	T1,TPTADR,(T2)	; Store the new address
	LOAD.	T2,TPTNXT,(T2)	; Get the next pointer
	JUMPN	T2,FIXP.0	; And loop until end of list
	POPJ	P,		; And return
	SUBTTL	Page processing -- Find a free page

;+
;.hl1 M$FFPG
;This routine will find a free page in the working set that has the
;attributes that are in register T1.
;.literal
;
; Usage:
;	T1/ Attributes
;	PUSHJ	P,M$FFPG
;	(Return)
;
; On return:
;	T1/ Page number of the page that matches
;
;.end literal
;-

M$FFPG:
	SUBTTL	Page processing -- Find n free pages

;+
;.hl1 M$FNFP
;This routine will find n free pages.  It will determine the type of pages
;to find by the attributes that are specified in register T1.
;.literal
;
; Usage:
;	T1/ Attributes
;	T2/ Number of pages
;	PUSHJ	P,M$FNFP
;	(Return)
;
; On return:
;	T1/ Page number of the first page that matches
;
;.end literal
;-

M$FNFP:
	SUBTTL	Page processing -- Release one page

;+
;.HL1 M$RELP
;This routine will release one page of memory.  It will destroy the page
;so that it doesn't exist.
;.literal
;
; Usage:
;	T1/ Page number
;	PUSHJ	P,M$RELB
;	(Return)
;
; On return:
;	- Page released
;
;.end literal
;-

M$RELP:
IFN FTDEBUG,<
	PUSHJ	P,CHKPAG		; Check for valid page number
>; End of IFN FTDEBUG
	MOVEI	T2,1			; Just one page
	EXCH	T1,T2			; Move into the right places
	FALL	M$RLNP			; Fall into the general routine
	SUBTTL	Page processing -- Release N pages

;+
;.hl1 M$RLNP
;This routine will release N pages.  It is called by the upper level
;memory management processing.
;.literal
;
; Usage:
;	T1/ Number of pages
;	T2/ First page number to releae
;	PUSHJ	P,M$RLNP
;	(Return)
;
; On return:
;	- Pages releaed
;
;.end literal
;-

M$RLNP:
IFN FTDEBUG,<
	PUSHJ	P,CHKPAG		; Range check the page number
	PUSH	P,T1			; Save this
	ADD	T1,T2			; Add in the total number
	SUBI	T1,1			; Back up one
	PUSHJ	P,CHKPAG		; Validate this page number
	POP	P,T1			; Get the page number back
>; End of IFN FTDEBUG
TOPS10,<
	MOVN	T2,T2			; Make this minus the number of
					;  pages to create
	MOVE	T3,T1			; Get the page number
	TXO	T3,PA.GAF		; Make this go away
	MOVX	T1,<XWD .PAGCD,T2>	; Get the function
RLNP.1:	PAGE.	T1,			; Create the pages
	  SKIPA				; Failed, skip this
	JRST	.POPJ1			; Give a good return

; Here if the PAGE. UUO has failed.  Determine if we should try to create
; the page on disk.

	CAXE	T1,PAGLE%		; Limit exceeded?
	  POPJ	P,			; No, Bad
	TXOE	T3,PA.GCD		; Create it on disk then
	  POPJ	P,			; Already tried that.
	JRST	RLNP.1			; Try again
>; End of TOPS10 conditional
	SUBTTL	Page processing -- Create one specific page

;+
;.hl1 M$CPAG
;This routine will acquire 1 page from the operating system.  This
;routine is called from the upper level memory management processing.
;.literal
;
; Usage:
;	T1/ Page number to create
;	PUSHJ	P,M$CPAG
;	(Failure return)
;	(Successful return)
;
; On a failure return:
;	T1/ PAGE. error code (TOPS-10 only)
;
; On a good return:
;	- page created.
;
;.END LITERAL
;-

M$CPAG:	MOVEI	T2,1			; Just create one page
	FALL	M$CPGS			; Fall into the next routine
	SUBTTL	Page processing -- Acquire N pages

;+
;.hl1 M$CPGS
;This routine will acquire N pages from the operating system.  This
;routine is called from upper level memory management processing and
;from once only processing.
;.literal
;
; Usage:
;	T1/ Page number of the first page
;	T2/ Number of pages to allocate
;	PUSHJ	P,M$CPGS
;	(Failure return)
;	(Success return)
;
; On a failure return:
;	T1/ PAGE. error code (TOPS-10 only)
;
; On a good return:
;	- page created.
;
;.end literal
; This routine will attempt to create the pages on disk if it is not
;possible to create them in core.
;.end literal
;-

M$CPGS:
IFN FTDEBUG,<
	PUSHJ	P,CHKPAG		; Range check the page number
	PUSH	P,T1			; Save this
	ADD	T1,T2			; Add in the total number
	SUBI	T1,1			; Back up one
	PUSHJ	P,CHKPAG		; Validate this page number
	POP	P,T1			; Get the page number back
>; End of IFN FTDEBUG
TOPS10<
	MOVN	T2,T2			; Make this minus the number of
					;  pages to create
	MOVE	T3,T1			; Get the page number
CPGS.1:	MOVX	T1,<XWD .PAGCD,T2>	; Get the function
	PAGE.	T1,			; Create the pages
	  SKIPA				; Failed, skip this
	JRST	.POPJ1			; Give a good return

; Here if the PAGE. UUO has failed.  Determine if we should try to create
; the page on disk.

	CAXE	T1,PAGLE%		; Limit exceeded?
	  POPJ	P,			; No, Bad
	TXOE	T3,PA.GCD		; Create it on disk then
	  POPJ	P,			; Already tried that.
	JRST	CPGS.1			; Try again
>; End of TOPS10 conditional
	SUBTTL	Page processing -- Check for a valid page number

;+
;.hl1 CHKPAG
;This routine is a debugging routine to validate the page number that is
;in T1.  This routine will stopcode if the page number is invalid.
;.literal
;
; Usage:
;	T1/ Page number
;	PUSHJ	P,CHKPAG
;	(Return)
;
; On return:
;	- Page number if valid
;
;.end literal
;-

IFN FTDEBUG,<
CHKPAG:	CAIGE	T1,1000			; Is this valid?
	  POPJ	P,			; Yes, just return
	STOPCD	IPN,<Invalid page number>
>; End of IFN FTDEBUG
	SUBTTL	Low segment

	$IMPURE			; Data PSECT
	LOWVER(MEM,2)		; Define the low segment version

IFN FTDEBUG,<			; Debugging storage
CFRSAC:	BLOCK	20		; AC's from last valid call to M$CFRE
CFRPDL:	BLOCK	D.PDLL		; PDL from last valid call to M$CFRE
> ; End of IFN FTDEBUG


FSTBLK:	BLOCK	1		; Pointer to first core block
CMDBUF:	BLOCK	$QRLEN		; Address of core block for command buffer
CPMQRG:	BLOCK	$QRLEN		; Default prompt
XPNPTR:	BLOCK	1		; Temp pointer for M$XPND

; CPYCTB and CPYCND data areas.

OLDCND:	BLOCK	1		; Indirect pointer to old CNDs
NEWCND:	BLOCK	1		; Indirect pointer to the new CNDs
NUMCND:	BLOCK	1			; Number of CNDs in the lists
	SUBTTL	End of TECMEM

	END			; End of TECMEM