BcdLiteralsImpl.mesa
Copyright © 1985 by Xerox Corporation. All rights reserved.
Satterthwaite, April 24, 1986 4:23:19 pm PST
Maxwell, August 11, 1983 2:23 pm
Paul Rovner, September 22, 1983 11:43 am
Russ Atkinson (RRA) March 7, 1985 0:59:00 am PST
DIRECTORY
Basics: TYPE USING [BITXOR, bytesPerWord, LongMult, LowHalf, RawBytes],
BcdDefs: TYPE USING [Base, BcdBase, FTIndex, FTNull, FTRecord, --PageSize,-- SGIndex, VersionStamp],
BcdLiterals: TYPE USING [],
IO: TYPE USING [STREAM, UnsafePutBlock],
PrincOpsUtils: TYPE USING [LongCopy],
RCMapOps: TYPE USING [RCMT, MapMap, Create, Destroy, FindMapMapEntry, GetSpan, Include],
RTBcd: TYPE USING [AnyStamp, RefLitIndex, RefLitItem, RefLitList, RTBase, RTHeader, StampIndex, StampList, TypeIndex, TypeItem, TypeList, UTInfo, VersionID],
UnsafeStorage: TYPE USING [GetSystemUZone],
VM: TYPE USING [AddressForPageNumber, Allocate, Free, Interval, nullInterval, wordsPerPage];
BcdLiteralsImpl: MONITOR
IMPORTS Basics, IO, PrincOpsUtils, RCMapOps, UnsafeStorage, VM
EXPORTS BcdLiterals = {
OPEN BcdDefs;
input data structures
TypeMap: TYPE ~ RECORD[SEQUENCE length: NAT OF RTBcd.TypeIndex];
LitMap: TYPE ~ RECORD[SEQUENCE length: CARDINAL OF RTBcd.RefLitIndex];
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: REF Nodes, newLimit: NAT] RETURNS[newTree: REF Nodes] ~ {
oldLimit: NAT ~ IF tree = NIL THEN 0 ELSE tree.length;
newTree ← NEW[Nodes[newLimit]];
IF tree # NIL THEN {
FOR i: NAT IN [0 .. MIN[oldLimit, newLimit]) DO newTree[i] ← tree[i] ENDLOOP;
};
};
Scramble: PROC[n: CARDINAL] RETURNS[WORD] ~ INLINE { -- see Knuth, v 3, p. 509-511
RETURN[Basics.LowHalf[Basics.LongMult[n, 44451]]]};
data structures for literal values
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];
state record
LiteralState: TYPE ~ REF LiteralStateInfo;
LiteralStateInfo: PUBLIC TYPE~RECORD[
input
typeMap: REF TypeMap←NIL,
litMap: REF LitMap←NIL,
type mapping
typeList: REF RTBcd.TypeList←NIL,
nextType: NAT𡤀,
typeTree: REF Nodes←NIL,
ATOM and ROPE literal mapping
litList: REF RTBcd.RefLitList←NIL,
nextLit: NAT𡤀,
litTree: REF Nodes←NIL,
RC map table
rcmt: RCMapOps.RCMT←NIL,
literal values
textSpace: VM.Interval←VM.nullInterval,
textBase: LONG POINTER←NIL,
textOffset, textLimit: CARDINAL𡤀,
textPages: CARDINAL𡤀,
hashVec: REF ARRAY HVIndex OF HTIndex←NIL,
ht: REF HashSeq←NIL,
nextHti: HTIndex𡤀,
version stamps
stampList: REF RTBcd.StampList←NIL,
nextStamp: NAT𡤁
];
utilities
Copy: PROC[from: LONG POINTER, nwords: CARDINAL, to: LONG POINTER] ~
PrincOpsUtils.LongCopy;
zone: UNCOUNTED ZONE = UnsafeStorage.GetSystemUZone[];
input routines
Load: PUBLIC PROC[
ls: LiteralState,
bcdBase: BcdDefs.BcdBase,
MapFile: PROC[FTIndex] RETURNS[FTIndex],
MapSegment: PROC[SGIndex] RETURNS[SGIndex]]
RETURNS[success: BOOL ← TRUE] ~ {
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] ~ INLINE {
FOR fti ← FTIndex.FIRST, fti + FTRecord.SIZE UNTIL fti = ftLimit DO
IF ls.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~rcmMap.FindMapMapEntry[old.rcMap]]]};
MapLitItem: PROC[old: RTBcd.RefLitItem, lit: LONG POINTER TO TEXT]
RETURNS[RTBcd.RefLitItem] ~ {
RETURN[[
referentType~MapType[ls, old.referentType],
offset~EnterText[lit],
length~old.length]]};
EnterType: PROC[item: RTBcd.TypeItem] RETURNS[index: RTBcd.TypeIndex] ~ {
i: Branch ← 0;
InsertType: PROC[item: RTBcd.TypeItem] RETURNS[index: Branch] ~ {
IF ls.typeList = NIL OR ls.nextType >= ls.typeList.length THEN {
oldLimit: NAT ~ IF ls.typeList = NIL THEN 0 ELSE ls.typeList.length;
newLimit: NAT ~ oldLimit + MAX[MIN[oldLimit/2, 500], 50];
AdjustTypeList[ls, newLimit]; ls.typeTree ← AdjustNodes[ls.typeTree, newLimit]};
index ← ls.nextType; ls.nextType ← ls.nextType + 1;
ls.typeList[index] ← item; ls.typeTree[index] ← [l~nullBranch, r~nullBranch];
RETURN};
IF ls.nextType = 0 THEN [] ← InsertType[item];
DO
SELECT CompareTypes[item, ls.typeList[i]] FROM
$ls => {
IF ls.typeTree[i].l = nullBranch THEN ls.typeTree[i].l ← InsertType[item];
i ← ls.typeTree[i].l};
$gr => {
IF ls.typeTree[i].r = nullBranch THEN ls.typeTree[i].r ← InsertType[item];
i ← ls.typeTree[i].r};
ENDCASE => RETURN[[i]]
ENDLOOP};
EnterRefLit: PROC[item: RTBcd.RefLitItem] RETURNS[RTBcd.RefLitIndex] ~ {
i: Branch ← 0;
InsertRefLit: PROC[item: RTBcd.RefLitItem] RETURNS[index: Branch] ~ {
IF ls.litList = NIL OR ls.nextLit >= ls.litList.length THEN {
oldLimit: NAT ~ IF ls.litList = NIL THEN 0 ELSE ls.litList.length;
newLimit: NAT ~ oldLimit + MAX[MIN[oldLimit/2, 500], 50];
AdjustLitList[ls, newLimit]; ls.litTree ← AdjustNodes[ls.litTree, newLimit]};
index ← ls.nextLit; ls.nextLit ← ls.nextLit + 1;
ls.litList[index] ← item; ls.litTree[index] ← [l~nullBranch, r~nullBranch];
RETURN};
IF ls.nextLit = 0 THEN [] ← InsertRefLit[item];
DO
SELECT CompareLits[item, ls.litList[i]] FROM
$ls => {
IF ls.litTree[i].l = nullBranch THEN ls.litTree[i].l ← InsertRefLit[item];
i ← ls.litTree[i].l};
$gr => {
IF ls.litTree[i].r = nullBranch THEN ls.litTree[i].r ← InsertRefLit[item];
i ← ls.litTree[i].r};
ENDCASE => RETURN[[i]]
ENDLOOP};
LitText: PROC[offset: CARDINAL] RETURNS[LONG POINTER TO TEXT] ~ INLINE {
RETURN[ls.textBase + offset]};
EnterText: PROC[s: LONG POINTER TO TEXT] RETURNS[offset: CARDINAL] ~ {
HashValue: PROC[s: LONG POINTER TO TEXT] RETURNS[HVIndex] ~ INLINE {
n: CARDINAL ~ s.length;
v: WORD ~ (IF n = 0 THEN 0 ELSE (s[0]-0c)*177b + (s[n-1]-0c));
RETURN[Basics.BITXOR[v, n*17b] MOD ls.hashVec^.LENGTH]};
hvi: HVIndex ~ HashValue[s];
hti: HTIndex;
nw: CARDINAL;
ExpandTextSpace: PROC ~ INLINE {
newPages: CARDINAL ~ ls.textPages + MAX[MIN[ls.textPages/2, 16], 4];
newSpace: VM.Interval ~ VM.Allocate[count~newPages];
newBase: LONG POINTER ~ VM.AddressForPageNumber[newSpace.page];
IF ls.textSpace # VM.nullInterval THEN {
Copy[from~ls.textBase, to~newBase, nwords~ls.textOffset];
VM.Free[ls.textSpace]};
ls.textSpace ← newSpace; ls.textBase ← newBase;
ls.textPages ← newPages; ls.textLimit ← newPages*VM.wordsPerPage};
FOR hti ← ls.hashVec[hvi], ls.ht[hti].link UNTIL hti = HTNull DO
t: LONG POINTER TO TEXT ~ LitText[ls.ht[hti].offset];
IF EqText[s, t] THEN RETURN[ls.ht[hti].offset];
ENDLOOP;
nw ← TEXT[s.length].SIZE;
WHILE ls.textOffset + nw > ls.textLimit DO ExpandTextSpace[] ENDLOOP;
offset ← ls.textOffset;
Copy[from~s, to~ls.textBase+ls.textOffset, nwords~nw];
ls.textOffset ← ls.textOffset + nw;
hti ← AllocateHash[];
ls.ht[hti] ← [link~ls.hashVec[hvi], offset~offset]; ls.hashVec[hvi] ← hti;
RETURN};
AllocateHash: PROC RETURNS[hti: HTIndex] ~ {
ExpandHashSpace: PROC ~ {
oldLength: CARDINAL ~ IF ls.ht = NIL THEN 0 ELSE ls.ht.length;
newLength: CARDINAL ~ oldLength + MAX[MIN[oldLength/2, 1024], 256];
newHt: REF HashSeq ~ NEW[HashSeq[newLength]];
IF ls.ht # NIL THEN FOR i: NAT IN [0 .. ls.ht.length) DO newHt[i] ← ls.ht[i] ENDLOOP;
ls.ht ← newHt};
IF ls.ht = NIL OR ls.nextHti >= ls.ht.length THEN ExpandHashSpace[];
hti ← ls.nextHti; ls.nextHti ← ls.nextHti + 1;
RETURN};
EnterStamp: PROC[stamp: BcdDefs.VersionStamp] RETURNS[index: RTBcd.StampIndex] ~ {
ExpandStampList: PROC ~ INLINE {
oldSize: NAT ~ IF ls.stampList = NIL THEN 0 ELSE ls.stampList.limit-1;
AdjustStampList[ls, oldSize + MAX[MIN[oldSize/2, 256], 64]]};
FOR i: NAT IN [1 .. ls.nextStamp) DO
IF stamp = ls.stampList[i] THEN RETURN[[i]];
ENDLOOP;
IF ls.stampList = NIL OR ls.nextStamp >= ls.stampList.limit THEN ExpandStampList[];
index ← [ls.nextStamp]; ls.stampList[ls.nextStamp] ← stamp;
ls.nextStamp ← ls.nextStamp + 1;
RETURN};
rtHeader: RTBcd.RTBase ~ LOOPHOLE[bcdBase + bcdBase.rtPages.relPageBase*VM.wordsPerPage--BcdDefs.PageSize--];
nTypes, nLits: NAT;
IF rtHeader.versionIdent # RTBcd.VersionID THEN GO TO badFormat;
nTypes ← rtHeader[rtHeader.typeTable].length;
IF nTypes # 0 THEN {
rcmMap ← ls.rcmt.Include[
rcmb~@rtHeader[rtHeader.rcMapBase],
size~rtHeader.rcMapLength,
zone~zone];
ls.typeMap ← NEW[TypeMap[nTypes]];
FOR i: NAT IN [0 .. nTypes) DO
typeString: LONG POINTER TO TEXT ~
@rtHeader[rtHeader.litBase] + rtHeader[rtHeader.typeTable][i].ct;
ls.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 {
ls.litMap ← 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;
ls.litMap[i] ← EnterRefLit[MapLitItem[rtHeader[rtHeader.refLitTable][i], pName]];
ENDLOOP};
EXITS
badFormat => success ← FALSE;
};
RETURN};
MapLitLink: PUBLIC PROC[ls: LiteralState, old: RTBcd.RefLitIndex] RETURNS[RTBcd.RefLitIndex] ~ {
called after LoadLiterals, before UnloadLiterals
RETURN[IF ls.litMap = NIL THEN ERROR ELSE MapLit[ls, old]]};
MapTypeLink: PUBLIC PROC[ls: LiteralState, old: RTBcd.TypeIndex] RETURNS[RTBcd.TypeIndex] ~ {
called after LoadLiterals, before UnloadLiterals
RETURN[IF ls.typeMap = NIL THEN ERROR ELSE MapType[ls, old]]};
Unload: PUBLIC PROC[ls: LiteralState] ~ {
ls.typeMap ← NIL;
ls.litMap ← NIL};
type mapping operations
MapType: PROC[ls: LiteralState, old: RTBcd.TypeIndex] RETURNS[RTBcd.TypeIndex] ~ INLINE {
RETURN[ls.typeMap[old]]};
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]};
AdjustTypeList: PROC[ls: LiteralState, newLimit: NAT] ~ {
oldLimit: NAT ~ IF ls.typeList = NIL THEN 0 ELSE ls.typeList.length;
newList: REF RTBcd.TypeList ~ NEW[RTBcd.TypeList[newLimit]];
IF ls.typeList # NIL THEN {
FOR i: NAT IN [0 .. MIN[oldLimit, newLimit]) DO newList[i] ← ls.typeList[i] ENDLOOP;
ls.typeList ← NIL};
ls.typeList ← newList};
atoms and REFs to literals
MapLit: PROC[ls: LiteralState, old: RTBcd.RefLitIndex] RETURNS[RTBcd.RefLitIndex] ~ INLINE {
RETURN[ls.litMap[old]]};
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]
};
AdjustLitList: PROC[ls: LiteralState, newLimit: NAT] ~ {
oldLimit: NAT ~ IF ls.litList = NIL THEN 0 ELSE ls.litList.length;
newList: REF RTBcd.RefLitList ~ NEW[RTBcd.RefLitList[newLimit]];
IF ls.litList # NIL THEN {
FOR i: NAT IN [0 .. MIN[oldLimit, newLimit]) DO newList[i] ← ls.litList[i] ENDLOOP;
ls.litList ← NIL};
ls.litList ← newList};
RC maps
OpenRCMap: PROC[ls: LiteralState] ~ {
IF ls.rcmt = NIL THEN
ls.rcmt ← RCMapOps.Create[zone~zone, nPages~0, ptr~NIL, expansionOK~TRUE];
};
CloseRCMap: PROC[ls: LiteralState] ~ {
IF ls.rcmt # NIL THEN
ls.rcmt ← RCMapOps.Destroy[ls.rcmt];
};
literal value manipulation
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]};
version stamp manipulation
AdjustStampList: PROC[ls: LiteralState, newSize: NAT] ~ {
oldSize: NAT ~ IF ls.stampList = NIL THEN 0 ELSE ls.stampList.limit-1;
newList: REF RTBcd.StampList ~ NEW[RTBcd.StampList[newSize]];
FOR i: NAT IN [1 .. MIN[oldSize, newSize]] DO newList[i] ← ls.stampList[i] ENDLOOP;
ls.stampList ← newList};
output
EnterVersionFiles: PUBLIC PROC[
ls: LiteralState,
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 ls.stampList[i] = ftb[fti].version THEN RETURN;
ENDLOOP;
RETURN[FTNull]};
FOR i: NAT IN [0 .. ls.nextType) DO
IF ~ls.typeList[i].canonical AND ls.typeList[i].ut.version # RTBcd.AnyStamp THEN
[] ← MapFile[VersionToFile[ls.typeList[i].ut.version]];
ENDLOOP
};
RTHeaderSize: CARDINAL ~ RTBcd.RTHeader.SIZE;
SegmentSize: PUBLIC PROC[ls: LiteralState] RETURNS[nWords: CARDINAL] ~ {
RETURN[IF ls.litList = NIL AND ls.typeList = NIL
THEN 0
ELSE RTHeaderSize +
RTBcd.RefLitList[ls.nextLit].SIZE + ls.textOffset +
RTBcd.TypeList[ls.nextType].SIZE +
RTBcd.StampList[ls.nextStamp-1].SIZE + ls.rcmt.GetSpan[].size]
};
UpdateSegments: PUBLIC PROC[ls: LiteralState, MapSegment: PROC[SGIndex] RETURNS[SGIndex]] ~ {
called if output packing has produced new sgis
FOR i: NAT IN [0 .. ls.nextType) DO
ls.typeList[i].table ← MapSegment[ls.typeList[i].table] ENDLOOP
};
SealLiterals: PUBLIC PROC[ls: LiteralState] ~ {
ls.hashVec ← NIL;
ls.ht ← NIL;
ls.litTree ← NIL;
ls.typeTree ← NIL};
Write: PUBLIC PROC[ls: LiteralState, stream: IO.STREAM] ~ {
IF ls.litList # NIL OR ls.typeList # NIL THEN {
bytesPerWord: CARDINAL ~ Basics.bytesPerWord;
litSize: CARDINAL ~ RTBcd.RefLitList[ls.nextLit].SIZE;
typeSize: CARDINAL ~ RTBcd.TypeList[ls.nextType].SIZE;
stampSize: CARDINAL ~ RTBcd.StampList[ls.nextStamp-1].SIZE;
rcmSize: CARDINAL ~ ls.rcmt.GetSpan[].size;
header: RTBcd.RTHeader ← [
refLitTable~LOOPHOLE[RTHeaderSize],
litBase~LOOPHOLE[RTHeaderSize + litSize],
litLength~ls.textOffset,
rcMapBase~LOOPHOLE[(RTHeaderSize + litSize + ls.textOffset).LONG],
rcMapLength~rcmSize,
stampTable~LOOPHOLE[RTHeaderSize + litSize + ls.textOffset + rcmSize],
typeTable~LOOPHOLE[RTHeaderSize + litSize + ls.textOffset + rcmSize + stampSize]];
stream.UnsafePutBlock[[LOOPHOLE[(@header).LONG, LONG POINTER TO Basics.RawBytes], 0, RTHeaderSize*bytesPerWord]];
AdjustLitList[ls, ls.nextLit];
stream.UnsafePutBlock
[[LOOPHOLE[ls.litList, LONG POINTER TO Basics.RawBytes], 0, litSize*bytesPerWord]];
ls.litList ← NIL;
IF ls.textSpace # VM.nullInterval THEN {
stream.UnsafePutBlock[[ls.textBase, 0, ls.textOffset*bytesPerWord]];
VM.Free[ls.textSpace]};
IF rcmSize # 0 THEN
stream.UnsafePutBlock[[ls.rcmt.GetSpan[].base, 0, rcmSize*bytesPerWord]];
AdjustStampList[ls, ls.nextStamp-1];
stream.UnsafePutBlock
[[LOOPHOLE[ls.stampList, LONG POINTER TO Basics.RawBytes], 0, stampSize*bytesPerWord]];
ls.stampList ← NIL;
AdjustTypeList[ls, ls.nextType];
stream.UnsafePutBlock
[[LOOPHOLE[ls.typeList, LONG POINTER TO Basics.RawBytes], 0, typeSize*bytesPerWord]];
ls.typeList ← NIL}
};
Create: PUBLIC PROC RETURNS[ls: LiteralState] ~ {
ls ← NEW[LiteralStateInfo←[]];
ls.hashVec ← NEW[ARRAY HVIndex OF HTIndex ← ALL[HTNull]];
OpenRCMap[ls];
RETURN};
Finalize: PUBLIC PROC[ls: LiteralState] ~ {
CloseRCMap[ls];
ls.hashVec ← NIL};
}.