Enter your search terms Submit search form
	Web pdp-10.trailing-edge.com

	TITLE	CORBLI
	ENTRY	CORRES,CORGET,CORFRE
	TWOSEG
	RELOC	400000
;**Special version of CORMGT for use with BLISS
;**
;** Skip returns have been eliminated
;** The routines return 0 if they get an error
;** CORGET expects one argument PUSHed onto the stack (Length of block)
;** CORFRE expects 2 arguments PUSHed onto the stack:
;**		PUSHed first: the address of the block to free
;**		PUSHed second: the length of the block to free

	RADIX	10
T1=	1		; SCRATCH AC
T2=	2
T3=	3
LEN=	6		; LENGTH OF CURRENT BLOCK
BLK=	7		; ADDRESS OF CURRENT BLOCK
BLP=	8		; ADDRESS OF PREVIOUS BLOCK IN CHAIN
BLN=	9		; ADDRESS OF NEXT BLOCK IN CHAIN
P=	15		; PUSHDOWN LIST POINTER

SAVEND==	9		; LAST AC TO BE SAVED AND RESTORED

; RESET STORAGE
ALINI::			;Another name for the same thing
CORRES:	SETZM	FREPTR		; NO MORE FREE STORAGE CHAIN
	SETZM	NEXT		; NO MORE "NEXT" POINTER
	SETZM	SAVJBFF		; Clear saved .JBFF
	HLRZ	T1,.JBSA##	; Get first free location
	MOVEM	T1,FREEOK	; Save it away
	POPJ	P,

; ALLOCATE CORE STORAGE
CORGET:	PUSH	P,[0]		; INDICATE CORGET
	SKIPA

; RELEASE A STORAGE BLOCK
CORFRE:	PUSH	P,[1]		; INDICATE CORFRE

COM:	MOVEM	SAVEND,ACS+SAVEND ; SAVE AC'S TO SAVEND
	MOVE	SAVEND,[XWD 0,ACS]
	BLT	SAVEND,ACS+SAVEND-1
;	HLRZ	LEN,T1		; GET LENGTH OF BLOCK
;	HRRE	BLK,T1		; GET ADDR OF BLOCK (FOR FREE)
;Change for BLISS-36C argument passing
	HRRE	LEN,-2(P)	; Length is always the last argument
	HRRZ	BLK,-3(P)	; Addr for FREE, garbage otherwise
	POP	P,T1		; GET ENTRY INDICATOR
	JRST	.+1(T1)		; BRANCH BASED ON ENTRY
	JRST	GET		; CALL TO CORGET
	JRST	FREE		; CALL TO CORFRE

; COME HERE ON ALLOCATION REQUEST.  AT THIS POINT, 
;	LEN CONTAINS THE SIZE OF THE DESIRED BLOCK
GET:	MOVEI	BLN,FREPTR	; POINT TO FREE STORAGE CHAIN

; COME HERE TO LOOK AT THE FIRST (NEXT) BLOCK IN THE FREE STORAGE
; CHAIN.  WE MUST FIND THE FIRST BLOCK IN THE CHAIN WHICH IS
; LARGE ENOUGH TO HOLD THE DESIRED REQUEST.
GTL:	MOVE	BLP,BLN		; PREVIOUS BLOCK = OLD NEW BLOCK
	HRRZ	BLN,0(BLN)	; GET ADDRESS OF NEXT BLOCK IN CHAIN
	JUMPE	BLN,GTX		; GO EXPAND CORE AT END OF CHAIN
	HLRZ	T1,0(BLN)	; GET SIZE OF NEW BLOCK
	CAMLE	LEN,T1		; IS IT BIG ENOUGH?
	JRST	GTL		; GO FOR NEXT BLOCK IF NOT

