// MICRO storage allocator
// last edited December 13, 1979  9:12 PM
// Copyright Xerox Corporation 1979

get "micdecl.d"

external	// O.S.
[	Gets; Puts
	ReadBlock; WriteBlock
]


let dalloc(bp) be
// Return block to free storage
  [	let n = bp!bprefix
	test bp eq fsbot+fstop+1
	ifso	fsbot = fsbot+n+1
	ifnot
	  [	if n ge 2 then
		  [	@bp = slfl
			slfl = bp-fstop
			srover = slfl
		   ]
	   ]
   ]

and alloc(n) = valof
// Get block of n words
  [	if slfl ne 0 then
	 [ 	if srover eq 0 then srover = slfl
		let bp = srover + fstop
	   [	let pp = bp
		test @bp eq 0
		ifso	bp = slfl+fstop
		ifnot	bp = @bp + fstop
		if bp!bprefix eq n then
		  [	test bp eq slfl+fstop
			ifso	slfl = @bp
			ifnot	@pp = @bp
			srover = @bp
			resultis bp
		   ]
	   ] repeatuntil bp-fstop eq srover
	 ]
	let ptr = get1(n+1)
	@ptr = n
	resultis ptr+1
   ]

and alloctemp(n) = valof
// Get a block of n words.  It will not be saved on the .ST file
[	let newfslim = fslim+n+1
	let newfsgap = fstop+fsbot-newfslim
	if newfsgap le 0 then
		errx("STORAGE FULL", true)
	let ptr = fslim
	@ptr = n
	fslim = newfslim
	if newfsgap ls fsgap then
		fsgap = newfsgap
	resultis ptr+1
]

and dalloctemp(bp) be
[	if bp+bp!bprefix ne fslim then error("Dalloctemp error")
	fslim = bp-1
]

and get1(bsize) = valof
// Carve a block off the free storage area and check
//	to insure enough room.
  [	let newfsbot = fsbot-bsize
	let ptr = fstop+newfsbot
	let newfsgap = ptr-fslim
	if newfsgap le 0 then
		errx("STORAGE FULL",true)
	fsbot = newfsbot
	if newfsgap ls fsgap then
		fsgap = newfsgap
	resultis ptr
   ]

and bsize(blk) =
// Return size of block
	blk!bprefix


and sdump(chan) be
// Dump state on file
  [	let blko(chan, addr, nw) be
	// Write block with header
	  [	Puts(chan, nw)
		WriteBlock(chan, addr, nw)
	   ]
	dumpver = cversion
	blko(chan, aevals, nevals)
	blko(chan, fsbot+fstop, -fsbot)
   ]

and srecover(chan) be
// Recover state from file
  [  	let blkh(chan, minnw, maxnw) = valof
	// Read and check block length
	  [	let nw = Gets(chan)
		if (maxnw gr 0) & (nw ls minnw % nw gr maxnw) then
			error("Improper or incompatible /R file")
		resultis nw
	   ]
	ReadBlock(chan, aevals, blkh(chan, nevals, nevals))
	if dumpver ne cversion then error("Incompatible /R file")
	fsbot = -blkh(chan,1,fstop)
	ReadBlock(chan, fsbot+fstop, -fsbot)
   ]