.TITLE	PLAS32 - 32-Bit PLAS Region
	.SBTTL	PLAS32 - Title Page
	.IDENT	/V01.00/
;
; Fortran-callable routines to create dynamic region and manage using
; 32-bit address (I*4). The functions allow direct address or dynamic
; allocation.
;
; Author:	R.W. Stamerjohn		Meridian Technology Corporation
;
; Macro Library Calls:
;
	.MCALL	CRRG$S			;Create region
	.MCALL	CRAW$S			;Create address window
	.MCALL	MAP$S			;Map address to region
	.MCALL	RDBBK$			;Define region descriptor
	.MCALL	WDBBK$			;Define window descriptor
;
INCSIZ	= 77				;Allocation increment

REGION:	RDBBK$				;Define region descriptor
WINDOW:	WDBBK$				;Define window descriptor

	.SBTTL	INITDR * Initialize Region
;
;+
; Create the dynamic region and initialize for dynamic allocation.
;
; Call with:	status = INITDR(size,virt,len)
;		
;		size	-> Integer region size (32 word chunks)
;		virt	-> Starting address of virtual section
;		len	-> Length of virtual section (bytes)
;
; Exit with:	Returns integer status set to success (1) or the Directive
;		Status error code (negative).
;-
;
INITDR::				;Ref. label
;
; Get size of region to create.
;
	MOV	@2(R5),REGION+R.GSIZ	;Store size of region to create
;
; Set initial status bits and create the region.
;
	MOV	#RS.MDL!RS.ATT!RS.WRT!RS.RED,REGION+R.GSTS
	CRRG$S	#REGION			;Create the region
	BCS	9999$			; If CS - error, exit
;
; Setup window block to map the first part of the region.
;
	MOV	#IE.ALG,$DSW		;Preset error code
	MOV	4(R5),R0		;Get virtual address
	BIT	#017777,R0		;Is it on correct boundary
	BNE	9999$			; If NE - no, error

	ASH	#-13.,R0		;Shift APR address
	BIC	#177770,R0		;Clear any garbage
	MOVB	R0,WINDOW+W.NAPR	;Store the APR number
	MOV	@6(R5),R0		;Get size of window
	ASH	#-6,R0			;Convert to blocks
	BIC	#176000,R0		;Clear extraneous bits
	MOV	R0,WINDOW+W.NSIZ	;Store size of window
	MOV	REGION,WINDOW+W.NRID	;Store region ID
	CLR	WINDOW+W.NOFF		;Clear starting address to map
	CLR	WINDOW+W.NLEN		;Clear size to map
	MOV	#WS.MAP!WS.WRT!WS.64B,WINDOW+W.NSTS
;
; Map window into first part of region.
;
	CRAW$S	#WINDOW			;Create address window and map
	BCS	9999$			; If CS - error, exit
;
; Map window into first part of region.
;
	MAP$S	#WINDOW			;Create address window and map
	BCS	9999$			; If CS - error, exit
;
; Create initial pool space as needed by pool type. Return with R4,R5 set to
; top of allocated pool space and R3 to pool cell allocation increment.
;
	MOV	#INCSIZ+1,R0		;Set minumum allocation size
;
; Create pool header cell and link to cell with rest of allocated pool.
;
	CLR	R1			;Get starting pool cell
	CLR	R2			; ... at VM_address = 0
	CALL	MAPWDW			;Map pool header
	ADD	R0,R2			;Get address of first free cell
	MOV	R1,(R3)+		;Store link in header cell
	MOV	R2,(R3)+		; ... as a double word pointer
	CLR	(R3)+			;Mark header cell of size 0
	CLR	(R3)+			; ... in double precsision

	CALL	MAPWDW			;Map free cell header
	CLR	(R3)+			;Set end of free list
	CLR	(R3)+			; ... as a double word pointer

	MOV	REGION+R.GSIZ,R1	;Get size of region to create
	DEC	R1			; as size minus header
	CLR	R0			;Set actual size of region
	ASHC	#6,R0			; ... as 32-bit number
	MOV	R0,(R3)+		;Store free space size
	MOV	R1,(R3)+		; ... as 32-bit number

9999$:	MOV	$DSW,R0			;Get error status
	RETURN				;Return to caller

	.SBTTL	ALOCDR * Allocate Buffer
