// IFSScavInit.bcpl -- Scavenger initialization
// Copyright Xerox Corporation 1979, 1980, 1981, 1983
// Last modified June 16, 1983  9:18 PM by Boggs

get "AltoDefs.d"
get "Streams.d"
get "IfsFiles.decl"
get "IFS.decl"
get "IfsVmem.decl"
get "SysDefs.d"
get "IfsInit.decl"

external
[
// outgoing procedures
InitIFSPart1; InitIFSPart2; InitIFSPart3
IFSFinish

// incoming procedures
Junta; IFSAfterJunta; MyFrame; CallersFrame
Zero; MoveBlock; SetBlock
LoadRam; Idle; IFSIdle; IfsRamImage; InitBcplRuntime
InitOverlays; FixupSwappedOut; CallProcProcess
InitVMem; AddBuffers; InitXMOverlays; InitDisksFinish
InitializeZone; Allocate; Free; AddToZone; IFSAddToZone
IFSAllocate; IFSFree; IFSError; SysErr; CallSwat
PutTemplate; InitContextSched
SetWorkingDir; OpenFile; ReadBlock; PositionPage; GetCurrentFa
SplitPuts; LogErrors; Endofs; Closes; Resets
CreateKeyboardStream; ShowDisplayStream; CreateDisplayStream
IFSCreateDDMgr; BFSCreateDDMgr; Enqueue; InitializeContext
BFSWriteDiskDescriptor; BFSWritePages; ExtractSubstring
IfsScavenger; ScavNoBufsProc; IfsNoBufsProc
TFSSilentBoot; TFSSwatProc; BFSInit; CloseDisk

// outgoing statics
isb; ifsCtxQ; numVMemBufs
bfsDDMgr; tfsDDMgr

// incoming statics
CursorLink; snarfTable; oPageQ; chunkQ; dontSnarf
bigZone; smallZone; sysZone; lvSysZone; lenFMap
lvUserFinishProc; lvSwatContextProc
scratchDisk; scavDisk; sysDisk; dsp; OsVersion; debugFlag
AltoVersion; monthNames
]

static
[
bfsDDMgr; tfsDDMgr; ifsCtxQ
numVMemBufs = 0
savedUFP
spyBuffer = 3200b  //storage needed for spy buffer (changes over time)
isb
]

manifest
[
stackLimit = 335b

lenDsp = 2*1024
lenScavStack = 3*1024
lenInitStack = 2*1024
lenCallProcStack = 1024

ecBadLoadRam = 16
ecOsVersion = 5
ecNumVMemBufs = 3
]

