// IfsInitRes.bcpl -- IFS resident initialization
// Copyright Xerox Corporation 1979, 1980, 1981, 1982
// Last modified May 12, 1982  6:41 PM by Taft

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

// incoming procedures
Junta; MyFrame; CallersFrame; Zero; MoveBlock; IFSAfterJunta; SetBlock
LoadRam; Idle; IFSIdle; IfsRamImage; InitBcplRuntime; RamTest
InitOverlays; CopyOverlays; FixupSwappedOut
InitDisks; InitDisksFinish; MakeFree; IFSFinish
InitVMem; SetEndCode
InitializeZone; Allocate; Free; Enqueue
AddToZone; IFSAddToZone
OpenIFSPart1; CreateIFSPart1
GetCreateParams; DestroyCreateParams
IFSAllocate; IFSFree; IFSError; SysErr; TFSSwatProc; CallProcProcess
ExtractSubstring; PutTemplate; Wss; InitContextSched; InitializeContext
OpenFile; Endofs; Closes; ReadBlock; WriteBlock; ReadLeaderPage
FilePos; SetFilePos; PositionPtr; CreateDiskStream; TruncateDiskStream
SetWorkingDir; PositionPage; JumpToFa; GetCurrentFa; GetCompleteFa

// outgoing statics
ifsCtxQ; primaryIFS; system; savedUFP; isb
debugFlag; numVMemBufs; spyBuffer

// incoming statics
lvCursorLink; snarfTable; dsp; OsVersion; AltoVersion
oPageQ; chunkQ; freePageQ; dontSnarf;
bigZone; smallZone; lvSysZone; sysZone; entFlag; lenFMap
lvUserFinishProc; lvSwatContextProc; TFSLeaveDisplay; leafPresent
]

static
[
ifsCtxQ; primaryIFS; system; savedUFP; isb
debugFlag = false
numVMemBufs = 0

spyBuffer = 5500b  // Storage needed for spy buffer (changes over time)
]

manifest
[
stackLimit = 335b

lenInitStack = 2*1024
lenCallProcStack = 800

ecBadLoadRam = 16
ecOsVersion = 5
]

//----------------------------------------------------------------------------
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 19 then IFSError(ecOsVersion, 19)

// 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 = 7*1024
lisb>>ISB.bigZoneIncr = 6*1024
lisb>>ISB.lenSmallZone = 2*1024
lisb>>ISB.smallZoneIncr = 0*1024
MoveBlock(lv lisb>>ISB.pinnedOverlays, pinnedOverlays,
 size ISB.pinnedOverlays/16)

// First, patch up the runtime environment in various ways
let t = AddToZone; AddToZone = IFSAddToZone; IFSAddToZone = t
@lvCursorLink = 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
      ]
   ]
RamTest(0)  // Doesn't return if Ram is bad
let ram = LoadRam(IfsRamImage, true)  //silent boot
if ram ne 0 then IFSError(ecBadLoadRam, ram)
RamTest(IfsRamImage+400B)

// Must now throw away LoadRam and microcode to gain enough memory
//  for primaryIFS creation, which needs a lot of space and executes
//  with the full OS in core.  Since the relocation table is above this,
//  we must slide it down.  While doing so, compress to 1 word/entry.
let relocTable = layoutVector!31  //table of resident init procs
LoadRam!0 = relocTable!0
for i = 1 to relocTable!0 do LoadRam!i = relocTable!(2*i-1)
lisb>>ISB.relocTable = LoadRam
SetEndCode(LoadRam+LoadRam!0+1)
lisb>>ISB.pcX = layoutVector!($X-$A)  // Bldr "X/Q"
lisb>>ISB.pcL = layoutVector!($L-$A)  // Bldr "L/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
CreateDiskStream = mainStatics!71B
ReadLeaderPage = mainStatics!72B
WriteBlock = mainStatics!76B
ReadBlock = mainStatics!77B
TruncateDiskStream = mainStatics!100B
PositionPage = mainStatics!101B
PositionPtr = mainStatics!102B
JumpToFa = mainStatics!103B
GetCurrentFa = mainStatics!104B
GetCompleteFa = mainStatics!105B
FilePos = mainStatics!110B
SetFilePos = mainStatics!111B

// Interpret any global switches passed to us by the Executive
lisb>>ISB.verifyTree = true
lisb>>ISB.maxBanksXM = 4
lisb>>ISB.enableMiscServers = true
let allocatorDebug = false
let allocateSpyBuffer = false
leafPresent = false
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 $C: case $c:
               lisb>>ISB.creatingPrimary = val; endcase
            case $D: case $d:
               debugFlag = val; endcase
            case $A: case $a:
               allocatorDebug = val; endcase
            case $V: case $v:
               lisb>>ISB.verifyTree = val; endcase
            case $S: case $s:
               allocateSpyBuffer = val; endcase
            case $X: case $x:
               unless val do lisb>>ISB.maxBanksXM = 0; endcase
            case $M: case $m:
               lisb>>ISB.enableMiscServers = val; endcase
            case $F: case $f:
               lenFMap = lenFMap+100; endcase
            case $L: case $l:
               leafPresent = val; 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 /X switch
if AltoVersion<<VERS.eng ne 3 then lisb>>ISB.maxBanksXM = 0