;
;+
; Allocate buffer (32-bit address) from  region pool.  This routine
; allocates a VM buffer by searching the free list for an available
; buffer.  The  allocation  is  by first fit from the bottom of the
; available buffer space.
;
; Call with:	CALL ALOCDR(addr,size)
;
;		size	-> Size to allocate in bytes (I*2 value)
;
; Exit with:	If no buffer space is available, addr is set to zero.
;
;		addr	-> Allocate buffer address (I*4 variable)
;-

ALOCDR::				;Ref. label
	MOV	2(R5),R0		;Get return variable
	CLR	(R0)+			;Preset allocation failure
	CLR	(R0)+			; ...
;
; Process allocation size and set allocation increment for mapping use.
;
	MOV	@4(R5),R0		;Get requested size.
	MOV	R0,R4			;Copy requested size
	MOV	#INCSIZ,R0		;Get incremental buffer size
	ADD	R0,R4			;Round allocation size to
	BIC	R0,R4			; boundary of pool
	INC	R0			;Get mapping size
;
; Initialize starting VM address to header cell.
;
	CLR	R1			;Initialize VM address
	CLR	R2			; ... to header cell
	CLR	-(SP)			;Save space on stack for previous
	CLR	-(SP)			; ... free cell pointer
;
; Map current cell and check if sufficient space for allocation.
;
1000$:	CALL	MAPWDW			;Map the current cell
	TST	4(R3)			;Is cell large enough?
	BNE	2000$			; If NE - yes, continue
	CMP	6(R3),R4		;Is cell large enough?
	BHIS	2000$			; If HIS - yes, continue
;
; Test for another free buffer and if none, attempt to allocate more pool.
;
1100$:	TST	(R3)			;Is there another free buffer?
	BNE	1200$			; If NE - yes, continue
	TST	2(R3)			;Is there another free buffer?
	BEQ	9999$			; If EQ - no, all done
;
; Advance to next cell in free list and loop.
;
1200$:	MOV	R2,2(SP)		;Copy address of this cell
	MOV	R1,(SP)			; ... in case we must relink
	MOV	(R3)+,R1		;Get next cell address
	MOV	(R3)+,R2		; ... in free pool list
	BR	1000$			; And retry allocation
;
; Allocate cell and update free list pointers.
;
2000$:	SUB	R4,6(R3)		;Subtract allocated space from
	SBC	4(R3)			; ... size of current cell

	ADD	6(R3),R2		;Get virtual address of the
	ADC	R1			; ... new allocated buffer
	ADD	4(R3),R1		; ... from end of free buffer
	MOV	2(R5),R4		;Get the return address
	MOV	R2,(R4)+		;Return allocated VM address
	MOV	R1,(R4)+		; ... for return to caller

	TST	4(R3)			;Is there still space in free buffer?
	BNE	9999$			; If NE - still some space left
	TST	6(R3)			;Check low word for space?
	BNE	9999$			; If NE - yes, continue on
;
; Used up a free buffer entirely, map next free buffer into previous one.
;
	MOV	(R3)+,-(SP)		;Save address of next free buffer
	MOV	(R3)+,-(SP)		; ... for later restore
	MOV	4(SP),R1		;Get address of previous buffer
	MOV	6(SP),R2		; ...
	CALL	MAPWDW			;Map this buffer
	MOV	(SP)+,2(R3)		;Store address of new VM free
	MOV	(SP)+,0(R3)		; ... pool in previous buffer
;
; Exit routine.
;
9999$:	ADD	#4,SP			;Clean the stack
	RETURN				;Return to caller

	.SBTTL	DEACDR * Deallocate Buffer
;
;+
; Deallocate buffer (32-bit address) to region pool.
;
; Call with:	CALL DEACDR(addr,size)
;
;		addr	-> Allocate buffer address (I*4 variable)
;		size	-> Size to allocate in bytes (I*2 value)
;
; Exit with:	Buffer returned to pool. No check is made for a bad
;		deallocation.
;-

DEACDR::				;Ref. label
;
; Process deallocation size and set cell allocation increment for mapping.
;
	MOV	@4(R5),R0		;Get the return size
	MOV	R0,R4			;Copy requested size
	MOV	#INCSIZ,R0		;Get incremental buffer size
	ADD	R0,R4			;Round allocation size to
	BIC	R0,R4			; boundary of pool
	INC	R0			;Get mapping size