//----------------------------------------------------------------------------
let InitIFSPart1(layoutVector, userParams, cfaIFSRun) be
//----------------------------------------------------------------------------
//This procedures is called with the full OS in core, and does
// initialization requiring the BFS and other OS modules which
// are not needed once we get going.
[
// Patch in overlay numbers of overlays to be pinned in memory
let pinnedOverlays = table [ 0; 0; 0; 0; 0; 0; 0; 0; 0; 0 ]
compileif size ISB.pinnedOverlays/16 ne 10 then [ foo = nil ]

if OsVersion ls 17 then IFSError(ecOsVersion, 17)

// Create a local Initialization Storage Block.
// It will be copied into a block pointed to by the isb static once
//  the allocator has been set up.
// Install zone size constants now so they will be easy to patch.
let lisb = vec lenISB; Zero(lisb, lenISB)
lisb>>ISB.lenBigZone = 10*1024
lisb>>ISB.bigZoneIncr = 0
lisb>>ISB.lenSmallZone = 2*1024
lisb>>ISB.smallZoneIncr = 0
MoveBlock(lv lisb>>ISB.pinnedOverlays, pinnedOverlays,
 size ISB.pinnedOverlays/16)

// First, patch the runtime environment in various ways
let t = AddToZone; AddToZone = IFSAddToZone; IFSAddToZone = t
CursorLink = 0  // unlink cursor from mouse
Idle = IFSIdle  // install our own Idle procedure for TFS
@lvSwatContextProc = TFSSwatProc

// Put an hourglass in the cursor
MoveBlock(cursorBitMap, table
   [
   37776b; 20002b; 34016b; 17074b; 7570b; 3760b; 1740b; 700b
   1740b; 3260b; 6230b; 14714b; 31746b; 23762b; 37776b; 0
   ], 16)

// Load the Ram with IFS microcode
// First, change all the XMAR←s to MAR←s if running on a non-XM Alto
if AltoVersion<<VERS.eng ne 3 then  // an XM Alto is an "Alto 3"
   [
   structure UInst:  // Alto microinstruction
      [
      RSEL bit 5; ALUF bit 4; BS bit 3; F1 bit 4;
      F2 bit 4; LOADT bit 1; LOADL bit 1; NEXT bit 10;
      ]
   for i = 0 to 1777b do
      [ // XMAR← is F1=1, f2=6, but high-order bits of f1/f2 are complemented
      let uInst = IfsRamImage + 400b +2*i
      if uInst>>UInst.F1 eq 11b & uInst>>UInst.F2 eq 16b then
         uInst>>UInst.F2 = 10b
      ]
   ]
let ram = LoadRam(IfsRamImage, true)  // silent boot
if ram ne 0 then IFSError(ecBadLoadRam, ram)

// Now throw away LoadRam and microcode.
// Since the relocation table is above this, we must slide it down.
// While doing so, compress it to 1 word/entry.
let relocTable = layoutVector!31
LoadRam!0 = relocTable!0
for i = 1 to relocTable!0 do LoadRam!i = relocTable!(2*i-1)
lisb>>ISB.relocTable = LoadRam
@stackLimit = LoadRam+LoadRam!0+1
lisb>>ISB.pcX = layoutVector!($X-$A)  // Bldr "X/Q"
lisb>>ISB.pcI = layoutVector!($I-$A)  // Bldr "I/Q"

// InitIFSPart1 (cont'd)

// Set up access to resident instances of OS procedures also in overlays.
// All procedures that are in Dirs, DiskStreams, DiskStreamsMain, and
// DiskStreamsAux and that are externally called during InitIFSPart1
// must be enumerated here.  Offsets are taken from Sys.bk.
let mainStatics = lvSysZone - 221B  //entry 0 of main statics vector
SetWorkingDir = mainStatics!53b
OpenFile = mainStatics!56b
ReadBlock = mainStatics!77b
PositionPage = mainStatics!101b
GetCurrentFa = mainStatics!104b
BFSCreateDDMgr = mainStatics!234b
BFSWriteDiskDescriptor = mainStatics!233b
BFSWritePages = mainStatics!254b

// Interpret any global switches passed to us by the Executive
lisb>>ISB.maxBanksXM = 0  //temporarily
let allocatorDebug = false
let allocateSpyBuffer = false
lenFMap = 500  //don't screw around!
while userParams!0 ne 0 do
   [
   if userParams>>UPE.type eq globalSwitches then
      [
      let val = true
      for i = 1 to userParams>>UPE.length-1 do
         [
         switchon userParams!i into
            [
            case $-:
               val = not val; loop
            case $D: case $d:
               debugFlag = val; endcase
            case $A: case $a:
               allocatorDebug = val; endcase
            case $S: case $s:
               allocateSpyBuffer = val; endcase
            case $X: case $x:
               unless val do lisb>>ISB.maxBanksXM = 0; endcase
            case $F: case $f:
               lenFMap = lenFMap+100; endcase
            case $1 to $4:
               lisb>>ISB.maxBanksXM = userParams!i-$0; endcase
            default:
               PutTemplate(dsp, "Unknown switch /$C, ignored.*n",
                userParams!i)
            ]
         val = true
         ]
      ]
   userParams = userParams + userParams>>UPE.length
   ]

// if no potential for XM then turn off XM switch
if AltoVersion<<VERS.eng ne 3 then lisb>>ISB.maxBanksXM = 0

// Set up micorcoded bcpl runtime
InitBcplRuntime()

// InitIFSPart1 (cont'd)

// Create the system free storage zones.
// These zones will end up surrounded by vMem buffers, so they
// begin and end on standard page boundaries.
let iChunkQ = vec 1; iChunkQ!0 = 0
chunkQ = iChunkQ

// Large blocks come from bigZone:
lisb>>ISB.bigZoneBot = @stackLimit+(1 lshift logStdPageLength -1) &
 (-1) lshift logStdPageLength
@stackLimit = lisb>>ISB.bigZoneBot + lisb>>ISB.lenBigZone
bigZone = InitializeZone(lisb>>ISB.bigZoneBot, lisb>>ISB.lenBigZone, SysErr,
 (allocatorDebug ? SysErr, 0))

// Small blocks come from smallZone:
let base = @stackLimit
@stackLimit = base + lisb>>ISB.lenSmallZone
smallZone = InitializeZone(base, lisb>>ISB.lenSmallZone, SysErr,
 (allocatorDebug ? SysErr, 0))

// Initialize the IFS Allocator and divert calls to sysZone into it.
sysZone = Allocate(smallZone, 6)
oPageQ = sysZone+2; oPageQ!0 = 0
chunkQ = sysZone+4; chunkQ!0 = iChunkQ!0; chunkQ!1 = iChunkQ!1
sysZone>>ZN.Allocate = IFSAllocate
sysZone>>ZN.Free = IFSFree
let lenSnarf = 1 lshift (16-logStdPageLength)
snarfTable = Allocate(bigZone, lenSnarf)
SetBlock(snarfTable,-1, lenSnarf)

// Create the real Initialization Storage Block
isb = Allocate(sysZone, lenISB)
MoveBlock(isb, lisb, lenISB)
MoveBlock(lv isb>>ISB.cfaIFSSwap, cfaIFSRun, lCFA)

ifsCtxQ = Allocate(sysZone,2); ifsCtxQ!0 = 0
InitContextSched()  //queues a resident user finish proc

// Start the CallProc process.
Enqueue(ifsCtxQ, InitializeContext(Allocate(bigZone, lenCallProcStack),
 lenCallProcStack, CallProcProcess))

// Allocate spy buffer if required
test allocateSpyBuffer
   ifso
      [
      isb>>ISB.initStart = isb>>ISB.pcI+spyBuffer
      spyBuffer = isb>>ISB.pcI
      ]
   ifnot
      [ isb>>ISB.initStart = isb>>ISB.pcI; spyBuffer = 0 ]

//IFSFinish should be the first swappable user finish proc queued on
// lvUserFinishProc so that it will be the last one executed,
// because when it is done, vMem and overlays won't work.
savedUFP = @lvUserFinishProc
@lvUserFinishProc = IFSFinish

IfsNoBufsProc = ScavNoBufsProc
InitVMem()
bfsDDMgr = BFSCreateDDMgr(sysZone)
BFSWriteDiskDescriptor(sysDisk)  // OS version
sysDisk = BFSInit(sysZone, true, 0, bfsDDMgr)  // my version

// finished with most of the OS.  Junta!
Junta(levBuffer, IFSAfterJunta)
]

