COMPIL(SPC,,,,,,DUMMYFORGDSCISS)
DEFINE SPCINS <$FUNLK,$FXBLD,$FXGET,$FXG,$FXDEL,$FXD>
COMPXX(SPC,<$GETB,$GET1B,$DELB,$DEL1B,$FSADD,$FSINS,$FSINI,SPCINS>
	,<GOGTAB,X22,X33,CORGET,CORREL>
	,<SMALL SPACE SERVICE ROUTINES>,,HIIFPOSIB)
BEGIN SPCSER -- SMALL FREE BLOCK SERVICE
%GPROC ←← 1	;GETTING PROC
%DPROC ←← 2	;DELETING PROC
%FFRXX ←← 3	;INDEX OF FIRST FREE LOCATION
HEREFK($GETB,$GETB.)
	MOVE	C,-1(P)		;GET SIZE
	MOVE	USER,GOGTAB	;
	SKIPE	A,$FSLIS(USER)
	PUSHJ	P,$GET1B	;CDR DOWN LIST
	TDZA	A,A		;NO JOY
	MOVE	A,B		;THE RESULT
RET22:	SUB	P,X22
	JRST	@2(P)		;RETURN
HEREFK($DELB,$DELB.)
	MOVE	B,-1(P)		;THE BLOCK
	MOVE	USER,GOGTAB
	SKIPE	A,$FSLIS(USER)
	PUSHJ	P,$DEL1B
	MOVEI	A,0
	JRST	RET22
GET1B1:	HRRZ	A,(A)		;PART OF THE $GET1B LOOP
HEREFK($GET1B,$GET1.)
	JUMPE	A,CPOPJ		;CHECK NULLITUDE
	PUSHJ	P,@%GPROC(A)	;CALL THE ROUTINE
	JRST	GET1B1		;LOOP ON TO NEXT, THIS ONE LOST
CPOPJ1:	AOS	(P)		;SKIP RETURN IF WIN
CPOPJ:	POPJ	P,		;RETURN
DEL1B1:	HRRZ	A,(A)		;SAME KLUGE
HEREFK($DEL1B,$DEL1.)		
	JUMPE	A,CPOPJ		;
	PUSHJ	P,@%DPROC(A)	;ALLOCATE ROUTINE
	JRST	DEL1B1		;LOST, TRY NEXT
	JRST	CPOPJ1		;WIN
HEREFK($FSADD,$FSAD.)		;LINKS IN ONE BLOCK
	MOVE	USER,GOGTAB
	MOVEI	LPSA,$FSLIS(USER)
	PUSH	P,LPSA		;THIS IS THE OWNER
	PUSH	P,-2(P)		;THE RECORD TO ADD
	PUSHJ	P,$FSINS	;CALL INSERT ROUTINE
	JRST	RET22		;GO RETURN
HEREFK($FUNLK,$FUNL.)
	MOVE	LPSA,-1(P)	;THE BLOCK WE ARE TO UNLINK
	MOVE	TEMP,(LPSA)	;THE LEFT,,RIGHT
	TRNE	TEMP,-1		;IF HAVE A RIGHT HAND
	HLLM	TEMP,(TEMP)	;LET HIM HOLD MY LEFT
	MOVSS	TEMP		;SWAP HALVES
	HLRM	TEMP,(TEMP)	;LET HIM HOLD MY RIGHT
	JRST	RET22		;DONE
HEREFK($FSINS,$FSIN.)		;
	HRRZ	TEMP,-1(P)	;THE THING TO INSERT
	HRRZ	LPSA,-2(P)	;ADDRESS OF OWNER CELL
	HRLM	LPSA,(TEMP)	;REMEMBER AS BACK POINTER
	EXCH	LPSA,(LPSA)	;LPSA IS NOW FWD PTR
	TRNE	LPSA,-1		;WAS THE CHAIN NULL?
	HRLM	TEMP,(LPSA)	;NO HE GETS A BACK PTR TOO
	HRRM	LPSA,(TEMP)	;OLD HEAD IS NEW RIGHT BROTHER
RET33:	SUB	P,X33		;RETURN
	JRST	@3(P)		;
NOLOW <
NOUP <
REN <
	USE
>;REN
FSI:	0
	$FSINI
	0
	LINK	%INLNK,FSI
REN <
	USE HIGHS