; AT THIS POINT, WE HAVE FOUND A SUITABLE BLOCK.  THE ACS ARE:
;	BLN	POINTS TO THE SUITABLE BLOCK
;	BLP	POINTS TO THE PRECEDING BLOCK IN THE CHAIN
;	T1	CONTAINS THE LENGTH OF THE BLOCK POINTED TO BY BLN
;	LEN	CONTAINS THE SIZE OF THE DESIRED BLOCK.
; FURTHERMORE, WE KNOW AT THIS POINT THAT LEN IS LESS THAN OR
; EQUAL TO T1.
	MOVE	BLK,BLN		; THIS IS THE BLOCK ADDRESS WE WILL RETURN
;** Make it zero out left half and return only address
;** We know the length already
	HRRZM	BLK,AC1		; STORE INTO RETURN AC T1
	SUB	T1,LEN		; GET LENGTH REMAINING IN BLN BLOCK AFTER
				; WE REMOVE WHAT WE WANT.
	JUMPG	T1,GTLG		; GO IF THERE IS SOMETHING LEFT

; IF CONTROL COMES HERE, THEN THE CURRENT BLOCK IS EXACTLY THE SIZE
; REQUESTED BY THE CALLER. WE MUST SIMPLY REMOVE IT FROM THE CHAIN.
	HRRZ	T2,0(BLK)	; GET ADDRESS OF FOLLOWING BLOCK
	HRRM	T2,0(BLP)	; STORE AS "NEXT" POINTER FOR PRECEDING BLOCK

; NOW WE NEED ONLY UPDATE THE "NEXT" LOCATION.  THIS LOCATION CONTAINS
; THE ADDRESS OF THE FIRST LOCATION BEYOND THE LAST BLOCK IN
; THE FREE CHAIN.  IF WE HAVE GIVEN AWAY THE LAST BLOCK IN THE
; CHAIN, THEN "NEXT" MUST BE MODIFIED.
	ADD	BLK,LEN		; GET ADDR OF END OF CURRENT BLOCK
	CAME	NEXT		; WERE WE AT END OF CHAIN?
	JRST	RET		; JUST RETURN IF NOT
	HLRZ	T1,0(BLP)	; GET LENGTH OF PRECEDING BLOCK
	ADD	T1,BLP		; AND FIND END OF IT
	SKIPE	FREPTR		; BUT IS THE FREE CHAIN NOW EMPTY?
	SETZM	T1		; THEN "NEXT" = 0 IN THAT CASE
	MOVEM	T1,NEXT		; SET CORRECT ADDR FOR NEXT
	JRST	RET		; RETURN TO CALLER

; COME HERE IF WE HAVE FOUND A BLOCK WHICH IS LARGER THAN THE
; DESIRED SIZE.  AT THIS POINT,
;	BLN	CONTAINS POINTER TO THE FOUND FREE BLOCK
;	BLP	POINTS TO THE PRECEDING BLOCK IN THE CHAIN
;	BLK	SAME AS BLN
;	T1	LENGTH REMAINING FOR THE BLN BLOCK AFTER REMOVING
;		THE BLOCK WE ARE GIVING AWAY
;	LEN	THE LENGTH OF THE BLOCK WE ARE GIVING AWAY.
GTLG:	ADDM	LEN,0(BLP)	; ADJUST POINTER IN PRECEDING BLOCK
	HRRZ	BLN,0(BLP)	; BLN NOW POINTS TO NEW SHORTENED BLOCK
	HRL	T1,0(BLK)	; GET ADDRESS OF FOLLOWING BLOCK
	MOVSM	T1,0(BLN)	; STORE LENGTH/NEXT FOR SHORTENED BLOCK
	JRST	RET		; RETURN TO CALLER

