// ReadMB.bcpl -- Read MB file
// Last modified June 26, 1985  3:38 PM by Rumph
  // taken from LoadMB.bcpl
  // 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 MesaString: [ length word; maxLength word; char^0,1 byte ]
//----------------------------------------------------------------------------

//----------------------------------------------------------------------------
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
]


//----------------------------------------------------------------------------
let ReadMB() be
//----------------------------------------------------------------------------
[
Ws("*nReadMB of June 26, 1985")

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

let streamOut = 0
let outName = vec 50
let inFileQ = vec 1; inFileQ!0 = 0

   [ // 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 $O: case $o:
               streamOut = EvalParam(stringVec, "OW", "Output file name: ", outName)
               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 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) = $l
   outName>>String.char^(i+3) = $s
   outName>>String.length = i+3
   streamOut = OpenFile(outName, ksTypeWriteOnly, charItem)
   ]

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")
   ReadMBFile(streamMB, streamOut)
   Closes(streamMB)
   inFile = inFile>>InFile.next
   ]

let pos = vec 1; FilePos(streamOut, pos)
Closes(streamOut)
PutTemplate(dsp, "*n$ED bytes written on $S.", pos, outName)
finish
]

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

//----------------------------------------------------------------------------
and ReadMBFile(stream, streamOut) be
//----------------------------------------------------------------------------
[
manifest lenBuf = 1024
manifest minLenBuf = 128
let mbBuf = vec lenBuf
let mb = mbBuf
let endBuf = mbBuf
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
let addrValue = 0

   [ // 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:
         [
         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)
         PutTemplate(streamOut, "$S*n", name)
         mb = mb + lenMBMemoryName + lenName
         endcase
         ]

      case mbAddress:
         addrValue = mb>>MB.address.value
         mb = mb + lenMBAddress + ReadName(lv mb>>MB.address.name, name)
         PutTemplate(streamOut, "   $S:*t$UO*n", name, addrValue)
         endcase

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

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

//----------------------------------------------------------------------------
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 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
]