.enabl	lc,mcl
	.title	SHEAP - Super Heap Routines
	.ident	/JMS007/
;++
;	SHEAP - Super Heap Routines
;
;	SHEAP requires that the following lines be in your .CMD file:
;
;	  Wndws = 5
;	  DefGbl = SHAREA:x	; (x) is the # of areas avail. for regions.
;	  DefGbl = SHAPR1:x	; (x) is the APR # of area 1.
;	  DefGbl = SHAPR2:x	; (x) is the APR # of area 2.
;	  DefGbl = SHAPR3:x	; (x) is the APR # of area 3.
;	  DefGbl = SHAPR4:x	; (x) is the APR # of area 4.
;	  DefGbl = SHAPR5:x	; (x) is the APR # of area 5.
;	  DefGbl = SHAPR6:x	; (x) is the APR # of area 6.
;	  DefGbl = SHAPR7:x	; (x) is the APR # of area 7.
;
;	Also, Pascal programs must preallocate their stack space with
;	the EXTSCT command, in order to stop the OTS from trying to put
;	its heap where the SHEAP will go.
;
;	All Procedures and Functions use the Pascal Calling Sequence.
;
;--
;
;
	.sbttl	Definitions
;
	rdbdf$			; Load in definitions
	wdbdf$
;
;	Page Size
;
	PagSiz = 4096. / 32.	; (Words)
;
;	Page Headers
;
	Lock = 0		; Lock Word Offset
	PagNum = 2		; Page Number Offset
	Connct = 4		; Connect Word Offset
	FreeHdr = 6		; Free List Header Offset
				; Offset 8. is reserved
	FirstFree = 10.		; Offset of first free location
;
;	Zero Page Information
;
	HighRegion = 10.	; Offset to Highest Region Counter
	RegBitmap = 12.		; Offset to Region Use Bitmap
	ZeroFirstFree = 138.	; Offset to first free location.
	RegNum = 1000.		; There can be 1000 regions.
;
;	Region Cache symbols
;
	RC.Num = 0		; Offset to region number.
	RC.RId = 2		; Offset to region Id.
	RC.LRU = 4		; Offset to least recently used counter.
	RIdEntrySize = 6	; Size of each entry (in bytes).
	RidNumOfEntries = 20.	; Number of Cache entries available.
;
;	Free Space layouts
;
	FR.Ptr = 0		; Pointer to next free area offset
	FR.Siz = 2		; Size of this free area offset.
;++
;
;	Error Codes
;
	E.SUCC = 1	; Operation Successful
	E.PGLK = -1	; Page Locked 
	E.PGNM = -2	; Page Not Mapped 
	E.DIRE = -3	; Directive Error 
	E.PGUS = -4	; Page In Use 
    	E.NCON = -5	; Not Connected to Page 
	E.OUTR = -6	; Out of Regions
	E.NOSP = -7	; No space left in this region for allocate.
	E.NoRg = -10	; No Region List
	E.NSRg = -11	; No Such Region
;
;	Directive Numbers (for error messages)
;
	D.ATRG = 1
	D.CRRG = 2
	D.CRAW = 3
 	D.MAP  = 4
	D.DTRG = 5
;
;--
;
;	Pascal booleans
;
	True = 1
	False = 0
;
;	Miscellaneous
;
	RgnFlags = <rs.del!rs.ext!rs.wrt!rs.red>
;

	.sbttl	Predefined Types
;++
;	Pre Defined Types
;
; type
;   SHeapStatusType = packed array [1..3] of integer;
;
;   SuperPointerType = 
;     record
;       Region : integer;
;       Ptr    : ^integer;  { Program uses type casting to get real pointers }
;     end;
;
;--
;
;	SuperPointer Definitions
;
	SP.Reg = 0			; Offset of Region
	SP.Ptr = 2			; Offset to 16-bit Pointer

	.sbttl	SHCREA - Create SuperHeap Region
;++
;
; [External (SHCREA)]
; procedure Create_SuperHeap_Region(var SHeapStatus : SHeapStatusType;
;				    var RegionNumber : integer;
;					Area : integer := 1);
;   external;
;
;   This procedure creates a new 8Kb region, using the next available region
;   number (gotten from SHP000).  The region is created with the name SHPxxx,
;   where xxx is the RegionNumber.  The region header is then initialized.
;--
	.psect	SHEAP,ro,i		; Code Psect
;
	Status = 22			; SHeapStatus Offset
	RegNum = 20			; RegionNumber Offset
	Area = 16			; Area Offset
;
SHCREA::
	mov	r0,-(sp)		; Prepare scratch registers.
	mov	r1,-(sp)
	mov	r2,-(sp)
	mov	r3,-(sp)
	mov	r4,-(sp)
	mov	r5,-(sp)
;
	mov	#SHAREA,r1		; Check the currently mapped regions...
1000$:	mov	r1,r0			; ... to see if region zero is mapped.
	dec	r0
	asl	r0			; Check in this index.
	tst	CurReg(r0)		; See if region zero is here.
	beq	1005$			; Is it?
	sob	r1,1000$		; No, Anymore places to check?
;
	mov	Area(sp),r1		; No, load it temporarily.
	mov	r1,r0
	dec	r0
	asl	r0
	mov	SHP000+r.gid,@RIdTbl(r0)	; Set up to map it.
	map$s	WndTbl(r0)		; And go grab 'er.
	bcc	1005$			; Were we successful?
	jmp	7000$			; No, go to error routine.
;
1005$:	mov	@BasTbl(r0),r0		; Yes, get the base address.
	mov	r1,-(sp)		; Say which page is current.
	call	LckCur			; Lock the current page.
;
	mov	HighRegion(r0),r5	; Get the highest region #.
	clr	r4
	div	#8.,r4			; R4 <- # of full bytes in the map.
	clr	r3			; R5 <- # of bits in last byte.
	tst	r5			; Did we have a remainder?
	beq	1200$			; Nope!
1100$:	sec				; Cover for the remainder.
	rol	r3			; Make a mask that fits.
	sob	r5,1100$		; Got all the bits yet?
;
	mov	r0,r2			; Get the offset to the region.
	add	r4,r2			; Get the end of the used area.
	bicb	RegBitMap(r2),r3	; See if all the regions are used.
	bne	1500$			; Were they?
;
1200$:	tst	r4			; Yep, Check if there are more groups.
	beq	1400$			; Are there?
1300$:	mov	#377,r3			; Take a full mask.
	mov	r0,r2			; Get the offset to the region.
	add	r4,r2			; Get the end of the used area.
	dec	r2			; Make it an offset.
	bicb	RegBitMap(r2),r3	; See if all in this group are used.
	bne	1505$			; Were they?
	sob	r4,1300$		; Yep, check next group.
;
1400$:	mov	HighRegion(r0),r4	; Get the next region to map.
	cmp	r4,#999.		; See if there are any.
	bge	6900$			; Is it too big?
	inc	r4			; No, pick one to use.
	mov	r4,HighRegion(r0)	; Save the region number.
	br	2000$
