// MDmisc.bcpl -- miscellaneous services for MicroD
// last edited July 20, 1980  10:10 PM

	get "mddecl.d"

external [	// defined here
	StoreString	// (str, zone) -> ptr
	MaxBlock	// (zone) -> length
	ScratchZone	// (base, length) -> zone
	NextOverlay	// ()
	// Statics
	PutTS
	@Storage; @EndStorage
	MinSpace
	RealMin
	// for initialization
	GetLow; PutLow
	GetStorage; PutStorage
	RealPutTS
		// OS replacements
	Ws; Wss; Wo; Wos
]

external [
		// OS
	Allocate
	CallSwat
	Dvec
	MoveBlock
	Noop
	Puts
	Usc
	Zero
	dsp
		// LoadOverlay
	LoadOverlay
		// Template
	PutTemplate
		// MDerr
	Err
		// MDmain
	@OutputS
	OverlayCFA; lvOverlayLoc; lOverlaySz
]


static [
	PutTS	// Noop or RealPutTS
	Storage	// top of temporary zone
	EndStorage	// bottom of permanent zone
	MinSpace = -1
	RealMin = -1
]

// Storage management

let GetStorage(nil, Size) = valof
[	PutTS("Get($O)", Size)
	EndStorage = EndStorage-Size
	CheckSpace()
	Zero(EndStorage, Size)
	resultis EndStorage
]

and CheckSpace() be
[	if Usc(Storage, EndStorage) ge 0 then
	   Err(Fatal, "Out of storage")
	let gap = EndStorage-Storage
	if Usc(gap, MinSpace) ls 0 then MinSpace = gap
]

and PutStorage(nil, Ptr, Size; numargs na) be
[	if na ls 3 then	// called from system
	[ PutTS("SysPut($O)", Ptr-EndStorage)
	  return
	]
	PutTS("Put($O)", Size)
	if Ptr ne EndStorage then
	   CallSwat("Bad call on PutStorage")
	EndStorage = Ptr+Size
]

and GetLow(nil, Size) = valof
[	PutTS("GetLow($O)", Size)
	let Ptr = Storage
	Storage = Storage+Size
	CheckSpace()
	Zero(Ptr, Size)
	resultis Ptr
]

and PutLow(nil, Ptr, Size; numargs na) be
[	if na ls 3 then	// called from system
	[ PutTS("SysPutLow($O)", Storage-Ptr)
	  return
	]
	PutTS("PutLow($O)", Size)
	if Ptr+Size ne Storage then
	   CallSwat("Bad call on PutLow")
	Storage = Ptr
]

and RealPutTS(str, val) be
[	static [ lastCall0 = 0; lastCall1 = 0 ]
	PutTemplate(OutputS, str, val)
	let frame = ((lv str-4)!0)!0
	let call0, call1 = frame!1, (frame!0)!1
	if (call0 ne lastCall0) % (call1 ne lastCall1) then
	[ PutTemplate(OutputS, " from $UO from $UO", call0, call1)
	  lastCall0, lastCall1 = call0, call1
	]
	Puts(OutputS, $*N)
]

and StoreString(str, zone) = valof
[	let nw = str>>BS.length rshift 1 + 1
	let p = Allocate(zone, nw)
	MoveBlock(p, str, nw)
	resultis p
]

and MaxBlock(nil) = valof
[	if RealMin eq -1 then RealMin = MinSpace	// assume large Get is going to be done
	resultis EndStorage-Storage-1
]

and ScratchZone(ptr, len) = valof
[	static [ @szbeg; @szptr; @getsz; @putsz ]
	szbeg = ptr
	szptr = ptr+len
	let GetScratch(nil, n) = valof
	[ szptr = szptr-n
	  if szptr-szbeg ls 0 then Err(Fatal, "Scratch zone full")
	  resultis szptr
	]
	getsz = GetScratch
	putsz = Noop
	resultis lv getsz
]

and NextOverlay() be
[	let sz = lOverlaySz
	Dvec(NextOverlay, lv sz)
	let ptr = LoadOverlay(OverlayCFA, @lvOverlayLoc, EndStorage, ScratchZone(sz, lOverlaySz))
	if ptr eq 0 then
	  Err(Fatal, "Out of storage")
	Storage = ptr
	CheckSpace()
	lvOverlayLoc = lvOverlayLoc+1
]


// Replacements for OS

and Wo(x) be Wos(dsp, x)
and Wos(s, x) be PutTemplate(s, "$6UO", x)

and Ws(x) be Wss(dsp, x)
and Wss(s, x) be
[	structure S: [ length byte; char↑1,255 byte ]
	for i = 1 to x>>S.length do Puts(s, x>>S.char↑i)
]