//
// OVERLAYS.BCPL - Bcpl overlay package
// last edited September 16, 1976  6:19 PM
//

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

external	// procedures used
[		// O.S.
	SetBlock
	ActOnDiskPages
	Usc
	Dvec
	CallSwat
		// User-supplied
	UserReadOverlay
]

external	// statics used
[	sysDisk
]

external	// procedures defined
[	LockPendingCode	// ()
	FindOverlayFromPn	// (pn) -> od
	GeneratePresentOverlays	// (proc(od))
	@OverlayFaultProc
	DeclareOverlayPresent	// (od, core)
	OverlayFirstPn	// (od) -> pn
	OverlayNpages	// (od) -> npages
	OverlayDiskAddr	// (od) -> da
	OverlayCoreAddr	// (od) -> core
	ReadOverlay	// (pn, core, npages)
	ReleaseOverlay	// (od, doIt) -> ok
]

external	// statics defined
[	@OverlayNumber
	OverlayFaults
	FirstOD
	LastOD
	OverlayFp
]


static
[	@OverlayNumber = 0
	OverlayFaults
	FirstOD
	LastOD
	OverlayFp
	MinOverlayLoc = -1
]


let LockPendingCode(dummy) be
[	for od = FirstOD by ODsize to LastOD do od>>OD.onstack = 0
	let frame = (lv dummy)!-4
	while Usc(@frame, frame) gr 0 do
	 [ let pc = frame!1
	   if Usc(pc, MinOverlayLoc) ge 0 then	// O.S. or overlay
	    for od = FirstOD by ODsize to LastOD do
	     if (od>>OD.core ne 0) & ((pc-od>>OD.core) rshift 8 ls (od+ODsize)>>OD.firstPn-od>>OD.firstPn) then
	      od>>OD.onstack = 1
	   frame = @frame
	 ]
]

and FindOverlayFromPn(pn) = valof
[	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) resultis od
	   fpn = npn
	 ]
	CallSwat("FindOD failed")
]

and GeneratePresentOverlays(proc) be
	for od = FirstOD by ODsize to LastOD do
	   if od>>OD.core ne 0 then proc(od)

and 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
	let od = LastOD-ovn*ODsize
	DeclareOverlayPresent(od, UserReadOverlay(od))
	// Check to make sure overlay is now present
	let callerframe = (lv ac0)!-4
	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
	   CallSwat("Bad overlay call")
	// Re-execute call
	callerframe!1 = callerpc1-2
	resultis table[ #1401 ](ac0, ac1)	// load up ACs and exit
]

and DeclareOverlayPresent(od, base) be
[	if Usc(base, MinOverlayLoc) ls 0 then MinOverlayLoc = base
	let p = base+#21+base!1
	let plim = p+2*p!-1
	while p ne plim do
	 [ @(p!0) = base+#20+p!1
	   p = p+2
	 ]
	od>>OD.core = base
]

and OverlayFirstPn(od) = od>>OD.firstPn
and OverlayNpages(od) = (od+ODsize)>>OD.firstPn-od>>OD.firstPn
and OverlayDiskAddr(od) = od>>OD.da

and OverlayCoreAddr(od) = od>>OD.core

and ReadOverlay(pn, core, np) 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)
	DAs!0 = FindOverlayFromPn(pn)>>OD.da
	ActOnDiskPages(sysDisk, CAs-pn, DAs-pn, OverlayFp, pn, pn+np-1, DCreadD)
]

and ReleaseOverlay(od, flag) = valof
[	if od>>OD.onstack ne 0 resultis false
	unless flag resultis true
	let faultaddr = OverlayFaults+(od-FirstOD)/ODsize
	let base = od>>OD.core
	let p = base+#21+base!1
	let plim = p+2*p!-1
	while p ls plim do
	 [ @(p!0) = faultaddr
	   p = p+2
	 ]
	od>>OD.core = 0
	resultis true
]