// LoadMB.bcpl -- loads MB file on Dorado

// Last modified June 25, 1982  6:18 PM by Taft

get "Streams.d"
get "AltoFileSys.d"

external
[
// incoming procedures
SetupReadParam; ReadParam; EvalParam
OpenFile; Closes; ReadBlock; WriteBlock; FilePos; SetFilePos; GetCompleteFa
Ws; Gets; Puts; Resets; ReadLeaderPage; TruncateDiskStream
PutTemplate; Enqueue
Zero; MoveBlock; Usc; CallSwat; ReadCalendar; Allocate

// incoming statics
keys; dsp; sysZone
]


structure MBName ^0,0 byte  // terminates on null byte
structure String [ length byte; char ^1,1 byte ]

//----------------------------------------------------------------------------
structure MB:		// block format in MB file
//----------------------------------------------------------------------------
[
word0 word =
   [
   blank byte		// used in Midas MB files, but not in normal ones
   type byte		// block type
   ]
data:
   [
   sourceLine word	// source line number
   value ^0,0 word	// left-adjusted data
   ] =
memory:
   [
   memoryNum word	// memory number
   location word	// first location in memory
   ] =
fixup:
   [
   memoryNum word	// memory number
   location word	// location in memory
   firstBit byte	// field to be stored into
   lastBit byte
   value word		// value to be stored
   ] =
memoryName:
   [
   memoryNum word	// memory number
   width word		// memory width
   name @MBName		// memory name
   ] =
address:
   [
   memoryNum word	// memory number
   value word		// address value
   name @MBName		// address symbol name
   ] =
undefined:
   [
   memoryNum word	// memory number
   location word	// location in memory
   firstBit byte	// field to be stored into
   lastBit byte
   name @MBName		// external symbol name
   ]
]

manifest
[
// block types
mbEnd = 0		// end of MB file
mbData = 1		// store memory data and increment location
mbMemory = 2		// set memory number and location
mbFixup = 3		// forward reference fixup
mbMemoryName = 4	// correlate memory name and number
mbAddress = 5		// define address symbol
mbUndefined = 6		// external reference

// block lengths
lenMBData = offset MB.data.value/16  // + size of value
lenMBMemory = offset MB.memory.location/16 +1
lenMBFixup = offset MB.fixup.value/16 +1
lenMBMemoryName = offset MB.memoryName.name/16  // + size of name
lenMBAddress = offset MB.address.name/16  // + size of name
lenMBUndefined = offset MB.undefined.name/16  // + size of name

maxMemoryNum = 50
maxLenName = 127
]

//----------------------------------------------------------------------------
structure IM:		// IM word, in MB file only
//----------------------------------------------------------------------------
[
word0 word =
   [ RSTK bit 4; ALUF bit 4; BSEL bit 3; LC bit 3; ASEL01 bit 2 ] =
   [ RSTK0 bit 1; rest0 bit 15 ]
word1 word =
   [ ASEL2 bit 1; BLK bit 1; FF bit 8; JCN05 bit 6 ] =
   [ ASEL2BLK bit 2; rest1 bit 14 ]
word2 word =
   [ JCN67 bit 2; PE020 bit 1; PE2131 bit 1; blank bit 12 ]
word3 word =
   [ blank bit 4; absoluteAddr bit 12 ]
]

//----------------------------------------------------------------------------
structure IFUM:		// IFUM word, in MB file and in Item
//----------------------------------------------------------------------------
[
word0 word =
   [ blank bit 5; PA bit 1; IFAD bit 10 = [ IFAD01 bit 2; IFAD29 bit 8 ] ]
word1 word =
   [
   SGN bit 1; IPAR bit 3 = [ P0 bit; P1 bit; P2 bit ]; LEN bit 2;
   RBASEB bit 1; MEMB bit 3 = [ MEMB0 bit 1; MEMB12 bit 2 ];
   TYPE bit 2; N bit 4
   ]
]

