TITLE	.ALCBF ALLOCATE DYNAMIC I/O BUFFERS
	SEARCH	UUOSYM
	ENTRY	.ALCBF,.FREBF

	TWOSEG
	RELOC	400000

	T1=	1
	T2=	2
	T3=	3
	T4=	4
	P1=	5
	P2=	6
	P3=	7
	P4=	10
	P=	17

;.ALCBF -- ALLOCATE DYNAMIC I/O BUFFERS
;CALL:	MOVE	T1,[XWD NBUF,BUFSIZ]
;	MOVE	T2,[XWD OPNBLK,BFHDR]
;	PUSHJ	P,.ALCBF
;	*RETURN*
;ACS:	T1-3

.ALCBF::PUSHJ	P,.SAVE3##	;SAVE P1-3
	MOVE	P1,T1		;COPY NBUF,,BUFSIZ
	PUSH	P,T2		;REMEMBER BUFFER HEADER ADDRESS
	HLRZ	T1,T2		;GET OPEN BLOCK ADDRESS
	MOVE	T2,.OPDEV(T1)	;GET THE DEVICE NAME
	DEVTYP	T2,		;SEE WHAT IT IS
	 JRST	ABFERR		;SHOULD NEVER HAPPEN
	DEVSIZ	T1,		;SEE WHAT DEFAULTS ARE FOR THIS DEV
	 JRST	ABFERR		;SHOULD NEVER HAPPEN
	TLNN	P1,-1		;IS NBUF THERE?
	HLL	P1,T1		;NO--USE THE DEFAULT
	TLNE	T2,(TY.VAR)	;CAN DEVICE HAVE VARIABLE BUFFER SIZE?
	TRNN	P1,-1		;YES--IS IT SPECIFIED?
	 HRRI	P1,-3(T1)	;NO--USE DEFAULT
	ADDI	P1,3		;COMPUTE ACTUAL BUFFER SIZE
	HLRZ	P2,P1		;GET # BUFFERS
	HRRZ	P3,(P)		;GET "LAST BUFFER" SET UP

ALCBF1:	HRRZ	T1,P1		;GET CORE BLOCK SIZE
	PUSHJ	P,.ALCOR##	;GET THE BLOCK
	AOS	T1		;ADDRESS THE BUFFER LINK POINTERS
	HRRM	T1,(P3)		;FORM A RING
	MOVEI	T2,-2(P1)	;SIZE OF DATA AREA
	HRLM	T2,(T1)		;STORE IN BUFFER
	MOVE	P3,T1		;MOVE ALONG THE RING
	SOJG	P2,ALCBF1	;MAKE ALL REQUIRED

	POP	P,T2		;GET BUFFER HEADER ADDRESS
	MOVSI	T3,(1B0)	;GET NOT USED BIT
	HLLM	T3,(T2)		;SET IT IN THE BUFFER
	HRRZ	T2,(T2)		;FIRST BUFFER ADDRESS
	HRRM	T2,(T1)		;COMPLETE THE RING
	POPJ	P,		;RETURN

ABFERR:	OUTSTR	[ASCIZ\?ABFDUF DEVSIZ/TYP UUO FAILED\]
	EXIT	1,
	JRST	.-1		;NO CONTINUE HERE!
;.FREBF -- RETURN BUFFERS TO FREE CORE
;CALL:	MOVE	T1,BUFHDR ADDRESS
;	PUSHJ	P,.FREBF
;	*RETURN*
;ACS:	T1-2

.FREBF::PUSHJ	P,.SAVE2##
	MOVE	P1,T1		;SAVE BUFFER HEADER ADDRESS
	HRRZ	P2,(P1)		;GET FIRST UFFER
	HLLM	P2,(P1)		;CLEAR LH OF BUFFER RING HEADER
