COMMENT ⊗   VALID 00008 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	TITLE FS - Free Storage Management Routines
C00004 00003	SUBR FSGET,SIZE		Get a block from Free Strorage
C00014 00004	SUBR FSGETZ,SIZE		Get and zero a block from Free Strorage
C00015 00005	SUBR FSREL,ADDR		Release Free Strorage block
C00022 00006	SUBR FSINIT			Initialize Free Strorage
C00024 00007	SUBR CORFULL			Print error message about core full
C00025 00008	Local Storage
C00026 ENDMK
C⊗;
TITLE FS - Free Storage Management Routines

COMMENT ⊗

These routines handle the management of free storage. These routines
do the allocation and release of free storage.	In addition, it will
incorporate into its structure, buffers obtained by moving JOBFF.

CAUTION: Do not call these routines from user interrupt level unless
	 interlocks exist (BEGLOK and ENDLOK) and have been properly
	 initialized.

⊗;

	SEARCH TVRHDR		;Macro definitions

.INSERT STRUC.FAI[S,NET] ;Node definitions

↓RET←1
↓TAC←2

IFNDEF TRIVIAL,< TRIVIAL←←3 >	;Minimum size for block

IFNDEF BEGLOK,< DEFINE BEGLOK(X)<>>	;Begin locked region
IFNDEF ENDLOK,< DEFINE ENDLOK(X)<>>	;End locked region

SUBR FSGET,SIZE		;Get a block from Free Strorage
COMMENT β

Calling sequence:
	PUSH P,[SIZE]		;Size of block needed
	PUSHJ P,FSGET
Returns:
  Address of block

Description:
  Searches free storage list for suitably large block and returns
  it if it is available.  Otherwise, it expands core to make it fit.

Calls:
  FSINIT

Called by:
  Many routines

Side effects:
  Alters free storage list.  Advances JOBFF if none available.

Destroys:
  TAC
