TITLE	FREE STORAGE PACKAGE
	SUBTTL	STEVE KIDD           22 MAR 70
;
;	FREE STORAGE INITIALIZATION
;	CALL IS
;		COMMON SPACE(1) 
;		CALL HEREIS (SPACE)
;
	ENTRY HEREIS
	EXTERN JOBFF,JOBREL
HEREIS:	0
	MOVEM	1,HX1#		;SAVE AC1
	MOVE	(16)		;ADDR(SPACE)
	SUBI	2		;ADJUST TO BE RELATIVE TO 0
	HRRM	SPACE#		;PATCHINTO SUBSCRIPT CALCULATOR
	MOVEI	1,^D9		;SET COUNT
	SETZM	HDR(1)		;AND CLEAR HDR TABLE
	SOJGE	1,.-1
	MOVE	1,HX1		;RESTORE AC1
	JRA	16,(16)		;AND RETURN
;
;	FREE STORAGE ALLOCATION
;	CALL IS
;		CALL ALLOC (J,SIZE,ERRET)
;
;	WHERE	J IS A SUBSCRIPT RELATIVE TO SPACE,
;		SIZE IS THE SIZE OF BLOCK TO BE ALLOCATED
;		ERRET IS AN OPTIONAL ERROR RETURN.
;
;	IF ERRET IS TAKEN, J WILL BE SET TO AN ERROR  CODE AS FOLLOWS:
;		1 INVALID CALL
;		2 REQUEST EXCEEDS PHYSICAL CORE
;		3 REQUEST EXCEEDS AVAILABLE VIRTUAL CORE
;

	ENTRY	ALLOC
;
ALLOC:	0
	MOVEM	1,AX1		;SAVE  REGISTERS
	MOVEM	2,AX2
	MOVEM	3,AX3
	MOVEM	4,AX4
	MOVE	1,@1(16)	;SIZE TO AC1
	MOVEM	1,SIZE
AL4:	JFFO	1,.+3		;GET BUCKET NO.
	MOVEI	1		;ERROR 1
	JUMPA	PANIC
;
	SUBI	2,^D26
	JUMPGE	2,.+2
	SETZ	2,0
AL3:	MOVE	1,HDR(2)	;GET LIST HDR
AL1:	TRNN	1,777777	;EXIST RT-LINK?
	JUMPA	NXTLST		;NO.
	MOVE	4,1(1)		;YES. GET SIZE OF BLOCK.
	SUB	4,SIZE		;BIG ENOUGH?
	JUMPGE	4,AL2		;YES.
	HRR	1,(1)		;NO. GET NEXT RT-LINK.
	JUMPA	AL1		;AND CONTINUE.
;
AL2:	HRRZ	0,1	;CALC RETURN SUBSCRIPT VALUE.
	SUB	0,SPACE
	MOVEM	0,@(16)		;SET J.
	MOVE 	2,(1)		;DELETE BLOCK FROM CHAIN.
	HLLM	2,(2)
	MOVSS	2
	HLRM	2,(2)
	MOVE	0,1(1)		;SET CURRENT BLOCK SIZE
	MOVNM	0,(1)		;INTO BLOCK HDR.
	CAIGE	4,2		;NEED TO FREE REMAINDER?
	JUMPA	AL5		;NO.
	MOVN	2,SIZE		;SET -SIZE INTO
	MOVEM	2,(1)		;CURRENT BLOCK CONTROL WORD.
;
	ADD	1,SIZE
	SUBI	4,1
	MOVNM	4,1(1)		;MOVE -SIZE TO DUMMY BLOCK
	ADDI	1,2		;MOVE ADDR(BLOCK) TO CALL+1
	MOVEM	1,.+2		;AND
	JSA	16,FREE		;FREE REMAINDER OF BLOCK.
	0
;
AL5:	MOVE	1,AX1		;RESTORE REGISTERS
	MOVE	2,AX2
	MOVE	3,AX3
	MOVE	4,AX4
	JRA	16,(16)		;AND RETURN
;
NXTLST:	SOJGE	2,AL3		;ANY MORE LISTS? YES.
	JUMPA	GRBC		;NO. CHANGE JOBFF
	PAGE
;	FREE STORAGE DE-ALLOCATION
;
;	CALL IS
;		CALL FREE ( SPACE(J) )
;	WHERE SPACE(J) IS THE FIRST WORD OF A BLOCK 
;	ALLOCATED WITH ALLOC.
;	IF BLOCK IS HIGHEST BLOCK IN USER CORE, JOBFF
;	IS REDUCED, ELSE BLOCK IS INSERTED IN FREE SPACE
;	LIST.
;
	ENTRY	FREE
