file BcdLiteralsImpl.mesa
last edited by Satterthwaite, October 4, 1982 11:36 am
Last Edited by: Maxwell, August 11, 1983 2:23 pm
DIRECTORY
Alloc: TYPE USING [AddNotify, DropNotify, Handle, Notifier],
Basics: TYPE USING [bytesPerWord, LongMult, LowHalf],
BcdDefs: TYPE USING [
Base, BcdBase, FTIndex, FTNull, FTRecord, RFIndex, RFNull, rftype, SGIndex,
TFIndex, TFNull, tftype, VersionStamp],
BcdErrorDefs: TYPE USING [ErrorFile],
BcdLiterals: TYPE USING [],
IO: TYPE USING [STREAM, UnsafePutBlock],
OSMiscOps: TYPE USING [FreePages, Pages],
PrincOps: TYPE USING [wordsPerPage],
PrincOpsUtils: TYPE USING [BITXOR, LongCOPY],
RCMapOps: TYPE USING [MapMap, Finalize, FindMapMapEntry, GetBase, Include, Initialize],
RTBcd: TYPE USING [
AnyStamp, RefLitIndex, RefLitItem, RefLitList, RTBase, RTHeader,
StampIndex, StampList, TypeIndex, TypeItem, TypeList, UTInfo, VersionID];
BcdLiteralsImpl: PROGRAM
IMPORTS Alloc, Basics, BcdErrorDefs, IO, OSMiscOps, PrincOpsUtils, RCMapOps
EXPORTS BcdLiterals = {
OPEN BcdDefs;
Copy: PROC [from: LONG POINTER, nwords: CARDINAL, to: LONG POINTER] ~
PrincOpsUtils.LongCOPY;
table: Alloc.Handle;
zone: UNCOUNTED ZONE;
tfb, rfb: BcdDefs.Base;
Notifier: Alloc.Notifier ~ {tfb ← base[tftype]; rfb ← base[rftype]};
input
TypeMap: TYPE ~ RECORD [SEQUENCE length: NAT OF RTBcd.TypeIndex];
typeMap: LONG POINTER TO TypeMap ← NIL;
LitMap: TYPE ~ RECORD [SEQUENCE length: CARDINAL OF RTBcd.RefLitIndex];
litMap: LONG POINTER TO LitMap ← NIL;
LoadLiterals: PUBLIC PROC [
fti: FTIndex,
bcdBase: BcdDefs.BcdBase,
MapFile: PROC [FTIndex] RETURNS [FTIndex],
MapSegment: PROC [SGIndex] RETURNS [SGIndex]] ~ {
IF bcdBase.rtPages.pages # 0 THEN {
ftb: BcdDefs.Base ~ LOOPHOLE[bcdBase, BcdDefs.Base] + bcdBase.ftOffset;
ftLimit: FTIndex ~ bcdBase.ftLimit;
VersionToFile: PROC [i: RTBcd.StampIndex] RETURNS [fti: BcdDefs.FTIndex] ~ {
FOR fti ← FTIndex.FIRST, fti + FTRecord.SIZE UNTIL fti = ftLimit DO
IF stampList[i] = ftb[fti].version THEN RETURN;
ENDLOOP;
RETURN [FTNull]};
rcmMap: RCMapOps.MapMap;
MapTypeItem: PROC [old: RTBcd.TypeItem, name: LONG POINTER TO TEXT]
RETURNS [RTBcd.TypeItem] ~ {
stamp: RTBcd.StampIndex ~ IF old.ut.version = RTBcd.AnyStamp
THEN RTBcd.AnyStamp
ELSE EnterStamp[rtHeader[rtHeader.stampTable][old.ut.version]];
IF ~old.canonical AND stamp # RTBcd.AnyStamp THEN
[] ← MapFile[VersionToFile[stamp]];  -- force file entry
RETURN [[
table~MapSegment[old.table],
sei~old.sei,
canonical~old.canonical,
ct~[EnterText[name]],
ut~[version: stamp, sei: old.ut.sei],
rcMap~RCMapOps.FindMapMapEntry[rcmMap, old.rcMap]]]};
MapLitItem: PROC [old: RTBcd.RefLitItem, lit: LONG POINTER TO TEXT]
RETURNS [RTBcd.RefLitItem] ~ {
RETURN [[
referentType~MapType[old.referentType],
offset~EnterText[lit],
length~old.length]]};
rtHeader: RTBcd.RTBase ~ LOOPHOLE[bcdBase + PrincOps.wordsPerPage*bcdBase.rtPages.relPageBase];
nTypes, nLits: NAT;
IF rtHeader.versionIdent # RTBcd.VersionID THEN GO TO badFormat;
nTypes ← rtHeader[rtHeader.typeTable].length;
IF nTypes # 0 THEN {
OpenRCMap[];
rcmMap ← RCMapOps.Include[
rcmb~@rtHeader[rtHeader.rcMapBase],
nWords~rtHeader.rcMapLength,
zone~zone];
typeMap ← zone.NEW[TypeMap[nTypes]];
FOR i: NAT IN [0 .. nTypes) DO
typeString: LONG POINTER TO TEXT ~
@rtHeader[rtHeader.litBase] + rtHeader[rtHeader.typeTable][i].ct;
typeMap[i] ← EnterType[MapTypeItem[rtHeader[rtHeader.typeTable][i], typeString]];
ENDLOOP;
IF rcmMap # NIL THEN zone.FREE[@rcmMap]};
nLits ← rtHeader[rtHeader.refLitTable].length;
IF nLits # 0 THEN {
litMap ← zone.NEW[LitMap[nLits]];
FOR i: NAT IN [0 .. rtHeader[rtHeader.refLitTable].length) DO
pName: LONG POINTER TO TEXT ~
@rtHeader[rtHeader.litBase] + rtHeader[rtHeader.refLitTable][i].offset;
litMap[i] ← EnterRefLit[MapLitItem[rtHeader[rtHeader.refLitTable][i], pName]];
ENDLOOP};
EXITS
badFormat => BcdErrorDefs.ErrorFile[$error, "has an incompatible version"L, fti]}};
MapLitLinks: PUBLIC PROC [rfi: RFIndex] ~ {
called after LoadLiterals, before UnloadLiterals
IF litMap # NIL AND rfi # RFNull THEN {
OPEN new~~rfb[rfi];
FOR i: NAT IN [0..new.length) DO new.frag[i] ← MapLit[new.frag[i]] ENDLOOP}};
MapTypeLinks: PUBLIC PROC [tfi: TFIndex] ~ {
called after LoadLiterals, before UnloadLiterals
IF typeMap # NIL AND tfi # TFNull THEN {
OPEN new~~tfb[tfi];
FOR i: NAT IN [0..new.length) DO new.frag[i] ← MapType[new.frag[i]] ENDLOOP}};
UnloadLiterals: PUBLIC PROC ~ {
IF typeMap # NIL THEN zone.FREE[@typeMap];
IF litMap # NIL THEN zone.FREE[@litMap]};
data structures for auxiliary tree structures
Relation: TYPE ~ {ls, gr, eq};
Branch: TYPE ~ CARDINAL --[0..NAT.LAST+1]--;
nullBranch: Branch ~ NAT.LAST+1;
Nodes: TYPE ~ RECORD [SEQUENCE length: NAT OF RECORD [l, r: Branch]];
AdjustNodes: PROC [tree: POINTER TO LONG POINTER TO Nodes, newLimit: NAT] ~ {
oldLimit: NAT ~ IF tree^ = NIL THEN 0 ELSE tree^.length;
newTree: LONG POINTER TO Nodes ~ zone.NEW[Nodes[newLimit]];
IF tree^ # NIL THEN {
FOR i: NAT IN [0 .. MIN[oldLimit, newLimit]) DO newTree[i] ← tree^[i] ENDLOOP;
zone.FREE[@(tree^)]};
tree^ ← newTree};
Scramble: PROC [n: CARDINAL] RETURNS [WORD] ~ INLINE { -- see Knuth, v 3, p. 509-511
RETURN [Basics.LowHalf[Basics.LongMult[n, 44451]]]};
types
MapType: PROC [old: RTBcd.TypeIndex] RETURNS [RTBcd.TypeIndex] ~ INLINE {
RETURN [typeMap[old]]};
typeList: LONG POINTER TO RTBcd.TypeList;
nextType: NAT;
typeTree: LONG POINTER TO Nodes;
EnterType: PROC [item: RTBcd.TypeItem] RETURNS [index: RTBcd.TypeIndex] ~ {
i: Branch ← 0;
IF nextType = 0 THEN [] ← InsertType[item];
DO
SELECT CompareTypes[item, typeList[i]] FROM
$ls => {
IF typeTree[i].l = nullBranch THEN typeTree[i].l ← InsertType[item];
i ← typeTree[i].l};
$gr => {
IF typeTree[i].r = nullBranch THEN typeTree[i].r ← InsertType[item];
i ← typeTree[i].r};
ENDCASE => RETURN [[i]]
ENDLOOP};
CompareTypes: PROC [l, r: RTBcd.TypeItem] RETURNS [Relation] ~ {
sl: WORD ~ Scramble[l.ct];
sr: WORD ~ Scramble[r.ct];
RETURN [
SELECT sl FROM
< sr => $ls, > sr => $gr,
ENDCASE =>
SELECT TRUE FROM
l.canonical AND ~r.canonical => $ls,
~l.canonical AND r.canonical => $gr,
ENDCASE => -- l.canonical = r.canonical
IF l.canonical THEN $eq ELSE CompareUTFs[l.ut, r.ut]]};
CompareUTFs: PROC [l, r: RTBcd.UTInfo] RETURNS [Relation] ~ {
UTWords: TYPE ~ ARRAY [0..RTBcd.UTInfo.SIZE) OF WORD;
FOR i: NAT IN [0..RTBcd.UTInfo.SIZE) DO
SELECT LOOPHOLE[l, UTWords][i] FROM
< LOOPHOLE[r, UTWords][i] => RETURN [$ls];
> LOOPHOLE[r, UTWords][i] => RETURN [$gr];
ENDCASE;
ENDLOOP;
RETURN [$eq]};
InsertType: PROC [item: RTBcd.TypeItem] RETURNS [index: Branch] ~ {
IF typeList = NIL OR nextType >= typeList.length THEN {
oldLimit: NAT ~ IF typeList = NIL THEN 0 ELSE typeList.length;
newLimit: NAT ~ oldLimit + MAX[MIN[oldLimit/2, 500], 50];
AdjustTypeList[newLimit]; AdjustNodes[@typeTree, newLimit]};
index ← nextType; nextType ← nextType + 1;
typeList[index] ← item; typeTree[index] ← [l~nullBranch, r~nullBranch];
RETURN};
AdjustTypeList: PROC [newLimit: NAT] ~ {
oldLimit: NAT ~ IF typeList = NIL THEN 0 ELSE typeList.length;
newList: LONG POINTER TO RTBcd.TypeList ~ zone.NEW[RTBcd.TypeList[newLimit]];
IF typeList # NIL THEN {
FOR i: NAT IN [0 .. MIN[oldLimit, newLimit]) DO newList[i] ← typeList[i] ENDLOOP;
zone.FREE[@typeList]};
typeList ← newList};
atoms and REFs to literals
MapLit: PROC [old: RTBcd.RefLitIndex] RETURNS [RTBcd.RefLitIndex] ~ INLINE {
RETURN [litMap[old]]};
litList: LONG POINTER TO RTBcd.RefLitList;
nextLit: NAT;
litTree: LONG POINTER TO Nodes;
EnterRefLit: PROC [item: RTBcd.RefLitItem] RETURNS [RTBcd.RefLitIndex] ~ {
i: Branch ← 0;
IF nextLit = 0 THEN [] ← InsertRefLit[item];
DO
SELECT CompareLits[item, litList[i]] FROM
$ls => {
IF litTree[i].l = nullBranch THEN litTree[i].l ← InsertRefLit[item];
i ← litTree[i].l};
$gr => {
IF litTree[i].r = nullBranch THEN litTree[i].r ← InsertRefLit[item];
i ← litTree[i].r};
ENDCASE => RETURN [[i]]
ENDLOOP};
CompareLits: PROC [l, r: RTBcd.RefLitItem] RETURNS [Relation] ~ {
sl: WORD ~ Scramble[l.offset];
sr: WORD ~ Scramble[r.offset];
RETURN [SELECT sl FROM
< sr => $ls,
> sr => $gr,
ENDCASE => SELECT l.length FROM
= r.length =>
SELECT l.referentType - r.referentType FROM
= 0 => $eq, > 0 => $gr, ENDCASE => $ls,
< r.length => $ls,
ENDCASE => $gr]};
InsertRefLit: PROC [item: RTBcd.RefLitItem] RETURNS [index: Branch] ~ {
IF litList = NIL OR nextLit >= litList.length THEN {
oldLimit: NAT ~ IF litList = NIL THEN 0 ELSE litList.length;
newLimit: NAT ~ oldLimit + MAX[MIN[oldLimit/2, 500], 50];
AdjustLitList[newLimit]; AdjustNodes[@litTree, newLimit]};
index ← nextLit; nextLit ← nextLit + 1;
litList[index] ← item; litTree[index] ← [l~nullBranch, r~nullBranch];
RETURN};
AdjustLitList: PROC [newLimit: NAT] ~ {
oldLimit: NAT ~ IF litList = NIL THEN 0 ELSE litList.length;
newList: LONG POINTER TO RTBcd.RefLitList ~ zone.NEW[RTBcd.RefLitList[newLimit]];
IF litList # NIL THEN {
FOR i: NAT IN [0 .. MIN[oldLimit, newLimit]) DO newList[i] ← litList[i] ENDLOOP;
zone.FREE[@litList]};
litList ← newList};
RC maps
rcmOpen: BOOL;
OpenRCMap: PROC ~ {
IF ~rcmOpen THEN {
RCMapOps.Initialize[nPages~0, ptr~NIL, expansionZone~zone];
rcmOpen ← TRUE}};
CloseRCMap: PROC ~ {
IF rcmOpen THEN {RCMapOps.Finalize[]; rcmOpen ← FALSE}};
literal values
textSpace: LONG POINTER; -- to words
textOffset, textLimit: CARDINAL;
textPages: CARDINAL;
HVIndex: TYPE ~ [0 .. 251);
HTIndex: TYPE ~ CARDINAL;
HTNull: HTIndex ~ HTIndex.LAST;
HashNode: TYPE ~ RECORD [offset: CARDINAL, link: HTIndex];
HashSeq: TYPE ~ RECORD [SEQUENCE length: CARDINAL OF HashNode];
hashVec: LONG POINTER TO ARRAY HVIndex OF HTIndex;
ht: LONG POINTER TO HashSeq;
nextHti: HTIndex;
LitText: PROC [offset: CARDINAL] RETURNS [LONG POINTER TO TEXT] ~ INLINE {
RETURN [textSpace + offset]};
EnterText: PROC [s: LONG POINTER TO TEXT] RETURNS [offset: CARDINAL] ~ {
hvi: HVIndex ~ HashValue[s];
hti: HTIndex;
nw: CARDINAL;
FOR hti ← hashVec[hvi], ht[hti].link UNTIL hti = HTNull DO
t: LONG POINTER TO TEXT ~ LitText[ht[hti].offset];
IF EqText[s, t] THEN RETURN [ht[hti].offset];
ENDLOOP;
nw ← TEXT[s.length].SIZE;
WHILE textOffset + nw > textLimit DO ExpandTextSpace[] ENDLOOP;
offset ← textOffset;
Copy[from~s, to~textSpace+textOffset, nwords~nw];
textOffset ← textOffset + nw;
hti ← AllocateHash[];
ht[hti] ← [link~hashVec[hvi], offset~offset]; hashVec[hvi] ← hti;
RETURN};
HashValue: PROC [s: LONG POINTER TO TEXT] RETURNS [HVIndex] ~ {
n: CARDINAL ~ s.length;
v: WORD ~ (IF n = 0 THEN 0 ELSE (s[0]-0c)*177b + (s[n-1]-0c));
RETURN [PrincOpsUtils.BITXOR[v, n*17b] MOD hashVec^.LENGTH]};
EqText: PROC [t1, t2: LONG POINTER TO TEXT] RETURNS [BOOL] ~ INLINE {
IF t1.length # t2.length THEN RETURN [FALSE];
FOR i: NAT IN [0..t1.length) DO
IF t1[i] # t2[i] THEN RETURN [FALSE] ENDLOOP;
RETURN [TRUE]};
ExpandTextSpace: PROC ~ {
newPages: CARDINAL ~ textPages + MAX[MIN[textPages/2, 16], 4];
newSpace: LONG POINTER ~ OSMiscOps.Pages[newPages];
IF textSpace # NIL THEN {
Copy[from~textSpace, to~newSpace, nwords~textOffset];
OSMiscOps.FreePages[textSpace]};
textSpace ← newSpace;
textPages ← newPages; textLimit ← newPages*PrincOps.wordsPerPage};
AllocateHash: PROC RETURNS [hti: HTIndex] ~ {
IF ht = NIL OR nextHti >= ht.length THEN ExpandHashSpace[];
hti ← nextHti; nextHti ← nextHti + 1;
RETURN};
ExpandHashSpace: PROC ~ {
oldLength: CARDINAL ~ IF ht = NIL THEN 0 ELSE ht.length;
newLength: CARDINAL ~ oldLength + MAX[MIN[oldLength/2, 1024], 256];
newHt: LONG POINTER TO HashSeq ~ zone.NEW[HashSeq[newLength]];
IF ht # NIL THEN {
FOR i: NAT IN [0 .. ht.length) DO newHt[i] ← ht[i] ENDLOOP;
zone.FREE[@ht]};
ht ← newHt};
version stamps
stampList: LONG POINTER TO RTBcd.StampList;
nextStamp: NAT;
EnterStamp: PROC [stamp: BcdDefs.VersionStamp] RETURNS [index: RTBcd.StampIndex] ~ {
FOR i: NAT IN [1 .. nextStamp) DO
IF stamp = stampList[i] THEN RETURN [[i]];
ENDLOOP;
IF stampList = NIL OR nextStamp >= stampList.limit THEN ExpandStampList[];
index ← [nextStamp]; stampList[nextStamp] ← stamp; nextStamp ← nextStamp + 1;
RETURN};
ExpandStampList: PROC ~ INLINE {
oldSize: NAT ~ IF stampList = NIL THEN 0 ELSE stampList.limit-1;
AdjustStampList[oldSize + MAX[MIN[oldSize/2, 256], 64]]};
AdjustStampList: PROC [newSize: NAT] ~ {
oldSize: NAT ~ IF stampList = NIL THEN 0 ELSE stampList.limit-1;
newList: LONG POINTER TO RTBcd.StampList ~
zone.NEW[RTBcd.StampList[newSize]];
FOR i: NAT IN [1 .. MIN[oldSize, newSize]] DO newList[i] ← stampList[i] ENDLOOP;
IF stampList # NIL THEN zone.FREE[@stampList];
stampList ← newList};
output
EnterVersionFiles: PUBLIC PROC [
ftb: BcdDefs.Base, ftLimit: BcdDefs.FTIndex,
MapFile: PROC [BcdDefs.FTIndex] RETURNS [BcdDefs.FTIndex]] ~ {
VersionToFile: PROC [i: RTBcd.StampIndex] RETURNS [fti: BcdDefs.FTIndex] ~ {
FOR fti ← FTIndex.FIRST, fti + FTRecord.SIZE UNTIL fti = ftLimit DO
IF stampList[i] = ftb[fti].version THEN RETURN;
ENDLOOP;
RETURN [FTNull]};
FOR i: NAT IN [0 .. nextType) DO
IF ~typeList[i].canonical AND typeList[i].ut.version # RTBcd.AnyStamp THEN
[] ← MapFile[VersionToFile[typeList[i].ut.version]];
ENDLOOP};
RTHeaderSize: CARDINAL ~ RTBcd.RTHeader.SIZE;
LitSegSize: PUBLIC PROC RETURNS [nWords: CARDINAL] ~ {
RETURN [IF litList = NIL AND typeList = NIL
THEN 0
ELSE RTHeaderSize +
RTBcd.RefLitList[nextLit].SIZE + textOffset +
RTBcd.TypeList[nextType].SIZE +
RTBcd.StampList[nextStamp-1].SIZE + RCMapOps.GetBase[].nWords]};
UpdateSegments: PUBLIC PROC [MapSegment: PROC [SGIndex] RETURNS [SGIndex]] ~ {
called if output packing has produced new sgis
FOR i: NAT IN [0 .. nextType) DO
typeList[i].table ← MapSegment[typeList[i].table] ENDLOOP};
SealLiterals: PUBLIC PROC ~ {
zone.FREE[@hashVec];
IF ht # NIL THEN zone.FREE[@ht];
IF litTree # NIL THEN zone.FREE[@litTree];
IF typeTree # NIL THEN zone.FREE[@typeTree]};
WriteLiterals: PUBLIC PROC [stream: IO.STREAM] ~ {
IF litList # NIL OR typeList # NIL THEN {
bytesPerWord: CARDINAL ~ Basics.bytesPerWord;
litSize: CARDINAL ~ RTBcd.RefLitList[nextLit].SIZE;
typeSize: CARDINAL ~ RTBcd.TypeList[nextType].SIZE;
stampSize: CARDINAL ~ RTBcd.StampList[nextStamp-1].SIZE;
rcmSize: CARDINAL ~ RCMapOps.GetBase[].nWords;
header: RTBcd.RTHeader ← [
refLitTable~LOOPHOLE[RTHeaderSize],
litBase~LOOPHOLE[RTHeaderSize + litSize],
litLength~textOffset,
rcMapBase~LOOPHOLE[LONG[RTHeaderSize + litSize + textOffset]],
rcMapLength~rcmSize,
stampTable~LOOPHOLE[RTHeaderSize + litSize + textOffset + rcmSize],
typeTable~LOOPHOLE[RTHeaderSize + litSize + textOffset + rcmSize + stampSize]];
stream.UnsafePutBlock[[@header, 0, RTHeaderSize*bytesPerWord]];
AdjustLitList[nextLit];
stream.UnsafePutBlock[[litList, 0, litSize*bytesPerWord]];
zone.FREE[@litList];
IF textSpace # NIL THEN {
stream.UnsafePutBlock[[textSpace, 0, textOffset*bytesPerWord]];
OSMiscOps.FreePages[textSpace]};
IF rcmSize # 0 THEN
stream.UnsafePutBlock[[RCMapOps.GetBase[].base, 0, rcmSize*bytesPerWord]];
CloseRCMap[];
AdjustStampList[nextStamp-1];
stream.UnsafePutBlock[[stampList, 0, stampSize*bytesPerWord]];
zone.FREE[@stampList];
AdjustTypeList[nextType];
stream.UnsafePutBlock[[typeList, 0, typeSize*bytesPerWord]];
zone.FREE[@typeList]}};
Initialize: PUBLIC PROC [ownTable: Alloc.Handle, scratchZone: UNCOUNTED ZONE] ~ {
table ← ownTable; table.AddNotify[Notifier];
zone ← scratchZone;
litList ← NIL; litTree ← NIL; nextLit ← 0;
textSpace ← NIL; textPages ← 0; textOffset ← textLimit ← 0;
hashVec ← zone.NEW[ARRAY HVIndex OF HTIndex ← ALL[HTNull]];
ht ← NIL; nextHti ← 0;
rcmOpen ← FALSE;
stampList ← NIL; nextStamp ← 1;
typeList ← NIL; typeTree ← NIL; nextType ← 0};
Finalize: PUBLIC PROC ~ {
zone ← NIL;
table.DropNotify[Notifier]; table ← NIL};
}.