// IfsOverlaysInit.bcpl - initialize structures for IFS Overlays package
// Copyright Xerox Corporation 1980

// Last modified March 6, 1980  6:19 PM by Taft

get "IfsOverlays.decl"
get "IfsXEmulator.decl"
get "IfsVMem.decl"
get "AltoFileSys.d"
get "Ifs.decl"
get "Disks.d"
get "IfsInit.decl"

external
[
// outgoing procedures
InitOverlays; DeclareOEP; DeclareXEP; FixupSwappedOut

// incoming procedures
DeclareAllOEPs
OvDOPAGEIO; OvPageType; OvCleanupLocks; AllocateVMem
OvPageGroupBase; OvPageGroupAlign; OvPageGroupSize; SwappedOut
Allocate; Free; IFSError; Usc; DefaultArgs
SetBlock; MoveBlock; Zero; ActOnDiskPages; Dvec

// incoming statics
oVmd; ovPageSize; logOvPageSize; logOvVmPages; ovFirstPage
numOvXMPages; numOvXMPagesPerBank
sysZone; bigZone; isb; sysDisk
OverlayFp; OverlayDisk; @OverlayEntry; @OverlaySave; @OverlayFaultProc;
FirstOD; EndOD; FirstOEP; EndOEP;
]

manifest
[
numSwapPages = 1024	// 2↑18 words - Code overlay
numOEP = 200		// maximum number of OEPs
numXEP = 20		// max number of XEPs
// Note: numOEP and numXEP don't affect the amount of space actually consumed.
MaxScanPages = 40	// max pages to scan at a time during OverlayScan

ecOverlayScan = 8
ecTooManyOEPs = 9
ecTooManyXEPs = 55
]

structure ODV:	// first part of overlay vector
[
nov word	// # of overlays
nep word	// # of special entries
fp @FP		// FP for overlay file
disk word	// disk for overlay file
]
manifest lODV = size ODV/16
manifest xODV = 3	// extra instructions

structure OSS:  // OverlayScan state, used during initialization
[
OVbuf word	// page buffer origin
OVnbufs word	// size of buffer in pages
OVcurpn word	// current first page in buffer
OVcurnp word	// current # of pages in buffer
OVdas word	// DA vector for pages in buffer +1
OVpagesize word	// page size in overlay file
]
manifest lenOSS = size OSS/16

//----------------------------------------------------------------------------
let InitOverlays(disk, cfa, buf, bufLen; numargs na) be
//----------------------------------------------------------------------------
// Initializes the overlay package with the overlays starting
// at address "cfa" on "disk".  buf, if supplied, is a buffer of
// length bufLen that OverlayScan can use for scratch.
[
DefaultArgs(lv na, -2, 0, 0)
logOvPageSize = disk>>DSK.lnPageSize
ovPageSize = 1 lshift logOvPageSize
logOvVmPages = logOvPageSize-logVMPageLength
ovFirstPage = cfa>>CFA.fa.pageNumber

// assign some virtual memory for overlays
oVmd = Allocate(sysZone, lenVMD+lenVMI)
let oVmi = oVmd+lenVMD
oVmi>>VMI.DOPAGEIO = OvDOPAGEIO
oVmi>>VMI.CleanupLocks = OvCleanupLocks
oVmi>>VMI.PageType = OvPageType
oVmi>>VMI.PageGroupBase = OvPageGroupBase
oVmi>>VMI.PageGroupAlign = OvPageGroupAlign
oVmi>>VMI.PageGroupSize = OvPageGroupSize
oVmi>>VMI.type = vmiTypeOverlay
AllocateVMem(oVmd, oVmi, numSwapPages)

// build vector of all OEPs and XEPs
let oev = vec numOEP+numXEP
oev!0 = 0; oev!numOEP = 0
DeclareAllOEPs(oev)

// now fire up the overlay machinery.
// Note that this will clobber all procedure statics which are
// in overlays.  After this, any modules which were loaded as
//both initialization and overlays will no longer appear resident.
isb>>ISB.lenOD = 25 + lOD*isb>>ISB.numOverlays + lOEP*oev!0
isb>>ISB.oD = Allocate(bigZone, isb>>ISB.lenOD)
let errorCode = OverlayScan(lv cfa>>CFA.fp, isb>>ISB.oD, isb>>ISB.lenOD,
 lv cfa>>CFA.fa, buf, bufLen, 0, 0, disk, oev+1, oev!0)
if errorCode ls 0 then IFSError(ecOverlayScan, errorCode)

// Leave the XEP table in the ISB for use by IfsOvXMInit
isb>>ISB.xepTable = Allocate(sysZone, oev!numOEP +1)
MoveBlock(isb>>ISB.xepTable, oev+numOEP, oev!numOEP +1)
]

