// InstallUtils.Bcpl -- OS install sequence utility routines
// Copyright Xerox Corporation 1980
// last modified March 1, 1980  5:24 PM by Boggs

get "AltoFileSys.d"
get "Sysdefs.d"
get "SysInternals.d"

external
[
// outgoing procedures
GetString; ReadNumber; GetNumber; YesNo
GetNthLevel; GetLevelSa; RestoreLev

// general os procedures:
Gets; Puts; Ws
MoveBlock; Zero; Usc

// display
CharWidth; EraseBits; GetBitPos

// misc
CallSwat

// incoming statics
juntaTable; keys; dsp

// for level calculations
LevBasic; LevBuffer; LevFilePointers; LevBcpl; LevStatics
LevBFSBase; LevBFSWrite; LevAlloc; LevStreams; LevScan; LevDirectory
LevKeyboard; LevDisplay; LevMain
]

//String I/O

//----------------------------------------------------------------------------
let GetString(p, preload; numargs na) = valof
//----------------------------------------------------------------------------
// Read a string, terminated by carriage return, from the keyboard.
// Store it into the vector "p"
[
let opos = GetBitPos(dsp)
test na gr 1
   ifso  //Preload the response
      [
      Ws(preload)
      MoveBlock(p, preload, preload>>STRING.length rshift 1 +1)
      ]
   ifnot p!0 = 0
let count = p>>STRING.length
let char = Gets(keys)
if char ne $*s & char ne $*n then
   [
   count = 0
   EraseBits(dsp, opos-GetBitPos(dsp))
      [
      test char eq 10b % char eq 1 % char eq 177b  //Ctl-A or BS or DEL
         ifso if count ne 0 then
            [
            EraseBits(dsp, -CharWidth(dsp, p>>STRING.char↑count))
            count = count -1
            ]
         ifnot
            [
            Puts(dsp,char)
            count = count +1
            p>>STRING.char↑count = char
            ]
      char = Gets(keys)
      ] repeatuntil char eq $*n
   ]
Ws("*n")
p>>STRING.length = count
resultis count/2 +1  //WORD length of the string
]

//----------------------------------------------------------------------------
and ReadNumber(radix; numargs n) = valof
//----------------------------------------------------------------------------
[
if n eq 0 then radix = 10
let str = vec 20; GetString(str)
resultis GetNumber(str, radix)
]

//----------------------------------------------------------------------------
and GetNumber(p, radix) = valof
//----------------------------------------------------------------------------
[
let n = 0
for i = 1 to p>>STRING.length do
   n = n*radix+((p>>STRING.char↑i) - $0)
resultis n
]

//----------------------------------------------------------------------------
and YesNo(c1, c2, c3, c4; numargs na) = valof
//----------------------------------------------------------------------------
// Get an answer.  Return:
//	0 if "no" (default)
//	1 if "yes"
//	n if character is n-1 th argument (optional)
[
let c = Gets(keys)
if c ge $a & c le $z then c = c-$a+$A
if c eq $Y then [ Ws(" Yes*N"); resultis 1 ]
for i = 2 to na+1 do if c eq (lv c1)!(i-2) then
   [
   Ws(" "); Puts(dsp, c); Ws("*n")
   resultis i
   ]
Ws(" No*N"); resultis 0
]

// Routines for dealing with level assignments

// Each level is given a 16-bit name, defined by manifest constants of
// the form "levBasic".

//----------------------------------------------------------------------------
and GetNthLevel(n,p) = valof
//----------------------------------------------------------------------------
// Returns true if there is an nth level.
//	p!0 is name; p!1 is starting address of the level.
//	Level 0 is at the top of core.
[
let levnam = selecton n into
   [
   case 0:	levBasic
   case 1:	levBuffer
   case 2:	levFilePointers
   case 3:	levBcpl
   case 4:	levStatics
   case 5:	levBFSbase
   case 6:	levBFSwrite
   case 7:	levAlloc
   case 8:	levStreams
   case 9:	levScan
   case 10:	levDirectory
   case 11:	levKeyboard
   case 12:	levDisplay
   case 13:	levMain
   default:	-1
   ]
if levnam ls 0 then resultis false	//does not exist
if n ge juntaTable>>JT.jLevels then CallSwat("junta table too small")
p!0 = levnam
p!1 = GetLevelSa(levnam)		//retrieve starting address
resultis true
]

// Get first core address of the level of the given name

//----------------------------------------------------------------------------
and GetLevelSa(levnam) = selecton levnam into
//----------------------------------------------------------------------------
   [
   case -1:			177000b		//Tippy top
   case levBasic:		LevBasic
   case levBuffer:		LevBuffer
   case levFilePointers:	LevFilePointers
   case levBcpl:		LevBcpl
   case levStatics:		LevStatics
   case levBFSbase:		LevBFSBase
   case levBFSwrite:		LevBFSWrite
   case levAlloc:		LevAlloc
   case levStreams:		LevStreams
   case levScan:		LevScan
   case levDirectory:		LevDirectory
   case levKeyboard:		LevKeyboard
   case levDisplay:		LevDisplay
   case levMain:		LevMain
   ]


//----------------------------------------------------------------------------
and RestoreLev(levnam) = valof
//----------------------------------------------------------------------------
// Returns true if the level in question must be restored.
[
let goodlevel = juntaTable>>JT.jAtLevel
if goodlevel eq 0 then resultis true //Always restore
let q = GetLevelSa(levnam)
resultis Usc(q, goodlevel!1) ls 0
]