FREBF1:	MOVEI	T1,-1(P2)	;ADDRESS THE CORE
	HRRZ	P2,(P2)		;MOVE TO NEXT BUFFER
	PUSHJ	P,.DECOR##	;FREE THIS BUFFER
	CAME	P2,(P1)		;DONE FREEING THE BUFFER?
	 JRST	FREBF1		;NO--DO SOME MORE
	SETZM	(P1)		;YES--CLEAR THE BUFFER HEADER ADDRESS
	POPJ	P,		;RETURN

	NOSYM
	PRGEND
	TITLE	.ALCOR	DYNAMIC CORE ALLOCATION
	SEARCH	JOBDAT
	ENTRY	.ALCOR,.DECOR,.RECOR
	TWOSEG
	RELOC	400000

	T1=	1		;TEMPORARY
	T2=	2
	T3=	3
	T4=	4
	P1=	5		;PRESERVED
	P2=	6
	P3=	7
	P4=	10
	P=	17

	MINSIZ==3		;MINIMUM CORE BLOCK SIZE

	IFNDEF KOUNT,KOUNT==0		;NON-ZERO FOR LOOP COUNTS

COMMENT	\THE CORE IS ALLOCATED WITH A LINK WORD AT -1(T1).  THE LEFT
	HALF CONTAINS A WORD COUNT AND SHOULD NOT BE TOUCHED.  ALL CORE
	ALLOCATED BY .ALCOR WILL BE PRE-ZEROED.
	\


;.ALCOR -- ALLOCATE A CORE BLOCK
;CALL:	MOVE	T1,WORDS
;	PUSHJ	P,.ALCOR
;	*RETURN,T1 HAS ADDRESS*
;ACS:	RETURNS ADDRESS OF CORE BLOCK IN T1

.ALCOR::JUMPLE	T1,.POPJ##	;WATCH OUT FOR FUNNY CALLS
	PUSHJ	P,.SAVE2##	;SAVE THE PROTECTED REGISTER
	PUSHJ	P,.PSH4T##	;SAVE T1-4 ALSO
	MOVEI	P1,1(T1)	;ALLOW FOR THE LINK WORD
	SKIPN	SAVJFF		;HAS RECORE BEEN CALLED?
	 PUSHJ	P,.RECOR	;NO, DO AN IMPLICIT CALL
IFN KOUNT,AOS	KACALL		;COUNT THIS CALL TO ALCOR

	SKIPE	T4,FRE.DY	;IS THE LIST EMPTY?
	 JRST	ALCOR1		;NO--SKIP AHEAD
	PUSHJ	P,GETCOR	;YES--START THE LIST
	MOVEM	T4,FRE.DY	;SAVE FOR FUTURE REFERENCE

ALCOR1:	MOVEI	T4,FRE.DY	;INIT THE POINTER
ALCOR2:	MOVE	T3,T4		;REMEMBER FROM WHENCE WE CAME
IFN KOUNT,AOS	KALOOP		;COUNT LOOP THRU
	HRRZ	T4,(T4)		;CHAIN TO THE NEXT BLOCK
	JUMPE	T4,ALCOR3	;JUMP IF AT THE END OF THE LIST
	HLRZ	T2,(T4)		;NO--GET BLOCK SIZE
	CAML	T2,P1		;HOW DOES IT LOOK ON ME?
	 JRST	GOTBLK		;FINE SO FAR
	  JRST	ALCOR2		;A LITTLE SMALL

;GET HERE WHEN NO BLOCK IS BIG ENOUGH

ALCOR3:	PUSHJ	P,GETCOR	;GET MORE CORE
	HRRM	T4,(T3)		;LINK IT INTO THE LIST
	HLRZ	T2,(T4)		;PICK UP THE BLOCK SIZE
	HLRZ	T1,(T3)		;GET THE END BLOCK SIZE
	ADDI	T1,(T3)		;COMPUTE END OF BLOCK
	CAIE	T1,(T4)		;IS IT ON THE END OF CORE?
	 JRST	GOTBLK		;NO--SKIP AROUND
	SUBI	T1,(T3)		;YES--GET SIZE AGAIN
	ADDI	T1,(T2)		;COMPUTE SIZE OF NEW LARGER BLOCK
	HRLZM	T1,(T3)		;STORE SIZE AND ZERO LINK
	JRST	ALCOR1		;NOW GO FIND THE NEW BLOCK

;HERE WITH A GOOD BLOCK