// Set up microcoded 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 on sysZone into it.
sysZone = Allocate(smallZone, 10); Zero(sysZone, 10)
oPageQ = sysZone+2
chunkQ = sysZone+4; MoveBlock(chunkQ, iChunkQ, 2)
freePageQ = sysZone+6
ifsCtxQ = sysZone+8
sysZone>>ZN.Allocate = IFSAllocate
sysZone>>ZN.Free = IFSFree
let savedSysZone = @lvSysZone
@lvSysZone = sysZone
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)

// Start the CallProc process.
InitContextSched()
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.
// ***** Do not queue any userFinishProcs between here and
//	the end of InitIFSPart2 *****
savedUFP = @lvUserFinishProc
@lvUserFinishProc = IFSFinish

// Build the "system" user info block for internal file operations
system = Allocate(sysZone, lenUserInfo); Zero(system, lenUserInfo)
system>>UserInfo.userName = ExtractSubstring("System")
system>>UserInfo.connName = system>>UserInfo.userName
system>>UserInfo.capabilities.wheel = true

// The following procedures must be called before any attempt to TFSInit.
// Note that VMem won't actually work until we have given it some buffers.
InitVMem()
InitDisks()  //must be after InitVMem because it does a LockCell

// InitIFSPart1 (cont'd)

// Open Primary file system
if isb>>ISB.creatingPrimary then
   [
   let cPar = GetCreateParams(ifsTypePrimary)
   if cPar eq 0 then finish
   let ec = CreateIFSPart1(cPar)
   DestroyCreateParams(cPar)
   if ec eq 0 break
   Wss(dsp, "*nUnable to create Primary IFS.")
   PutTemplate(dsp, "  Error code is $D. - See IFS.Errors", ec)
   ] repeat

// Since OpenIFSPart1 does TFSInit passing the ifsDDMgr, we must
//  give VMem a buffer to page the DiskDescriptor with.
//  We 'know' that @stackLimit is at a page boundary.
@stackLimit = @stackLimit + 1 lshift logStdPageLength
MakeFree(0, @stackLimit - 1 lshift logStdPageLength, 1 lshift logStdPageLength)
let ec = nil
primaryIFS = OpenIFSPart1("Primary", lv ec)
if primaryIFS eq 0 then [ IFSError(ec); finish ]

// Copy overlays from model 31 to Trident
CopyOverlays(primaryIFS>>IFS.lpdt↑0, cfaIFSRun, lv isb>>ISB.cfaIFSSwap)

// Copy vital files from model 31 to Trident.
CopyDiabloFile("IFS.Errors", true)
CopyDiabloFile("IFS.Syms", false)

// Finished with most of the OS.  Junta!
@lvSysZone = savedSysZone
Junta(levBasic, IFSAfterJunta)
]


//----------------------------------------------------------------------------
and CopyDiabloFile(name, vital) be
//----------------------------------------------------------------------------
// Copies a file from the model 31 to IFS logical unit 0.
// Failure to do so is considered a fatal error if "vital" is true.
[
// Open file on Diablo disk
let diablo = OpenFile(name, ksTypeReadOnly, charItem)
if diablo eq 0 then test vital
   ifso IFSError(ecDiabloFile, name)
   ifnot return

// Open file on Trident disk
let trident = OpenFile(name, ksTypeWriteOnly, charItem,
 verLatest, 0, 0, sysZone, 0, primaryIFS>>IFS.lpdt↑0)
if trident eq 0 then test vital
   ifso IFSError(ecTridentFile, name)
   ifnot [ Closes(diablo); return ]

// Copy file
let buf = Allocate(sysZone, 1024)
until Endofs(diablo) do
   WriteBlock(trident, buf, ReadBlock(diablo, buf, 1024))
let pos = vec 1  // supply filePos sink explicitly to avoid OS 17 bug
if (FilePos(diablo, pos) & 1) ne 0 then  //back up over garbage byte
   SetFilePos(trident, 0, FilePos(trident, pos)-1)
Free(sysZone, buf)

Closes(diablo)
Closes(trident)
]

//----------------------------------------------------------------------------
and InitIFSPart2() be
//----------------------------------------------------------------------------
// This procedure sets up the overlay machinery and gives the virtual memory
//  package enough buffers to work with.  Most of the OS is gone now.
[
// Make stack end in zero rather than loop or garbage
CallersFrame()!0 = 0

// Make the screen black
let dcb = Allocate(sysZone, 4, false, true); Zero(dcb, lDCB)
dcb>>DCB.background = 1
@displayListHead = dcb
TFSLeaveDisplay = true

// Give most of our stack to vmem and free storage zones.
// Must keep 'lenInitStack' words (more or less) until initialization finished
let base = @stackLimit
@stackLimit = (MyFrame()-lenInitStack) & (-1) lshift logStdPageLength
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
InitOverlays(primaryIFS>>IFS.lpdt↑0, lv isb>>ISB.cfaIFSSwap, buf, bufLen)
Free(sysZone, buf)
InitDisksFinish()  //fix up OEPs for TFSFinishProc and disk objects
// ***** Do not queue any user finish procedures before here *****

// This must be the last procedure called by InitIFSPart2
FixupSwappedOut(isb>>ISB.relocTable)
]