;
1500$:	inc	r4			; Get the group number.
1505$:	clr	r2			; Now count the bits.
1510$:	inc	r2			; Remember where we are.
	ror	r3			; Check this bit.
	bcc	1510$			; Was it set?
;
	dec	r4			; Make it an offset.
	mul	#8.,r4			; Group size * Offset.
	mov	r5,r4			; Get the base bit of the group.
	add	r2,r4			; Add in the bit # and we have a reg #.
;
2000$:	mov	r4,r3			; Look up the bitmap bit.
	clr	r2
	dec	r3			; Make it a true offset.
	div	#8.,r2			; R2 <- Byte Offset.  R3 <- Bit Offset.
	add	r0,r2
	inc	r3			; Bits start at 1!
	clr	r5			; Wait! We need a mask!
	sec
2100$:	rol	r5			; One bit mask, coming up.
	sob	r3,2100$		; Carefully align it.
	bisb	r5,RegBitMap(r2)	; And finally set the bit.
;
	mov	#<SHPxxx+r.gnam+2>,-(sp)	; Pass the RAD50 Arg.
	mov	r4,-(sp)		; Pass the num to convert.
	call	IntR50			; And convert it.
;
	bis	#RgnFlags,SHPxxx+r.gsts	; Set the flags for the create.
	crrg$s	#SHPxxx			; Create region.
	bcs	9000$			; Did we succeed?
	bit	#rs.crr,SHPxxx+r.gsts	; Yes, see if we really did create it.
	beq	10000$			; Did we?
;
	mov	r4,-(sp)		; Temporarily store the region number.
	mov	#RIdCac,r2		; Yes, add an entry to the RId Cache.
	mov	#RIdNumOfEntries,r3	; Make sure we check every entry.
	mov	#-1.,r4			; Start with the highest possible.
	mov	r2,r5			; Allow first one by default.
5000$:	cmp	RC.LRU(r2),r4		; See if the current LRU is lower.
	bhis	6000$			; Is it lower than the old one?
	mov	r2,r5			; Yes, remember it.
	mov	RC.LRU(r2),r4		; And try for lower.
6000$:	add	#RIdEntrySize,r2	; Go to the next entry.
	sob	r3,5000$		; Do we have more?
;
	mov	(sp)+,r4		; Retrieve the region number.
	mov	r4,RC.Num(r5)		; And store it.
	mov	SHPxxx+r.gid,RC.RId(r5)	; And the region Id.
	mov	#-1.,RC.LRU(r5)		; And give it a new LRU count.
;
	dec	Lock(r0)		; Unlock the Zero Page.
	dec	r1			; Get the offset to the window table.
	asl	r1
	mov	SHPxxx+r.gid,@RidTbl(r1)	; Set up to map new page.
	map$s	WndTbl(r1)		; And map it.
	bcs	7000$			; Were we successful?
;
	mov	#1,Lock(r0)		; Lock it for initialization.
	mov	r4,PagNum(r0)		; Give it its page number.
	mov	#1,Connct(r0)		; Let it know we're here.
	mov	#FirstFree,FreeHdr(r0)	; Store the first free address.
	mov	@LenTbl(r1),r3		; Get the length of this region.
	asl	r3			; Multiply it by 64.
	asl	r3
	asl	r3
	asl	r3
	asl	r3
	asl	r3
	sub	#FirstFree,r3		; Subtract out the header space.
	clr	FirstFree(r0)		; End the linked list here.
	mov	r3,<FirstFree+2>(r0)	; And save the length of it.
;
	dec	Lock(r0)		; And unlock this page.
	mov	Area(sp),r0		; Get the area number again.
	dec	r0
	asl	r0			; Get its offset.
	mov	r4,CurReg(r0)		; Save this as the current region.
	mov	r4,@RegNum(sp)		; And return it to the guy.
;
	mov	#E.SUCC,@Status(sp)	; We Made it!
	br	12000$			; Go to the end...
;
6900$:	mov	#E.OUTR,@Status(sp)	; No More Regions.
	br	12000$
;
7000$:	mov	Status(sp),r0		; Get the status word.
	mov	#D.MAP,2(r0)		; MAP$S error.
	br	11000$
;
9000$:	mov	Status(sp),r0		; CRRG error.
	mov	#D.CRRG,2(r0)
	br	11000$
;
10000$:	mov	#E.PGUS,@Status(sp)	; Page already exists.
	br	12000$
;
11000$:	mov	#E.DIRE,(r0)		; Save the actual error code.
	mov	$dsw,4(r0)		; and what the Exec said was wrong.
;
12000$:	mov	(sp)+,r5		; Restore the registers
	mov	(sp)+,r4
	mov	(sp)+,r3
	mov	(sp)+,r2
	mov	(sp)+,r1
	mov	(sp)+,r0
	mov	(sp)+,4(sp)
	cmp	(sp)+,(sp)+
	return

	.sbttl	SHCONN - Connect to Region
;++
;
; [External (SHCONN)]
; procedure Connect_To_Region(var SHeapStatus : SHeapStatusType;
;				  RegionNumber : integer;
;				  Area : integer := 1);
;   external;
;
;   This procedure attaches and maps to the region specified by RegionNumber, 
;   and increments the Connect counter.   If there is already a region mapped
;   at the time this procedure is called, it is unmapped.
;--
	Status = 12		; SHeapStatus Offset
	RegNum = 10		; RegionNumber Offset
	Area = 6		; Offset to Area.
;
	.psect	SHEAP,ro,i
;
SHCONN::
	mov	r0,-(sp)		; Get ourselves someplace to work.
	mov	r1,-(sp)
;
	mov	#<SHPxxx+r.gnam+2>,-(sp)	; Pass the address to IntR50.
	mov	<RegNum+2>(sp),-(sp)	; And pass the region number.
	call	IntR50			; And get the Rad-50 name.
	bis	#RgnFlags,SHPxxx+r.gsts	; Set the flags for the attach.
	atrg$s	#SHPxxx			; Attached said region.
	bcs	1000$
;
	mov	Area(sp),r1		; Find out what area we are to use.
	mov	r1,r0
	dec	r0			; Get its offset to the Window Block.
	asl	r0
;
	clr	-(sp)			; Create place for the Flag.
	mov	<Status+2>(sp),-(sp)	; Pass someplace for status.
	mov	RidTbl(r0),-(sp)	; Pass the address to store the RId.
	mov	<RegNum+6>(sp),-(sp)	; Pass the Region Number.
	call	GetRId			; And get the Region Id.
	tst	(sp)+			; Check to see if everything went ok.
	beq	3500$			; Did it?
;
	map$s	WndTbl(r0)		; And map to the region.
	bcs	2000$			; Did we succeed?