GOTBLK:	SUB	T2,P1		;GET SIZE DIFFERENCE
IFGE MINSIZ,<CAILE T2,MINSIZ>	;CHECK FOR BLOCK TOO SMALL
	JUMPN	T2,TOOBIG	;JUMP IF THE BLOCK IS TOO LARGE
	HRRZ	T2,(T4)		;NO, IT FITS FINE, UNLINK FROM FREE LIST
	HRRM	T2,(T3)		;STORE LINK INTO PREVIOUS BLOCK
	JRST	ZERBLK		;GO CLEAR IT AND RETURN

;THE BLOCK WE FOUND WAS TOO BIG, ADJUST ALL POINTERS

TOOBIG:	HRL	T2,(T4)		;FORM NEW POINTER (SWAPPED)
	HRLZM	P1,(T4)		;STORE NEW LINK WORD (SIZE)
	ADD	T4,P1		;POINT AT THE FRAGMENT
	MOVSM	T2,(T4)		;STORE THE LINK WORD FOR THE FRAGMENT
	HRRM	T4,(T3)		;STORE PTR TO FRAGMENT IN PREVIOUS BLOCK
	SUB	T4,P1		;GET TO THE BLOCK AGAIN
IFN KOUNT,AOS	KFRGB		;COUNT A FRAGMENTED ALLOCATION

ZERBLK:	AOS	T4		;SKIP THE LINK WORD
	SOS	P1		;UNCOUNT IT
	MOVE	T1,T4		;SET ADDRESS FOR RETURN TO USER
	SETZM	(T1)		;CLEAR THE FIRST WORD
	HLLZS	-1(T1)		;ENSURE THAT RH OF MY WORD IS CLEAR
	SOJLE	P1,ACRXIT	;JUMP IF ONLY ONE WORD
	HRLZ	T2,T4		;NO--FORM BLT CONTROL WORD
	HRRI	T2,1(T4)	;...
	ADD	P1,T4		;COMPUTE END OF THE BLOCK
	BLT	T2,(P1)		;CLEAR THE BLOCK
ACRXIT:	MOVE	P1,T1		;SAVE OVER .POP4T
	PUSHJ	P,.POP4T##	;RESTORE T1-4
	MOVE	T1,P1		;POSITION ANSWER
	POPJ	P,		;RETURN TO CALLER

;CALL HERE TO GET CORE
;RETURN .POPJ WITH CORE BLOCK ADDRESS IN T4

GETCOR:	MOVE	T1,.JBFF	;GET END OF CORE
	ADD	T1,P1		;COMPUTE WHAT WE NEED
	CORE	T1,		;ASK MON FOR IT
	 JRST	NOCORE		;GO DIE
	MOVE	T1,.JBREL	;GET END OF CORE BOUNDARY
	AOS	T1		;PUT .JBFF IN THE BOONIES (CLAIM THE WHOLE BLOCK)
	MOVE	T4,.JBFF	;GET CURRENT END OF CORE (START OF BLOCK)
	MOVEM	T1,.JBFF	;STORE NEW END OF CORE
	SUB	T1,T4		;COMPUTE CHUNK SIZE
	HRLZM	T1,(T4)		;STORE LINK WORD FOR THIS NEW BLOCK
	POPJ	P,		;TAKE 'GOT NEW CORE' RETURN

NOCORE:	OUTSTR	[ASCIZ\?ACRNEC NOT ENOUGH CORE\]
	EXIT	1,		;EXIT QUIETLY
	JRST	GETCOR		;GO TRY AGAIN ON CONTINUE
;.RECOR -- RESET CORE ALLOCATION
;CALL:	PUSHJ	P,.RECOR
;	*RETURN*
;ACS:	T1

.RECOR::SKIPE	T1,SAVJFF	;FIRST CALL?
	 JRST	RESCOR		;NO, GO RESET CORE
	MOVE	T1,.JBFF	;GET START OF FREE CORE
	MOVEM	T1,SAVJFF	;REMEMBER IT FOR CORE SHRINKING
RCRXIT:	SETZM	FRE.DY		;CLEAR THE FREE-LIST
IFN KOUNT,<
	SETZM	KF.ZER		;CLEAR THE COUNTERS
	SKIPA	T1,.+1		;
	 KF.ZER,,KF.ZER+1
	BLT	T1,KE.ZER