; COME HERE WHEN THE END OF THE FREE CHAIN IS REACHED, INDICATING
; THAT THERE IS NO FREE BLOCK WHICH IS LARGE ENOUGH TO SATISFY
; THE REQUEST.
; WE SIMPLY ALLOCATE STORAGE FROM THE END OF CORE, INDICATED BY
; THE .JBFF POINTER, AND WE EXPAND CORE IF NECESSARY.
GTX:	SKIPN	BLK,SAVJBFF	; Use saved JBFF value if any
	 HRRZ	BLK,.JBFF##	; GET ADDRESS WE WILL RETURN
	MOVE	T1,BLK		; COPY IT OVER
	ADD	T1,LEN		; THIS WILL BE NEW .JBFF VALUE
	CAILE	T1,-1		; CHECK FOR SEGMENT OVERFLOW
	JRST	NOCORE		; WE'VE RUN OUT OF STORAGE
	MOVE	T2,T1		; COPY NEW END OF CORE POINTER
	SOS	T2		; DECREMENT TO GET LAST LOC WANTED
	CAMG	T2,.JBREL##	; DO WE HAVE TO EXPAND CORE?
	JRST	.+3		; SKIP EXPANSION IF NOT
	CORE	T2,		; EXPAND CORE
	JRST	NOCORE		; EXPANSION FAILED
	SKIPE	SAVJBFF		; Save in saved JBFF if used
	 JRST	[MOVEM T1,SAVJBFF
		 JRST  .+2]	; Don't overwrite the real .JBFF in this case
	MOVEM	T1,.JBFF##	; SET NEW .JBFF
;** Make left half of AC1 0 so we return only address
	HRRZM	BLK,AC1		; CHANGE RETURN AC
	JRST	RET		; RETURN TO CALLER

; COME HERE TO RETURN A BLOCK OF STORAGE TO THE FREE CHAIN.
; AT THIS POINT, 
;	BLK	POINTS TO THE BLOCK TO BE RETURNED
;	LEN	CONTAINS THE LENGTH OF THE BLOCK BEING FREED
FREE:	CAMG	BLK,FREEOK	; IS ADDRESS TOO CLOSE TO ZERO?
	JRST	BADFRE		; BAD IF SO
	SKIPN	T1,SAVJBFF	;Use saved JBFF if any
	 MOVE	T1,.JBFF##	;use real one
	CAML	BLK,T1		; HAS .JBFF ALREADY BEEN CHANGED?
	JRST	RET		; NOTHING TO DO IF SO

; WE MUST LOOP THROUGH THE EXISTING CHAIN OF FREE BLOCKS TO
; DETERMINE WHERE THE BLOCK BEING FREED SHOULD GO.
	MOVEI	BLN,FREPTR	; POINT TO BEGINNING OF CHAIN

; COME HERE TO GET FIRST (NEXT) BLOCK IN FREE CHAIN
FRL:	MOVE	BLP,BLN		; MOVE UP ONE BLOCK
	HRRZ	BLN,0(BLN)	; GET ADDR OF NEXT
	JUMPE	BLN,.+3		; SKIP TEST IF END OF CHAIN
	CAMGE	BLN,BLK		; IS THIS THE RIGHT POSITION?
	JRST	FRL		; LOOP FOR NEXT IF NOT

; WE COME HERE WHEN WE HAVE THE CORRECT POSITION OF THE BLOCK
; BEING FREED.  EITHER THE BLOCK IS TO BE INSERTED BETWEEN
; THE TWO BLOCKS POINTED TO BY BLP AND BLN, OR ELSE WE HAVE
; REACHED THE END OF THE CHAIN, AND THE NEW BLOCK GOES ONTO THE
; END OF THE CHAIN.  IN THE LATTER CASE, BLP POINTS TO THE LAST
; BLOCK IN THE CHAIN, AND BLN IS ZERO.

