//Run.bcpl - Run a Mesa Image file - R. Johnsson
//last modified by Johnsson:  September 30, 1980  12:22 PM 

//Bldr/L/V 200/W Front.run/S Run MBoot Mesa-Nova1 Mesa-Nova2 MesaImage XMesaImage XMesaOverflow Configuration ReadPram

// This program may be run as the main program or may be driven
// by the more general RunMesa.bcpl

get "AltoDefs.d"
get "SysDefs.d"
get "AltoFileSys.d"
get "Streams.d"
get "RunMesa.d"

external // ReadPram
	[
	LoadPackedRAM
	]

static [
	bootList
	bootLoader
	bootMap
	bootMapSize
	memoryBanks = allBanks		// bit mask (100000b rshift bank)
	microcodeLoaded = 0		// bit mask (1 lshift bank)
	tempBootList
	tempBootMap
	]

manifest [
	lvEndCode = #335
	]


let RunThisFile (layout, up, cfa) be 
[
until up!0 eq 0 do
  [
  if up>>UPE.type eq mesaMemoryMask then
    [ memoryBanks = up!1; break ]
  up = up + up>>UPE.length
  ]
let file = CreateDiskStream(lv cfa>>CFA.fp, ksTypeReadOnly)
JumpToFa(file, lv cfa>>CFA.fa)
if Endofs(file) then
  [
  GiveMicrocodeVersion()
  Closes(file)
  file = CreateDiskStream(lv cfa>>CFA.fp, ksTypeReadWrite)
  JumpToFa(file, lv cfa>>CFA.fa)
  MoveToPageBoundary(file) // will extend to page boundary
  // patch word 1 of file (SV.H.length) to be the page number of
  // the last page in the file before the image file.
  GetCompleteFa(file, cfa)
  SetFilePos(file, 0, 2)
  Puts(file, cfa>>CFA.fa.pageNumber-1)
  Closes(file)
  finish
  ]
let header = vec lImagePrefix-1
ReadBlock(file,header,lImagePrefix)
DetermineConfiguration()
LoadInternalMicrocode()
Run(file,header)
]


and Run(image,pHeader) be
[
// image prefix has been read and is pointed to by pHeader
// stream is positioned just after header
@lvEndCode = MesaImage // reclaim space

tempBootMap = AllocCodeSpace(3*256)
tempBootList = AllocCodeSpace(lBootList)
Zero(tempBootList, lBootList)
let header = AllocCodeSpace(lImagePrefix)
MoveBlock(header, pHeader, lImagePrefix)
let intvec = AllocCodeSpace(16)

bootMap = header>>ImagePrefix.diskAddresses

//read in the page address-count words until a 0 is found
let pageMap=vec 250
let mapLast=nil
for i=0 to 250 do
    [
    pageMap!i=Gets(image)
    if pageMap!i eq 0 then
	[
	mapLast=i
	break
	]
    ]

MoveToPageBoundary(image)
let cfa = vec lCFA-1
GetCompleteFa(image, cfa)
let daOfFirstPage = nil
RealDiskDA(sysDisk, cfa>>CFA.fa.da, lv daOfFirstPage)

FindSpace(pageMap, mapLast, lv bootLoader, lv bootList)

//get stuff ready for page zero
FixMESANOVA(tempBootList)

SetupBootMap(pageMap, mapLast, tempBootMap, cfa)

FixMBOOT(tempBootList,bootMap,daOfFirstPage)

FixInterrupts(tempBootList, intvec)
let initialstate = xNovaCode+MesaNovaSize2
MakeBltItem(lv tempBootList>>BootList.blt↑blInitialState,
    lv header>>ImagePrefix.state, initialstate, lStateVector)
tempBootList>>BootList.initialState = initialstate;
MakeBltItem(lv tempBootList>>BootList.blt↑blPageMap,
    tempBootMap, bootMap, bootMapSize)

@lvUserFinishProc = FinishPtr
Junta(levBasic, Go)

]