>;REN
>;NOUP
>;NOLOW
HEREFK($FSINI,$FSI..)
	SKIPN	USER,GOGTAB
	ERR	<$FSINI CALLED W/O GOGTAB INITIALIZED>
	SKIPE	$FSLIS(USER)
	ERR	<$FSINI CALLED WITH THINGS ON $FSLIS>,1
	MOVEI	C,3	;JUST A LITTLE BLOCK
	PUSHJ	P,CORGET
	ERR	<CORGET DIDN'T GIVE ME ANY>,1
	HRRZM	B,$FSLIS(USER)
	HRLZI	C,$FSLIS(USER)
	MOVEM	C,(B)
	MOVEI	C,CORGET
	MOVEM	C,%GPROC(B)
	MOVEI	C,[PUSHJ P,CORREL
		   AOS(P)
		   POPJ P,
		  ]
	MOVEM	C,%DPROC(B)
	POPJ	P,
%FXIX ←← %FFRXX	;FIRST LEGAL FIELD
DEFINE $FXFLD(ID) <
	ID ←← %FXIX
	%FXIX ←← %FXIX+1
>
$FXFLD	%BLKSIZ	;BLOCK SIZE
$FXFLD	%MINSIZ	;MIN ACCEPTABLE SIZE
$FXFLD	%BLKCNT	;NUMBER OF BLOCKS PER SPACE
$FXFLD	%USECNT	;NUMBER OF BLOCKS ALLOCATED FROM THIS SPACE
$FXFLD	%MAXADR	;MAX ADDRESS OF A BLOCK IN THIS SPACE
$FXFLD	%FRELIS	;FREE LIST
$FXFLD	%SUBLIS	;SUBLIST OF SIMILAR BLOCKS
$FXFLD	%FIRBLK	;FIRST DATA WORD
HEREFK($FXGET,$FXGE.)
	CAMG	C,%BLKSIZ(A)	;WOULD IT FIT
	CAMGE	C,%MINSIZ(A)	;
	POPJ	P,		;NO
	PUSH	P,A		;YEP GO DOWN KINDERN
FGTRY:	SKIPE	A,%SUBLIS(A)	;IF ANY
	PUSHJ	P,$GET1B	;
	JRST	ADDAB		;ADD A BLOCK
FGWIN:	POP	P,A		;I AM SUCH A WINNER
	JRST	CPOPJ1		;& GO WIN
ADDAB:	MOVE	A,(P)		;SINCE A IS ZERO AT THIS POINT
	MOVEI	B,%SUBLIS(A)	;OWNER OF NEW LIST
	PUSH	P,B		;BUILD CALL TO $FXBLD
	PUSH	P,-1(P)		;PUSH A COPY OF A
	PUSHJ	P,$FXBLD	;MAKES A NEW SPACE FOR $FXG
	MOVE	A,(P)		;WHERE WE HAD SAVED IT
	JRST	FGTRY		;GO TRY AGAIN -- EXPECT TO WIN
HEREFK($FXG,$FXG.)
	CAMG	C,%BLKSIZ(A)	;WOULD IT FIT?
	CAMGE	C,%MINSIZ(A)	;
	POPJ	P,		;NO WAY
	SKIPN	B,%FRELIS(A)	;ONE ON FREE LIST
	POPJ	P,		;NO SUCH LUCK
	AOS	%USECNT(A)	;ONE LESS FREE NOW
	PUSH	P,(B)		;KLUGY WAY TO COPY FREE LIST
	POP	P,%FRELIS(A)	;PUTS BACK THE NEXT ONE
	JRST	CPOPJ1		;GO SKIP RETURN -- WE WIN
HEREFK($FXDEL,$FXDE.)		
	PUSH	P,A		;IN THIS CASE, JUST GO DOWN CHILDREN
	SKIPE	A,%SUBLIS(A)	;
	PUSHJ	P,$DEL1B	;LIKE SO
	SOS	-1(P)		;WILL NA SKIP RETURN
	POP	P,A		;GET OWN NAME BACK
	JRST	CPOPJ1		;I AM A WINNER
HEREFK($FXD,$FXD.)		
	CAMG	B,%MAXADR(A)	;IN RANGE?
	CAIG	B,(A)		;A IS MY OWN POINTER,REMEMBER
	POPJ	P,		;NOPE
	SOSG	%USECNT(A)	;IF THIS WAS THE LAST
	JRST	BIGKIL		;THEN THE WHOLE BLOCK GOES AWAY
	PUSH	P,B		;MUST PRESERVE
	HRRZS	B		;JUST BE SURE RHS ONLY IS ON
	EXCH	B,%FRELIS(A)	;SAVE AWAY NEW LIST
	MOVEM	B,@%FRELIS(A)	;& LINK IT TO OLD
	POP	P,B		;GET BACK
	JRST	CPOPJ1		;WHAT WINNAGE!