; WE MUST NOW CHECK TO SEE WHETHER THE BLOCK BEING FREED LIES
; BETWEEN THE TWO BLOCKS, OR WHETHER IT OVERLAPS ONE OF THE
; BLOCKS ON THE CHAIN.  IF IT OVERLAPS, THEN AN ILLEGAL ARGUMENT
; WAS PASSED TO THE ROUTINE.
	HLRZ	T1,0(BLP)	; GET LENGTH OF PRECEDING BLOCK
	ADD	T1,BLP		; COMPUTE END OF PRECEDING BLOCK
	CAMLE	T1,BLK		; DOES CURRENT BLOCK OVERLAP THIS?
	JRST	BADFRE		; BLOCKS OVERLAP -- ERROR
	MOVE	T2,BLK		; GET ADDR OF BLOCK BEING FREED
	ADD	T2,LEN		; COMPUTE ADDR OF END OF BLOCK
	JUMPE	BLN,.+3		; IF END OF CHAIN, DON'T TEST FOR OVERLAP
	CAMLE	T2,BLN		; FREED BLOCK OVERLAP NEXT BLOCK?
	JRST	BADFRE		; OVERLAP -- THIS IS AN ERROR

; AT THIS POINT, WE HAVE VERIFIED THAT THE BLOCK BEING RETURNED
; IS LEGAL, AND WE CAN NOW INSERT THE FREED BLOCK INTO
; THE FREE BLOCK CHAIN.
	HRLM	LEN,0(BLK)	; SET LENGTH OF FREED BLOCK
	HRRM	BLN,0(BLK)	; NEW BLOCK POINTS TO NEXT BLOCK
	HRRM	BLK,0(BLP)	; PRECEDING BLOCK POINTS TO NEW BLOCK

; WE HAVE NOW INSERTED THE FREED BLOCK, BUT ONE MORE CHECK HAS TO BE
; MADE.  IT IS POSSIBLE THAT THE FREED BLOCK CAN BE COMBINED WITH
; THE PRECEDING BLOCK, OR THE NEXT BLOCK, OR BOTH, TO FORM ONE BIG
; BLOCK.  AT THIS POINT,
;	BLP	POINTS TO THE PRECEDING
;	T1	POINTS TO THE FIRST LOCATION BEYOND THE PRECEDING BLOCK
;	BLK	POINTS TO THE NEW BLOCK
;	T2	POINTS TO THE FIRST LOCATION BEYOND THE NEW BLOCK
;	BLN	POINTS TO THE NEXT BLOCK IN THE CHAIN, OR IS ZERO
;		IF THE NEW BLOCK HAS GONE AT THE END OF THE CHAIN
;	LEN	IS THE LENGTH OF THE CURRENT BLOCK
	CAME	T1,BLK		; END OF PRECEDING BLOCK = START OF
				; NEW BLOCK?
	JRST	FRCH		; GO IF NOT
	MOVSS	LEN		; PUT LENGTH OF NEW BLOCK INTO LEFT HALF
	ADDM	LEN,0(BLP)	; INCREASE LENGTH OF PRECEDING BLOCK
	HRRM	BLN,0(BLP)	; PRECEDING BLOCK NOW POINTS TO NEXT BLOCK
	MOVE	BLK,BLP		; NEW BLOCK IS NOW THE COMBINED BLOCK

; NOW CHECK TO SEE IF THE NEW BLOCK CAN BE COMBINED WITH THE
; NEXT BLOCK.
FRCH:	CAME	T2,BLN		; END OF NEW BLOCK = START OF NEXT?
	JRST	FRCE		; GO IF NOT
	HLLZ	LEN,0(BLN)	; GET LENGTH OF NEXT BLOCK
	ADDM	LEN,0(BLK)	; INCREASE LENGTH OF NEW BLOCK
	HRRZ	T1,0(BLN)	; GET BLOCK POINTED TO BY NEXT BLOCK
	HRRM	T1,0(BLK)	; TAKE NEXT BLOCK OUT OF THE CHAIN