FREE:	0
	MOVEM	1,FX1
	MOVEM	2,FX2		;SAVEREGISTERS
	MOVEM	3,FX3
	HRRZ	3,(16)		;ARG PTR TO C3
	SUBI	3,1
	MOVN	1,(3)		;+SIZE TO AC1
	JUMPG	1,.+3		;TEST SIZE >0
	MOVEI	1
	JUMPA	PANIC		;(INVALID CONTROL WORD)
;
	MOVE	2,3		;BLOCK ADDR +BLOCK SIZE+1
	ADD	2,1
	ADDI	2,1		;=NEXT BLOCK ADDR
	CAML	2,JOBFF		;LAST BLOCK IN CORE?
	JUMPA	REDCOR		;YES.  RESET JOBFF
;			NO. REPLACE IN CHAIN.
	MOVEM	1,1(3)		;PUT SIZE IN WORD 1
	JFFO	1,.+1		;GET BUCKET NUMBER
;
	SUBI	2,^D26
	JUMPGE	2,.+2
	SETZ	2,0
	MOVE	1,HDR(2)		;HDR(N) TO AC1
	MOVEM	3,HDR(2)
	HRLM	3,(1)		;NEW BACK PTR
	HRRM	1,(3)		;LINK FOR RG(BLOCK(0))
	MOVEI	2,HDR(2)
	HRLM	2,(3)		;BACK PTR FOR LH(BLOCK(0))
;
RL1:	MOVE	1,FX1		;RESTORE REGISTERS
	MOVE	2,FX2
	MOVE	3,FX3
	JRA	16,1(16)	;AND RETURN
REDCOR:	MOVE	2,3
	CALL	2,[SIXBIT /CORE/]	;REDUCE ALLOCATED CORE
	JUMPA	PANIC
	MOVE	2,3
	MOVEM	2,JOBFF
	JUMPA	RL1
;
;	GRBC [GRABCORE] ADJUSTS JOBFF IN THE JOB DATA
;	TABLE TO SATISFY THE REQUEST, USING THE CORE UUO IF 
;	NECESSARY.  IF INSUFFICIENT CORE IS AVAILABLE IT
;	GIVES A TTY MESSAGE AND QUITS.
;
GRBC:	HRRZ	1,JOBFF		;CALC NEW JOBFF
	MOVEM	1,CLIM
	ADD	1,SIZE
	ADDI	1,1
	MOVEM	1,NUJBFF	;=OLD JOBFF+SIZE+1
	MOVE	1,JOBREL	;JOBREL-JOBFF
	SUB	1,JOBFF		;=SPACE AVAILABLE W/O CORE UUO
	CAML	1,SIZE		;ENOUGH?
	JUMPA	ENUF		;YES.
	MOVE	1,NUJBFF	;NO.
	CALL	1,[SIXBIT /CORE/]	;INCREASE CORE ALLOCATION
	JUMPA	PANIC2		;INSUFF CORE FROM MONITOR
;
ENUF:	MOVE	1,NUJBFF	;SET NEW JOBFF TO REQUESTED LOC
	HRRM	1,JOBFF
;
	MOVE	1,SIZE		;SET NEG LENGTH WORD INTO 
	MOVNM	1,@CLIM		;BLOCK HDR
	MOVE	1,CLIM		;SET RETURN ARGUMENT
	SUB	1,SPACE
	MOVEM	1,@(16)
	JUMPA	AL5		;AND EXIT.
;
PANIC2:	MOVEI	2		;ERROR CODE TO AC0
PANIC:	MOVE	1,2(16)		;DECIDE IF 3RD ARG IS PRESENT
	AND	1,[XWD 777000,0]	;MASK OUT ALL BUT OPCODE
	CAME	1,[JUMP]	;=JUMP?
	JUMPA	FATAL		;NO.
	MOVEM	@(16)		;YES.  ERROR CODE TO J
	HRR	16,@2(16)	;PATCH RETURN ADDRESS
	JUMPA	AL5		;AND RETURN GRACEFULLY
;
	TTY=5
	EXTERN	OCTO.
FATAL:	MOVEI	1,MESG		;AC1 -> FORMAT
	HRRZM	16,ADDR#	;SAVE RETURN ADDR FOR DIAG
	OUT.	1,TTY		;EXECUTE FORTRAN WRITE
	DATA.	4,ADDR
	FIN.	0,0		;TERMINATE FORT I/O
	CALL	1,[SIXBIT /EXIT/]	;AND QUIT
;
MESG:	ASCII	.(' CORE ALLOCATION ERROR AT USER ' O6/).
AX1:	Z
AX2:	Z
AX3:	Z
AX4:	Z
SIZE:	Z
CLIM:	Z
FX1:	Z
FX2:	Z
FX3:	Z
NUJBFF:	Z
HDR:	BLOCK	^D10
	END