// OsMain.bcpl -- CallSubsys and utilities
// Copyright Xerox Corporation 1979, 1980
// Last modified September 7, 1980  6:06 PM by Boggs

get "AltoFileSys.d"
get "Streams.d"
get "SysDefs.d"
get "AltoDefs.d"
get "SysInternals.d"
get "BcplFiles.d"

external
[
// outgoing procedures
CallSubsys; Junta	//public
FinishInitOs		//private

// incoming procedures by junta level
// Basic
InLd; CallSwat

// BFS
BFSClose; BFSWriteDiskDescriptor
DefaultArgs; SysErr
MyFrame; GotoLabel; GotoFrame; CallersFrame
StartIO; Usc; SetBlock; MoveBlock; Zero

// DiskStreams
Gets; Puts; Closes; Endofs; Resets
ReadBlock; WriteBlock
PositionPage; GetCompleteFa

// Dirs
OpenFile

// Alloc
InitializeZone

// Keyboard
SetKeyboardProc

// Display
ShowDisplayStream

// OsUtils
GetFixedInit; SetEndCode; Ws

// incoming system-wide statics
fpExecutive; fpSysBoot; EnumerateFp
keys; dsp; sysFont; sysDisk
juntaTable; OsFinishCode; EventVector
lvAbortFlag; lvCursorLink
sysZone; protectedSysZone; lProtectedSysZone
]

manifest
[
// error codes
ecStaticLocation = 1960
ecCodeLocation = 1961
ecNoExecutive = 1962
ecIllegalJuntaLevelName = 1963
ecAlreadyJuntaed = 1964
ecBLV = 1965
ecNotInstalled = 1966

userBottom = 1000b
]

static [ subsys; swat; userParams; sysRoot ]

//---------------------------------------------------------------------------
let FinishInitOs() be
//---------------------------------------------------------------------------
// This routine is called after all boot initialization is complete.
// Here is where we are supposed to come when a "finish" is executed
[
@activeInterrupts = OsActiveNormal //Reset interrupt system...
//Point intVec slots for idle channels at location zero.
//If we somehow get an interrupt we should land in swat.
//Note that the truth about whether a channel is in use is whether
// the channel bit in ACTIVE is on; testing the intVec slot for
// zero is frowned upon.
for i = 0 to 14 do
   if (OsActiveNormal&(1 lshift i)) eq 0 then
      interruptVector!i = 0
StartIO(3)		//Turn off Ethernet

SetEndCode(userBottom)	//"Finish" only sets temporarily

let cjProc = juntaTable>>JT.jReason
if OsFinishCode gr 0 & cjProc eq 0 test OsFinishCode eq fcAbort
   ifso Ws("...aborted...")
   ifnot SysErr(nil, OsFinishCode) //Type it out!

// Remove user's display quickly, because it is probably running in his
// stack.  The calls below will begin to clobber the stack!
ShowDisplayStream(dsp, DSalone)	//Make it the only display

@lvCursorLink = true	//Re-enable cursor.
GetFixedInit()		//No more free storage.
SetKeyboardProc()	//Turn off user procedure
sysZone = InitializeZone(protectedSysZone, lProtectedSysZone)
BFSWriteDiskDescriptor(sysDisk)	//Write bit table if changed.
@lvAbortFlag = 0	//Enable SWAT aborts

if cjProc then  //User called CounterJunta()
   [
   juntaTable>>JT.jReason = 0
   cjProc()  //Call him
   finish  //If he should return!
   ]

// Now decide what to run if anything.
let runsys = 0
let ev = EventVector
   [
   let len = ev>>EVM.length
   if len eq 0 then break	//No events to process
   let md = ev + size EVM/16
   let type = ev>>EVM.type
   if type eq eventCallSubsys then
      [
      test len ne 1
         ifso runsys = OpenFile(md, ksTypeReadOnly)
         ifnot  //invoking HiddenFtp.run
            [
            runsys = OpenFile("Sys.Boot", ksTypeReadOnly, 0, 0, fpSysBoot)
            PositionPage(runsys, 3)
            ]
      MoveBlock(ev, ev+len, EventVector+(EventVector!-1)-ev-len)
      break
      ]
   if type eq eventInLd then InLd(md, md)
   ev = ev+len
   ] repeat

if runsys eq 0 then
   runsys = OpenFile("Executive.Run.", ksTypeReadOnly, 0, 0, fpExecutive)

sysRoot = CallersFrame()  //This will obliterate our frame...
CallSubsys(runsys)
]

//---------------------------------------------------------------------------
and CallSubsys(subsysX, swatX, doReturn, userParamsX; numargs na) be
//---------------------------------------------------------------------------
[
DefaultArgs(lv na, 1, false, false, 0)
swat = swatX; subsys = subsysX; userParams = userParamsX

//Returning from a subsystem call is not yet implemented
//if doReturn then [...]

GotoLabel(sysRoot, SystemMain)
]