and Go() be
[
MoveBlock(bootList, tempBootList, 256);
MoveBlock(bootLoader, MBOOT, 256);
bootLoader(bootList)
]


and AllocCodeSpace(length) = valof
[
let p = @lvEndCode
@lvEndCode = p + length
resultis p
]


and MoveToPageBoundary(stream) be
[
let fa = vec lFA-1
GetCurrentFa(stream,fa)
if fa>>FA.charPos eq 0 then return
PositionPage(stream, fa>>FA.pageNumber+1)
]


and FindSpace(pageMap,mapLast,lvLoader,lvList) be
[
//find space for boot loader and pagemap which does not interfere
//with this program or the image to be loaded
let inUse=vec 15
Zero(inUse, 16)
bootMapSize = lFP+1+1	// FP + page + terminator
let nexti = nil
let i = 0
until i eq mapLast do
    [
    let item = lv (pageMap!i)
    test item>>MapItem.tag
	ifso
	    [
	    nexti = i+lchangeMapItem
	    bootMapSize = bootMapSize + 2
	    ]
	ifnot nexti = i+lnormalMapItem
    let page, count = item>>MapItem.page, item>>MapItem.count
    bootMapSize = bootMapSize + count
    for j=page to page+count-1 do
	[
	let wd = j rshift 4
	inUse!(wd) = inUse!(wd) % (#100000 rshift (j&#17))
	]
    i = nexti
    ]
// The bootMap page(s) is not available either
for j = bootMap rshift 8 to
  (bootMap rshift 8)+((bootMapSize+255) rshift 8)-1 do
    [
    let wd = j rshift 4
    inUse!(wd) = inUse!(wd) % (#100000 rshift (j&#17))
    ]
let lastpage= #174000 rshift 8
let firstpage=(@lvEndCode+255) rshift 8
let p = AllocPages(inUse, firstpage, lastpage, 1)
@lvLoader = p lshift 8
if p ne 0 then
    p = AllocPages(inUse, p+1, lastpage, 1)
@lvList = p lshift 8
if @lvList eq 0 then
	AbortMsg("*NCan't find enough space for loader.")
]



and AllocPages(map, first, last, npages) = valof
[
let n = 0
for i = first to last do
    [
    test (map!(i rshift 4) &  (#100000 rshift (i & #17))) eq 0
      ifso
	[ n = n + 1; if n eq npages then resultis i-n+1 ]
      ifnot n = 0
    ]
resultis 0
]


and SetupBootMap(pageMap, mapLast, pmLoc, cfa) be
[
MoveBlock(pmLoc,lv (cfa>>CFA.fp),lFP)
pmLoc>>BootMap.firstpage = cfa>>CFA.fa.pageNumber
let a = 0
let nexti = nil
let i = 0
until i eq mapLast do
	[
	let item = lv (pageMap!i)
	test item>>MapItem.tag
	  ifso 
	    [
	    pmLoc>>BootMap.address↑a = (item>>MapItem.base lshift 1) + 1
	    pmLoc>>BootMap.address↑(a+1) = item>>MapItem.da
	    a = a + 2
	    nexti = i+lchangeMapItem
	    ]
	  ifnot nexti = i+lnormalMapItem
	
	let memaddress = item>>MapItem.page lshift 8
	for j = 1 to item>>MapItem.count do
	    [
	    pmLoc>>BootMap.address↑a = memaddress
	    memaddress = memaddress + #400
	    a = a + 1
	    ]
	i = nexti
	]
pmLoc>>BootMap.address↑a = 0
]


and FixMBOOT(data,pmLoc,firstDa) be
[
@PointerToBootMap = pmLoc
data>>BootList.pageMap = pmLoc
data>>BootList.firstDa = firstDa
]


and FixMESANOVA(data) be
[
@OSFPtr = OsFinish
@AC1Ptr = MesaStart
@OutLdPtr = OutLd
@InLdPtr = InLd
@FinProcPtr = SystemDispatch+sGoingAway
@processTrapPtr = SystemDispatch+sProcessTrap
@firstProcessPtr = FirstProcess
@lastProcessPtr = LastProcess
@firstStateVectorPtr = FirstStateVector
@STOPUser = STOPImplementer
@CleanUpQueueUser = CleanUpQueueImplementer
@RequeueSubUser = RequeueSubImplementer
@WakeHeadUser = WakeHeadImplementer
MakeBltItem(lv data>>BootList.blt↑blMesaNova1, MesaNova1, TXV, MesaNovaSize1)
MakeBltItem(lv data>>BootList.blt↑blMesaNova2, MesaNova2, xNovaCode, MesaNovaSize2)
@PuntData = 0
]


and MakeBltItem(item, source, dest, count) be
[
item>>BltItem.firstSourceM1 = source-1
item>>BltItem.lastDest = dest+count-1
item>>BltItem.minusCount = -count
]


and FixInterrupts(data,v) be
[
let t=@PScode - 2
for i=0 to 14 do
    [ t=t+1; v!i=t ]
MakeBltItem(lv data>>BootList.blt↑blInterruptVector, v, interruptVector, 15)
DisableInterrupts()
@displayInterrupt = 0
@activeInterrupts = 0
@wakeupsWaiting = 0
EnableInterrupts()
v!TimeoutInterruptLevel = AdvanceTimerPtr
]


and let LoadInternalMicrocode() = valof
[
let MBFile=0
let ramver = 0
if HardwareConfiguration>>HardwareInfo.ControlStore eq RAMandROM then
  [CompatibilityCheck
  // this implicitly allows XMesa 5.0 ROM to be used with (X)Mesa 6.0
  if @MesaImage ne ROMCompatibility then		// ROM too old
	[
	HardwareConfiguration>>HardwareInfo.XMmicrocode = false
	HardwareConfiguration>>HardwareInfo.useXM = false
	]
  ]CompatibilityCheck

// are we D0 or Dorado?
if HardwareConfiguration>>HardwareInfo.AltoType > 3 then resultis false

switchon HardwareConfiguration>>HardwareInfo.ControlStore into
    [ControlStoreCases
    case RAM0only:
      [NoROM
      if microcodeLoaded ne 0 then endcase
      LoadPackedRAM(MesaImage, lv ramver)
      HardwareConfiguration>>HardwareInfo.mesaMicrocodeVersion = ramver
      endcase
      ]NoROM
    case RAM3K:
      if (microcodeLoaded & 2) eq 0 then
	[TwoRAMs
        LoadPackedRAM(XMesaImage, lv ramver, 1)	// load RAM1
        HardwareConfiguration>>HardwareInfo.mesaMicrocodeVersion = ramver
        ]TwoRAMs
    case RAMandROM:
      [
      if (microcodeLoaded & 1) ne 0 then endcase
      test HardwareConfiguration>>HardwareInfo.XMmicrocode
	ifso LoadPackedRAM(XMesaOverflow, lv ramver, 0)
	ifnot
	  [IgnoreROM
	  LoadPackedRAM(MesaImage, lv ramver, 0)
	  HardwareConfiguration>>HardwareInfo.mesaMicrocodeVersion = ramver
	  ]IgnoreROM
      ]
    ]ControlStoreCases
resultis true
]


and GiveMicrocodeVersion() be
[
Ws("microcode ")
Wns(dsp, @MesaImage)
Puts(dsp,$[)
Wns(dsp, @XMesaImage)
Puts(dsp,$-)
Wns(dsp, @XMesaOverflow)
Puts(dsp, $])
]


and AbortMsg(s; numargs na) be
[
if na ne 0 then Ws(s)
Resets(keys)
KeyboardWait()
abort
]


and KeyboardWait() be
[
Ws(" [] ")
let char=Gets(keys)
Puts(dsp,char)
if char eq $f % char eq 3 then finish  
]