>;END IFN KOUNT
	POPJ	P,		;RETURN TO CALLER

RESCOR:	CAMG	T1,.JBREL	;IF WE NEED TO,
	 CORE	T1,		;GIVE BACK SOME CORE
	JFCL			;(SHOULD NEVER HAPPEN)
	MOVE	T1,SAVJFF	;GET ORIG CORE ALLOC
	MOVEM	T1,.JBFF	;RESET IT
	JRST	RCRXIT		;GO CLEAR LIST AND RETURN
;.DECOR -- GIVE BACK A CORE BLOCK
;CALL:	MOVE	T1,CORBLK
;	PUSHJ	P,.DECOR
;	*RETURN*
;ACS:	T1-2

.DECOR::PUSHJ	P,.SAVE3##	;SAVE P1-3
IFN KOUNT,AOS	KDCALL		;COUNT CALL TO .DECOR
	MOVEI	P1,-1(T1)	;POINT AT BLOCK LINK WORD
	  MOVEI	P2,FRE.DY	;START AT THE BEGINNING

DECOR1:	MOVE	P3,P2		;REMEMBER WHERE WE WERE
	HRRZ	P2,(P2)		;CHAIN ALONG THE LIST
IFN KOUNT,AOS	KDLOOP		;COUNT THE LOOK
	JUMPE	P2,DECOR2	;JUMP IF WE REACHED THE END
	CAMGE	P2,P1		;PASSED IT IN CORE ADDRESSES?
	 JRST	DECOR1		;NO--MOVE ALONG THE LIST

DECOR2:	HLRZ	T1,(P1)		;GET CORE BLOCK SIZE
	ADDI	T1,(P1)		;COMPUTE END OF NEW BLOCK
	CAME	T1,P2		;IS P2 RIGHT AFTER ME?
	 JRST	[
		HRRM	P2,(P1)	;NO--POINT ME AT IT
		JRST	DECOR3	;AND CHECK LOWER BOUND
		]
	HLRZ	T1,(P1)		;YES--GET CORE BLOCK SIZES
	HLRZ	T2,(P2)		;OF BOTH BLOCKS
	ADD	T1,T2		;COMPUTE NEW LARGER FREE BLOCK SIZE
	HRL	T1,(P2)		;FORM NEW POINTER (SWAPPED)
	MOVSM	T1,(P1)		;STORE NEW BLOCK POINTER

DECOR3:	HLRZ	T1,(P3)		;GET SIZE OF PREDECESSOR BLOCK
	JUMPE	T1,[
		HRRM	P1,(P3)	;MUST BE FIRST BLOCK--STORE LINK
		POPJ	P,	;ALL DONE HERE
		]
	ADD	T1,P3		;FIND END OF PREDECESSOR
	CAME	T1,P1		;IS IT IMMEDIATE PREDECESSOR?
	 JRST	[		;NO--STORE LINK AND RETURN
		HRRM	P1,(P3)	;...
		POPJ	P,	;ALL DONE
		]
	HLRZ	T1,(P3)		;YES--GET SIZE OF PREDECESSOR
	MOVS	P1,(P1)		;GET FREED BLOCK DATA WORD SWAPPED
	ADDI	T1,(P1)		;COMPUTE SIZE OF NEW LARGER BLOCK
	HLL	T1,P1		;FORM SWAPPED POINTER WORD
	MOVSM	T1,(P3)		;STORE NEW BLOCK POINTER WORD
	POPJ	P,		;ALL DONE

	RELOC	0		;LOCAL STORAGE

FRE.DY::BLOCK	1		;START OF FREE CORE LIST
SAVJFF:	BLOCK	1		;ORIGINAL CORE ALLOCATION
IFN KOUNT,<
KF.ZER:
KACALL:	BLOCK	1		;# CALLS TO .ALCOR
KALOOP:	BLOCK	1		;# LOOPS IN .ALCOR
KDCALL:	BLOCK	1		;# CALLS TO .DECOR
KDLOOP:	BLOCK	1		;# LOOPS IN .DECOR
KFRGB:	BLOCK	1		;# FRAGMENTED BLOCKS ALLOCATED
KE.ZER==.-1
>;END IFN KOUNT

	RELOC
	NOSYM
	END