;
  	mov	RegNum(sp),CurReg(r0)	; Save the Current Region number.
	mov	@BasTbl(r0),r0		; Get the starting address.
	mov	r1,-(sp)		; Pass the area number to lock.
	call	LckCur			; Lock the page.
	inc	Connct(r0)		; Connect to the region.
	dec	Lock(r0)		; And unlock it for everyone to use.
;
	mov	#E.Succ,@Status(sp)	; Let 'em know we've done it!
	br	4000$
;
1000$:	mov	Status(sp),r0		; Get the addr of SHeapStatus
	mov	#D.ATRG,2(r0)		; ATRG$ error.
	br	3000$
;
2000$:	mov	Status(sp),r0		; MAP$ error.
	mov	#D.MAP,2(r0)
;
3000$:	mov	#E.DirE,(r0)		; Tell them it's a directive error
	mov	$dsw,4(r0)		; And give them what the opsys gave us.
	br	4000$
;
3500$:	clr	(sp)+			; Clear out temp when GetRid fails.
;
4000$:	mov	(sp)+,r1		; Restore our state
	mov	(sp)+,r0
	mov	(sp)+,4(sp)
	cmp	(sp)+,(sp)+
	return

	.sbttl	SHDISC - Disconnect_From_Region
;++
;
; [External (SHDISC)]
; procedure Disconnect_From_Region (var SHeapStatus : SHeapStatusType;
;					RegionNumber : integer;
;					Area : integer := 1);
;   external;
;
;   This procedure disconnects (and de-attaches) from the region specified by
;   RegionNumber.  Disconnecting is performed by decrementing the Connect 
;   Counter.  If the Connect Counter is set to zero, then the region is deleted
;   from the system.
;--
	Status = 20			; SHeapStatus offset
	RegNum = 16			; RegionNumber offset
	Area = 14			; Offset to Area.
;
	.psect	SHEAP,ro,i
;
SHDISC::
	mov	r0,-(sp)		; Claim our stake!
	mov	r1,-(sp)
	mov	r2,-(sp)
	mov	r3,-(sp)
	mov	r4,-(sp)
	clr	DelFlg			; And initialize are variables.
;
	mov	Area(sp),r1		; Find out what area to use.
	dec	r1			; And get the offset of that area.
	asl	r1
;
	clr	-(sp)			; And create the status flag.
	mov	<Status+2>(sp),-(sp)	; Pass the SHeapStatus.
	mov	RidTbl(r1),-(sp)	; Pass the address to store the RId.
	mov	<RegNum+6>(sp),-(sp)	; Pass the Region Number.
	call	GetRid			; And get the Region Id.
	tst	(sp)+			; Check to see if everything went ok.
	beq	5500$			; Did it?
;
	mov	@RidTbl(r1),SHPxxx+r.gid	; Set up for the detach later.
	map$s	WndTbl(r1)		; And map to the region requested.
	bcs	3000$			; Success?
;
	mov	Area(sp),-(sp)		; Get the area to lock.
	call	LckCur			; Lock this region.
	mov	@BasTbl(r1),r0		; Get the base address.
	dec	Connct(r0)		; And set down the lock count.
	bne	1000$			; Were we the last to let go?
	dec	DelFlg			; Yes, remember to remove it totally.
;
1000$:	dec	Lock(r0)		; Either way, we have to unlock it.
	mov	SHP000+r.gid,@RidTbl(r1)	; And get the Zero Page.
	map$s	WndTbl(r1)
	bcs	3000$			; Did we get a hold of it?
	clr	CurReg			; Yep, remember that we're here.
;
	bis	#rs.mdl,SHPxxx+r.gsts	; Finishing setting up for detach.
	dtrg$s	#SHPxxx			; And detach it.
	bcs	4000$			; Success?
;
	tst	DelFlg			; See if we are supposed to delete it.
	beq	2000$			; Are we?
	mov	@BasTbl(r1),r0		; Yes, get the page's base address.
	mov	Area(sp),-(sp)		; Tell it what area to lock.
	call	LckCur			; Lock current page for updating.
	mov	RegNum(sp),r3		; Look up the bitmap bit.
	clr	r2
	dec	r3			; Make it an offset.
	div	#8.,r2			; r2 <- Byte Offset.  r3 <- Bit Offset.
	add	r0,r2
	inc	r3			; Bits start at 1!
	clr	r4			; Make a mask.
	sec
1500$:	rol	r4
	sob	r3,1500$
	bicb	r4,RegBitMap(r2)	; And clear the bit.
	dec	Lock(r0)		; And unlock the page.
;
2000$:	mov	#RIdCac,r0		; Get the Region Id Cache.
	mov	#RIdNumOfEntries,r1	; And the number of entries in it.
2500$:	cmp	RC.Num(r0),RegNum(sp)	; Compare this entry in the cache.
	bne	2750$			; Is it for our region?
	clr	RC.Num(r0)		; Yes, re-initialize each field.
	clr	RC.RId(r0)
	clr	RC.LRU(r0)
2750$:	add	#RIdEntrySize,r0	; Go to the next entry in the cache.
	sob	r1,2500$
;
	mov	#E.Succ,@Status(sp)	; Success!
	br	6000$
;
3000$:	mov	Status(sp),r0		; Get the address of the status block.
	mov	#D.MAP,2(r0)		; Map$s Error.
	br	5000$
;
4000$:	mov	Status(sp),r0		; DTRG$ Error.
	mov	#D.DTRG,2(r0)
;
5000$:	mov	#E.DIRE,(r0)		; Save the error code.
	mov	$dsw,4(r0)		; And the DSW.
	br	6000$
;
5500$:	clr	(sp)+			; Clear out temp when GetRid fails.
;
6000$:	mov	(sp)+,r4		; Get the guy's registers back.
	mov	(sp)+,r3
	mov	(sp)+,r2
	mov	(sp)+,r1
	mov	(sp)+,r0
	mov	(sp)+,4(sp)
	cmp	(sp)+,(sp)+
	return
;
	.psect	SHPDAT,rw,d,gbl		; Data Psect
DelFlg:	.word	0			; Delete Flag (0 = no deletion req.)

	.sbttl	SHMAP - Map To Region
;++
;
; [External (SHMAP)]
; procedure Map_To_Region(var SHeapStatus : SHeapStatusType;
;			      RegionNumber : integer;
;			      Area : integer := 1);
;   external;
;
;   This procedure unmaps from the current region, if there is one, and then 
;   maps to the new region.  If RegionNumber is currently mapped, then this
;   routine has no effect.
;
;--
	Status = 10		; SHeapStatus Offset
	RegNum = 6		; RegionNumber Offset
	Area = 4		; Offset to Area.
;
	.psect	SHEAP,ro,i
;
SHMAP::
	mov	r0,-(sp)		; Get a little niche for our stuff.
;
	mov	Area(sp),r0		; Get the area to use.
	dec	r0
	asl	r0			; And calculate its offset value.