manifest
[
// masks defining contribution of each word to each parity bit
ifumW0P0 = 1400B; ifumW0P1 = 377B; ifumW0P2 = 2000B
ifumW1P0 = 317B; ifumW1P1 = 0B; ifumW1P2 = 107460B
]

//----------------------------------------------------------------------------
structure RM:		// RM word, in MB file and in Item
//----------------------------------------------------------------------------
[
word0 word
]

//----------------------------------------------------------------------------
structure Item:		// control store item
//----------------------------------------------------------------------------
[
extraIM bit 4 =		// extra bits for IM data
   [ PE020 bit; RSTK0 bit; PE2131 bit; BLK bit ]
zero bit 1		// must be zero
blank bit 8		// unused, leave zero for now
type bit 3		// Item type
data:  // IM, IFUM, or RM
   [
   addr word		// address
   word0 word		// left half (IM, IFUM) or entire value (RM)
   word1 word		// right half (IM, IFUM)
   ] =
end:
   [
   blank word
   checksum word	// checksum over entire item array
   startAddr word	// starting address
   ]
]

manifest
[
// Item types
itemIM = 0		// IM data
itemIFUM = 1		// IFUM data
itemEnd = 2		// End block
itemRM = 3		// RM data

lenItem = size Item/16
]

//----------------------------------------------------------------------------
structure CSArray:	// control store array
//----------------------------------------------------------------------------
[
length word		// length of array (Items)
maxLength word		// max length of array (Items)
item ^0,0 @Item
]

//----------------------------------------------------------------------------
structure MesaString: [ length word; maxLength word; char^0,1 byte ]
//----------------------------------------------------------------------------

//----------------------------------------------------------------------------
structure EBFile:	// Ether Bootable format
//----------------------------------------------------------------------------
[
overheadPage word 256 =
   [
   etherVersionNumber word
   mustBeZero word 2
   creationDate word 2
   name @MesaString	// name of this .eb file
   ]
item ^0,0 @Item
]

//----------------------------------------------------------------------------
structure BRFile:	// Bcpl binary format
//----------------------------------------------------------------------------
[
bcplVersionNumber word
fileLength word
blank word		// must be zero
nameTableOffset word
blank word		// must be zero
labelTableOffset word
blank word		// must be zero
codeOffset word
blank word		// must be zero
chainTableOffset word
blank word		// must be zero
zchainTableOffset word
blank word 3		// must be zero
labelTable word 3 =
   [
   labelCount word	// must be 1
   labelNameNumber word	// must be 1
   labelPC word		// must be 1
   ]
chainTable word 1	// must be zero
zchainTable word 1	// must be zero
nameTable word 3 =
   [
   nameCount word	// must be 1
   nameDescriptor word	// must be 140b
   blank word
   nameString word 0	// actually @String
   ]
code word 2 =
   [
   codeLength word
   codeFirst word 1		// should be zero
   item ^0,0 @Item
   ]
]

//----------------------------------------------------------------------------
structure InFile:	// Input file descriptor
//----------------------------------------------------------------------------
[
next word
name word		// -> complete file name string
cfa @CFA
startAddr word		// microcode starting address for this overlay
]
manifest lenInFile = size InFile/16

manifest
[
maxItems = 4096+1024+256+1  // IM+IFUM+RM+End, enough for one full image
lenCSArray = offset CSArray.item/16 + maxItems*lenItem
lenEBFile = offset EBFile.item/16  // + Item array
lenBRFile = offset BRFile.nameString/16  // + name string + Item array
etherVersionNumber = 0 lshift 8 + 1  // *** Change to 1 lshift 8 someday ***
bcplVersionNumber = 2 lshift 8
]


