;
;	ALLOC - C FREE STORAGE ROUTINES
;
;	This file is PDP-10 dependent, system independent.
;
;	CALLOC (SIZE) => *CHAR		; ALLOCATE ZEROED CHARACTERS
;	SALLOC (SIZE) => *INT		; ALLOCATE ZEROED WORDS
;	CFREE (*CHAR)			; RETURN CHARACTERS
;	SFREE (*INT)			; RETURN WORDS
;
;	AFREE (SIZE) => (ADDR)		; ALLOCATE GARBAGE WORDS
;	AFRET (ADDR, SIZE)		; DEALLOCATE WORDS
;	AFREZ (SIZE) => (ADDR)		; ALLOCATE AND ZERO WORDS
;
;	ALOCSTAT (&NWALLOC, &NBFREE) => NWFREE	; COMPUTE STATS
;

TITLE ALLOC
.INSRT NC
.INSRT NM


;	THESE ARE STORAGE-ALLOCATION ROUTINES WITH SOME PROTECTION

CENTRY	CALLOC,[NWORDS]		; ALLOCATE CHARACTERS
XENTRY	SALLOC,CALLOC		; ALLOCATE WORDS

	SKIPL	A,NWORDS	; DON'T ADD TO BAD SIZE
	ADDI	A,2		; FOR HEADER WORDS
	CALL	AFREZ,[A]
	ADDI	A,2		; POINTER TO USER AREA OF BLOCK
	MOVE	B,NWORDS
	MOVEM	B,-1(A)		; STORE SIZE IN HEADER
	MOVE	B,A
	ADD	B,[147506732514]
	MOVEM	B,-2(A)		; MAGIC WORD IN HEADER
	RETURN

CENTRY	CFREE,[PTR]		; RETURN CHARACTERS
XENTRY	SFREE,CFREE		; RETURN WORDS

	MOVE	A,PTR
	MOVE	B,-2(A)
	SUB	B,A
	CAME	B,[147506732514]
	 GO	CF$BAD
	MOVEI	A,-2(A)
	MOVE	B,1(A)
	ADDI	B,2
	CALL	AFRET,[A,B]
	SETZ	A,
CF$RET:	RETURN
CF$BAD:	CROAK	BAD CALL TO CFREE/SFREE
	SETO	A,
	GO CF$RET


.IDATA
MDATA	FNWORDS		; NUMBER OF WORDS ALLOCATED
	0
MDATA	FLIST
	FLIST+1		; LIST OF FREE BLOCKS
	0
.CODE
;
;	AFREE - ALLOCATE STORAGE
;

CENTRY	AFREE,[BSIZE]
XENTRY	GETVEC,AFREE

	MOVE	A,BSIZE
	JUMPLE	A,AE$BAD	; SIZE MUST BE POSITIVE
	CAIL	A,400000	; SIZE MUST BE REASONABLE
	 GO	AE$BAD
	HRLZI	D,(A)		; SIZE IN LEFT HALF FOR COMPARISON
	MOVEI	B,FLIST		; PREVIOUS BLOCK ADDR IN B
	HRRZ	C,(B)		; CURRENT BLOCK ADDR IN C
A1:	CAMG	D,(C)		; IS CURRENT BLOCK BIG ENOUGH?
	 GO	A3		; YES
	MOVEI	B,(C)		; CURRENT BLOCK -> PREVIOUS BLOCK
	HRRZ	C,(C)		; NEXT BLOCK -> CURRENT BLOCK
	JUMPN	C,A1		; BLOCK EXISTS => LOOP
	HLRZ	B,D		; DESIRED SIZE IN B
	PPUSH	B		; SAVE SIZE NEEDED
	CALL	GETCORE,[B]	; ALLOCATE NEW BLOCK (SIZE,,ADDR)
	HLRZ	B,A		; SIZE OBTAINED
	HRRZ	A,A		; ADDRESS OF BLOCK
	PPOP	D		; SIZE NEEDED
	SUBI	B,(D)		; HOW MUCH EXTRA OBTAINED?
	JUMPE	B,AE$RET	; NO EXCESS => DONE
	PPUSH	A		; ADDRESS OF BLOCK
	ADDM	B,(P)		; ADDRESS OF DESIRED PART OF BLOCK
	CALL	AFRET,[A,B]	; RETURN THE EXCESS
	PPOP	A		; ADDRESS OF DESIRED PART OF BLOCK
	GO	AE$RET		; DONE

;	HERE WHEN A SUFFICIENTLY LARGE BLOCK FOUND IN LIST

A3:	HLRZ	D,D		; DESIRED SIZE IN D
	HLRZ	A,(C)		; SIZE OF BLOCK IN LIST
	SUBI	A,(D)		; EXCESS
	JUMPE	A,A4		; NO EXCESS => DELETE BLOCK FROM LIST
	HRLM	A,(C)		; NEW BLOCK SIZE
	ADDI	A,(C)		; ADDRESS OF DESIRED PART OF BLOCK
	GO	AE$RET		; DONE

;	HERE WHEN ENTIRE BLOCK IS TO BE REMOVED FROM THE LIST

A4:	HRRZ	A,(C)		; NEXT BLOCK IN LIST
	HRRM	A,(B)		; CHAIN TO PREVIOUS BLOCK
	MOVEI	A,(C)		; RETURN THIS BLOCK
	GO	AE$RET		; DONE

AE$BAD:	CROAK	AFREE CALLED WITH BAD SIZE ARGUMENT
	SETZ	A,
AE$RET:	RETURN			; DONE

;
;	AFRET - DEALLOCATE STORAGE
;