;
	clr	-(sp)			; Leave space for a flag.
	mov	<Status+2>(sp),-(sp)	; Pass the SHeapStatus.
	mov	RidTbl(r0),-(sp)	; Pass the location for the RId.
	mov	<RegNum+6>(sp),-(sp)	; Pass the Region Number.
	call	GetRid			; And get the Region Id.
	tst	(sp)+			; Did it?
	beq	3000$
;
	map$s	WndTbl(r0)		; And grab it.
	bcs	1000$			; Success?
;
	mov	RegNum(sp),CurReg(r0)	; Yes, remember that this is current.
	mov	#E.Succ,@Status(sp)	; Tell our folks at home we're ok.
	br	3000$
;
1000$:	mov	Status(sp),r0		; An error occured in the Map!
	mov	#E.DirE,(r0)		; Tell the guy!
	mov	#D.MAP,2(r0)
	mov	$dsw,4(r0)
;
3000$:	mov	(sp)+,r0
	mov	(sp)+,4(sp)
	cmp	(sp)+,(sp)+
	return

	.sbttl	SHNEW - SHeap New
;++
;
; [External (SHNEW)]
; function SHeap_New (var SuperPointer : SuperPointerType;
;		          Size : integer;
;			  Area : integer := 1) : boolean;
;   external;
;
;   This function allocates a block of memory which is Size bytes long in
;   the current page.  If there isn't enough space in the current page, the
;   routine returns false, otherwise it returns true.  If it succesfully
;   allocates the space, the SuperPointer is initialized to point to it.
;
;   SHeap_New locks the current page before modifying it.  If the caller
;   has already locked the page before calling New, the call will hang.
;
;--
	Flag = 14		; Return boolean offset
	SupPtr = 12		; SuperPointer offset
	Size = 10		; Size offset
	Area = 6		; Offset to Area.
;
	.psect	SHEAP,ro,i
;
SHNEW::
	mov	r0,-(sp)		; Save some workspace.
	mov	r1,-(sp)
;
	mov	SupPtr(sp),r0		; Get the address of the SuperPointer.
	mov	Area(sp),-(sp)		; Give it the area to lock.
	call	LckCur			; Lock current page.
;
	mov	Area(sp),r1		; Get the area to use.
	dec	r1			; Calculate the offset to use.
	asl	r1
;
	clr	-(sp)			; Make space for a temporary pointer.
	clr	-(sp)			; And for a flag from the allocate.
	mov	#4,-(sp)		; Pass the addr of our temp pointer.
	add	sp,(sp)
	mov	<Size+6>(sp),-(sp)	; Pass the size the guy wants.
	mov	<Area+10>(sp),-(sp)	; Pass the Area the guy wants.
	call	Alloc			; And allocate the space.
	mov	(sp)+,<Flag+2>(sp)	; Save the resultant flag.
	beq	1000$			; Did we succeed in the allocation?
;
	mov	(sp)+,SP.Ptr(r0)	; Save the 16-bit pointer.
	mov	CurReg(r1),SP.Reg(r0)	; And the region it exists in.
	br	2000$
;
1000$:	clr	(sp)+			; Remove temporary pointer.
;
2000$:	mov	@BasTbl(r1),r0		; Get the base address of the region.
	dec	Lock(r0)		; Unlock the page.
;
	mov	(sp)+,r1		; And return...
	mov	(sp)+,r0
	mov	(sp)+,4(sp)
	cmp	(sp)+,(sp)+
	return

	.sbttl	SHDISP - SHeap Dispose
;++
;
; [External (SHDISP)]
; procedure SHeap_Dispose(var SHeapStatus : SHeapStatusType;
;			      SuperPointer : SuperPointerType;
;			      Area : integer := 1);
;   external;
;
;   This function deallocates the block of memory at the location specified
;   by SuperPointer, which is Size bytes long.  This space is then added to
;   the free space list.
;
;--
	Status = 22		; SHeapStatus offset.
	SupPtr = 20		; SuperPointer offset.
	Area = 16		; Offset to Area.
;
	.psect	SHEAP,ro,i
;
SHDISP::
	mov	r0,-(sp)		; Claim a little working area.
	mov	r1,-(sp)
	mov	r2,-(sp)
	mov	r3,-(sp)
	mov	r4,-(sp)
	mov	r5,-(sp)
;
	mov	Area(sp),r5		; Get the area number to work in.
	dec	r5			; Calculate it's offset.
	asl	r5
;
	mov	SupPtr(sp),r0		; Get the requested region number.
	cmp	SP.Reg(r0),CurReg(r5)	; See if we need a new region.
	beq	1000$			; Do we?
;
	clr	-(sp)			; Leave space for the flag.
	mov	<Status+2>,-(sp)	; Pass the dummy status array.
	mov	RIdTbl(r5),-(sp)	; Pass where to put the RId.
	mov	SP.Reg(r0),-(sp)	; Pass the Region Number.
	call	GetRid			; And get the Region Id.
	tst	(sp)+
	beq	10000$			; Success?
;
	map$s	WndTbl(r5)		; and grab it.
	bcs	9000$			; Success?
	mov	SP.Reg(r0),CurReg(r5)	; Yes, remember this reg. is loaded.
;
1000$:	mov	Area(sp),-(sp)		; Specify which area to lock.
	call	LckCur			; Lock the current region for updates.
	mov	SP.Ptr(r0),r1		; Get the pointer to dispose.
	mov	@BasTbl(r5),r0		; Get the base address of this region.
	sub	#2,r1			; Point to the real start of the area.
	clr	r2			; Init the previous entry pointer.
	mov	FreeHdr(r0),r3		; Get the first entry's offset.
	beq	4000$
;
2000$:	add	r0,r3			; Make it an address.
	cmp	r1,r3			; Compare this ptr w/next area.
	blo	3000$			; Is this area after the pointer?
	mov	r3,r2			; Make it a previous pointer.
	mov	FR.Ptr(r3),r3		; Get the next offset.
	beq	4000$			; Is it the end of the list?
	br	2000$			; No, go loop again.
;
3000$:	mov	r1,r4			; Calculate where this area ends.
	add	(r1),r4			; By adding the length to it's address.
	cmp	r3,r4			; See if it ends where the next begins?
	bne	5000$			; Do they touch?
	add	FR.Siz(r3),(r1)		; Yes, combine their lengths.
	mov	FR.Ptr(r3),r3		; And go to the next region.
	add	r0,r3			; And make it's offset an address.
	br	5000$
;
4000$:	mov	r0,r3			; Put in null address for next pointer.
;
5000$:	tst	r2			; Look at the previous pointer.
	beq	6000$			; Did we have one?
	mov	r2,r4			; Yes, calculate where it ends.
	add	FR.Siz(r2),r4		; By adding in it's length.
	cmp	r1,r4			; And check if they are neighbors.
	bne	6000$			; Are they?
	add	(r1),FR.Siz(r2)		; Yes, combine their areas.
	sub	r0,r3			; Make the next ptr be an offset.
	mov	r3,FR.Ptr(r2)		; And make the prev ptr point to it.
	br	8000$
