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