//----------------------------------------------------------------------------
let LoadMB() be
//----------------------------------------------------------------------------
[
Ws("*nLoadMB of June 25, 1982")

let csArray = vec lenCSArray; Zero(csArray, lenCSArray)
csArray>>CSArray.maxLength = maxItems

let stringVec, switchVec = vec 50, vec 50
SetupReadParam(stringVec, switchVec)

let WriteHeader = 0
let verify = false

for i = 1 to switchVec!0 do
   switchon switchVec!i into
      [
      case $B: case $b:
         WriteHeader = WriteBRHeader
         endcase
      case $E: case $e:
         WriteHeader = WriteEBHeader
         endcase
      case $V: case $v:
         verify = true
         endcase
      default:
         Fail("undefined global switch /$C", switchVec!i)
      ]

let streamOut = 0
let outName = vec 50
let inFileQ = vec 1; inFileQ!0 = 0
let labelName = vec 50
MoveBlock(labelName, "LoadRamTable", 12/2+1)

   [ // repeat
   if ReadParam(0, 0, 0, 0, true) eq -1 then break
   switchon switchVec!0 into
      [
      case 0:
         switchVec!1 = $I  // fall thru (treat as input file name)
      case 1:
         switchon switchVec!1 into
            [
            case $I: case $i:
               [
               let inName = vec 50
               let s = EvalParam(stringVec, "IW", "Input MB file name: ", inName)
               let inFile = Allocate(sysZone, lenInFile)
               let l = inName>>String.length rshift 1 +1
               inFile>>InFile.name = Allocate(sysZone, l)
               MoveBlock(inFile>>InFile.name, inName, l)
               GetCompleteFa(s, lv inFile>>InFile.cfa)
               Closes(s)
               inFile>>InFile.startAddr = -1  // haven't seen start address yet
               Enqueue(inFileQ, inFile)
               endcase
               ]
            case $L: case $l:
               unless WriteHeader eq WriteBRHeader do
                  Fail("/L only allowed with .BR output")
               EvalParam(stringVec, $P, "Label for LoadRam table: ", labelName)
               endcase
            case $O: case $o:
               streamOut = EvalParam(stringVec, "OW", "Output file name: ", outName)
               if WriteHeader eq 0 then WriteHeader = WriteEBHeader
               endcase
            case $S: case $s:
               if inFileQ!0 eq 0 then
                  Fail("start addr must follow the input file to which it applies")
               (inFileQ!1)>>InFile.startAddr =
                EvalParam(stringVec, $B, "Starting address: ")
               endcase
            default:
               Fail("undefined local switch /$C", switchVec!1)
               ]
         endcase
      default:
         Fail("multiple local switches")
      ]
   ] repeat

if inFileQ!0 eq 0 then Fail("no input file specified")

if WriteHeader ne 0 & streamOut eq 0 then
   [  // default output filename to match last input filename
   MoveBlock(outName, (inFileQ!1)>>InFile.name, 50)
   for i = 1 to outName>>String.length do
      if outName>>String.char^i eq $. then outName>>String.length = i-1
   let i = outName>>String.length
   outName>>String.char^(i+1) = $.
   outName>>String.char^(i+2) = WriteHeader eq WriteBRHeader? $b, $e
   outName>>String.char^(i+3) = WriteHeader eq WriteBRHeader? $r, $b
   outName>>String.length = i+3
   streamOut = OpenFile(outName, ksTypeWriteOnly, wordItem)
   ]

let defaultStartAddr = WriteHeader ne 0? 1076B, 1070B  // boot, resume start addrs

if WriteHeader ne 0 then
   WriteHeader(streamOut, csArray, labelName, outName)

let totalItems = 0
let inFile = inFileQ!0
while inFile ne 0 do
   [
   let streamMB = OpenFile(inFile>>InFile.name, ksTypeReadOnly, charItem, 0,
    lv inFile>>InFile.cfa.fp)
   if streamMB eq 0 then CallSwat("Failed to open existing file")
   let items = csArray>>CSArray.length
   ReadMBFile(streamMB, csArray)
   Closes(streamMB)
   if inFile>>InFile.startAddr eq -1 then inFile>>InFile.startAddr = defaultStartAddr
   AppendEndItem(csArray, inFile>>InFile.startAddr)
   items = csArray>>CSArray.length - items
   totalItems = totalItems + items
   PutTemplate(dsp, "*n$D items read from $S; starting address = $UOB.",
    items, inFile>>InFile.name, inFile>>InFile.startAddr)
   if WriteHeader ne 0 then
      [  // write csArray out onto file and re-use it
      WriteBlock(streamOut, lv csArray>>CSArray.item^0, csArray>>CSArray.length*lenItem)
      Zero(csArray, lenCSArray)
      csArray>>CSArray.maxLength = maxItems
      ]
   inFile = inFile>>InFile.next
   ]

if WriteHeader ne 0 then
   [
   let pos = vec 1; FilePos(streamOut, pos)
   if WriteHeader eq WriteBRHeader then
      [
      TruncateDiskStream(streamOut)
      FixUpBRHeader(streamOut, totalItems*lenItem, labelName)
      ]
   Closes(streamOut)
   PutTemplate(dsp, "*n$ED bytes written on $S.", pos, outName)
   finish
   ]

if verify then
   [
   Ws("*nLoad and boot?")
      [ // repeat
      switchon Gets(keys) into
         [
         case $Y: case $y: case $*n:
            break
         case $N: case $n: case $*177:
            finish
         default:
            Ws("?")
         ]
      ] repeat
   ]

let LoadRamAndJump = table [ 61036B; 1401B ]
LoadRamAndJump(lv csArray>>CSArray.item^0, true)
]

