// MOVERLAY.BCPL - Modification of LPD's OVERLAYS.BCPL
//	OVERLAYS last edited 16 September 76
//	MOVERLAY last edited: 25 October 1979

get "overlays.d"
get "altofilesys.d"
get "disks.d"
get "mdecl.d"

external [
// OS
	SetBlock; ActOnDiskPages; Usc; Dvec; sysDisk
	Allocate; Free; CallersFrame; RetryCall

// MIDAS
	MidasSwat; Initialized; Storage; EndStorage

// MDISP
	MakeDispZoneAvail; ReUseDispSpace; DisplayOff

// MMPRGN
	MPDEveryTime

// Defined here
	SwappedOut; FlushOverlays; KillOverlays; PeelOverlay
	OverlayZone; OverlayFlushed; OvTable
	@OverlayFaultProc; ReadOverlay

	@OverlayNumber
	OverlayFaults
	FirstOD
	LastOD
	OverlayFp
]


static
[	@OverlayNumber = 0
	OverlayFaults
	FirstOD
	LastOD
	OverlayFp

//"OverlayFlushed" is used to avoid multiple display rebuilding.
//When the display is off, display update is delayed so that
//only a single painting of each line will be required.
	OverlayZone = -1; OverlayFlushed = true; OvTable
]

let OverlayFaultProc(ac0, ac1, nil, nil, nil, nil, nil, nil, nil, nil, nil, nil, nil, nil, nil, nil, nil, nil, nil, nil) = valof
[ // *** Critical code began at JSR to missing procedure
	let ovn = OverlayNumber; OverlayNumber = 0
// *** End critical code
	if OverlayZone eq 0 do MakeDispZoneAvail()
	OverlayFlushed = false
	let od = LastOD-ovn*ODsize
	let Pn = od>>OD.firstPn
	let Np = (od+ODsize)>>OD.firstPn-Pn
	let Core = Allocate(OverlayZone,Np lshift 8)
	ReadOverlay(Pn,Core,Np,od)
// Check to make sure overlay is now present
	let callerframe = CallersFrame()
	let callerpc1 = callerframe!1
	let callins = callerpc1!-1
	let disp = (callins&#177)-(callins&#200)
	let dif = (selecton (callins&#177400) into
	 [ case #64400: callerpc1!(disp-1)	// JSRII
	   case #65000: callerframe!disp	// JSRIS
	   case #6000: callins&#377	// JSR @
	   default: lv OverlayFaults	// no good
	 ])!0-OverlayFaults
	if (dif ge 0) & (dif le (LastOD-FirstOD)/ODsize) then
	   MidasSwat(BadOverlayCall)
	RetryCall(ac0,ac1)	// load up ACs and exit
]


and FixUpStatics(ca,val) be
[	let p = ca+#21+ca!1
	let plim = p+2*p!-1
	while p ne plim do
	[ @(p!0) = val eq 0 ? ca+#20+p!1,val
	  p = p+2
	]
]


and ReadOverlay(pn,core,np,od) be
[	let DAs, CAs = np, np
	Dvec(ReadOverlay, lv DAs, lv CAs)
	for i = 0 to np-1 do CAs!i = core + i lshift 8
	SetBlock(DAs, fillInDA, np+1)
	let fpn = FirstOD>>OD.firstPn
	for od = FirstOD by ODsize to LastOD do
	[ let npn = (od+ODsize)>>OD.firstPn
	  if (pn ls npn) & (pn ge fpn) do
	  [ DAs!0 = od>>OD.da
	    ActOnDiskPages(sysDisk,CAs-pn,DAs-pn,OverlayFp,
		pn,pn+np-1,DCreadD)
	    FixUpStatics(core,0)
	    od>>OD.core = core
	    return
	  ]
	  fpn = npn
	]
	MidasSwat(NoOD)		//Couldn't find OD
]

and ReleaseOverlay(od) be
[	let frame = CallersFrame()
	let np = (od+ODsize)>>OD.firstPn-od>>OD.firstPn
	let ca = od>>OD.core
//pc is frame!1
	while Usc(@frame,frame) > 0 do
	[ if (frame!1 - ca) rshift 8 < np then MidasSwat(BadOvlRelease)
	  frame = @frame
	]
	FixUpStatics(ca,OverlayFaults+(od-FirstOD)/ODsize)
	od>>OD.core = 0
]


//Flush overlays in OverlayZone and rebuild the display
//Postpone call of MPDEveryTime until Init2 has been executed.
and KillOverlays() be
[	if FlushOverlays() do
	[ if Initialized then MPDEveryTime(nil,true)
	  test DisplayOff
	  ifso
	  [ MakeDispZoneAvail(); OverlayFlushed = true
	  ]
	  ifnot ReUseDispSpace()
	]
]


//Kill all overlays above EndStorage (which includes the bit buffers
//normally in OverlayZone and any extra storage added from the stack
//or sysZone), but don't rebuild the display
and FlushOverlays() = valof
[	if OverlayZone eq 0 do resultis false
	for od = FirstOD by ODsize to LastOD do
	[ let Ca = od>>OD.core
	  if Usc(Ca,EndStorage) ge 0 do
	  [ ReleaseOverlay(od)
	    Free(OverlayZone,Ca)
	  ]
	]
	resultis true
]

//Flush an overlay in the free area at the end of Midas, if there is
//one, and return true; otherwise, return false
and PeelOverlay() = valof
[	let P = OvTable!0
	if P < 3 then resultis false
	OvTable!0 = P-2
	ReleaseOverlay(OvTable!(P-1))
	Storage = OvTable!(P-2); resultis true
]


and SwappedOut() be MidasSwat(SwapOutCall)