//----------------------------------------------------------------------------
and DeclareOEP(oev, lvProc, nil, nil, nil, nil, nil, nil, nil,
    nil, nil; numargs na) be
//----------------------------------------------------------------------------
// Declares up to 10 procedures that are to be Overlay Entry Points (OEPs).
// A procedure must be declared an OEP if it is in an overlay and is
// ever called other than through its static (typical cases are procedures
// put into objects or passed as arguments).
// Usage: procedures named DeclarexxxOEP in the resident initialization
// are called from the DeclareAllOEPs procedure in IfsOvCopy.bcpl,
// and are passed an Overlay Entry Vector (oev) as their first argument.
// These procedures declare OEP procedures by calling:
//	DeclareOEP(oev, lv Proc1, lv Proc2, ...)
[
for i = 0 to na-2 do
   [
   oev!0 = oev!0+1
   if oev!0 ge numOEP then IFSError(ecTooManyOEPs)
   oev!(oev!0) = (lv lvProc)!i
   ]
]

//----------------------------------------------------------------------------
and DeclareXEP(oev, lvProc, nil, nil, nil, nil, nil, nil, nil,
    nil, nil; numargs na) be
//----------------------------------------------------------------------------
// Declares up to 10 procedures that are to be XM Entry Points (XEPs)
// if they actually end up being loaded into extended memory.
// An XEP procedure may be executed directly out of XM by the extended
// emulator.  A non-XEP procedure, when called, forces the overlay containing
// the procedure to be swapped into bank 0 before execution.
// All BCPL procedures are declared XEPs automatically.  Assembly-language
// procedures must be declared XEPs explicitly where appropriate.
// Assembly-language procedures may be XEPs if they "play by the BCPL rules",
// meaning:  (1) no S-group instructions; (2) no PC-relative JSRs;
// (3) no absolute references to literals in the code (but PC-relative
// references are ok); (4) no fiddling with the stack.
// Note: it is ok for a procedure to be both an OEP and an XEP, if that is
// appropriate.
[
let xev = oev+numOEP
for i = 0 to na-2 do
   [
   xev!0 = xev!0+1
   if xev!0 ge numXEP then IFSError(ecTooManyXEPs)
   xev!(xev!0) = (lv lvProc)!i
   ]
]

//----------------------------------------------------------------------------
and FixupSwappedOut(relocTable) be
//----------------------------------------------------------------------------
// Fixes up all resident initialization procedure statics to
// point to SwappedOut.  relocTable is the compressed relocation table
// created in InitIFSPart1.
// This must be absolutely the last resident initialization procedure called.
[
for i = 1 to relocTable!0 do
   [
   let pStatic = relocTable!i
   // Patch static if procedure is in resident init (i.e., after "I/Q")
   // and is not also in an overlay or declared to be an OEP.
   if Usc(@pStatic, isb>>ISB.pcI) ge 0 &
    Usc(@pStatic-isb>>ISB.oD, isb>>ISB.lenOD) ge 0 then
      @pStatic = SwappedOut
   ]
]

// Overlay package initialization
// Derived from OVERLAYSINIT.BCPL, by P. Deutsch,
// last edited November 8, 1978  8:48 AM