//----------------------------------------------------------------------------
and Fail(string, par1, par2, par3) be
//----------------------------------------------------------------------------
[
Ws("*nCommand error: ")
PutTemplate(dsp, string, par1, par2, par3)
Ws("*n")
abort
]

//----------------------------------------------------------------------------
and ReadMBFile(stream, csArray) be
//----------------------------------------------------------------------------
[
manifest lenBuf = 1024
manifest minLenBuf = 128
let mbBuf = vec lenBuf
let mb = mbBuf
let endBuf = mbBuf
let item = lv csArray>>CSArray.item^(csArray>>CSArray.length)
let endItem = lv csArray>>CSArray.item^(csArray>>CSArray.maxLength)
let memoryNumIM = -2
let memoryNumIFUM = -2
let memoryNumRM = -2
let memoryNum = -1
let addr = nil
let memoryWidths = vec maxMemoryNum; Zero(memoryWidths, maxMemoryNum)
let name = vec maxLenName

   [ // repeat
   if (endBuf-mb) ls minLenBuf then
      [
      let wordsRemaining = endBuf-mb
      MoveBlock(mbBuf, mb, wordsRemaining)
      mb = mbBuf
      wordsRemaining = wordsRemaining +
       ReadBlock(stream, mb+wordsRemaining, lenBuf-wordsRemaining)
      if wordsRemaining le 0 then CallSwat("Missing End block in MB file")
      endBuf = mbBuf+wordsRemaining
      ]

   switchon mb>>MB.type into
      [
      case mbEnd:
         break

      case mbData:
         [
         let value = lv mb>>MB.data.value
         test memoryNum eq memoryNumIM ifso
            [
            item>>Item.type = itemIM
            item>>Item.data.addr = value>>IM.absoluteAddr
            item>>Item.data.word0 = value>>IM.rest0 lshift 1 + value>>IM.ASEL2
            item>>Item.data.word1 = value>>IM.rest1 lshift 2 + value>>IM.JCN67
            item>>Item.PE020 = value>>IM.PE020
            item>>Item.RSTK0 = value>>IM.RSTK0
            item>>Item.PE2131 = value>>IM.PE2131
            item>>Item.BLK = value>>IM.BLK
            item = item+lenItem
            if item ge endItem then CallSwat("Item array overflowed")
            ]
         ifnot test memoryNum eq memoryNumIFUM ifso
            [
            item>>Item.type = itemIFUM
            item>>Item.data.addr = addr
            // Despite what the manual says, the hardware really wants to
            // see even parity -- hence the "not" in the following statements
            value>>IFUM.P0 = not OddParity((value>>IFUM.word0 & ifumW0P0) xor
             (value>>IFUM.word1 & ifumW1P0))
            value>>IFUM.P1 = not OddParity((value>>IFUM.word0 & ifumW0P1) xor
             (value>>IFUM.word1 & ifumW1P1))
            value>>IFUM.P2 = not OddParity((value>>IFUM.word0 & ifumW0P2) xor
             (value>>IFUM.word1 & ifumW1P2))
            item>>Item.data.word0 = value>>IFUM.word0
            item>>Item.data.word1 = value>>IFUM.word1
            item = item+lenItem
            if item ge endItem then CallSwat("Item array overflowed")
            ]
         ifnot test memoryNum eq memoryNumRM ifso
            [
            item>>Item.type = itemRM
            item>>Item.data.addr = addr
            item>>Item.data.word0 = value>>RM.word0
            item = item+lenItem
            if item ge endItem then CallSwat("Item array overflowed")
            ]
         ifnot if memoryNum eq -1 then
            CallSwat("Data for unspecified memory")
         addr = addr+1
         mb = mb + lenMBData + memoryWidths!memoryNum
         endcase
         ]

      case mbMemory:
         memoryNum = mb>>MB.memory.memoryNum
         if memoryWidths!memoryNum eq 0 then
            CallSwat("Undefined memory")
         addr = mb>>MB.memory.location
         mb = mb + lenMBMemory
         endcase

      case mbFixup:
         CallSwat("Fixup block encountered in MB file")

      case mbMemoryName:
         [
         let newMemoryNum = mb>>MB.memoryName.memoryNum
         if Usc(newMemoryNum, maxMemoryNum) gr 0 then
            CallSwat("Memory number out of bounds")
         memoryWidths!newMemoryNum = (mb>>MB.memoryName.width +15) rshift 4
         let lenName = ReadName(lv mb>>MB.memoryName.name, name)
         test StringEq(name, "IM") ifso memoryNumIM = newMemoryNum
         ifnot test StringEq(name, "IFUM") ifso memoryNumIFUM = newMemoryNum
         ifnot if StringEq(name, "RM") then memoryNumRM = newMemoryNum
         mb = mb + lenMBMemoryName + lenName
         endcase
         ]

      case mbAddress:
         mb = mb + lenMBAddress + ReadName(lv mb>>MB.address.name, name)
         endcase

      case mbUndefined:
         CallSwat("Undefined symbol block encountered in MB file")

      default:
         CallSwat("Unknown block type in MB file")
      ]
   ] repeat

csArray>>CSArray.length = (item - lv csArray>>CSArray.item^0)/lenItem
]