; THE CHAIN IS NOW CORRECT, AND ONLY ONE ADDITIONAL DETAIL MUST BE
; CLEANED UP.  THE LOCATION "NEXT" POINTS TO THE LOCATION OF MEMORY
; WHICH IS ONE BEYOND THE LAST BLOCK ON THE FREE CHAIN.  THIS
; WILL HAVE TO BE UPDATED NOW IF THE NEW BLOCK WAS PUT ONTO THE
; END OF THE CHAIN.  SINCE T2 POINTS TO THE FIRST LOCATION AFTER THE
; END OF THE NEW BLOCK, WE MAY TEST FOR THIS SITUATION BY SEEING
; WHETHER T2 EXCEEDS NEXT.
FRCE:	CAML	T2,NEXT		; SHOULD NEXT BE UPDATED?
	MOVEM	T2,NEXT		; UPDATE NEXT
;	JRST	RET

; COME HERE TO GIVE A NORMAL RETURN TO THE CALLER
;**RET:;Skip returns are a NO-NO!
;***	AOS	(P)		; INCREMENT RETURN ADDRESS

; COME HERE TO GIVE AN ERROR RETURN TO THE CALLER.

; WE MUST NOW CHECK TO SEE WHETHER IT IS TIME TO FREE UP STORAGE.
; WE MUST DO THIS IF .JBFF HAS BECOME LESS THAN OR EQUAL
; TO "NEXT", THE LOCATION FOLLOWING THE END OF THE FREE CHAIN.
; IF .JBFF HAS BECOME SMALLER, THEN WE REMOVE THE LAST BLOCK ON
; THE FREE CHAIN, RECOMPUTE "NEXT", SET .JBFF TO POINT TO
; THE BEGINNING OF THE BLOCK JUST RELEASED, AND EXECUTE A CORE
; UUO TO TELL THE MONITOR THAT WE DON'T WANT ANYTHING AFTER .JBFF.

; IT MAY BE DESIRABLE AT SOME POINT TO REWRITE THIS SECTION OF CODE
; TO FIGURE OUT WHETHER A CORE UUO IS REALLY NECESSARY. THIS WILL
; REQUIRE SOME KA/KI DEPENDING CODE.
RETER:	;**In case of error, return 0
	SETZM	AC1

RET:
	SKIPN	T2,SAVJBFF	;Use saved JBFF if in use
	 MOVE	T2,.JBFF##	;Use real one
	SKIPE	T1,NEXT		; GET "NEXT" VALUE, AND SKIP IF
				; FREE CHAIN IS EMPTY
	CAMGE	T1,T2		; LESS THAN .JBFF?
	JRST	RETC		; NOTHING TO DO

; WE MUST NOW FIND THE LAST BLOCK ON THE FREE CHAIN, SO THAT WE
; CAN RELEASE IT.
	MOVEI	BLN,FREPTR	; POINT TO CHAIN HEADER

; COME HERE TO MOVE UP TO FIRST (NEXT) FREE BLOCK IN CHAIN
RETL:	HRRZ	BLK,0(BLN)	; CURRENT BLOCK = BLOCK AFTER NEXT
	JUMPE	BLK,RETLA	; GO IF END OF CHAIN
	MOVE	BLP,BLN		; MOVE UP ONE BLOCK
	MOVE	BLN,BLK
	JRST	RETL		; AND LOOP BACK FOR NEXT

; WHEN CONTROL COMES HERE, BLP AND BLN POINT, RESPECTIVELY, TO THE
; LAST TWO BLOCKS ON THE FREE CHAIN.
RETLA:	HLLZS	0(BLP)		; PREVIOUS BLOCK IS NEW END OF CHAIN
	SKIPE	SAVJBFF		;Use saved .JBFF if in use
	 JRST	[MOVEM BLN,SAVJBFF
		 JRST .+2]	;Do not modify real one
	MOVEM	BLN,.JBFF##	; RESET .JBFF TO BEGINNING OF BLOCK
	SOS	BLN		; DECREMENT TO GET LAST LOC WANTED
	CORE	BLN,		; REDUCE SIZE OF CORE STORAGE
	JFCL			; SHOULD NEVER HAPPEN
	HLRZ	T1,0(BLP)	; GET LENGTH OF PRECEDING BLOCK
	ADD	T1,BLP		; GET LOCATION AFTER END OF BLOCK
	MOVEM	T1,NEXT		; AND STORE AS NEW VALUE OF "NEXT"
	SKIPN	FREPTR		; BUT IS FREE CHAIN EMPTY?
	SETZM	NEXT		; IF SO, THEN NEXT = 0