;
; Save virtual address of buffer we should return.
;
	MOV	2(R5),R3		;Get address of address
	MOV	(R3)+,R2		;Get the return address
	MOV	(R3)+,R1		; ... and the high part
	MOV	R2,-(SP)		;Save virtual address we
	MOV	R1,-(SP)		; ... are returning to pool
;
; Initialize starting VM address to header cell.
;
	CLR	R1			;Initialize VM address
	CLR	R2			; ... to header cell
;
; Map current cell and check if allocate space belongs here.
;
1000$:	CALL	MAPWDW			;Map current cell

	TST	(R3)			;Is this end of list
	BNE	1100$			; If NE - no, skip
	TST	2(R3)			;Is this end of list
	BEQ	2000$			; If EQ - yes, insert

1100$:	CMP	(SP),(R3)		;Check high part of next address
	BHI	1200$			; If HI - buffer does not fit
	BLO	2000$			; If LO - buffer fits in here
	CMP	2(SP),2(R3)		;Check low part of address
	BLO	2000$			; If LO - buffer fits in here
;
; Advance to next buffer in free list and repeat check.
;
1200$:	MOV	(R3)+,R1		;Get next virtual address
	MOV	(R3)+,R2		; ... in free pool list
	BR	1000$			;And loop
;
; Found place to return buffer. First check if buffer falls at end of
; current buffer. If so, update size of current buffer.
;
2000$:	SUB	6(R3),2(SP)		;Back up returning buffer
	SBC	(SP)			; ... in double precsision
	SUB	4(R3),(SP)		; ... to check if new buffer is at end
	CMP	R1,(SP)			;Does the new buffer append to current?
	BNE	2100$			; If NE - no, continue
	CMP	R2,2(SP)		;Check low part of address
	BNE	2100$			; If NE - no, continue
	ADD	R4,6(R3)		;Add returning size to current buffer
	ADC	4(R3)			; ... in double precision
	BR	2200$			;And continue
;
; Buffer is non-contiguous to current, store pointer to new buffer and
; map new buffer to next free slot. First restore virtual address.
;
2100$:	ADD	6(R3),2(SP)		;Get actual VM address back
	ADC	(SP)			; ... by reversving process
	ADD	4(R3),(SP)		; ... in double precsision
	MOV	(R3)+,-(SP)		;Save virtual address of next
	MOV	(R3)+,-(SP)		; ... free buffer
	MOV	6(SP),-(R3)		;Store virtual address of
	MOV	4(SP),-(R3)		; ... new free buffer
	MOV	(R3)+,R1		;Copy virtual address of
	MOV	(R3)+,R2		; ... new free buffer
	CALL	MAPWDW			;Map this address
	MOV	(SP)+,2(R3)		;Link in address of next buffer
	MOV	(SP)+,0(R3)		; ... in free list
	CLR	4(R3)			;Store size of deallocated buffer
	MOV	R4,6(R3)		;Store size of deallocated buffer
;
; Check if new buffer is directly in front of next buffer in free list.
; If so, make one allocation from the two.
;
2200$:	MOV	R2,-(SP)		;Copy current buffer address
	MOV	R1,-(SP)		; ... as double word address
	ADD	6(R3),R2		;Get end of current buffer
	ADC	R1			; ... by adding in size of buffer
	ADD	4(R3),R1		; ... in double precision
	CMP	R1,(R3)+		;Does next link abut this segment?
	BNE	2210$			; If NE - no, continue
	CMP	R2,(R3)+		;Does next link abut this segment?
	BNE	2210$			; If NE - no, continue
	MOV	-(R3),R2		;Get address of next segment
	MOV	-(R3),R1		; ... as a double word
	CALL	MAPWDW			;Map this address
	ADD	#10,R3			;Advance to bottom
	MOV	-(R3),-(SP)		;Save size of next segment
	MOV	-(R3),-(SP)		; ... as a double word
	MOV	-(R3),-(SP)		;Save link to next segment
	MOV	-(R3),-(SP)		; ... as a double word
	MOV	10(SP),R1		;Get old segment address back again
	MOV	12(SP),R2		; ... as a double word
	CALL	MAPWDW			;Map old address back
	MOV	(SP)+,(R3)+		;Store link to next free cell
	MOV	(SP)+,(R3)+		; ... as a double word
	ADD	(SP)+,(R3)+		;Update size of this cell
	ADD	(SP)+,(R3)		; ... add in low part of size
	ADC	-(R3)			; ... in double precision