;
6000$:	mov	(r1),r4			; Save the size for a sec.
	sub	r0,r3			; Make the next ptr be an offset.
	mov	r3,FR.Ptr(r1)		; Add the offset to the list.
	mov	r4,FR.Siz(r1)		; And the size.
	sub	r0,r1			; Of course, make this ptr an offset.
	tst	r2			; See where the previous link is.
	beq	7000$			; Is it the free list head?
;
	mov	r1,FR.Ptr(r2)		; No, save the offset in the entry.
	br	8000$
;
7000$:	mov	r1,FreeHdr(r0)		; Update the free header.
;
8000$:	dec	Lock(r0)		; Unlock the region.
	mov	#E.Succ,@Status(sp)	; Tell the guy we've suceeded.
	br	11000$
;
9000$:	mov	Status(sp),r0		; A MAP$ error has occured.
	mov	#E.DIRE,(r0)
	mov	#D.MAP,2(r0)
	mov	$dsw,4(r0)
	br	11000$
;
10000$:	clr	(sp)+			; Pop the top off of the stack.
;
11000$:	mov	(sp)+,r5		; Yankee, go home.
	mov	(sp)+,r4
	mov	(sp)+,r3
	mov	(sp)+,r2
	mov	(sp)+,r1
	mov	(sp)+,r0
	mov	(sp)+,4(sp)
	cmp	(sp)+,(sp)+
	return

	.sbttl	SHFREE - Free Space
;++
;
; [External (SHFREE)]
; function Free_Space(Area : integer := 1) : integer;
;   external;
;
;   This function returns the size of the largest allocatable space in the
;   current region.
;
;--
	Size = 12			; Offset to the return value.
	Area = 10			; Offset to the Area.
;
	.psect	SHEAP,ro,i
;
SHFREE::
	mov	r0,-(sp)		; Clear out some space.
	mov	r1,-(sp)
	mov	r2,-(sp)
;
	mov	Area(sp),r0		; Get the area to use.
	dec	r0			; Calculate its offset.
	asl	r0
	mov	@BasTbl(r0),r0		; Get the base address of the area.
	clr	r2			; Zero out our largest space.
	mov	FreeHdr(r0),r1		; Grab the offset of the Freelist.
	beq	3000$			; Is there any free space?
;
1000$:	add	r0,r1			; Yep, make the offset an address.
	cmp	FR.Siz(r1),r2		; Check the size on this entry.
	ble	2000$			; Is it bigger than what we have?
	mov	FR.Siz(r1),r2		; Yes, remember it for later.
2000$:	mov	FR.Ptr(r1),r1		; Get the next offset.
	bne	1000$			; Is this the end of the list?
;
3000$:	mov	r2,Size(sp)		; Return what we found out.
	mov	(sp)+,r2		; Recover our registers
	mov	(sp)+,r1
	mov	(sp)+,r0
	mov	(sp)+,(sp)
	return

	.sbttl	SHINIT - SHeap_Initialize
;++
;
; [External (SHINIT)]
; procedure SHeap_Initialize (var SHeapStatus : SHeapStatusType;
;			      var NumOfAreas : integer);
;   external;
;
;   This procedure initializes the Super Heap system.  It performs the 
;   following functions (not necessarily in the order stated):
;
;     - Initialize static variables.
;     - If it doesn't exist, create page SHP000 and initialize it.
;     - Connect to SHP000.
;
;   This procedure returns the Number of areas that the taskbuilder has
;   specified (by the SHAREA global).
;--
	Status = 10			; SHeapStatus Offset
	Areas = 6			; NumOfAreas Offset
;
	.psect	SHEAP,ro,i		; Code Psect
SHINIT::
	mov	r0,-(sp)		; Create Scratch register
	mov	r1,-(sp)
;
	clr	InitFl			; Assume it's initialized.
	atrg$s	#SHP000			; Try to attach to base region.
	bcc	1000$			; Did we succeed?
;
	cmp	$dsw,#ie.pns		; No - Why not?
	bne	3000$			; Was it because 000 doesn't exist?
;
	crrg$s	#SHP000			; Yes, try and create the region.
	bcs	4000$			; Did we succeed?
	bit	#rs.crr,SHP000+r.gsts	; Yes, see if we really did create it.
	beq	1000$			; Did we?
;
	dec	InitFl			; Remember that it was just created.
;
1000$:	mov	#SHAREA,r1		; Get the number of windows to init.
1500$:	mov	r1,r0			; Make the current # into an index.
	dec	r0
	asl	r0
	craw$s	WndTbl(r0)		; Create the region.
	bcs	5000$			; Success?
	mov	#-1,CurReg(r0)		; Yes, remember it as unmapped.
	sob	r1,1500$		; Did we get everything?
;
	mov	SHP000+r.gid,@RIdTbl	; Map the Zero Page into window Zero.
	map$s	WndTbl
	bcs	5500$
	mov	@BasTbl,r0		; Get the base address of the region
	tst	InitFl			; Check if it needs initialization.
	beq	2000$			; Does it?
;
	mov	#1,Lock(r0)		; Lock this region while we update it.
	clr	PagNum(r0)		; This, of course, is page zero.
	clr	Connct(r0)		; No tasks attached to it, yet.
	clr	HighRegion(r0)		; This is the highest region.
	mov	#63.,r1			; The length of bit map in words.
	mov	r0,r2
	add	#RegBitMap,r2		; The first byte of the bitmap.
1750$:	clr	(r2)+			; Clear out the bitmap.
	sob	r1,1750$
;
	mov	#ZeroFirstFree,FreeHdr(r0)	; Set up the free list.
	mov	WndBl0+w.nlen,r1	; Get the length of this region.
	asl	r1			; Unfortunately, it refers to
	asl	r1			; 64-byte blocks.
	asl	r1
	asl	r1
	asl	r1
	asl	r1			; There, now we can deal with it.
	sub	#ZeroFirstFree,r1	; Subtract out the header space.
	clr	ZeroFirstFree(r0)	; End the linked list here.
	mov	r1,ZeroFirstFree+2(r0)	; And save that as the length.
	dec	Lock(r0)		; Unlock the region for a sec.
;
2000$:	mov	#1,-(sp)		; Tell it to lock the first area.
	call	LckCur			; Lock it so we can write this!
	inc	Connct(r0)		; Tell them we're here.
	dec	Lock(r0)		; And unlock the region.
;
	mov	#RIdCac,r0		; Get the Region Id Cache.
	mov	#RIdNumOfEntries,r1	; And the number of entries in it.
2500$:	clr	RC.Num(r0)		; Initialize each entry.
	clr	RC.RId(r0)
	clr	RC.LRU(r0)
	add	#RIdEntrySize,r0	; Go to the next entry in the cache.
	sob	r1,2500$