β;
	THIS←RET	;Address of block being and later returned
	SIZ←TAC+1	;Size of block stored here for speed (also
			;reused for other purposes

	BEGLOK FSLOK↑		;Enter interlocked region
	PUSHP SIZ
	MOVS SIZ,SIZE
	TLNE SIZ,740000		;Too big?
	  FATAL<Free storage request too big>
COMMENT ⊗ Free storage blocks are limited to a maximum of 37777
words in this implimentation of free storage system.  This error
will also occur if a negative size is requested. ⊗;
	SKIPN FSTAIL		;Has free storage been set up?
	  CALL FSINIT		;  No, initialize
	SKIPN THIS,ROVER	;Is there a free storage list?
	  JRST NOFS		;  No, get it from the top
LOOP:	CAMG SIZ,-1(THIS)	;Is this block big enough?
	  JRST GOTCHA		;  Yes, use it!
	FSNXT THIS,THIS		;Fetch next element of FS list
	CAME THIS,ROVER		;Have all nodes been check?
	  JRST LOOP		;  No, try next one
;No large enough block available, expand core to make one which
;fits
NOFS:	MOVE TAC,JOBFF		;Get last known value of JOBFF
	SUB TAC,OLDFF		;Has it moved?
	JUMPE TAC,JBFFOK	;  No, JOBFF is OK
	JUMPL TAC,CORDWN	;  Yes, but cored reduced. Trouble.
;A buffer has been allocated by someone by expanding JOBFF.  Mark the
;space as being used.
;
;Core map at this point
;	     |			|
;	     |	free storage	|
;	    _|__________________|
;FSTAIL --->_|__________________|
;OLDFF	---> |			|
;	     |			|
;	     |	system buffer	|
;	    _|__________________|
;JOBFF	---> |			|
;	     |			|
	TRO TAC,(%FSUSE+%FSTMP) ;Make header for system buffer
	MOVSM TAC,@FSTAIL	;Note: We are guaranteed that the
				;last block in free storage is not
				;avaiable, so we don't worry about
				;%FSPRA
				;(Even if it doesn't, it only prevents
				; the new block from being merged
				; from the top)
	MOVSI TAC,(%FSUSE)	;Make new top marker
	MOVE THIS,JOBFF		;Get pointer to old top of core
	AOS JOBFF		;Allocate one word for top marker
				;Note: We're about to expand core so
				;that JOBFF pointing to NXM doesn't
				;hurt, though slightly uncleanily.
	MOVEM TAC,(THIS)	;Set marker
	MOVEM THIS,FSTAIL	;New TAIL
;Allocate a block from the top of core
;
;Core map at this point
;	     |			|
;	     |	free storage	|
;	    _|__________________|
;FSTAIL --->_|__________________|
;JOBFF	---> |			|
;	     |			|
;	     |			|
JBFFOK: HLRZ THIS,SIZ		;Get size for block
	ADD THIS,JOBFF		;New top of core
	ADDI THIS,1		;One more to account for marker
				;for top of free storage
	CAMLE THIS,JOBREL	;Expand core?
	  JRST[ XCT FSGCORE	  ;Yes, try to get more core
		  CALL CORFULL	  ;Print error message for core full
		JRST JBFFOK ]	  ;Got core, now use it (or retry if
				  ;it failed
;
;Core map at this point
;	     |			|
;	     |	free storage	|
;	    _|__________________|
;FSTAIL --->_|__________________|
;JOBFF	---> |			|
;	     |			|
;	     |			|
;	     |			|
;THIS	---> |			|
;	     |			|
	MOVEM THIS,JOBFF	;Set JOBFF to have block we want
	MOVEM THIS,OLDFF	;Remember JOBFF we just made
	MOVSI TAC,(%FSUSE)	;Make new top marker
	MOVEM TAC,-1(THIS)	;Set top header
	OR TAC,SIZ		;Make header word for new block
	MOVEM TAC,@FSTAIL	;Just recycle old top marker
	SUBI THIS,1		;Get address of new top marker
	EXCH THIS,FSTAIL	;Return old top block and set new
	ADDI THIS,1		;top marker
;	     |			|
;	     |			|
;	     |	free storage	|
;	    _|__________________|
;THIS	---> |			|
;	     |	new block	|
;	    _|__________________|
;FSTAIL --->_|__________________|
;JOBFF	---> |			|
;	     |			|
;	     |			|
	JRST DONE
;JOBFF is lower than we lost saw it
CORDWN:
  WARN<JOBFF lower than top of free storage.  Data structures may be garbaged>
COMMENT ⊗ Someone unexpectedly moved the pointer the system uses to
make I/O buffers into the middle of the free storage area.  If some
file was opened after that, it may have overwritten some of the
data structure.  This is most certainly a bug and you may proceed
at your own risk.⊗;
	MOVE TAC,OLDFF		;Fix it up for now by just restoring
	MOVEM TAC,JOBFF		;JOBFF to its old value
;Found a block which is large enough
GOTCHA: MOVE TAC,-1(THIS)	;See how much of the block is used
	SUB TAC,SIZ
	CAML TAC,SWTRIV		;It is large enough to worry about?
	JRST SPLIT		;  Yes, split block into two parts
;Block is of appropriate size to use directly
	FSFSZ SIZ,THIS		;Fetch size of block
	ADD SIZ,THIS		;Point to next block
	MOVSI TAC,(%FSPRA)	;and clear next block's mark that
	ANDCAM TAC,(SIZ)	;that this one is free
	MOVSI TAC,(%FSUSE)	;Now, we can mark this block as
	IORB TAC,-1(THIS)	;in use and also fetch next pointer
	FSPRV SIZ,THIS		;Fetch pointer to previous link in
				;free block list
;RH SIZ: Next free block
;RH TAC: Previous free block
	FSNXTM TAC,SIZ		;Unlink node to be allocated
	FSPRVM SIZ,TAC
	HRRZM SIZ,ROVER		;Set pointer to next free block
	CAIN THIS,(TAC)		;Is this the last block?
	SETZM ROVER		;  Yes, no longer have a list
	JRST DONE

;Block is too big to use directly, split it into two blocks
SPLIT:	HLRZ SIZ,TAC		;Move into right half for arithmetic
	SUBI SIZ,1		;operations and account for header
	FSFSZM SIZ,THIS		;Set new size of this block
	ADDI THIS,1(SIZ)	;Point to new block
	FSPSZM SIZ,THIS		;Set trailing size field for free
				;block
;Core map at this point
;	     |__________________|
;	     |			|
;	     |			|
;	     |	free storage	|
;	    _|__________________|
;THIS	---> |			|
;	     |	new block	|
;	    _|__________________|
	MOVS SIZ,SIZE		;Fetch size of block wanted
	TLO SIZ,(%FSPRA+%FSUSE) ;Mark in use and previous block as
				;being available
	MOVEM SIZ,-1(THIS)	;Set size field in this node
	MOVE SIZ,SIZE		;Clear previous block available bit
	ADD SIZ,THIS		;in the next block
	MOVSI TAC,(%FSPRA)
	ANDCAM TAC,(SIZ)
DONE:	POPP SIZ		;Restore saved accumulator
	ENDLOK FSLOK		;Leave locked region
	SUB P,[XWD 2,2]
	JRSTF @2(P)

SUBREND FSGET

SUBR FSGETZ,SIZE		;Get and zero a block from Free Strorage
COMMENT β

Calling sequence:
	PUSH P,[SIZE]		;Size of block needed
	PUSHJ P,FSGETZ
Returns:
  Address of block

Description:
  Same as FSGET except it zeros the block before returning it

Calls:
  FSGET

Called by:
  Many routines

Side effects:
  (See FSGET)

Destroys:
  TAC
β;
	CALL FSGET,SIZE
	SETZM (RET)		;Clear first word
	MOVS TAC,RET		;Make IOWD to do rest
	HRRI TAC,1(RET)
	ADD RET,SIZE		;Point at last word
	BLT TAC,-1(RET)		;Zero rest of block
	SUB RET,SIZE		;Restore pointer to block
	SUB P,[XWD 2,2]
	JRSTF @2(P)

SUBREND FSGETZ

SUBR FSREL,ADDR		;Release Free Strorage block
COMMENT β

Calling sequence:
	PUSH P,ADDR		;ADDR points to free storage block
	PUSHJ P,FSREL
Returns:
  Undefined

Description:
  Returns block to free storage system.  In detail, if the block
  above is free, it is merged with this block.	If block below it is
  free and merges given block with it if so.  Otherwise, the block is
  added to the free storage list.

Calls:

Called by:
  Many routines

Side effects:
  Alters free storage list.

Destroys:
  TAC
β;
prints/FSREL needs to check against top
/
	THIS←RET	;Address of block being and later returned
	SIZ←TAC+1	;Size of block stored here for speed (also
			;reused for other purposes

	BEGLOK FSLOK		;Enter interlocked region
	PUSHP SIZ		;Save an AC
	MOVE THIS,ADDR
	HLLZ SIZ,-1(THIS)	;Fetch size and flags
	TLZ SIZ,(%FSUSE+%FSMRK+%FSTMP)	;Clear random crud
	TLZN SIZ,(%FSPRA)	;Is previous block available?
	JRST NOTBLW		;  No, not below free
;Core map at this point
;	     |			|
;	     |			|
;	     |	free block	|
;	    _|__________________|
;THIS	---> |			|
;	     |	block to free	|
;	    _|__________________|
;	     |			|
;	     |	     ???	|
;	     |			|
	FSPSZ TAC,THIS		;Fetch size of previous block
	MOVN TAC,TAC
	ADDI THIS,-1(TAC)	;Point to previous block
	ADD SIZ,[XWD 1,0]	;Account for header word
	ADDB SIZ,-1(THIS)	;Update and fetch size
	HLRZ TAC,SIZ		;Point to next block
	ADDI TAC,1(THIS)
	MOVEM SIZ,-2(TAC)	;Set block size
	MOVSI SIZ,(%FSPRA)	;Set previous block available
	ORB SIZ,-1(TAC)		;and also, fetch its size
	TLNE SIZ,(%FSUSE)	;Is it in use?
	JRST DONE		;  Yes, we're done then
;New block and next block need to be merged
;Core map at this point
;	    _|__________________|
;THIS	---> |			|
;	     |	free block	|
;	    _|__________________|
;TAC	---> |			|
;	     |	free block	|
;	     |			|
	MOVEM THIS,ADDR		;Save pointer to lower block
	FSPRV THIS,TAC		;Unlink upper block
	FSNXT SIZ,TAC
	CAMN TAC,ROVER		;Are we unlinking the head of list?
	  MOVEM SIZ,ROVER	;  Yes, advance it to next
	FSPRVM THIS,SIZ		;Previous block now sees next block
	FSNXTM SIZ,THIS		;Next block now sees previous block
	MOVE THIS,ADDR		;Get back pointer to lower block
	HLLZ SIZ,-1(TAC)	;Get size of upper block
	ADD SIZ,[1B17-%FSPRA]	;Account for header and flush bit
				;saying previous block is available
	ADDB SIZ,-1(THIS)	;Update size for lower block
	HLRZ TAC,SIZ		;Point to next block
	ADD TAC,THIS
	MOVEM SIZ,-1(TAC)	;Set top size
	JRST DONE		;Now, we're finished

;New block and next block need to be merged
;Core map at this point
;	    _|__________________|
;THIS	---> |			|
;	     |	block to free	|
;	    _|__________________|
;TAC	---> |			|
;	     |	free block	|
;	     |			|
NOTBLW: HLRZ TAC,SIZ		;Check top
	ADDI TAC,1(THIS)
	MOVEM SIZ,-1(THIS)	;Set size (with tag bits cleared)
	MOVEM SIZ,-2(TAC)	;Set size in top while convenient
	HLLZ SIZ,-1(TAC)	;Fetch header for next block
	TLNE SIZ,(%FSUSE)	;In use?
	JRST MRKTOP		;  Yes, mark
	MOVEM THIS,ROVER	;Will be next block to consider allocating
	ADD SIZ,[XWD 1,0]	;Account for header
	ADDM SIZ,-1(THIS)	;Update lower size
	FSPRV SIZ,TAC		;Fetch previous block in F.S. List
	FSPRVM SIZ,THIS		;Copy into lower block
	FSNXTM THIS,SIZ		;Make its next pointer see new block
	FSNXT SIZ,TAC		;Fetch next block
	FSNXTM SIZ,THIS		;Copy into lower block
	FSPRVM THIS,SIZ		;Make previous pointer
	FSFSZ SIZ,THIS		;Put in size pointer at end of block
	ADDI THIS,1(SIZ)
	FSPSZM SIZ,THIS		;Set size at top
	JRST DONE
MRKTOP: MOVSI SIZ,(%FSPRA)	;Mark previous block available
	ORM SIZ,-1(TAC)
	SKIPE TAC,ROVER		;Get head of FS list
	JRST ADDNOD		;  Yes, there is a list
EMPTY:	FSNXTM THIS,THIS	;Point to self if empty
	FSPRVM THIS,THIS
	MOVEM THIS,ROVER	;This node constitutes new freelist
	JRST DONE
ADDNOD: FSPRV SIZ,TAC		;Fetch previous block in F.S. List
	FSNXTM THIS,SIZ		;Make its next pointer see new block
	FSPRVM SIZ,THIS		;Make new block point to previous
	FSPRVM THIS,TAC		;Make previous pointer
	FSNXTM TAC,THIS		;Make new block point to next
DONE:	POPP SIZ		;Save an AC
	ENDLOK FSLOK		;leave interlocked region
	SUB P,[XWD 2,2]
	JRSTF @2(P)

SUBREND FSREL

SUBR FSINIT			;Initialize Free Strorage
COMMENT β

Calling sequence:
	PUSHJ P,FSINIT

Returns:
  Undefined

Description:
  Initializes Free Storage system.  Remembers top of free storage
  system.

  CAUTION:  Don't call this with interrupts enabled!  (FSGET excepted)

Calls:

Called by:
  Initialization, FSGET

Side effects:
  Makes free storage list.  Advances JOBFF

Destroys:

β;
	SKIPA
	  JRST FSGCOK		;Starting at FSINIT+1 avoids changes to FSGCOR
	MOVE RET,[CORE RET,]	;Yes, try to get more core
	MOVEM RET,FSGCOR	;Instruction to execute to get more core
FSGCOK: MOVE RET,JOBFF		;Make pointer to top of core
	MOVEM RET,FSBEG		;Remember beginning of F.S.
	MOVEM RET,FSTAIL
	SETZM ROVER		;Clear pointer to next block to examine.
	MOVSI RET,(%FSUSE)	;Make a top marker
	MOVEM RET,@JOBFF
	AOS RET,JOBFF		;Allocate word for marker
	MOVEM RET,OLDFF		;Remember what we saw for top of
				;core
RETRY:	CAMLE RET,JOBREL	;See if core needs to be expanded
	  JRST[ CORE RET,
		  CALL CORFULL	;Print core full message
		MOVE RET,JOBFF
		JRST RETRY ]
INCORE: MOVEI RET,TRIVIAL	;Set trivial block size
	MOVSM RET,SWTRIV
	POPJ P,

SUBREND FSINIT

;SUBR CORFULL			;Print error message about core full
COMMENT β

Calling sequence:
	PUSHJ P,CORFULL

Returns:
  Undefined

Description:
  Prints error message for core full.

Calls:

Called by:
  FSGET,FSINIT

Side effects:
  Waits for response from user.

Destroys:

β;

CORFUL: WARN<No core left, will retry>
COMMENT ⊗There was no large enough block in free storage list and
attempt to get more core failed.  The fact that you have run out
of core may be indicative of some problem with this program or
what you are asking it to do. ⊗;
	POPJ P,

;SUBREND CORFULL

;Local Storage

INTERNAL FSGCOR

INTEGER FSBEG		;Beginning of free storage
INTEGER ROVER		;Pointer to next block to examine
INTEGER FSTAIL		;Pointer to top of free storage
INTEGER SWTRIV		;Swapped trivial block size (smallest
			;sized block which will be alllocated)
INTEGER OLDFF		;Copy of JOBFF
INTEGER FSGCOR		;Instruction to execute to get more code

EXTERNAL JOBFF		;First Free location in top of core

END