//----------------------------------------------------------------------------
and OverlayInit(odv, fixv, disk; numargs na) be
//----------------------------------------------------------------------------
[
DefaultArgs(lv na, -1, 0, odv>>ODV.disk)
OverlayFp = lv odv>>ODV.fp
OverlayDisk = (disk eq 0? sysDisk, disk)
let nov = odv>>ODV.nov
if nov eq 0 return
FirstOD = odv+lODV
let od = FirstOD
for i = 1 to nov do
   [
   od>>OD.core, od>>OD.onstack = 0, 0
   od>>OD.JSR = STA3JSRI+lv OverlaySave
   od = od+lOD
   ]
EndOD = od
od = od+lOD	// skip over extra firstPn
od!0 = #54000+lv OverlayEntry		// STA 3
od!1 = #35001				// LDA 3 1,2
od!2 = #2000+lv OverlayFaultProc	// JMP @
OverlaySave = od
let fixp = fixv
if na ge 2 then	// fix up swapped-out statics
   [
   let val = FirstOD
   while @fixp ge 0 do
      [
      let nfixp = fixp+@fixp+1
         [
         fixp = fixp+1
         if fixp eq nfixp break
         (@fixp)!0 = val
         ] repeat
      val = val+lOD
      ]
   fixp = fixp+1
   ]
OEPinit(od+xODV, odv>>ODV.nep, fixp)
]

//----------------------------------------------------------------------------
and OEPinit(oep, nep, epv) be
//----------------------------------------------------------------------------
[
FirstOEP = oep
for i = 1 to nep do
   [
   let sa = @epv
   if Usc(@sa-FirstOD, EndOD-FirstOD) ls 0 then
      [	// procedure really is in an overlay
      oep>>OEP.JSRJMP = STA3JSRI+lv OverlaySave
      oep>>OEP.ODorEP = @sa			// od address
      @sa = oep
      ]
   // otherwise, procedure is resident, OEP isn't needed
   epv = epv+1
   oep = oep+lOEP
   ]
EndOEP = oep
]

//----------------------------------------------------------------------------
and OverlayScan(fptr, odv, len, fa, pbuf, bsize, fixv, fsize, disk, epv, nep;
   numargs na) = valof
//----------------------------------------------------------------------------
[
DefaultArgs(lv na, -3, 0, 0, 0, 0, 0, 0, 0, 0)
// Initialize the work area
Zero(odv, len)
MoveBlock(lv odv>>ODV.fp, fptr, lFP)
odv>>ODV.disk = disk
OverlayInit(odv)	// Just set OverlayFp, OverlayDisk

let odend = odv+len
let iOVpagesize, iOVbuf, iOVnbufs = nil, nil, nil
iOVpagesize = 1 lshift OverlayDisk>>DSK.lnPageSize
let mybuf = iOVpagesize+2
test bsize ls mybuf
   ifso
      [
      Dvec(OverlayScan, lv mybuf)
      iOVbuf, iOVnbufs = mybuf, 1
      ]
   ifnot
      [
      iOVbuf, iOVnbufs = pbuf, (bsize-1)/(iOVpagesize+1)
      if iOVnbufs gr MaxScanPages then iOVnbufs = MaxScanPages
      ]
let oss = vec lenOSS  // can't declare this until after Dvec
oss>>OSS.OVpagesize = iOVpagesize
oss>>OSS.OVbuf = iOVbuf
oss>>OSS.OVnbufs = iOVnbufs
oss>>OSS.OVdas = oss>>OSS.OVbuf+(oss>>OSS.OVnbufs*oss>>OSS.OVpagesize)
@(oss>>OSS.OVdas) = fptr>>FP.leaderVirtualDa
oss>>OSS.OVcurpn, oss>>OSS.OVcurnp = 0, 0
OverlayFp = fptr
let pn = nil
test fa eq 0
   ifso
      [
      let buf = advancetopage(oss, 1, 2)	// read first data page
      pn = buf!1+1
      if pn ls 2 resultis 0	// no overlays
      ]
   ifnot
      [
      oss>>OSS.OVcurpn, oss>>OSS.OVcurnp, @(oss>>OSS.OVdas) = fa>>FA.pageNumber, 0, fa>>FA.da
      pn = oss>>OSS.OVcurpn
      ]
let od = odv+lODV
let fixi = 0

   [ // repeat
   if (od+(lOD+xODV)-odend) gr 0 resultis -1
   od>>OD.firstPn = pn
   let buf = advancetopage(oss, pn, MaxScanPages)
   if (buf eq 0) % (buf!4 eq 0) break
   od>>OD.da = oss>>OSS.OVdas!((buf-oss>>OSS.OVbuf)/oss>>OSS.OVpagesize)
   let skip = buf!1+#20
   let npages = (buf!4+oss>>OSS.OVpagesize-1)/oss>>OSS.OVpagesize
   let buf = advancetopage(oss, pn + skip/oss>>OSS.OVpagesize, MaxScanPages)
   let wn = skip rem oss>>OSS.OVpagesize
   let n = buf!wn
   let nw = oss>>OSS.OVbuf+(oss>>OSS.OVcurnp*oss>>OSS.OVpagesize)-buf
   if fixv ne 0 then
      [
      if fixi+n+1 ge fsize resultis -2
      fixv!fixi = n
      fixi = fixi+1
      ]
   for i = 1 to n do
      [
      wn = wn+1
      if wn ge nw then
         [
         buf = advancetopage(oss, oss>>OSS.OVcurpn+oss>>OSS.OVcurnp, MaxScanPages)
         wn = wn-nw
         nw = oss>>OSS.OVcurnp*oss>>OSS.OVpagesize
         ]
      let stat = buf!wn
      @stat = od
      if fixv ne 0 then
         [
         fixv!fixi = stat
         fixi = fixi+1
         ]
      wn = wn+1
      ]
   pn = pn+npages
   od = od+lOD
   ] repeat

odv>>ODV.nov = (od-(odv+lODV))/lOD
OverlayInit(odv)	// Set up ODs, initialize FirstOEP, EndOEP

// Process special entries
if (EndOEP+nep*lOEP-odend) gr 0 resultis -1
if fixv ne 0 then
   [
   if fixi+nep+1 ge fsize resultis -2
   fixv!fixi = -1
   MoveBlock(fixv+fixi+1, epv, nep)
   fixi = fixi+nep+1
   ]
odv>>ODV.nep = nep
OEPinit(FirstOEP, nep, epv)

if fixv ne 0 then fixv!fixi = -1
resultis fixi+1
]

