// 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