-- file: MBImpl.mesa
-- last modified by McCreight, August 18, 1981 5:10 PM
-- written by McCreight, August 4, 1981 2:44 PM
DIRECTORY
InlineDefs: FROM "InlineDefs",
MB: FROM "MB",
StreamDefs: FROM "StreamDefs",
StringDefs: FROM "StringDefs";
MBImpl: PROGRAM IMPORTS InlineDefs,StringDefs EXPORTS MB = PUBLIC
BEGIN OPEN MB;
IllegalMBFormat: SIGNAL = CODE;
curMB: MBHandle ← NIL;
curMem: MBMemoryPtr ← NIL; -- always in curMB
curWord: MBWordPtr ← NIL; -- always in curMem
ReadMB: PROCEDURE [
s: StreamDefs.StreamHandle -- a word stream -- , z: UNCOUNTED ZONE]
RETURNS [mb: MBHandle] =
BEGIN
FakeItem: TYPE = ARRAY [0..99] OF WORD;
fakeItem: FakeItem;
item: LONG POINTER TO MBItem ← LONG[LOOPHOLE[@fakeItem]];
curLC: CARDINAL; -- in curMem
GetNextItem: PROCEDURE =
BEGIN -- fakeItem and item must lie in the same storage
i: CARDINAL;
fakeItem[0] ← s.get[s];
SELECT item.itemType FROM
end => RETURN;
dataWord =>
FOR i IN [1..1 + (curMem.width + 15)/16] DO
fakeItem[i] ← s.get[s] ENDLOOP;
setLC => FOR i IN [1..2] DO fakeItem[i] ← s.get[s] ENDLOOP;
fixup => FOR i IN [1..4] DO fakeItem[i] ← s.get[s] ENDLOOP;
memName, addrSym =>
BEGIN
FOR i IN [1..2] DO fakeItem[i] ← s.get[s] ENDLOOP;
FOR i IN [3..99] DO
c: PACKED ARRAY [0..1] OF CHARACTER;
fakeItem[i] ← s.get[s];
c ← LOOPHOLE[fakeItem[i], PACKED ARRAY [0..1] OF CHARACTER];
IF c[0] = 0C OR c[1] = 0C THEN EXIT;
ENDLOOP;
END;
extRef =>
BEGIN
FOR i IN [1..3] DO fakeItem[i] ← s.get[s] ENDLOOP;
FOR i IN [4..99] DO
c: PACKED ARRAY [0..1] OF CHARACTER;
fakeItem[i] ← s.get[s];
c ← LOOPHOLE[fakeItem[i], PACKED ARRAY [0..1] OF CHARACTER];
IF c[0] = 0C OR c[1] = 0C THEN EXIT;
ENDLOOP;
END;
ENDCASE;
END;
FindMem: PROCEDURE [memNo: CARDINAL] RETURNS [m: MBMemoryPtr] = {
FOR m ← mb, m.nextMem UNTIL m = NIL OR m.memNo = memNo DO ENDLOOP};
mb ← NIL;
s.reset[s];
DO
GetNextItem[];
WITH ditem: item SELECT FROM
end => EXIT;
dataWord =>
BEGIN
w: MBWordPtr ← FindWord[curMem, curLC];
FOR i: CARDINAL IN [0..curMem.width) DO
w.value[i] ← ditem.bits[i] ENDLOOP;
curLC ← curLC + 1;
END;
setLC => BEGIN curMem ← FindMem[ditem.memNo]; curLC ← ditem.location; END;
fixup =>
BEGIN
w: MBWordPtr ← FindWord[FindMem[ditem.memNo], ditem.location];
FOR i: CARDINAL IN [ditem.firstBit..ditem.lastBit] DO
w.value[i] ← ditem.bits[i - ditem.firstBit] ENDLOOP;
END;
memName =>
BEGIN
nameLen: CARDINAL;
mb ← z.NEW[
MBMemory ← [
zone: z, nextMem: mb, name: NIL, memNo: ditem.memNo, length: 0,
width: ditem.width, words: NIL, symbols: NIL]];
FOR nameLen ← 0, nameLen + 1 WHILE ditem.name[nameLen] # 0C DO ENDLOOP;
mb.name ← z.NEW[StringBody [nameLen]];
FOR i: CARDINAL IN [0..nameLen) DO mb.name[i] ← ditem.name[i] ENDLOOP;
mb.name.length ← nameLen;
END;
addrSym =>
BEGIN
nameLen: CARDINAL;
m: MBMemoryPtr ← FindMem[ditem.memNo];
m.symbols ← z.NEW[
MBSym ← [nextSym: m.symbols, location: ditem.location, name: NIL]];
FOR nameLen ← 0, nameLen + 1 WHILE ditem.name[nameLen] # 0C DO ENDLOOP;
m.symbols.name ← z.NEW[StringBody [nameLen]];
FOR i: CARDINAL IN [0..nameLen) DO
m.symbols.name[i] ← ditem.name[i] ENDLOOP;
m.symbols.name.length ← nameLen;
END;
ENDCASE => SIGNAL IllegalMBFormat;
ENDLOOP;
END; -- of ReadMB
FreeMBMemory: PROCEDURE [memP: LONG POINTER TO MBMemoryPtr] =
BEGIN
IF curMB = memP↑ THEN curMB ← NIL;
IF memP↑ # NIL THEN
BEGIN
m: MBMemoryPtr ← memP↑;
z: UNCOUNTED ZONE ← m.zone;
z.FREE[@m.name];
FreeMBMemoryWords[m];
FreeMBMemorySymbols[m];
memP↑ ← m.nextMem;
z.FREE[@m];
END;
END;
FreeMBMemoryWords: PROCEDURE [mem: MBMemoryPtr] =
BEGIN
WHILE mem.words # NIL DO
w: MBWordPtr ← mem.words;
mem.words ← w.nextWord;
mem.zone.FREE[@w];
ENDLOOP;
END;
FreeMBMemorySymbols: PROCEDURE [mem: MBMemoryPtr] =
BEGIN
WHILE mem.symbols # NIL DO
s: MBSymPtr ← mem.symbols;
mem.symbols ← s.nextSym;
mem.zone.FREE[@s.name];
mem.zone.FREE[@s];
ENDLOOP;
END;
FreeMB: PROCEDURE [mb: MBHandle] = {
WHILE mb # NIL DO FreeMBMemory[@mb] ENDLOOP};
FindWord: PROCEDURE [m: MBMemoryPtr, location: LONG CARDINAL]
RETURNS [w: MBWordPtr] =
BEGIN -- words appear in address order
lastw: MBWordPtr ← NIL;
w ←
IF m = curMem AND curWord # NIL AND curWord.location <= location THEN
curWord ELSE m.words;
WHILE w # NIL AND w.location < location DO lastw ← w; w ← w.nextWord ENDLOOP;
IF w = NIL OR location < w.location THEN
BEGIN -- insert a new word
w ← m.zone.NEW[
MBWord [m.width] ← [nextWord: w, location: location, value: NULL]];
FOR i: CARDINAL IN [0..m.width) DO w.value[i] ← FALSE ENDLOOP;
IF lastw = NIL THEN m.words ← w ELSE lastw.nextWord ← w;
END;
IF m = curMem THEN curWord ← w;
END; -- of FindWord
FindMBMemory: PROCEDURE [mb: MBHandle, memName: STRING] RETURNS [MBMemoryPtr] =
BEGIN
FOR mem: MBMemoryPtr ← mb, mem.nextMem WHILE mem # NIL DO
IF EquivalentLongStrings[mem.name, memName] THEN RETURN[mem]; ENDLOOP;
RETURN[NIL];
END;
AnalyzeMemory: PROCEDURE [mem: MBMemoryPtr]
RETURNS [decodeWidth, wordCount, wordWidth: CARDINAL] =
BEGIN
maxAddress: LONG CARDINAL ← 0;
wordWidth ← mem.width;
decodeWidth ← 0;
wordCount ← 0;
FOR w: MBWordPtr ← mem.words, w.nextWord WHILE w # NIL DO
WHILE w.location > maxAddress DO
maxAddress ← 2*maxAddress+1; decodeWidth ← decodeWidth + 1; ENDLOOP;
wordCount ← wordCount + 1;
ENDLOOP;
END; -- of AnalyzeMemory
SuppressDefaultWords: PROCEDURE [mem: MBMemoryPtr, default: BOOLEAN] =
BEGIN
pWord: LONG POINTER TO MBWordPtr ← @mem.words;
FOR w: MBWordPtr ← pWord↑, pWord↑ WHILE w # NIL DO
FOR i: CARDINAL IN [0..mem.width) DO
IF w.value[i] # default THEN GOTO notDefault;
REPEAT
notDefault => pWord ← @w.nextWord;
FINISHED => {t: MBWordPtr ← w; pWord↑ ← w.nextWord; mem.zone.FREE[@t]};
ENDLOOP;
ENDLOOP;
END;
ReCast: PROCEDURE [mem: MBMemoryPtr, newWordWidth: CARDINAL] =
BEGIN
-- steals low-order address bits to widen the word by a power of 2.
-- puts all original bit 0's together, then all bit 1's, then bit 2's, etc.
newMem: MBMemory ← mem↑;
factor: CARDINAL;
FOR factor ← 1, 2*factor WHILE factor*mem.width<newWordWidth DO
ENDLOOP;
newMem.width ← factor*mem.width;
newMem.words ← NIL;
curMem ← NIL;
FOR w: MBWordPtr ← mem.words, w.nextWord WHILE w#NIL DO
newW: MBWordPtr ← FindWord[@newMem, w.location/factor];
FOR i: CARDINAL IN [0..mem.width) DO
newW.value[InlineDefs.LowHalf[factor*i+(w.location MOD factor)]] ← w.value[i];
ENDLOOP;
ENDLOOP;
FreeMBMemoryWords[mem];
FreeMBMemorySymbols[@newMem];
mem↑ ← newMem;
END;
PermuteAddress: PROCEDURE [mem: MBMemoryPtr, p: PermutationPtr] =
BEGIN
newMem: MBMemory ← mem↑;
newMem.words ← NIL;
curMem ← NIL;
FOR w: MBWordPtr ← mem.words, w.nextWord WHILE w#NIL DO
loc: LONG CARDINAL ← 0;
newW: MBWordPtr;
FOR i: CARDINAL DECREASING IN [0..p.length) DO
WITH p.seq[i] SELECT FROM
constantFalse => loc ← 2*loc+(IF invert THEN 1 ELSE 0);
addrBit => loc ← 2*loc+(IF InlineDefs.BITXOR[invert, w.value[index]] THEN 1 ELSE 0);
ENDCASE;
ENDLOOP;
newW ← FindWord[@newMem, loc];
FOR i: CARDINAL IN [0..mem.width) DO
newW.value[i] ← w.value[i];
ENDLOOP;
ENDLOOP;
FreeMBMemoryWords[mem];
FreeMBMemorySymbols[@newMem];
mem↑ ← newMem;
END;
PermuteData: PROCEDURE [mem: MBMemoryPtr, p: PermutationPtr] =
BEGIN
newMem: MBMemory ← mem↑;
newMem.width ← p.length;
newMem.words ← NIL;
curMem ← NIL;
FOR w: MBWordPtr ← mem.words, w.nextWord WHILE w#NIL DO
newW: MBWordPtr ← FindWord[@newMem, w.location];
FOR i: CARDINAL IN [0..p.length) DO
WITH p.seq[i] SELECT FROM
constantFalse => newW.value[i] ← invert;
addrBit => newW.value[i] ← InlineDefs.BITXOR[invert, w.value[index]];
ENDCASE;
ENDLOOP;
ENDLOOP;
FreeMBMemoryWords[mem];
mem↑ ← newMem;
END;
FindMBBit: PROCEDURE [
mb: MBHandle, memName: STRING, word: LONG CARDINAL, bit: CARDINAL]
RETURNS [BOOLEAN] =
BEGIN
lastWord: MBWordPtr;
IF curMB # mb OR curMem = NIL
OR NOT EquivalentLongStrings[memName, curMem.name] THEN
BEGIN
curMB ← mb;
curMem ← mb;
curWord ← NIL;
FOR curMem ← mb, curMem.nextMem UNTIL curMem = NIL
OR EquivalentLongStrings[memName, curMem.name] DO ENDLOOP;
END;
IF curWord = NIL OR word < curWord.location THEN curWord ← curMem.words;
lastWord ← curWord;
WHILE curWord # NIL AND curWord.location < word DO
lastWord ← curWord; curWord ← curWord.nextWord; ENDLOOP;
IF word = curWord.location THEN RETURN[curWord.value[bit]]
ELSE {curWord ← lastWord -- for next search -- ; RETURN[FALSE]};
END; -- of FindMBBit
EquivalentLongStrings: PROCEDURE [a, b: LONG STRING] RETURNS [BOOLEAN] =
BEGIN
IF a.length # b.length THEN RETURN[FALSE];
FOR i: CARDINAL IN [0..a.length) DO
IF StringDefs.UpperCase[a[i]] # StringDefs.UpperCase[b[i]] THEN
RETURN[FALSE];
ENDLOOP;
RETURN[TRUE];
END;
END. -- of MBImpl