//----------------------------------------------------------------------------
and advancetopage(oss, newpn, npages) = valof
//----------------------------------------------------------------------------
[
while newpn ge (oss>>OSS.OVcurpn+oss>>OSS.OVcurnp) do
   [
   let nextda = oss>>OSS.OVdas!(oss>>OSS.OVcurnp)
   if nextda eq eofDA resultis 0
   oss>>OSS.OVcurpn = oss>>OSS.OVcurpn+oss>>OSS.OVcurnp
   let nsp0 = MaxScanPages-oss>>OSS.OVnbufs
   let nsp1 = newpn-oss>>OSS.OVcurpn
   let nsp = (nsp0 ls nsp1? nsp0, nsp1)
   let np1 = nsp+oss>>OSS.OVnbufs
   if npages gr np1 then npages = np1
   let CAs = vec MaxScanPages
   SetBlock(CAs, oss>>OSS.OVbuf, MaxScanPages)
   for i = 1 to oss>>OSS.OVnbufs-1 do
      CAs!(nsp+i) = oss>>OSS.OVbuf+(i*oss>>OSS.OVpagesize)
   let DAs = vec MaxScanPages+1
   DAs!0 = nextda
   SetBlock(DAs+1, fillInDA, MaxScanPages)
   let lastnc = nil
   let lastpn = ActOnDiskPages(OverlayDisk, CAs-oss>>OSS.OVcurpn,
    DAs-oss>>OSS.OVcurpn, OverlayFp, oss>>OSS.OVcurpn,
    oss>>OSS.OVcurpn+npages-1, DCreadD, lv lastnc)
   oss>>OSS.OVcurpn = oss>>OSS.OVcurpn+nsp
   oss>>OSS.OVcurnp = lastpn+1-oss>>OSS.OVcurpn
   MoveBlock(oss>>OSS.OVdas, DAs+nsp, oss>>OSS.OVcurnp+1)
   if lastnc eq 0 then
      [
      oss>>OSS.OVcurnp = oss>>OSS.OVcurnp-1
      oss>>OSS.OVdas!(oss>>OSS.OVcurnp) = eofDA
      ]
   ]
resultis oss>>OSS.OVbuf+(newpn-oss>>OSS.OVcurpn)*oss>>OSS.OVpagesize
]