; WE NEED NOW ONLY RETURN TO THE CALLER, AFTER RESTORING HIS ACS.
RETC:	MOVSI	SAVEND,ACS	; SET BLT POINTER
	BLT	SAVEND,SAVEND	; RESTORE ALL REGISTERS
	POPJ	P,		; RETURN TO CALLER

	SUBTTL	ERROR MESSAGES

; COME HERE WHEN NO CORE IS AVAILABLE TO SATISFY CORGET REQUEST.
NOCORE:;	OUTSTR	[ASCIZ	/
;?CORNOC INSUFFICIENT STORAGE FOR CORGET REQUEST
;/]
;**Error message removed, routine will handle problem
	JRST	RETER

; COME HERE WHEN BAD ARGUMENTS ARE PASSED TO CORFRE
BADFRE:	OUTSTR	[ASCIZ	/
%Attempt to FREE storage that has not been allocated
/]
	JRST	RETER

	SUBTTL	LITERALS
	LIT

	SUBTTL	STORAGE AREA

	RELOC			; RELOCATE TO LOW SEGMENT

; FREPTR HAS THE FORMAT
;	XWD	0,ADDR OF FIRST BLOCK ON FREE CHAIN
; WHERE THE "ADDR" IS ZERO IF THE FREE CHAIN IS EMPTY.
; THE ELEMENTS OF THE FREE CHAIN ARE ORDERED BY INCREASING CORE
; ADDRESS.  THE FIRST WORD OF EACH ELEMENT OF THE FREE CHAIN
; HAS THE FORMAT
;	XWD	LENGTH OF THIS ELEMENT, ADDR OF NEXT ELEMENT
; WHERE THE "ADDR" IS ZERO FOR THE LAST ELEMENT OF THE FREE CHAIN.
; THE CORMGT ROUTINE AUTOMATICALLY COMBINES ADJACENT BLOCKS INTO
; ONE BIG BLOCK WHERE NECESSARY.
FREPTR:	BLOCK	1		; FREE CHAIN POINTER

; Saved value of .JBFF.  Set this up if playing "games" with .JBFF
; to build buffers or whatever.  CORBLI will read (and possibly modify)
; SAVJBFF instead of .JBFF if it is non-zero.  
; SAVJBFF MUST BE ZEROED if you don't want it to be believed.
SAVJBFF:: BLOCK	1		; Saved value of .JBFF


; LOCATION "NEXT" CONTAINS THE ADDRESS OF THE LOCATION FOLLOWING
; THE LAST BLOCK IN THE FREE CHAIN.  WE KEEP THIS AROUND SO THAT
; WE HAVE A QUICK WAY OF CHECKING WHETHER SOMEBODY ELSE HAS
; REDUCED .JBFF WITHOUT OUR KNOWING IT.  IF THE FREE CHAIN
; IS EMPTY, THEN LOCATION NEXT CONTAINS ZERO.
NEXT:	BLOCK	1		; NEXT LOC AFTER FREE CHAIN

; THE FOLLOWING IS THE SAVE AREA FOR THE ACS.
ACS:	BLOCK	SAVEND		; AC SAVE AREA
AC1=ACS+T1

; THE FOLLOWING LOCATION IS USED TO CHECK FOR ILLEGAL ARGUMENTS
; TO CORFRE. It is initialized from JOBSA[LH].
FREEOK::BLOCK	1		; NO FREE BLOCK CAN LIE BEFORE HERE.
	END