BIGKIL:	PUSH	P,LPSA		;SAVE A COUPLE
	PUSH	P,TEMP		;
	PUSH	P,B
	PUSH	P,A		;GO UNLINK THIS BLOCK
	PUSHJ	P,$FUNLK	;LIKE SO
	MOVE	B,A		;GO CLOBBER THE WHOLE BLOCK
	PUSHJ	P,CORREL	;LIKE SO
	POP	P,B		;A PITY CANNOT JUST ZERO OUT B
	POP	P,TEMP		;GET ACS BACK
	POP	P,LPSA		;
	JRST	CPOPJ1		;RETURN
HEREFK($FXSPC,$FXSP.)
	MOVEI	C,%FIRBLK	;HOW BIG IT NEEDS TO BE
	PUSHJ P,CORGET		;USE CORGET SPACE FOR THIS (DONT REALLY HAVE TO
	ERR <NO CORE TO BE HAD>,1  ; BUT MAY WANT TO DO THIS AT FUNNY TIMES)
	MOVE	A,B		;WHERE WE WILL RETURN VALUE
	HRL	B,B		;CLEANSE IT
	HRRI	B,1(B)
	SETZM	(B)
	BLT	B,%FIRBLK-1(A)
	MOVEI	B,$FXGET	;
	MOVEM	B,%GPROC(A)
	MOVEI	B,$FXDEL
	MOVEM	B,%DPROC(A)
	POP	P,B
	POP	P,%BLKCNT(A)
	POP	P,%MINSIZ(A)
	POP	P,%BLKSIZ(A)
	JRST	(B)
HEREFK($FXBLD,$FXBL.)		
	MOVE	A,-1(P)		;MUST ADD A BLOCK
	PUSH	P,C		;SAVE THIS SIZE REQUEST
	PUSH	P,TEMP		;SAVE A COUPLE ACS
	PUSH	P,LPSA		;WHICH WE PROMISSED NOT TO MUNGE
	PUSH	P,B		
	SKIPN	C,%BLKCNT(A)	;
	ERR	<IT DOESN'T HELP YOU MUCH TO ALLOCATE ZERO MORE BLOCKS>,1,L1DON
	IMUL	C,%BLKSIZ(A)	;B ← NOMINAL BLOCK SIZE * COUNT + OVERHEAD
	ADDI	C,%FIRBLK	; 
	PUSHJ	P,CORGET	;A BLOCK OF THIS GREAT SIZE
	ERR	<COULDN'T GET ANY MORE SPACE FROM CORGET>,1
	MOVEI	TEMP,%FIRBLK(A)	;NOW CHAIN ALL SUB-BLOCKS TOGETHER
	MOVEI	LPSA,0		;
	MOVE	C,%BLKCNT(A)	;SO WE WILL COUNT DOWN
	MOVEM	C,%BLKCNT(B)	;ALSO, THE BLOCK COUNT FOR THIS
L1B:	MOVEM	LPSA,(TEMP)	;POINT TO NEXT
	MOVE	LPSA,TEMP	;REMEMBER THE BACK POINTER
	ADD	TEMP,%BLKSIZ(A)	;NEXT BLOCK
	SOJG	C,L1B		;COUNT DOWN TO ZERO
L1DON:	MOVEM	LPSA,%FRELIS(B)	;THIS IS THE FIRST FREE
	MOVEM	LPSA,%MAXADR(B)	;ALSO THE MAX ADDRESS BLOCK IN THIS SPACE
	SETZM	%USECNT(B)	;USE COUNT IS ZERO
	SETZM	%SUBLIS(B)	;THE SUBLIST IS ZERO
	MOVE	LPSA,%MINSIZ(A)	;COPY THESE, TOO (HRROI POP IS FASTER
	MOVEM	LPSA,%MINSIZ(B)	;BUT THIS ALLOWS EASIER REARRANGEMENT)
	MOVE	LPSA,%BLKSIZ(A)	;
	MOVEM	LPSA,%BLKSIZ(B)	;
	MOVEI	LPSA,$FXG	;THE HANDLERS FOR THESE
	MOVEM	LPSA,%GPROC(B)	;REMEMBER THE HANDLER
	MOVEI	LPSA,$FXD
	MOVEM	LPSA,%DPROC(B)	;
	PUSH	P,-6(P)		;GO LINK ONTO THIS ADDRESS
	PUSH	P,B		;THE BLOCKID
	PUSHJ	P,$FSINS	;USING THE STANDARD INSERTER
	POP	P,B
	POP	P,LPSA		;GET ACS BACK
	POP	P,TEMP		;
	POP	P,C		;
	SUB	P,X33
	JRST	@3(P)		;RETURN
BEND SPCSER
ENDCOM	(SPC)