CENTRY	AFRET,[PTR,BSIZE]

	MOVE	A,PTR
	MOVE	B,BSIZE
	JUMPLE	B,CODE [	; SIZE MUST BE POSITIVE
		CROAK	AFRET CALLED WITH BAD SIZE ARGUMENT
		GO	ARRET
		]
	MOVEI	C,FLIST		; ADDRESS OF PREVIOUS BLOCK IN C
	HRRZ	D,(C)		; ADDRESS OF CURRENT BLOCK IN D
A5:	CAIG	A,(D)		; FIND PLACE IN LIST
	 GO	A8		; NEW BLOCK GOES HERE
	MOVEI	C,(D)		; CURRENT BLOCK -> PREVIOUS BLOCK
	HRRZ	D,(D)		; NEXT BLOCK -> CURRENT BLOCK
	JUMPN	D,A5		; BLOCK EXISTS => LOOP

;	HERE TO INSERT NEW BLOCK AFTER A GIVEN BLOCK IN LIST

A6:	HLRZ	D,(C)		; SIZE OF OLD BLOCK
	ADDI	D,(C)		; END OF OLD BLOCK
	CAIGE	A,(D)		; OVERLAP WITH PREVIOUS BLOCK ?
	 GO	CODE [		; YES, ERROR
		CROAK AFRET CALLED WITH BAD ADDRESS
		GO	ARRET
		]
	CAIN	A,(D)		; CONTIGUOUS WITH PREVIOUS BLOCK ?
	 GO	A7		; YES, GO MERGE THEM
	HRRZ	D,(C)		; ADDRESS OF NEXT BLOCK (IF ANY)
	HRLI	D,(B)		; SIZE OF BLOCK BEING FREED (IN LEFT HALF)
	MOVEM	D,(A)		; MAKE DOPE WORD OF BLOCK BEING FREED
	HRRM	A,(C)		; CHAIN IT TO PREVIOUS BLOCK
	GO	ARRET		; DONE

;	HERE TO MERGE BLOCK WITH PREVIOUS BLOCK (ADDR IN C)

A7:	HLRZ	D,(C)		; SIZE OF OLD BLOCK
	ADDI	D,(B)		; ADD SIZE OF BLOCK BEING FREED
	HRLM	D,(C)		; STORE NEW SIZE IN OLD BLOCK
	GO	ARRET		; DONE

;	HERE IN INSERT NEW BLOCK IN MIDDLE OF LIST

A8:	MOVEI	0,(A)		; ADDRESS OF NEW BLOCK
	ADDI	0,(B)		; END OF NEW BLOCK
	CAILE	0,(D)		; OVERLAP WITH NEXT BLOCK ?
	 GO	CODE [		; YES, ERROR
		CROAK AFRET CALLED WITH BAD ADDRESS
		GO	ARRET
		]
	CAIE	0,(D)		; CONTIGUOUS WITH NEXT BLOCK ?
	 GO	A6		; NO, APPEND TO PREVIOUS BLOCK
	MOVS	0,(D)		; SWAPPED DOPE WORD OF NEXT BLOCK
	ADDI	0,(B)		; SIZE OF COMBINED BLOCK
	MOVSM	0,(A)		; MAKE DOPE WORD OF COMBINED BLOCK
	HRRM	A,(C)		; CHAIN IT TO PREVIOUS BLOCK
	HLRZ	D,(C)		; SIZE OF PREVIOUS BLOCK
	ADDI	D,(C)		; END OF PREVIOUS BLOCK
	CAIE	D,(A)		; CONTIGUOUS WITH PREVIOUS BLOCK ALSO ?
	 GO	ARRET		; NO, DONE
	HLRZ	D,(C)		; SIZE OF PREVIOUS BLOCK
	ADDI	0,(D)		; SIZE OF COMBINED BLOCK
	MOVSM	0,(C)		; MERGE AGAIN
ARRET:	RETURN			; DONE


;
;	AFREZ - ALLOCATE ZEROED BLOCK
;

CENTRY	AFREZ,[BSIZE]

	CALL	AFREE,[BSIZE]	; ALLOCATE A BLOCK
	SETZM	(A)		; ZERO FIRST WORD
	MOVE	B,BSIZE		; THE SIZE
	SOJE	B,AZRET		; NUMBER OF WORDS REMAINING TO BE ZEROED
	ADDI	B,(A)		; LAST WORD OF BLOCK
	HRLZI	C,(A)		; FIRST WORD OF BLOCK (LEFT HALF)
	HRRI	C,1(A)		; SECOND WORD OF BLOCK (RIGHT HALF)
	BLT	C,(B)		; TRANSFER ZEROES
AZRET:	RETURN			; DONE

;
;	ALOCSTAT - COMPUTE ALLOCATION STATISTICS
;

CENTRY	ALOCSTAT,[PNALOC,PNBFREE]

	MOVE	A,FNWORDS	; NUMBER ALLOCATED
	MOVEM	A,@PNALOC
	SETZ	A,		; ZERO SUM OF FREE BLOCK SIZES
	SETZM	@PNBFREE	; ZERO COUNT OF FREE BLOCKS
	MOVEI	B,FLIST		; PREVIOUS BLOCK ADDR IN B
	HRRZ	C,(B)		; CURRENT BLOCK ADDR IN C
A9:	HLRZ	D,(C)		; GET SIZE OF BLOCK
	ADD	A,D		; ADD TO SUM
	AOS	@PNBFREE
	MOVEI	B,(C)		; CURRENT BLOCK -> PREVIOUS BLOCK
	HRRZ	C,(C)		; NEXT BLOCK -> CURRENT BLOCK
	JUMPN	C,A9		; BLOCK EXISTS => LOOP
	RETURN

END