2210$:	ADD	#4,SP			;Clean stack
;
; Exit routine.
;
9999$:	ADD	#4,SP			;Clean stack
	RETURN				;Return to caller

	.SBTTL	MAPDR * Map 32-Bit Address to Window Beginning
;
;+
; Map the 32-bit address to a 16-bit address within the window,
;
; Call with:	CALL MAPDR(addr,size)
;
;		addr	-> 32-bit address to map (I*4 variable)
;		size	-> Size of area to map   (I*2 variable)
;
; Exit with:	Beginning of window positioned to 32-bit address
;-

MAPDR::					;Ref. label
	MOV	2(R5),R0		;Get buffer address
	MOV	(R0)+,R2		;Get the address (low)
	MOV	(R0)+,R1		;Get the address (high)
	MOV	@4(R5),R0		;Get the size to map
	MOV	#-1,WINDOW+W.NOFF	;Force a remapping
	CALL	MAPWDW			;Map the virtual address
	RETURN				;Return to caller

	.SBTTL	IDXDR * Map 32-Bit Address to Window Offset
;
;+
; Map the 32-bit address to a 16-bit address within the window, return
; a window offset as a Fortran I*2 array index.
;
; Call with:	index = IDXDR(addr,size)
;
;		addr	-> 32-bit address to map (I*4 variable)
;		size	-> Size of area to map   (I*2 variable)
;
; Exit with:	Specific area mapped, index return to 'addr' position.
;-

IDXDR::					;Ref. label
	MOV	2(R5),R0		;Get buffer address
	MOV	(R0)+,R2		;Get the address (low)
	MOV	(R0)+,R1		;Get the address (high)
	MOV	@4(R5),R0		;Get the size to map
	CALL	MAPWDW			;Map the virtual address

	MOV	R3,R0			;Copy the virtual address
	SUB	WINDOW+W.NBAS,R0	;Get offset in window (byte)
	ASR	R0			;Get offset in window (word)
	INC	R0			;Get offset in window (FORTRAN)
	RETURN				;Return to caller

	.SBTTL	MAPWDW * MAP VM BUFFER
;
;+
; Call with:	JSR	PC,MAPWDW
;
;		R1,R2	-> Buffer address
;		R0	-> Buffer size
;
; Exit with:	R3	-> Mapped buffer address
;
;		Caller expects R0-R2,R4-R5 to be saved.
;-
MAPWDW:					;Ref label
;
; Correctly position calling arguments.
;
	MOV	R1,-(SP)		;Save high address
	MOV	R2,-(SP)		;Save low address
	MOV	R0,-(SP)		;Save size to map
	MOV	R1,R0			;Copy virtual address
	MOV	R2,R1			; ...
	MOV	(SP),R2 		;Get size to map
;
; See if requested buffer is mapped by current window?
;
	MOV	WINDOW+W.NOFF,R3	;Get start of current window
	ASHC	#-6,R0			;Get start of buffer in 32-word blocks
	CMP	R1,R3			;Is start of buffer mapped?
	BLO	1000$			; If LO - no, map buffer
	ADD	#INCSIZ,R2		;Round size to next 32-word block
	ASH	#-6,R2			;Get size in 32-word blocks
	ADD	R1,R2			;Get end of buffer in 32-word blocks
	ADD	WINDOW+W.NLEN,R3	;Get end of current window
	CMP	R2,R3			;Is end of buffer mapped?
	BLOS	2000$			; If LO - yes, continue
;
; Map wanted buffer to current window.
;
1000$:	MOV	R1,WINDOW+W.NOFF	;Set new start of buffer
	CLR	WINDOW+W.NLEN		;Set to map as much as possible
	MAP$S	#WINDOW			;Map window to buffer
;
; Get offset in window to desired buffer.
;
2000$:	MOV	WINDOW+W.NOFF,R1	;Get current offset into window
	ASH	#6,R1			; as low part of 32-bit address
	MOV	2(SP),R3		;Get virtual address we want
	SUB	R1,R3			;Get offset into region
	ADD	WINDOW+W.NBAS,R3	;Get virtual address in window
	MOV	(SP)+,R0		;Restore size
	MOV	(SP)+,R2		; ...
	MOV	(SP)+,R1		; ...
	RETURN				;Return to caller

	.END