.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 = ; .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 #,-(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,(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 #,-(sp) ; Pass the address to IntR50. mov (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 (sp),-(sp) ; Pass someplace for status. mov RidTbl(r0),-(sp) ; Pass the address to store the RId. mov (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 (sp),-(sp) ; Pass the SHeapStatus. mov RidTbl(r1),-(sp) ; Pass the address to store the RId. mov (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 (sp),-(sp) ; Pass the SHeapStatus. mov RidTbl(r0),-(sp) ; Pass the location for the RId. mov (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 (sp),-(sp) ; Pass the size the guy wants. mov (sp),-(sp) ; Pass the Area the guy wants. call Alloc ; And allocate the space. mov (sp)+,(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 ,-(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 #,-(sp) ; Pass an address to IntR50 mov (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,,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,,,, WndBl1: wdbbk$ SHAPR2,PagSiz,,,, WndBl2: wdbbk$ SHAPR3,PagSiz,,,, WndBl3: wdbbk$ SHAPR4,PagSiz,,,, WndBl4: wdbbk$ SHAPR5,PagSiz,,,, WndBl5: wdbbk$ SHAPR6,PagSiz,,,, WndBl6: wdbbk$ SHAPR7,PagSiz,,,, ; .end