MDLoadBinImpl:
CEDAR
PROGRAM
IMPORTS
Basics, FS, IO, RefText, Rope,
MDGlobalVars, MDOps, MDUtils
= BEGIN OPEN MDDefs, MDGlobalVars, MDUtils;
fixes: LIST OF Symbol;
verbose: BOOL ← FALSE;
LoadBinaryFiles:
PUBLIC
PROC[srcList: SrcFile]
RETURNS[ok:
BOOL] = {
undefList: LIST OF Symbol ← NIL;
MDOps.InitSymbolTable[];
memDescArray ← ALL[NIL];
memDescArray[IMmemx] ← NEW[MemDescObj ← [name: "IM", widthInBits: 96]];
memDescArray[RMmemx] ← NEW[MemDescObj ← [name: "RM", widthInBits: 16]];
nInstructions ← 0;
nIFUInstructions ← 0;
imMask ← NIL;
fixes ← NIL; -- forget previous fixes
IF outFile.fullName #
NIL
THEN
outFile.strm ← FS.StreamOpen[outFile.fullName, $create];
FOR src: SrcFile ← srcList, src.next
UNTIL src =
NIL
DO
LoadOneFile[src];
src.niLast ← nInstructions;
MDOps.Report[infoOnly, "%g\t%bb instructions \twritten %g\n",
IO.rope[src.fullName], IO.int[src.niLast - src.niFirst], IO.time[src.createDate]];
ENDLOOP;
MDOps.Report[infoOnly, "\n\tTotal of %bb instructions\n\n", IO.int[nInstructions]];
FOR i:
INTEGER
IN [1.. nMemX)
DO
memDesc: MemDescRecord = memDescArray[i];
IF memDesc = NIL OR memDesc.count = 0 THEN LOOP;
MDOps.Report[infoOnly, "%bb words in %g\n",
IO.int[memDesc.count], IO.rope[memDesc.name] ];
ENDLOOP;
check for undefined sumbols
FOR fx:
LIST
OF Symbol ← fixes, fx.rest
UNTIL fx =
NIL
DO
symb: Symbol = fx.first;
IF symb.memNum = -1 THEN undefList ← CONS[symb, undefList];
ENDLOOP;
IF undefList #
NIL
THEN {
IF external
THEN MDOps.Report[infoOnly, "\n *** external symbols:\n\t"]
ELSE MDOps.Report[infoOnly, "\n *** undefined symbols:\n\t"];
FOR sL:
LIST
OF Symbol ← undefList, sL.rest
UNTIL sL =
NIL
DO
MDOps.Report[infoOnly, " %g", IO.rope[sL.first.name]];
ENDLOOP;
IF ~external
THEN {
MDOps.Report[infoOnly, "\n\t\t quitting\n"];
RETURN[FALSE];
};
};
FOR fx:
LIST
OF Symbol ← fixes, fx.rest
UNTIL fx =
NIL
DO
symb: Symbol = fx.first;
FOR fr: FixupRecord ← symb.fixup, fr.next
UNTIL fr =
NIL
DO
SELECT fr.fieldDesc
FROM
im1Field =>
TRUSTED {
MDUtils.IMPtr[fr.addr].wx1.W1AddrAndGroupLink ← symb.labelAddr;
};
im2Field =>
TRUSTED {
MDUtils.IMPtr[fr.addr].wx2.W2AddrAndbLink ← symb.labelAddr;
};
ifField =>
TRUSTED {
fixPtr: MDDefs.IFUMRecordPtr = MDUtils.IFUMPtr[fr.addr];
fixPtr.ifumWord0.ifad ← symb.labelAddr;
};
null => ERROR;
ENDCASE => ERROR;
ENDLOOP;
ENDLOOP;
make another pass over IM, changing .+1 encoding into imaginary addr
TRUSTED {
FOR i:
CARDINAL
IN [0..nInstructions)
DO
imPtr: MDDefs.IMRecordPtr = MDUtils.IMPtr[i];
IF imPtr.wx1.W1AddrAndGroupLink = WNext
THEN
imPtr.wx1.W1AddrAndGroupLink ← i+1;
IF imPtr.wx2.W2AddrAndbLink = WNext
THEN
imPtr.wx2.W2AddrAndbLink ← i+1;
imPtr.word0 ← imPtr.wx0;
imPtr.word1 ← imPtr.wx1;
imPtr.word2 ← imPtr.wx2;
ENDLOOP;
};
RETURN[TRUE];
};
FieldDesc:
TYPE =
MACHINE
DEPENDENT
RECORD
[firstBit (0: 0..7): [0..377B], encoded (0: 8..15): [0..377B] ]; -- encoded = nBits+firstBit-1
the following to agree with Micro's notion of fields
W1FieldDesc: FieldDesc = [firstBit: 4*16+4, encoded: 12+(4*16+4)-1];
W2FieldDesc: FieldDesc = [firstBit: 5*16+4, encoded: 12+(5*16+4)-1];
IFADfield: FieldDesc = [firstBit: 4, encoded: 12+4-1];
OneMinusWNull: WORD = 170001B;
MDataDispArray: TYPE = ARRAY [0..nMemX) OF mDataDisp;
mDataDisp:
TYPE = {
dataIFUM, dataALUFM, dataIM, dataRM, dataDISP, dataIMLOCK, dataSkip,
dataIMMASK, dataOther
};
mDataArray: MDataDispArray ← ALL[dataOther];
verMemX: INTEGER ← -1;
LoadOneFile:
PROC[src: SrcFile] = {
inStrm: STREAM = FS.StreamFromOpenFile[src.of];
iBase: CARDINAL ← nInstructions;
memNum: INTEGER ← 0;
addr: CARDINAL ← 0;
AdjustAddr:
PROC[w:
WORD]
RETURNS [new:
WORD] = {
w1: WORD ← Basics.BITAND[w, LOOPHOLE[IMsize-1]];
IF w1 = WNull
THEN new ←
LOOPHOLE[addr,
WORD] + OneMinusWNull + w
ELSE new ← LOOPHOLE[iBase, WORD] + w;
};
src.niFirst ← nInstructions;
src.niLast ← NImax; -- in case of error
DO
blkType: INTEGER ← GetInteger[inStrm];
SELECT blkType
FROM
MBend => {
inStrm.Close[]; -- this will close the FS.OpenFile too
src.of ← FS.nullOpenFile;
EXIT
}; -- so can set breakppoint
MBdata => {
thisAddr: CARDINAL ← addr;
addr ← addr + 1;
[] ← GetWord[inStrm]; -- line number, ignore for all
SELECT mDataArray[memNum]
FROM
dataOther => DataProc[inStrm, memNum, thisAddr];
dataIM =>
TRUSTED {
-- Dorado model 1 only
imPtr: IMRecordPtr = IMPtr[thisAddr];
imPtr.imw0 ← GetWord[inStrm];
imPtr.imw1 ← GetWord[inStrm];
imPtr.imw2 ← GetWord[inStrm];
imPtr.wx0 ← LOOPHOLE[GetWord[inStrm]];
imPtr.wx1 ← LOOPHOLE[GetWord[inStrm]];
imPtr.wx2 ← LOOPHOLE[GetWord[inStrm]];
adjust W1 and W2 addresses
imPtr.wx1 ← LOOPHOLE[AdjustAddr[LOOPHOLE[imPtr.wx1]]];
imPtr.wx2 ← LOOPHOLE[AdjustAddr[LOOPHOLE[imPtr.wx2]]];
IF nInstructions # thisAddr
THEN
MDOps.Report[fatalError,
"%g ....Imaginary addresses not consecutive (%g follows %g)\n",
IO.int[nInstructions], IO.int[thisAddr], IO.int[nInstructions-1]];
nInstructions ← thisAddr + 1;
IF nInstructions > NImax THEN IMFull[];
};
dataIFUM =>
TRUSTED {
ifum0: IFUMWord0 ← LOOPHOLE[GetWord[inStrm]];
ifumPtr: IFUMRecordPtr ← MDUtils.IFUMPtr[thisAddr];
IF ifumBits[thisAddr]
THEN
MDOps.Report[fatalError,
"\n*** Attempt to load IFUM[%g] twice\n", IO.int[thisAddr]];
IF ifum0.ifad # WNull THEN ifum0.ifad ← ifum0.ifad+iBase;
IF thisAddr >= nIFUInstructions THEN nIFUInstructions ← thisAddr + 1;
ifumBits[thisAddr] ← TRUE;
ifumPtr.ifumWord0 ← ifum0;
ifumPtr.otherData ← GetWord[inStrm];
};
dataALUFM =>
TRUSTED {
alufmBits[thisAddr] ← TRUE;
(alufmArrayHead+thisAddr)^ ← GetWord[inStrm];
};
dataRM =>
TRUSTED {
val: WORD = GetWord[inStrm];
IF rmBits[thisAddr]
AND ((rmArrayHead+thisAddr)^ # val)
THEN
MDOps.Report[infoOnly,
"\n*** Attempt to load RM[%g] twice\n", IO.int[thisAddr]];
(rmArrayHead+thisAddr)^ ← val;
rmBits[thisAddr] ← TRUE;
};
dataIMLOCK => {
bits: INTEGER ← GetInteger[inStrm];
imLocked[thisAddr] ← (bits < 0); -- testing high order bit
};
dataIMMASK => {
msk: IMMask ← NEW[IMMaskRec ← [next: imMask, addr: thisAddr+iBase]];
msk.mask ← GetWord[inStrm];
msk.mSeq ← Basics.BITSHIFT[GetWord[inStrm], -12]; -- rshift
imMask ← msk;
};
dataDISP => [] ← GetWord[inStrm]; -- DISP - not defined yet
dataSkip =>
FOR i:
INTEGER
IN [0..memDescArray[memNum].wordsOfData)
DO
[] ← GetWord[inStrm];
ENDLOOP;
ENDCASE => NULL;
};
MBaddress => {
memNum ← GetInteger[inStrm];
IF memNum = IMmemx
THEN {
addr ← GetCardinal[inStrm] + iBase;
IF addr > NImax THEN IMFull[];
}
ELSE addr ← GetWord[inStrm];
};
MBfixup =>
TRUSTED {
-- forward reference
thisMem: INTEGER ← GetInteger[inStrm];
thisAddr: CARDINAL ← GetCardinal[inStrm];
fieldDesc: FieldDesc ← LOOPHOLE[GetWord[inStrm]];
val: WORD ← GetWord[inStrm];
SELECT thisMem
FROM
IMmemx => {
IF fieldDesc = W1FieldDesc
THEN
MDUtils.IMPtr[iBase+thisAddr].wx1.W1AddrAndGroupLink ←
val ← val + iBase;
IF fieldDesc = W2FieldDesc
THEN
MDUtils.IMPtr[iBase+thisAddr].wx2.W2AddrAndbLink ←
val ← val + iBase;
LOOP;
};
IFUMmemx => {
-- check pass
fixPtr: IFUMRecordPtr = MDUtils.IFUMPtr[thisAddr];
IF fieldDesc = IFADfield THEN val ← val + iBase;
fixPtr.ifumWord0.ifad ← val;
};
ALUFMmemx => (alufmArrayHead+thisAddr)^ ← val;
RMmemx => (rmArrayHead+thisAddr)^ ← val;
ENDCASE => {
FixProc[thisMem, thisAddr, fieldDesc, val];
};
};
MBmemory => {
memNum: INTEGER = GetInteger[inStrm];
widthInBits: INTEGER = GetInteger[inStrm];
symName: ROPE = ReadSymName[inStrm];
MemoryProc[memNum, widthInBits, symName];
};
MBsymbol => {
thisMem: INTEGER = GetInteger[inStrm];
val: WORD ← GetWord[inStrm];
symName: ROPE = ReadSymName[inStrm];
symbol: Symbol;
IF thisMem = IMmemx THEN val ← val + iBase;
symbol ← SymbolProc[thisMem, symName, val];
IF thisMem = IMmemx THEN TRUSTED { MDUtils.IMPtr[val].symbol ← symbol };
};
MBexternalfixup => {
memNum: INTEGER = GetInteger[inStrm];
loc: CARDINAL ← GetWord[inStrm];
bits: WORD ← GetWord[inStrm]; -- don't need to fix (see mdLoad.bcpl)
symName: ROPE ← ReadSymName[inStrm];
IF memNum = IMmemx THEN loc ← loc + iBase;
ExternalFixProc[symName, memNum, loc, bits];
};
ENDCASE => NULL;
ENDLOOP;
};
IMFull:
PROC =
{ MDOps.Report[fatalError, "\n ***IM is full - quitting\n"] };
scratch: REF TEXT ← NEW[TEXT[RefText.line]];
ReadSymName:
PROC[fx:
STREAM]
RETURNS[
ROPE] = {
scratch.length ← 0;
DO
ch: CHAR = fx.GetChar[];
IF ch = '\000 THEN EXIT;
scratch ← RefText.AppendChar[scratch, ch];
ENDLOOP;
IF fx.GetIndex[] MOD 2 = 1 THEN [] ← fx.GetChar[];
RETURN[Rope.FromRefText[scratch]];
};
outMemx: INTEGER ← -1;
outAddr: CARDINAL ← 177777B;
MachineVersion:
TYPE =
MACHINE
DEPENDENT
RECORD[
machine: [0..377B],
version: [0..377B]
];
version: MachineVersion ← [377B, 377B];
DMachine: [0..377B] ← 2; -- Dorado Model 1
DataProc:
PROC[inStrm:
STREAM, memNum:
INTEGER, addr:
CARDINAL] = {
IF memNum = verMemX
THEN {
fv: WORD = GetWord[inStrm];
fileV: MachineVersion = LOOPHOLE[fv];
IF ((version.machine < 377B)
AND (version # fileV))
OR
(fileV.machine # DMachine)
THEN
MDOps.Report[fatalError,
"\n *** File says VERSION = %bB -- disagrees with IM width\n",
IO.card[fv]];
version ← fileV;
}
ELSE {
mem: MemDescRecord = memDescArray[memNum];
IF mem.seen
THEN {
IF (memNum # outMemx)
OR (addr # outAddr+1)
THEN {
PutInteger[outFile.strm, MBaddress];
PutInteger[outFile.strm, memNum];
PutCardinal[outFile.strm, addr];
};
outMemx ← memNum;
outAddr ← addr;
PutInteger[outFile.strm, MBdata];
PutInteger[outFile.strm, memNum];
FOR i:
INTEGER
IN [0..mem.wordsOfData)
DO
PutWord[outFile.strm, GetWord[inStrm]];
ENDLOOP;
mem.count ← mem.count + 1;
}
ELSE {
IF memNum = 0
THEN
MDOps.Report[fatalError, "\n *** Data word before address set\n"]
ELSE
MDOps.Report[fatalError,
"\n *** Data for unknown memory %g", IO.int[memNum]];
};
};
};
MemoryProc:
PROC[memNum, widthInBits:
INTEGER, symName:
ROPE] = {
mem: MemDescRecord;
maxMemX: INTEGER = 4; -- since we know its a dorado
IF memNum <= 0
OR memNum > nMemX
THEN
MDOps.Report[fatalError, "\n *** Illegal memory #%g\n", IO.int[memNum]];
mem ← memDescArray[memNum];
IF mem =
NIL
THEN {
mem ← memDescArray[memNum] ← NEW[MemDescObj];
mem.widthInBits ← widthInBits;
mem.wordsOfData ← (widthInBits+15)/16;
mem.name ← symName;
}
ELSE {
-- check for idential definition
IF ~symName.Equal[mem.name,
FALSE]
THEN
MDOps.Report[fatalError, "\n *** Memory #%g (%g) redefined as %g\n",
IO.int[memNum], IO.rope[mem.name], IO.rope[symName]];
IF widthInBits # mem.widthInBits
THEN
MDOps.Report[fatalError, "\n *** Memory #%g not valid %g\n",
IO.int[memNum], IO.rope[symName]];
};
IF memNum = IMmemx
THEN {
other: MemDescRecord ← memDescArray[IFUMmemx];
IF other =
NIL
THEN {
memDescArray[IFUMmemx] ← other ← NEW[MemDescObj];
other.name ← "IFUM";
other.widthInBits ← 32;
};
other ← memDescArray[ALUFMmemx];
IF other =
NIL
THEN {
memDescArray[ALUFMmemx] ← other ← NEW[MemDescObj];
other.name ← "ALUFM";
other.widthInBits ← 8;
};
mDataArray[IMmemx] ← dataIM;
mDataArray[RMmemx] ← dataRM;
mDataArray[ALUFMmemx] ← dataALUFM;
mDataArray[IFUMmemx] ← dataIFUM;
};
IF memNum > maxMemX
THEN
-- must be unknown or fake
SELECT
TRUE
FROM
symName.Equal["DISP",
FALSE] =>
{ mDataArray[memNum] ← dataDISP; RETURN };
symName.Equal["IMLOCK",
FALSE] =>
{ mDataArray[memNum] ← dataIMLOCK; RETURN };
symName.Equal["RVREL", FALSE] =>
{ mDataArray[memNum] ← dataSkip; RETURN };
symName.Equal["VERSION", FALSE] =>
{ verMemX ← memNum; RETURN };
symName.Equal["IMMASK", FALSE] =>
{ mDataArray[memNum] ← dataIMMASK; RETURN };
ENDCASE => NULL;
IF mem.seen THEN RETURN;
mem.seen ← TRUE;
Copy memory def to output
IF memNum = IMmemx
THEN
MDOps.WriteMemoryDef[memNum, 64, symName]
ELSE MDOps.WriteMemoryDef[memNum, mem.widthInBits, symName];
};
SymbolProc:
PROC[memNum:
INTEGER, symName:
ROPE, addr:
CARDINAL]
RETURNS[symbol: Symbol] = {
Save symbols for later output
mem: MemDescRecord = memDescArray[memNum];
symbol ← NIL;
IF ~mem.seen THEN RETURN; -- skip DISP, IMLOCK, RVREL, VERSION
symbol ← MDOps.AddSym[symName];
IF symbol.memNum # -1
THEN { -- check for redefn
IF symbol.memNum # memNum
THEN
MDOps.Report[fatalError, "\n *** Symbol %g redefined from memory %g to %g\n",
IO.rope[symName], IO.int[symbol.memNum], IO.int[memNum]];
IF symbol.labelAddr # addr
AND verbose
THEN
MDOps.Report[infoOnly,
"\n *** Symbol %g in memory %g redefined from addr %g to %g\n",
IO.rope[symName], IO.int[symbol.memNum], IO.int[symbol.labelAddr], IO.int[addr]];
};
symbol.memNum ← memNum;
symbol.labelAddr ← addr;
IF (memNum # IMmemx)
AND (addr > mem.symMaxAddr)
THEN
mem.symMaxAddr ← addr;
};
FixProc:
PROC[memNum:
INTEGER, addr:
CARDINAL, fieldDesc: FieldDesc, val:
WORD] = {
Fixup for unknown memory - just copy
PutInteger[outFile.strm, MBfixup];
PutInteger[outFile.strm, memNum];
PutCardinal[outFile.strm, addr];
PutWord[outFile.strm, LOOPHOLE[fieldDesc]];
PutWord[outFile.strm, val];
};
ExternalFixProc:
PROC[symName:
ROPE, memNum:
INTEGER, loc, bits:
WORD] = {
fieldDesc: FieldDesc = LOOPHOLE[bits];
which: ExtFixField ← null;
symb: Symbol ← MDOps.AddSym[symName];
newFixup: FixupRecord;
prev: FixupRecord;
IF (memNum = IMmemx)
THEN {
SELECT fieldDesc
FROM
W1FieldDesc => which ← im1Field;
W2FieldDesc => which ← im2Field;
ENDCASE =>
MDOps.Report[fatalError, "\n *** %g....External reference to %g\n",
IO.card[loc], IO.rope[symName]];
}
ELSE
IF (memNum = IFUMmemx) AND (fieldDesc = IFADfield) THEN which ← ifField;
IF which = null
THEN {
mem: MemDescRecord = memDescArray[memNum];
MDOps.Report[fatalError, "\n *** %g %g ... External reference to %g",
IO.rope[mem.name], IO.card[loc], IO.rope[symName]];
};
newFixup ← NEW[FixupRec ← [memNum, which, loc, prev ← symb.fixup]];
symb.fixup ← newFixup;
IF prev = NIL THEN fixes ← CONS[symb, fixes]; -- first fixup for this symbol
};
END.