;
	clr	CurReg			; Remember that we are mapped.
	mov	Status(sp),r0		; Get Status word
	mov	#SHAREA,@Areas(sp)	; Return the NumOfAreas argument.
	mov	#E.SUCC,(r0)		; Let them know we did ok.
	br	7000$			; Bypass error processing code.
;
3000$:	mov	Status(sp),r0		; Get the status word
	mov	#D.ATRG,2(r0)		; Save the directive number
	br	6000$
;
4000$:	mov	Status(sp),r0		; CRRG error
	mov	#D.CRRG,2(r0)
	br	6000$
;
5000$:	mov	Status(sp),r0		; CRAW error
	mov	#D.CRAW,2(r0)
	br	6000$
;
5500$:	mov	Status(sp),r0		; MAP error
	mov	#D.MAP,2(r0)
;
6000$:	mov	#E.DIRE,(r0)		; Save the actual error code
	mov	$dsw,4(r0)		; and what the Exec said was wrong.
;
7000$:	mov	(sp)+,r1		; Restore our entry state
	mov	(sp)+,r0 
	mov	(sp)+,2(sp)
	clr	(sp)+
	return
;
	.psect	SHPDAT,rw,d,gbl		; Data Psect
InitFl:	.word	0			; Initialize flag (0 = initialized)

	.sbttl	SHCURR - Return Current Region
;++
;
; [External (SHCURR)]
; function Current_Region(Area : integer := 1) : integer;
;   external;
;
;   This function returns the region number of the currently mapped region.
;   A -1 means the area is not currently mapped to any regions.
;
;--
	RegNum = 6			; Offset to Region Number returned.
	Area = 4			; Offset to Area number.
;
	.psect	SHEAP,ro,i
;
SHCURR::
	mov	r0,-(sp)		; Make some work room.
;
	mov	Area(sp),r0		; Get the area requested.
	dec	r0			; Make it an offset.
	asl	r0
;
	mov	CurReg(r0),RegNum(sp)	; Return the region number.
;
	mov	(sp)+,r0		; Clean up after ourselves.
	mov	(sp)+,(sp)
	return

	.sbttl	SHLOAD - Region Loaded function
;++
;
; [External (SHLOAD)]
; function Region_Loaded (var SuperPointer : SuperPointerType;
;			      Area : integer := 1) : boolean;
;   external;
;
;   This function returns true if the region specified by SuperPointer is the
;   currently mapped region.
;--
	Flag = 12			; Offset to return flag.
	Super = 10			; Offset to Super Pointer address.
	Area = 6			; Offset to Area number.
;
	.psect	SHEAP,ro,i
;
SHLOAD::
	mov	r0,-(sp)		; Create some space for ourselves
	mov	r1,-(sp)
;
	mov	Area(sp),r0		; Get the Area number to work with.
	dec	r0
	asl	r0			; Calculate its offset.
;
	mov	#False,Flag(sp)		; Assume we won't find what we want.
	mov	Super(sp),r1		; Get the address of the Super Pointer.
	cmp	SP.Reg(r1),CurReg(r0)	; Compare the region numbers.
	bne	1000$			; Do they match?
	mov	#True,Flag(sp)		; Yes, signal truth!
;
1000$:	mov	(sp)+,r1		; Quickly - Run Away!
	mov	(sp)+,r0
	mov	(sp)+,2(sp)
	clr	(sp)+
	return

	.sbttl	SHLOCK - Lock Current Region function
;++
;
; [External (SHLOCK)]
; function Lock_Current_Region(Area : integer := 1) : boolean;
;   external;
;
;   This function locks the current region for write access.  Theoretically,
;   a task is not supposed to write into a region, unless it has it locked.
;   This function returns true if it was able to lock the region.
;
;--
	Flag = 6			; Offset to return flag.
	Area = 4			; Offst to Area Number.
;
	.psect	SHEAP,ro,i
;
SHLOCK::
	mov	r0,-(sp)		; Open a small cubby hole for things.
;
	mov	Area(sp),r0		; Get the area number to use.
	dec	r0
	asl	r0			; Make it something useful.
	mov	@BasTbl(r0),r0		; Get the base address of this area.
;
	mov	#True,Flag(sp)		; Assume we'll succeed.
	inc	Lock(r0)		; Try and lock it.
	cmp	Lock(r0),#1		; See if we succeeded.
	beq	1000$			; Did we?
	dec	Lock(r0)		; No, undo our goof.
	mov	#False,Flag(sp)		; And inform the caller.
;
1000$:	mov	(sp)+,r0		; Leave quietly.
	mov	(sp)+,(sp)
	return

	.sbttl	SHUNLO - Unlock Current Region
;++
;
; [External (SHUNLO)]
; procedure Unlock_Current_Region(Area : integer := 1);
;   external;
;
;   This function unlocks the current region, allowing other tasks to lock
;   it.
;
;--
	Area = 4			; Offset to Area number.
;
	.psect	SHEAP,ro,i
;
SHUNLO::
	mov	r0,-(sp)		; Save some space.
;
	mov	Area(sp),r0		; Get the area number.
	dec	r0
	asl	r0
	mov	@BasTbl(r0),r0		; Get the base address of the region.
	dec	Lock(r0)		; Unlock the region.
;
	mov	(sp)+,r0		; Clean up.
	mov	(sp)+,(sp)
	return

	.sbttl	SHLCKD - Is Region Locked?
;++
;
; [External (SHLCKD)]
; function Region_Is_Locked(Area : integer := 1) : boolean;
;   external;
;
;   This function returns true if the current region is locked (not necessarily
;   by this task).
;
;--
	Flag = 6			; Offset to return flag.
	Area = 4			; Offset to Area Number.
;
	.psect	SHEAP,ro,i
;
SHLCKD::
	mov	r0,-(sp)		; Create space.
;
	mov	Area(sp),r0		; Get the area number.
	dec	r0
	asl	r0
	mov	@BasTbl(r0),r0		; Get the base address of this area.
;
	mov	#False,Flag(sp)		; Assume region is not locked.
	tst	Lock(r0)		; But check anyways.
	beq	1000$			; Were we right?
	mov	#True,Flag(sp)		; No, correct ourselves.
;
1000$:	mov	(sp)+,r0		; Restore our state.
	mov	(sp)+,(sp)
	return

	.sbttl	SHWAIT - Wait And Lock
;++
;
; [External (SHWAIT)]
; procedure Wait_And_Lock(Area : integer := 1);
;   external;
;
;   This procedure waits until the current region is unlocked, and then locks
;   it.
;
;--
	Area = 2			; Offset to Area.
;
	.psect	SHEAP,ro,i
;
SHWAIT::
	mov	Area(sp),-(sp)		; Pass the area to lock.
	call	LckCur			; And call our standard locking stuff.
;
	mov	(sp)+,(sp)		; And clean up our mess.
	return

	.sbttl	SHCONV - Convert SuperPointer