//----------------------------------------------------------------------------
and AppendEndItem(csArray, startAddr) be
//----------------------------------------------------------------------------
[
let item = lv csArray>>CSArray.item^(csArray>>CSArray.length)
csArray>>CSArray.length = csArray>>CSArray.length +1
item>>Item.type = itemEnd
item>>Item.end.startAddr = startAddr
let checksum = 0
let firstItem = lv csArray>>CSArray.item^0
for i = 0 to (csArray>>CSArray.length * lenItem)-1 do
   checksum = checksum + firstItem!i
item>>Item.end.checksum = -checksum
]

//----------------------------------------------------------------------------
and ReadName(mbName, stringName) = valof
//----------------------------------------------------------------------------
// Converts from the MB name format to a normal string.
// Returns the number of words occupied by mbName.
[
let i = 0
   [ // repeat
   let char = mbName>>MBName^i
   if char eq 0 then break
   stringName>>String.char^(i+1) = char
   i = i+1
   ] repeat
stringName>>String.length = i
resultis i rshift 1 +1
]

//----------------------------------------------------------------------------
and StringEq(s1, s2) = valof
//----------------------------------------------------------------------------
[
let length = s1>>String.length
if length ne s2>>String.length resultis false
for i = 1 to length do
   [
   let c1, c2 = s1>>String.char^i, s2>>String.char^i
   if c1 ne c2 then
      unless (c1 xor 40B) eq c2 &
       Usc((c1 & 137B)-$A, $Z-$A) le 0 resultis false
   ]
resultis true
]