//---------------------------------------------------------------------------
and SystemMain() be
//---------------------------------------------------------------------------
// Control comes here to run a program subsys.
// Pause and userParams are already set up.
[
// Typically, userParams is allocated as a vector in the frame of
//  CallSubsys' caller.  CallSubsys has just done a GotoLabel to here,
//  setting the stack back to sysRoot.  So we are a bit exposed, since
//  that vector is below us, and liable to be clobbered by GetFrame
//  if we call anyone.  Fortunately MoveBlock is an asm procedure which
//  doesn't get a frame, so copy that vector before calling any BCPL procs!
let upVec = vec lUserParams
MoveBlock(upVec, userParams, lUserParams)
if userParams eq 0 then upVec!0 = 0	//No parameters really

let args = vec lBLV
ReadBlock(subsys, args, size SV.H/16)
let startingAddress = args>>SV.H.startingAddress
let nStaticLinks = args>>SV.H.nStaticLinks
let npages = args>>SV.H.length
ReadBlock(subsys, args, lBLV)  //args vector is reused.
// skip the first 16b words of the page 0 image
ReadBlock(subsys, 16b, 16b)
// and then load the rest of it
ReadBlock(subsys, 16b, 300b-16b)

let currentStack = MyFrame()
CheckBounds(userBottom, args>>BLV.startOfStatics,
 args>>BLV.endOfStatics, currentStack, ecStaticLocation)
CheckBounds(userBottom, args>>BLV.startOfCode,
 args>>BLV.afterLastCodeWord+nStaticLinks, currentStack, ecCodeLocation)

ReadBlock(subsys, args>>BLV.startOfStatics,
 args>>BLV.endOfStatics-args>>BLV.startOfStatics+1)  //read in statics

let len = args>>BLV.afterLastCodeWord+nStaticLinks-args>>BLV.startOfCode
if ReadBlock(subsys, args>>BLV.startOfCode, len) ne len then
   SysErr(nil, ecBLV)  //BLV disagrees with file

unless Endofs(subsys) do PositionPage(subsys, npages+1)
let cfa = vec lCFA; GetCompleteFa(subsys, cfa)
Closes(subsys)

SetEndCode(args>>BLV.endCode)
SetBlock(0, 77400b, 10b)
SetBlock(614b, 52525b, 621b-614b+1)	//To help detect parity errors

// Now fix up static links.
// EnumerateFp is used as the relocation base for the top static region.
// CallSubsys is used as the relocation base for the main static region.
let p = args>>BLV.afterLastCodeWord-1
for i = 1 to nStaticLinks do
   [
   // 'staticAddr' is the address of a user static needing initialization.
   // Bldr sets them to contain an index into one of the two system
   //  static regions.  High static indicies have the sign bit set.
   // 'index' is the address of the corresponding system static.
   let staticAddr = p!i		//Left by loader
   let index = @staticAddr	//ID in Sys.Bk file
   test index ls 0		// look for sign bit
      ifso index = (index-100000b) + lv EnumerateFp  //in top statics
      ifnot index = index + lv CallSubsys  //in main statics
   @staticAddr = @index  //copy system's static value into user's static
   ]

if swat then CallSwat("pause to swat")

startingAddress(args, upVec, cfa)  //call the subsystem

// subsystem returns control here
finish
]

//---------------------------------------------------------------------------
and CheckBounds(l, i1, i2, u, ecNo) be 
//---------------------------------------------------------------------------
   unless Usc(l, i1) le 0 & Usc(i1, i2) le 0 & Usc(i2, u) le 0 do
      SysErr(l, ecNo, i1, i2, u)

//---------------------------------------------------------------------------
and Junta(levnam, proc) be
//---------------------------------------------------------------------------
[
structure DL [ bl1 word 5; version word 1; bl2 word 2 ]
if (lv juntaTable>>JT.BootLabel)>>DL.version eq 0 then
   SysErr(nil, ecNotInstalled)
if juntaTable>>JT.jAtLevel ne 0 then
   SysErr(levnam, ecAlreadyJuntaed)

//Stuff here for cleaning out system free storage area
Closes(dsp)	//Close the system display

// In the following table, put cleanup code ABOVE the level name.  This
// is because the argument to Junta is the last level to KEEP.  Thus,
// if BFSwrite is kept, it is not necessary to write the bit table;
// but if only BFSbase is to be kept, the bit table must be written.

switchon levnam into
   [
   case levBasic:
   case levBuffer:
   case levFilePointers:
   case levBcpl:
   case levStatics:
      SysErr = CallSwat
   case levBFSbase:
      sysDisk = BFSClose(sysDisk)
   case levBFSwrite:
   case levAlloc:
   case levStreams:
   case levScan:
   case levDirectory:
      @displayInterrupt = @displayInterrupt & not kbInterruptBit
      @activeInterrupts = @activeInterrupts & not kbInterruptBit
   case levKeyboard:
   case levDisplay:
   case levMain:
      endcase
   default: SysErr(levnam, ecIllegalJuntaLevelName)
   ]

sysZone = 0	// Will cause a Swat break at 0 or 1 if used now.
let p = lv juntaTable>>JT.jTable
for i = 1 to juntaTable>>JT.jLevels do
   [
   if p!0 eq levnam then break
   p = p+2
   ]
juntaTable>>JT.jAtLevel = p	// remember how far back we went
let stack = p!1-4	//New stack root
@stack = stack		//Link to itself
GotoLabel(stack, proc)
]