//----------------------------------------------------------------------------
and InitIFSPart2() be
//----------------------------------------------------------------------------
// This procedure sets up the virtual memory and overlay machinery.
// Most of the OS is gone now.
[
// Get the keyboard going again quickly
CreateKeyboardStream()

// Make stack end in zero rather than loop or garbage
CallersFrame()!0 = 0

// Give most of our stack to vmem and free storage zones.
// Must keep 'lenInitStack' words (more or less) until the last moment
let base = @stackLimit
@stackLimit = (MyFrame()-lenInitStack) & (-1) lshift logStdPageLength
if isb>>ISB.bigZoneIncr ne 0 then
   [
   AddToZone(bigZone, base, isb>>ISB.bigZoneIncr)
   base = base + isb>>ISB.bigZoneIncr
   ]
if isb>>ISB.smallZoneIncr ne 0 then
   AddToZone(smallZone, base, isb>>ISB.smallZoneIncr)
base = base + isb>>ISB.smallZoneIncr
MakeFree(bigZone, base, @stackLimit-base)
dontSnarf = false  //ok for Allocate to snarf vmem buffers now

// Give InitOverlays the largest contiguous chunk of storage we can find
let bufLen = numVMemBufs lshift logStdPageLength
let buf = nil
   [
   buf = Allocate(sysZone, bufLen, true)
   if buf ne 0 break
   bufLen = bufLen - 1 lshift logStdPageLength
   ] repeat
isb>>ISB.numOverlays = 50  //CopyOverlays does this in IFS
InitOverlays(sysDisk, lv isb>>ISB.cfaIFSSwap, buf, bufLen)
Free(sysZone, buf)
InitDisksFinish()  //fix up OEPs for sysDisk & bfsDDMgr
// ***** Do not queue any user finish procedures efore here *****

// this must be the last procedure called by InitIFSPart2
FixupSwappedOut(isb>>ISB.relocTable)
]