;++
;
; [External (SHCONV)]
; procedure Convert_SuperPointer (var SuperPointer : SuperPointerType;
;				      Area : integer := 1);
;
; This procedure converts a given SuperPointer to use the region and base
; address that is in the specified Area.
;
;--
	Super = 10			; Offset to SuperPointer address.
	Area = 6			; Offset to Area Number.
;
	.psect	SHEAP,ro,i
;
SHCONV::
	mov	r0,-(sp)		; Get some scratch pad space.
	mov	r1,-(sp)
;
	mov	Super(sp),r0		; Get the address of the SuperPointer.
	mov	Area(sp),r1		; Get the Area number.
	dec	r1
	asl	r1			; Calculate it's offset.
;
	bic	#160000,SP.Ptr(r0)	; Clear out the apr number.
	add	@BasTbl(r1),SP.Ptr(r0)	; And add in the new base address.
;
	mov	CurReg(r1),SP.Reg(r0)	; Make the ptr refer to this region.
;
	mov	(sp)+,r1		; Clean up and leave.
	mov	(sp)+,r0
	mov	(sp)+,2(sp)
	clr	(sp)+
	return

	.sbttl	INTR50 - Integer to Rad-50.
;procedure IntR50(var Rad50 : integer;
;	   	      Value : integer);
;
;   This procedure converts an integer in the range of 0-999 specified by
;   Value to its radix 50 counterpart specified by Rad50.
;
	.psect	SHEAP,ro,i		; Code Psect
;
	Rad50 = 20			; Rad50 Address Offset
	Value = 16			; Value to be converted offset
;
IntR50:	mov	r0,-(sp)		; Prep scratch registers
	mov	r1,-(sp)
	mov	r2,-(sp)
	mov	r3,-(sp)
	mov	r4,-(sp)
	mov	r5,-(sp)