//----------------------------------------------------------------------------
and OddParity(value) = valof
//----------------------------------------------------------------------------
// Returns the bit which, when combined with value, would make it have
// odd parity.
[
value = value xor (value rshift 8)
value = value xor (value rshift 4)
resultis (113151B rshift (value & 17B)) & 1
]

//----------------------------------------------------------------------------
and WriteEBHeader(stream, csArray, nil, fileName) be
//----------------------------------------------------------------------------
[
let buf = vec 256  // = lenEBFile

// Make the embedded creation date be the same as the file's
ReadLeaderPage(stream, buf)
let creationDate = vec 1; MoveBlock(creationDate, lv buf>>LD.created, 2)
Zero(buf, lenEBFile)
MoveBlock(lv buf>>EBFile.creationDate, creationDate, 2)
buf>>EBFile.etherVersionNumber = etherVersionNumber
MesaFromBCPLString(lv buf>>EBFile.name, fileName)
WriteBlock(stream, buf, lenEBFile)
]

//----------------------------------------------------------------------------
and WriteBRHeader(stream, csArray, labelName, nil) be
//----------------------------------------------------------------------------
[
let brFile = vec lenBRFile; Zero(brFile, lenBRFile)
let nameLength = labelName>>String.length/2+1
brFile>>BRFile.bcplVersionNumber = bcplVersionNumber
// will be fixed up later:
// brFile>>BRFile.fileLength = offset BRFile.item/16 + nameLength + csArrayLength
brFile>>BRFile.nameTableOffset = offset BRFile.nameTable/16
brFile>>BRFile.labelTableOffset = offset BRFile.labelTable/16
brFile>>BRFile.codeOffset = offset BRFile.code/16 + nameLength
brFile>>BRFile.chainTableOffset = offset BRFile.chainTable/16
brFile>>BRFile.zchainTableOffset = offset BRFile.zchainTable/16
brFile>>BRFile.labelCount = 1
brFile>>BRFile.labelNameNumber = 1
brFile>>BRFile.labelPC = 1
brFile>>BRFile.nameCount = 1
brFile>>BRFile.nameDescriptor = 140b
WriteBlock(stream, brFile, lenBRFile)
WriteBlock(stream, labelName, nameLength)
Puts(stream, 0)		// codeLength (csArrayLength+1), will be fixed up later
Puts(stream, 0)		// codeFirst
]

//----------------------------------------------------------------------------
and FixUpBRHeader(stream, csArrayLength, labelName) be
//----------------------------------------------------------------------------
[
let nameLength = labelName>>String.length/2+1
SetFilePos(stream, 0, offset BRFile.fileLength/8)
Puts(stream, offset BRFile.item/16 + nameLength + csArrayLength)
SetFilePos(stream, 0, 2*(lenBRFile+nameLength))
Puts(stream, csArrayLength+1)
Resets(stream)  // so OS won't truncate when we close!
]

//----------------------------------------------------------------------------
and MesaFromBCPLString(mesaString, bcplString) = valof
//----------------------------------------------------------------------------
// Returns the number of words occupied by the mesaString
[
let length = bcplString>>String.length
mesaString>>MesaString.length = length
mesaString>>MesaString.maxLength = (length+1) & -2
for i = 1 to length do mesaString>>MesaString.char^(i-1) = bcplString>>String.char^i
resultis (offset MesaString.char^0 / 16) + (length+1) rshift 1
]