//---------------------------------------------------------------------------
and InitIFSPart3() be
//---------------------------------------------------------------------------
// This procedure will be called in as an overlay.
// It cuts up the resident initialization code into vmem buffers,
// and turns the remaining stack into vmem buffers.
[
// Attempt to load overlays into extended memory.
// If this is successful it will consume some of the storage
// formerly occupied by initialization code, updating isb>>ISB.initStart.
InitXMOverlays()

// Turn the remaining initialization code into vMem buffers.
MakeFree(bigZone, isb>>ISB.initStart, isb>>ISB.bigZoneBot-isb>>ISB.initStart)

// If we moved resident code into XM, turn it into free storage as well.
// Must do this after the preceding MakeFree to avoid the AddToZone bug.
if isb>>ISB.residentCodeXM then
   MakeFree(bigZone, isb>>ISB.pcX, isb>>ISB.pcI-isb>>ISB.pcX)

InitTimeIO()
tfsDDMgr = IFSCreateDDMgr()

// Open the Scavenger log
dsp = Allocate(sysZone, lST); SetBlock(dsp, CallSwat, lST)
dsp>>ST.par1 = CreateDisplayStream(5, Allocate(bigZone, lenDsp), lenDsp)
ShowDisplayStream(dsp>>ST.par1, DSalone)
dsp>>ST.par2 = OpenFile("IfsScavenger.log", ksTypeWriteOnly, charItem)
if dsp>>ST.par2 eq 0 then IFSError(ecDiabloFile, "IfsScavenger.log")
dsp>>ST.par2>>ST.error = LogErrors
dsp>>ST.puts = SplitPuts

// Create main process
Enqueue(ifsCtxQ, InitializeContext(Allocate(bigZone, lenScavStack),
 lenScavStack, IfsScavenger))

// Free up most of the remaining stack.
let base = @stackLimit
@stackLimit = MyFrame() -100
MakeFree(bigZone, base, @stackLimit-base)

// Change cursor to 'IFS'
MoveBlock(cursorBitMap, table
   [
   0; 0; 0; 0; 71706b; 21011b; 21010b; 21606b
   21001b; 21011b; 71006b; 0; 77777b; 0; 0; 0
   ], 16)
// All done initializing.  Let it rip.
]

//---------------------------------------------------------------------------
and MakeFree(zone,first,length) be
//---------------------------------------------------------------------------
// Cuts up the stretch of memory starting at 'first' into
// vmem buffers, adding any scraps to 'zone'.
[
manifest pageLength = 1 lshift logStdPageLength
manifest pageMask = (-1) lshift logStdPageLength
let last = first+length
let firstModPageLength = (first+pageLength-1) & pageMask
let lastModPageLength = last & pageMask
AddBuffers(firstModPageLength, lastModPageLength-1)

for i = firstModPageLength rshift logStdPageLength to
 lastModPageLength rshift logStdPageLength -1 do
   [ snarfTable!i = 0; numVMemBufs = numVMemBufs+1 ]
if numVMemBufs lshift (logStdPageLength-logVMPageLength) gr
 maxVMPages then IFSError(ecNumVMemBufs)

if firstModPageLength-first ge 10 then
   AddToZone(zone, first, firstModPageLength-first)
if last-lastModPageLength ge 10 then
   AddToZone(zone, lastModPageLength, last-lastModPageLength)
]


//----------------------------------------------------------------------------
and IFSFinish() be
//----------------------------------------------------------------------------
// The last finish procedure called when a finish is done
[
Closes(dsp>>ST.par1)
Closes(dsp>>ST.par2)

if scratchDisk ne sysDisk & scratchDisk ne 0 then 
   CloseDisk(scratchDisk, true)
if scavDisk ne 0 then CloseDisk(scavDisk)
CloseDisk(sysDisk)

@displayListHead = 0
TFSSilentBoot()
@lvUserFinishProc = savedUFP
]

//---------------------------------------------------------------------------
and InitTimeIO() be  // make legal constant string for modified IfsTimeIO
//---------------------------------------------------------------------------
monthNames = ExtractSubstring("x*007January*000*000*010February*000*005March*000*000*000*000*005April*000*000*000*000*003May*000*000*000*000*000*000*004June*000*000*000*000*000*004July*000*000*000*000*000*006August*000*000*000*011September*007October*000*000*010November*000*010December*000") +1