;
	mov	#3,r0			; Initialize our counter
	clr	r1			; Clear out the Target
	mov	Value(sp),r3		; Get the value to convert`
	clr	r2
	mov	#1000.,r4		; Store in the divisor.
;
	tst	r3			; Look at the value we were given.
	bmi	2$			; Are we less than zero?
	cmp	r3,#100			; No, See if we are too big...
	bge	2$			; Are we greater or equal to 100?
;
1$:	mov	r4,r5			; Move to get the next divisor
	clr	r4
	div	#10.,r4			; Divide divisor for the next digit.
	div	r4,r2			; Get the next digit.
	mul	#50,r1			; Roll the target string.
	add	r2,r1			; Add in the next digit.
	add	#36,r1			; Plus the "0" in Radix-50.
	clr	r2			; Get rid of old quotient
	sob	r0,1$			; Are we done?
;
	mov	r1,@Rad50(sp)		; Yes, save the result.
2$:	mov	(sp)+,r5		; Restore our state
	mov	(sp)+,r4
	mov	(sp)+,r3
	mov	(sp)+,r2
	mov	(sp)+,r1
	mov	(sp)+,r0
	mov	(sp)+,2(sp)
	clr	(sp)+
	return

	.sbttl	ALLOC - Allocate Heap Space In Current Region.
;{**Internal**}
;function Alloc(var Pointer : ^integer;
;		    Size : integer;
;		    Area : integer := 1) : boolean;
;
;  This procedure creates a region in the heap that is Size big.  If there is
;  such a region created the function returns true, otherwise it returns false.
;
	Flag = 24			; Offset for return flag.
	Ptr = 22			; Offset for Pointer
	Size = 20			; Offset for Size of region.
	Area = 16			; Offset to Area.
;
Alloc:	mov	r0,-(sp)		; Prepare scratch registers.
	mov	r1,-(sp)
	mov	r2,-(sp)
	mov	r3,-(sp)
	mov	r4,-(sp)
	mov	r5,-(sp)
;
	mov	Area(sp),r5		; Get the area to use.
	dec	r5			; Calculate the area's offset.
	asl	r5
	mov	@BasTbl(r5),r0		; Get the base address of the region.
	mov	Size(sp),r1		; And get the size we're to locate.
	inc	r1			; Guarantee it's an even address
	bic	#1,r1
	add	#2,r1			; Add two for the length word.
;
	mov	FreeHdr(r0),r2		; Get the first entry's offset.
	beq	6000$			; Did we have any free space?
	clr	r3			; Yes, clear out previous link.
1000$:	add	r0,r2			; Make it an address.
	cmp	FR.Siz(r2),r1		; Look at the size of the area.
	bge	2000$			; Did we get a match?
	mov	r2,r3			; Save this link as previous link.
	mov	FR.Ptr(r2),r2		; Get the next offset.
	bne	1000$			; Was it non-zero?
	br	6000$			; No, report error.
;
2000$:	add	#2,r1			; Check to see how much will be left.
	cmp	FR.Siz(r2),r1
	bgt	4000$			; Do we have enough for a new area?
	beq	3000$			; No, do we have just enough for us?
	sub	#2,r1			; Yes, remove the extra byte count.
;
3000$:	tst	r3			; See how far we have gone in the list.
	bne	3500$			; Have we gotten past the first one?
	mov	FR.Ptr(r2),FreeHdr(r0)	; Save the next entry into the head.
	br	5000$			; Go prepare this area for the caller.
;
3500$:	mov	FR.Ptr(r2),FR.Ptr(r3)	; Yes, Remove this entry from the list.
	br	5000$			; And go prepare the area for usage.
;
4000$:	sub	#2,r1			; Get the amount we want to use.
	mov	r2,r4			; Create the new free area.
	add	r1,r4			; Start it right after this area.
	mov	FR.Ptr(r2),FR.Ptr(r4)	; Make it point to what we pointed to.
	mov	FR.Siz(r2),FR.Siz(r4)	; And make it our size ...
	sub	r1,Fr.Siz(r4)		; ... minus what we took out.
	sub	r0,r4			; Get the new area's offset.
	tst	r3			; Is this the first entry?
	beq	4500$
	mov	r4,FR.Ptr(r3)		; And make the last area point to it.
	br	5000$
4500$:	mov	r4,FreeHdr(r0)		; Modify the first entry of the list.
;
5000$:	mov	r1,(r2)+		; Store the size and get the address.
	mov	r2,@Ptr(sp)		; And pass the addr back to the user.
	mov	#True,Flag(sp)		; Tell the caller he got what he wanted
	br	7000$			; And get the hell out of here.
;
6000$:	mov	#False,Flag(sp)		; Tell the caller that we were out.
;
7000$:	mov	(sp)+,r5		; Get our registers back.
	mov	(sp)+,r4
	mov	(sp)+,r3
	mov	(sp)+,r2
	mov	(sp)+,r1
	mov	(sp)+,r0
	mov	(sp)+,4(sp)
	cmp	(sp)+,(sp)+
	return
;

	.sbttl	LckCur - Lock Current Page
;{** INTERNAL **}
;procedure LckCur(Area : integer);
;  external;
;
;  This procedure locks the current page.  Caution:  If the page
;  accidentally gets locked by someone else, and doesn't get unlocked,
;  this routine will appear to hang.
;
	Area = 4			; Offset to Area.
;
	.psect	SHEAP,ro,i
;
LckCur:	mov	r0,-(sp)		; Get a scratch register.
	mov	Area(sp),r0		; Get the area to lock.
	dec	r0
	asl	r0
	mov	@BasTbl(r0),r0		; Get the base address.
;
1$:	inc	Lock(r0)		; Try and lock the region.
	cmp	Lock(r0),#1		; See if we got it.
	beq	3$			; Did we lock it?
	dec	Lock(r0)		; No, remove ourselves.
2$:	tst	Lock(r0)		; Wait for it to go to Zero.
	bne	2$			; Is it still locked?
	br	1$			; No, go and try again.
;
3$:	mov	(sp)+,r0		; Restore our state.
	mov	(sp)+,(sp)
	return

	.sbttl	GetRId - Get the specified Region Id.
;{** Internal **}
;function GetRId(var SHeapStatus : SHeapStatusType;
;		 var RId : integer;
;		     RegionNumber : integer) : boolean;
;
;  This function looks up the region identifier for RegionNumber and
;  returns it in RId.  If it does all this successfully, then it returns
;  true, otherwise it returns false.
;
	Flag = 22		; Offset to return flag value.
	Status = 20		; Offset to SHeapStatus address.
	RId = 16		; Offset to RId Address.
	RegNum = 14		; Offset to RegionNumber value.
;
	.psect	SHEAP,ro,i
;
GetRId:	mov	r0,-(sp)		; Get some scratch registers.
	mov	r1,-(sp)
	mov	r2,-(sp)
	mov	r3,-(sp)
	mov	r4,-(sp)
;
	mov	#RIdCac,r0		; First, see if it is in our cache.
	mov	#RidNumOfEntries,r1	; Get the cache length.
	clr	r2			; Clear out a space for the RId.
	mov	r0,r3			; Start with the first entry.
	mov	RC.LRU(r0),r4
;
1000$:	dec	RC.LRU(r0)		; Decrement the Least used counter.
	bhis	2000$			; Was it as low as should go?
	inc	RC.LRU(r0)		; Yes, put it back to what it was.
2000$:	cmp	RC.Num(r0),RegNum(sp)
	bne	3000$			; Is this the region # we want?
	inc	RC.LRU(r0)		; Yes, show that we have used it.
	mov	RC.RId(r0),r2		; Save the RId.
3000$:	cmp	RC.LRU(r0),r4		; See if this is the least used entry?
	bge	4000$			; Is it, so far?
	mov	r0,r3			; Save it's address as the lowest.
	mov	RC.LRU(r0),r4		; And remember what the new lowest is.
4000$:	add	#RIdEntrySize,r0	; Get the next entry from the cache.
	sob	r1,1000$		; See if we've check everyone.
;
	tst	r2			; Check our results.
	beq	5000$			; Did we get an RId?
;
	mov	r2,@RId(sp)		; We sure did!
	br	9000$
;
5000$:	mov	#<SHPxxx+r.gnam+2>,-(sp)	; Pass an address to IntR50
	mov	<RegNum+2>(sp),-(sp)	; And pass the region number.
	call	IntR50			; And get the Rad-50 region name.
	bic	#RgnFlags,SHPxxx+r.gsts	; Clear the flags to find out the Id.
	atrg$s	#SHPxxx			; Get the region id.
	bcs	10000$			; Did we succeed?
;
8000$:	mov	RegNum(sp),RC.Num(r3)	; We found it.  Now, let us ...
	mov	SHPxxx+r.gid,RC.RId(r3)	; ... remember it for next time.
	mov	#-1.,RC.LRU(r3)		; Make it the most recently found.
	mov	RC.RId(r3),@RId(sp)	; And return it as the RId.
;
9000$:	mov	#E.Succ,@Status(sp)	; Save the status as success.
	mov	#True,Flag(sp)		; Return True.
	br	13000$			; And go wash up.
;
10000$:	mov	Status(sp),r0		; Get the status address.
	mov	#E.DirE,(r0)		; Directive Error.
	mov	#D.ATRG,2(r0)		; MAP$ error.
	mov	$dsw,4(r0)
	mov	#False,Flag(sp)		; Return false
	br	13000$
;
13000$:	mov	(sp)+,r4		; Clean up after ourselves.
	mov	(sp)+,r3
	mov	(sp)+,r2
	mov	(sp)+,r1
	mov	(sp)+,r0
	mov	(sp)+,4(sp)
	cmp	(sp)+,(sp)+
	return

	.sbttl	SHPDAT - Global variables for Super Heap
;
	.psect	SHPDAT,rw,d,gbl		; Data Psect
;
CurReg:	.blkw	7			; The Current Region that is loaded
RIdCac:	.blkb	RIdEntrySize * RidNumOfEntries	; The Region Id Cache.
;
SHP000:	rdbbk$	PagSiz,SHP000,GEN,<rs.att!rs.wrt!rs.red>,0
SHPXXX:	rdbbk$	PagSiz,SHPXXX,GEN,rs.att,0
;
WndTbl:	.word	WndBl0,WndBl1,WndBl2,WndBl3,WndBl4,WndBl5,WndBl6
RIdTbl:	.word	WndBl0+w.nrid,WndBl1+w.nrid,WndBl2+w.nrid,WndBl3+w.nrid
	.word	WndBl4+w.nrid,WndBl5+w.nrid,WndBl6+w.nrid
BasTbl:	.word	WndBl0+w.nbas,WndBl1+w.nbas,WndBl2+w.nbas,WndBl3+w.nbas
	.word	WndBl4+w.nbas,WndBl5+w.nbas,WndBl6+w.nbas
LenTbl:	.word	WndBl0+w.nlen,WndBl1+w.nlen,WndBl2+w.nlen,WndBl3+w.nlen
	.word	WndBl4+w.nlen,WndBl5+w.nlen,WndBl6+w.nlen
;
WndBl0:	wdbbk$	SHAPR1,PagSiz,,,,<ws.wrt!ws.64b>
WndBl1:	wdbbk$	SHAPR2,PagSiz,,,,<ws.wrt!ws.64b>
WndBl2:	wdbbk$	SHAPR3,PagSiz,,,,<ws.wrt!ws.64b>
WndBl3:	wdbbk$	SHAPR4,PagSiz,,,,<ws.wrt!ws.64b>
WndBl4:	wdbbk$	SHAPR5,PagSiz,,,,<ws.wrt!ws.64b>
WndBl5:	wdbbk$	SHAPR6,PagSiz,,,,<ws.wrt!ws.64b>
WndBl6:	wdbbk$	SHAPR7,PagSiz,,,,<ws.wrt!ws.64b>
;
	.end