LoadMB.mesa: Read Dorado MB file
Copyright © 1985 by Xerox Corporation. All rights reserved.
taken from LoadMB.bcpl
Willie-Sue, April 21, 1988 1:23:20 pm PDT

DIRECTORY
Basics,
BasicTime USING [ToPupTime],
Commander,
CommandTool,
Convert USING [Error, CardFromRope],
FS,
IO,
Loader USING [BCDBuildTime],
MessageWindow USING [Append, Blink, Confirm],
PrincOps USING [aLOADRAMJ, zMISC],
PrincOpsUtils USING [LongZero],
RefText,
Rope,
ViewerClasses USING [Viewer],
ViewerIO USING [CreateViewerStreams],
ViewerOps USING [EnumProc, ChangeColumn, EnumerateViewers, FindViewer, OpenIcon],
VM USING [AddressForPageNumber, PagesForWords, SimpleAllocate];
LoadMB: CEDAR MONITOR
IMPORTS
Basics, BasicTime, Commander, CommandTool, Convert, FS, IO, Loader, MessageWindow, PrincOpsUtils, RefText, Rope, ViewerIO, ViewerOps, VM
= BEGIN
ROPE: TYPE = Rope.ROPE;
STREAM: TYPE = IO.STREAM;
Viewer: TYPE = ViewerClasses.Viewer;
tsStream: STREAM;
OneBit: TYPE = [0..1];
CSItem: TYPE = MACHINE DEPENDENT RECORD[
pe020(0: 0..0): OneBit,
rstk0(0: 1..1): OneBit,
pe2131(0: 2..2): OneBit,
blk(0: 3..3): OneBit,
zero(0: 4..4): OneBit ← 0,
blank(0: 5..12): [0..377B] ← 0,  -- unused, leave zero for now
type (0: 13..15): CSItemType,
dataOrEnd (1): SELECT OVERLAID * FROM
data => [
addr (1): WORD,  -- address
word0 (2): WORD,  -- left half (IM, IFUM) or entire value (RM)
word1 (3): WORD  -- right half (IM, IFUM)
],
end => [
endBlank (1): WORD,
checksum (2): INTEGER,  -- checksum over entire item array
startAddr (3): CARDINAL  -- starting address
],
ENDCASE
];
CSItemType: TYPE = MACHINE DEPENDENT {itemIM(0), itemIFUM(1), itemEnd(2), itemRM(3)};
block types
BlockType: TYPE = MACHINE DEPENDENT {
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
};
MBHeader: TYPE = BlockType;  -- block type
MBData: TYPE = MACHINE DEPENDENT RECORD[
sourceLine: CARDINAL,  -- source line number
value: CARDINAL   -- left-adjusted data starts here
];
MBMemory: TYPE = MACHINE DEPENDENT RECORD[
memNum: CARDINAL,  -- memory number
location: CARDINAL   -- first location in memory
name starts here - memory name
];
MBFixup: TYPE = MACHINE DEPENDENT RECORD[
memNum: CARDINAL,  -- memory number
location: CARDINAL,   -- location in memory
firstBit: BYTE,    -- field to be stored into
lastBit: BYTE,
value: CARDINAL   -- value to be stored
];
MBMemoryName: TYPE = MACHINE DEPENDENT RECORD[
memoryNum: CARDINAL,  -- memory number
width: CARDINAL    -- memory width
name starts here - memory name
];
MBAddress: TYPE = MACHINE DEPENDENT RECORD[
memNum: CARDINAL,  -- memory number
value: CARDINAL   -- address value
name starts here - address symbol name
];
MBUndefined: TYPE = MACHINE DEPENDENT RECORD[
memNum: CARDINAL, -- memory number
location: CARDINAL,  -- location in memory
firstBit: BYTE,   -- field to be stored into
lastBit: BYTE
name starts here - external symbol name
];
maxMemoryNum: INTEGER = 50;
etherVersionNumber: WORD = 1; -- *** Change to 1 lshift 8 someday ***
Defining an IMWord in the MB-file
RStkWord: TYPE = MACHINE DEPENDENT RECORD[ -- first word in IM word
SELECT OVERLAID * FROM
r1 => [rstk: [0..17B], aluf: [0..17B], bsel: [0..7B], lc: [0..7B], asel01: [0..3] ],
r2 => [rstk0: OneBit, rest0: [0..77777B] ],
ENDCASE
];
ASelWord: TYPE = MACHINE DEPENDENT RECORD[ -- second word in IM word
SELECT OVERLAID * FROM
a1 => [asel2: OneBit, blk: OneBit, ff: [0..377B], jcn05: [0..77B] ],
a2 => [asel2blk: [0..3], rest1: [0..37777B] ],
ENDCASE
];
IMWord: TYPE = MACHINE DEPENDENT RECORD[  -- IM word, in MB file only
rstk (0): RStkWord,
asel (1): ASelWord,
jcn67 (2: 0..1): [0..3],
pe020 (2: 2..2): OneBit,
pe2131 (2: 3..3): OneBit,
blank2 (2: 4..15): [0..7777B],
blank3 (3: 0..3): [0..17B],
absoluteAddr (3: 4..15): [0..7777B]
];
IFUMWord0: TYPE = MACHINE DEPENDENT RECORD[  -- IFUM word, in MB file
blank (0: 0..4): 0,
pa (0: 5..5): OneBit,
ifad (0: 6..15): [0..1777B],  -- no need for internal stucture of this field
];
IFUMWord1: TYPE = MACHINE DEPENDENT RECORD[
sgn (0: 0..0): OneBit,
p0 (0: 1..1): OneBit,  -- only these are referenced
p1 (0: 2..2): OneBit,  -- only these are referenced
p2 (0: 3..3): OneBit,  -- only these are referenced
len (0: 4..5): [0..3],
rbaseB (0: 6..6): OneBit,
memB (0: 7..9): [0..7],
type (0: 10..11): [0..3],
n (0: 12..15): [0..17B]
];
IFUMWord: TYPE = MACHINE DEPENDENT RECORD[
word0: WORD,  -- no internal structure needed
word1: IFUMWord1
];
-- masks defining contribution of each word to each parity bit for IFUMWord
ifumW0P0: WORD = 1400B;
ifumW0P1: WORD = 377B;
ifumW0P2: WORD = 2000B;
ifumW1P0: WORD = 317B;
ifumW1P1: WORD = 0B;
ifumW1P2: WORD = 107460B;
RMWord: TYPE = WORD;  -- RM word, in MB file and in Item
-- * * * * * * * * * * * * * * ** * * * * * * * * * * * * * *
SrcFile: TYPE = REF SrcFileRec;
SrcFileRec: TYPE = RECORD [ -- Input file descriptor
next: SrcFile,
name: ROPE,  -- -> complete file name string
stream: STREAM,
startAddr: CARDINAL ← 177777B  -- microcode starting address for this overlay
];
OutFile: TYPE = REF OutFileRec;
OutFileRec: TYPE = RECORD [
fullName: ROPE,
shortName: ROPE,
stream: STREAM
];
OutputFormat: TYPE = {immediate, brFormat, etherBootable};
EBHeader: TYPE = MACHINE DEPENDENT RECORD[
etherVersionNumber(0): WORD,
mustBeZero(1): INT ← 0,
creationDate(3): LONG CARDINAL,
nameLen(5): INTEGER,
maxNameLen (6): WORD,
nameChars(7): PACKED ARRAY[0..0) OF CHAR
];
ParityWord: TYPE = MACHINE DEPENDENT RECORD[
unused (0: 0..14): [0..77777B],
parity (0: 15..15): OneBit
];
maxItems: INT = 4096+1024+256+1; -- IM+IFUM+RM+End, enough for one full image
itemArray: LONG POINTER TO WORD ← NIL;
itemLength: CARDINAL = SIZE[CSItem];
itemArrayLength: CARDINAL = maxItems*itemLength;
nextItemAddr: LONG POINTER TO WORD;
scratch: LONG POINTER;  -- will be 256 words long, used for writing EBHeader
ebHeaderLength: INTEGER = 256;
herald: ROPE = "\n * * * * LoadMB of %g * * * *\n";
textLine: REF TEXT ← NEW[TEXT[RefText.line]];
ItemArrayOverflow: SIGNAL = CODE;
-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Main: Commander.CommandProc = {
argV: CommandTool.ArgumentVector ← CommandTool.Parse[cmd];
wDir: ROPE ← CommandTool.CurrentWorkingDirectory[];
outputFormat: OutputFormat ← immediate;
outFile: OutFile;
srcFileChain: SrcFile ← NIL;
lastSrcFile: SrcFile ← NIL;
defaultStartAddress: CARDINAL ← 177777B;
verify: BOOL ← FALSE;
lastFileName: ROPE;
AnotherSrcFile: PROC[name: ROPE] = {
sf: SrcFile ← NEW[SrcFileRec];
sf.name ←
CommandTool.FileWithSearchRules[lastFileName, ".mb", cmd, FALSE];
IF srcFileChain = NIL THEN srcFileChain ← lastSrcFile ← sf
ELSE {
lastSrcFile.next ← sf;
lastSrcFile ← sf;
};
};
tsStream ← TSStream["Dorado Microcode"];
tsStream.PutF[herald, IO.time[Loader.BCDBuildTime[LoadMB.Main]]];
IF itemArray = NIL THEN {
itemStartI: LONG POINTER ← VM.AddressForPageNumber[VM.SimpleAllocate[VM.PagesForWords[itemArrayLength]].page];
itemArray ← LOOPHOLE[itemStartI, LONG POINTER TO WORD];
};
TRUSTED { PrincOpsUtils.LongZero[itemArray, itemArrayLength] };
IF scratch = NIL THEN
scratch ← VM.AddressForPageNumber[VM.SimpleAllocate[1].page];
FOR i: NAT IN [1..argV.argc) DO
this: ROPE ← argV[i];
SELECT this.Fetch[0] FROM
IN ['0 .. '9] => {
ok: BOOL ← TRUE;
IF lastFileName = NIL THEN {
tsStream.PutF[
" start pos (%g) must follow source file - quitting\n", IO.rope[this]];
RETURN;
}
ELSE {
AnotherSrcFile[lastFileName];
lastFileName ← NIL;
};
IF lastSrcFile = NIL THEN {
tsStream.PutF[
" start pos (%g) but no source file specified - quitting\n", IO.rope[this]];
RETURN;
};
lastSrcFile.startAddr ← Convert.CardFromRope[this, 8 ! Convert.Error => {
tsStream.PutF[" Conversion error trying %g - quitting\n", IO.rope[this]];
ok ← FALSE;
CONTINUE }; ];
IF ~ok THEN RETURN;
lastFileName ← NIL;
};
'- => {  -- switches
FOR j: INT IN [1..this.Length[]) DO
SELECT this.Fetch[j] FROM
'B, 'b => {
outputFormat ← brFormat;
lastFileName ← NIL;
};
'E, 'e => {
outputFormat ← etherBootable;
lastFileName ← NIL;
};
'O, 'o => {
ext: ROPE ← IF outputFormat = etherBootable THEN ".eb" ELSE ".br";
outFile ← NEW[OutFileRec];
outFile.fullName ← FS.ExpandName[lastFileName, wDir].fullFName;
outFile.shortName ← ShortName[outFile.fullName];
lastFileName ← NIL;
};
'V, 'v => verify ← TRUE;
ENDCASE =>
tsStream.PutF["\n Undefined switch: %g\n", IO.char[this.Fetch[j]] ];
ENDLOOP;
}
ENDCASE => {   -- filename
IF lastFileName # NIL THEN AnotherSrcFile[lastFileName];
lastFileName ← this;
};
ENDLOOP;
IF lastFileName # NIL THEN AnotherSrcFile[lastFileName];
IF srcFileChain = NIL THEN {
tsStream.PutRope["\n No input file(s) specified - quitting\n"];
RETURN
};
IF outputFormat = brFormat THEN {
tsStream.PutRope["BR format not supported - quitting\n"];
RETURN;
};
IF outFile = NIL AND outputFormat = etherBootable THEN
OutFileNamesFromSrcFile[outFile ← NEW[OutFileRec], lastSrcFile.name, "eb"];
defaultStartAddress ← 1076B;
DoLoadMb[srcFileChain, outFile, defaultStartAddress, outputFormat, verify];
};
DoLoadMb: PROC[srcFileChain: SrcFile, outFile: OutFile,
    defaultStartAddress: CARDINAL, outputFormat: OutputFormat, verify: BOOL ] = {
totalItems: INT ← 0;
itemsThisFile: INT;
ok: BOOL;
IF outFile # NIL THEN outFile.stream ←
FS.StreamOpen[fileName: outFile.fullName, accessOptions: $create, keep: 2];
IF outputFormat = etherBootable THEN WriteEBHeader[outFile];
FOR srcF: SrcFile ← srcFileChain, srcF.next UNTIL srcF = NIL DO
BEGIN
srcF.stream ← FS.StreamOpen[srcF.name ! FS.Error =>
{ tsStream.PutRope[error.explanation]; GOTO cant} ];
tsStream.PutF[" ******* Reading %g\n", IO.rope[srcF.name] ];
[itemsThisFile, ok] ← ReadMBFile[srcF, tsStream];
IF ~ok THEN {
tsStream.PutRope["\n *** Errors encountered - quitting\n"];
srcF.stream.Close[];
IF outFile # NIL AND outFile.stream # NIL THEN outFile.stream.Close[];
RETURN;
};
IF srcF.startAddr = 177777B THEN srcF.startAddr ← defaultStartAddress;
srcF.stream.Close[];
AppendEndItem[nextItemAddr, srcF.startAddr];
totalItems ← totalItems + itemsThisFile + 1;  -- + 1 for endItem
tsStream.PutF["\n %bB items read from %g; starting address = %bB\n",
IO.int[totalItems], IO.rope[srcF.name], IO.int[srcF.startAddr]];
IF outputFormat # immediate THEN TRUSTED { -- write out the itemArray & re-use
outFile.stream.UnsafePutBlock[
[base: LOOPHOLE[itemArray], startIndex: 0, count: 2*totalItems*itemLength] ];
PrincOpsUtils.LongZero[itemArray, totalItems*itemLength];
};
EXITS
cant => NULL;
END;
ENDLOOP;
IF outFile # NIL AND outFile.stream # NIL THEN {
tsStream.PutF["\n %g bytes written on %g\n",
IO.int[outFile.stream.GetLength[]], IO.rope[outFile.fullName]];
outFile.stream.Close[];
};
tsStream.PutRope["\n\n ~~~~~~~ Finished ~~~~~~~\n"];
IF outputFormat = immediate OR verify THEN {
IF SomethingWorthSaving[] THEN RETURN;
MessageWindow.Blink[];
IF ~MessageWindow.Confirm["Confirm loading new microcode . . . "] THEN {
MessageWindow.Append["boot aborted."];
RETURN
};
LoadRamAndJump[LOOPHOLE[itemArray-1], 1];
};
};
SomethingWorthSaving: PROC RETURNS [BOOL] = {
dirty: BOOL ← FALSE;
CheckDirty: ViewerOps.EnumProc = {
IF v.newVersion OR v.newFile THEN dirty ← TRUE ELSE RETURN;
IF v.offDeskTop THEN ViewerOps.ChangeColumn[v, left];
};
ViewerOps.EnumerateViewers[CheckDirty];
IF dirty THEN {
MessageWindow.Blink[];
IF ~MessageWindow.Confirm["Confirm discard of edits . . . "] THEN {
MessageWindow.Append["boot aborted."];
RETURN[TRUE]
};
};
RETURN[FALSE]
};
-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
ReadMBFile: PROC[srcFile: SrcFile, tsStream: STREAM]
 RETURNS[itemsThisFile: INT, ok: BOOL] = TRUSTED {
memNum: INTEGER ← -1;
addr, addrValue: CARDINAL ← 0;
blockType: BlockType;
memoryWidths: ARRAY [-2 .. maxMemoryNum) OF CARDINAL ← ALL[0];
readStream: STREAM = srcFile.stream;
memoryNumIM, memoryNumIFUM, memoryNumRM: INTEGER ← -2;
nullMemoryNum: INTEGER = -1;
tempI: LONG POINTER ← VM.AddressForPageNumber[VM.SimpleAllocate[1].page];
temp: LONG POINTER TO WORD ← LOOPHOLE[tempI, LONG POINTER TO WORD];
GetBlockTypeFromStrm: PROC[strm: STREAM] RETURNS[BlockType] = TRUSTED {
blk: WORD ← GetWord[strm];
RETURN[LOOPHOLE[blk, BlockType]];
};
itemsThisFile ← 0;
ok ← TRUE;
nextItemAddr ← itemArray;
DO
thisItemLength: INT ← itemLength;
imItem: LONG POINTER TO CSItem;
blockType ← GetBlockTypeFromStrm[readStream];
imItem ← LOOPHOLE[nextItemAddr];
SELECT blockType FROM
mbEnd => RETURN[itemsThisFile, TRUE];
mbData => {
[] ← GetWord[readStream];  -- sourceLine, ignore
IF memNum # nullMemoryNum THEN
FOR i: CARDINAL IN [0..memoryWidths[memNum]) DO
(temp+i)^ ← GetWord[readStream]; ENDLOOP;
SELECT memNum FROM
memoryNumIM => {
mbDataBlock: LONG POINTER TO IMWord = LOOPHOLE[temp];
rstk2Word: r2 RStkWord = LOOPHOLE[mbDataBlock.rstk];
asel1Word: a1 ASelWord = LOOPHOLE[mbDataBlock.asel];
asel2Word: a2 ASelWord = LOOPHOLE[mbDataBlock.asel];
imItem.type ← itemIM;
imItem.addr ← mbDataBlock.absoluteAddr;
imItem.word0 ← (rstk2Word.rest0)*2 + asel1Word.asel2;
imItem.word1 ← (asel2Word.rest1)*4 + mbDataBlock.jcn67;
imItem.pe020 ← mbDataBlock.pe020;
imItem.rstk0 ← rstk2Word.rstk0;
imItem.pe2131 ← mbDataBlock.pe2131;
imItem.blk ← asel1Word.blk;
itemsThisFile ← itemsThisFile + 1;
nextItemAddr ← nextItemAddr + itemLength;
};
memoryNumIFUM => {
ifumDataBlock: LONG POINTER TO IFUMWord = LOOPHOLE[temp];
imItem.type ← itemIFUM;
imItem.addr ← addr;
Despite what the manual says, the hardware really wants to see even parity - hence the "not" in the following statements
ifumDataBlock.word1.p0 ←
NotOddParity[Basics.BITAND[ifumDataBlock.word0, ifumW0P0],
Basics.BITAND[LOOPHOLE[ifumDataBlock.word1], ifumW1P0] ];
ifumDataBlock.word1.p1 ←
NotOddParity[Basics.BITAND[ifumDataBlock.word0, ifumW0P1],
Basics.BITAND[LOOPHOLE[ifumDataBlock.word1], ifumW1P1] ];
ifumDataBlock.word1.p2 ←
NotOddParity[Basics.BITAND[ifumDataBlock.word0, ifumW0P2],
Basics.BITAND[LOOPHOLE[ifumDataBlock.word1], ifumW1P2] ];
imItem.word0 ← ifumDataBlock.word0;
imItem.word1 ← LOOPHOLE[ifumDataBlock.word1];
itemsThisFile ← itemsThisFile + 1;
nextItemAddr ← nextItemAddr + itemLength;
addr ← addr + 1;
};
memoryNumRM => {
rmDataBlock: LONG POINTER TO RMWord = LOOPHOLE[temp];
imItem.type ← itemRM;
imItem.addr ← addr;
imItem.word0 ← rmDataBlock^;
itemsThisFile ← itemsThisFile + 1;
nextItemAddr ← nextItemAddr + itemLength;
addr ← addr +1;
};
nullMemoryNum =>
tsStream.PutRope[" *** Data for unspecified memory\n"];
ENDCASE => NULL;
};
mbMemory => {
memNum ← GetInteger[readStream];
IF memoryWidths[memNum] = 0 THEN {
tsStream.PutF["\n *** Undefined memory (%g) - quitting\n", IO.int[memNum]];
RETURN[itemsThisFile, FALSE]
};
addr ← GetInteger[readStream];
};
mbFixup => {
tsStream.PutRope["Fixup block encountered in MB file - quitting\n"];
RETURN[itemsThisFile, FALSE]
};
mbMemoryName => {
newMemoryNum: INTEGER ← GetInteger[readStream];
width: WORD ← GetWord[readStream];
val: WORD ← width + 15;
name: ROPE;
ReadName[readStream, textLine];
IF newMemoryNum > maxMemoryNum THEN {
tsStream.PutF["\nNew MemoryNum (%g) is out of bounds", IO.int[newMemoryNum]];
RETURN[itemsThisFile, FALSE];
};
memoryWidths[newMemoryNum] ← Basics.BITSHIFT[val, -4];
name ← RefText.TrustTextAsRope[textLine];
SELECT TRUE FROM
name.Equal["IM", FALSE] => memoryNumIM ← newMemoryNum;
name.Equal["IFUM", FALSE] => memoryNumIFUM ← newMemoryNum;
name.Equal["RM", FALSE] => memoryNumRM ← newMemoryNum;
ENDCASE =>
tsStream.PutF["\n Other memory name (%g)\n", IO.rope[name]];
};
mbAddress => {
[] ← GetWord[readStream];
[] ← GetWord[readStream];
[] ← ReadName[readStream, textLine];
};
mbUndefined => {
tsStream.PutRope["Undefined symbol block encountered in MB file"];
RETURN[itemsThisFile, FALSE];
};
ENDCASE => {
tsStream.PutF["Unknown block type (%g) in MB file",
IO.card[LOOPHOLE[blockType, CARDINAL]] ];
RETURN[itemsThisFile, FALSE];
};
ENDLOOP;
};
LoadRamAndJump: PROC[itemArray: LONG POINTER, flag: CARDINAL] =
IF (flag MOD 2)=1 THEN {jump to the start address in the new Ram image}
Note: software must pass (pointer to first item)-1; must skip over it!!!
 TRUSTED MACHINE CODE {PrincOps.zMISC, PrincOps.aLOADRAMJ};
NotOddParity: PROC[w1, w2: WORD] RETURNS[notParity: OneBit] = {
OPEN Basics;
shft: WORD;
final: WORD;
value: WORD ← BITXOR[w1, w2];
value ← BITXOR[value, BITSHIFT[value, -8]];  -- rshift
value ← BITXOR[value, BITSHIFT[value, -4]];  -- rshift
shft ← BITAND[value, 17B];
final ← BITNOT[BITSHIFT[113151B, -shft]];
RETURN[LOOPHOLE[final, ParityWord].parity];
};
AppendEndItem: PROC[
 nextItemAddr: LONG POINTER TO WORD, startAddr: CARDINAL] = TRUSTED {
endItemAddr: LONG POINTER TO end CSItem = LOOPHOLE[nextItemAddr];
checksum: INTEGER ← 0;
addr: LONG POINTER TO INTEGER ← LOOPHOLE[itemArray];
wordsUsed: LONG CARDINAL =
LOOPHOLE[nextItemAddr-itemArray+SIZE[CSItem], LONG CARDINAL];
endItemAddr.type ← itemEnd;
endItemAddr.startAddr ← startAddr;
FOR i: LONG CARDINAL IN [0..wordsUsed) DO
checksum ← checksum + (addr+i)^;
ENDLOOP;
endItemAddr.checksum ← - checksum;
};
WriteEBHeader: PROC[outFile: OutFile] = TRUSTED {
of: FS.OpenFile = FS.OpenFileFromStream[outFile.stream];
ebHeader: LONG POINTER TO EBHeader = LOOPHOLE[scratch];
len: INTEGER = outFile.shortName.Length[];
cdl: Basics.LongNumber = LOOPHOLE[BasicTime.ToPupTime[FS.GetInfo[of].created]];
cdl2: Basics.LongNumber;
cdl2.hi ← cdl.lo;
cdl2.lo ← cdl.hi;  -- swap halves of date
PrincOpsUtils.LongZero[scratch, ebHeaderLength];
ebHeader.etherVersionNumber ← etherVersionNumber;
ebHeader.creationDate ← LOOPHOLE[cdl2];
ebHeader.nameLen ← len;
ebHeader.maxNameLen ← Basics.BITAND[LOOPHOLE[len+1, WORD], 177776B];  -- ugh
FOR i: INTEGER IN [0..len) DO
ebHeader.nameChars[i] ← outFile.shortName.Fetch[i];
ENDLOOP;
outFile.stream.UnsafePutBlock[
[base: LOOPHOLE[scratch], startIndex: 0, count: 2*ebHeaderLength]];
};
-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
ReadName: PROC[in: STREAM, buffer: REF TEXT] = {
Converts from the MB name format to a normal ref text.
i: INTEGER ← 0;
DO
char: CHAR ← in.GetChar[];
IF char = '\000 THEN {
IF in.GetIndex[] MOD 2 = 1 THEN [] ← in.GetChar[]; -- stream is word (16-bit) oriented
EXIT;
};
buffer[i] ← char;
i ← i + 1;
ENDLOOP;
buffer.length ← i;
};
-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
ShortName: PROC[fullName: ROPE] RETURNS[ROPE] = {
strips the leading directory stuff from name
cp: FS.ComponentPositions;
fsName: ROPE;
[fsName, cp, ] ← FS.ExpandName[fullName];
RETURN[fsName.Substr[cp.base.start, cp.base.length+cp.ext.length+1]]; -- +1 for .
};
OutFileNamesFromSrcFile: PROC[outFile: OutFile, srcName, ext: ROPE] = {
cp: FS.ComponentPositions;
fsName: ROPE;
baseName: ROPE;
[fsName, cp, ] ← FS.ExpandName[srcName];
IF cp.ext.length # 0 THEN baseName ← Rope.Substr[fsName, 0, cp.ext.start-1]
ELSE baseName ← Rope.Substr[fsName, 0, cp.ver.start-1];
outFile.fullName ← baseName.Cat[".", ext];
outFile.shortName ← ShortName[outFile.fullName];
};
GetWord: PROC[in: STREAM] RETURNS[WORD] = {
num: Basics.ShortNumber;
num.hi ← LOOPHOLE[in.GetChar[]];
num.lo ← LOOPHOLE[in.GetChar[]];
RETURN[LOOPHOLE[num, WORD]];
};
GetInteger: PROC[in: STREAM] RETURNS[INTEGER] = {
num: Basics.ShortNumber;
num.hi ← LOOPHOLE[in.GetChar[]];
num.lo ← LOOPHOLE[in.GetChar[]];
RETURN[LOOPHOLE[num, INTEGER]];
};
-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
TSStream: PROC[name: ROPE] RETURNS [IO.STREAM] = {
v: ViewerClasses.Viewer ← ViewerOps.FindViewer[name];
out: IO.STREAM ← ViewerIO.CreateViewerStreams[name, v].out;
IF v#NIL THEN IF v.iconic THEN ViewerOps.OpenIcon[v];
RETURN[out];
};
-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
GetIndex: PROC[strm: STREAM] RETURNS[INT] = { RETURN[strm.GetIndex[]] };
-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Commander.Register["LoadMB", Main, "Reads and Loads a MicroBinary file"];
END.