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],
UnsafeStorage: TYPE USING [GetSystemUZone];
BcdLiteralsImpl:
PROGRAM
IMPORTS Alloc, Basics, BcdErrorDefs, IO, OSMiscOps, PrincOpsUtils, RCMapOps, UnsafeStorage
EXPORTS BcdLiterals = {
OPEN BcdDefs;
Copy:
PROC [from:
LONG
POINTER, nwords:
CARDINAL, to:
LONG
POINTER] ~
PrincOpsUtils.LongCOPY;
table: Alloc.Handle;
zone: UNCOUNTED ZONE = UnsafeStorage.GetSystemUZone[];
tfb, rfb: BcdDefs.Base;
Notifier: Alloc.Notifier ~ {tfb ← base[tftype]; rfb ← base[rftype]};
input
TypeMap: TYPE ~ RECORD [SEQUENCE length: NAT OF RTBcd.TypeIndex];
typeMap: REF TypeMap ← NIL;
LitMap: TYPE ~ RECORD [SEQUENCE length: CARDINAL OF RTBcd.RefLitIndex];
litMap: REF 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 ← 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 ← 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 ~ {
typeMap ← NIL;
litMap ← NIL};
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]]]};
types
MapType:
PROC [old: RTBcd.TypeIndex]
RETURNS [RTBcd.TypeIndex] ~
INLINE {
RETURN [typeMap[old]]};
typeList: REF RTBcd.TypeList;
nextType: NAT;
typeTree: REF 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]; typeTree ← 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: REF RTBcd.TypeList ~ NEW[RTBcd.TypeList[newLimit]];
IF typeList #
NIL
THEN {
FOR i: NAT IN [0 .. MIN[oldLimit, newLimit]) DO newList[i] ← typeList[i] ENDLOOP;
typeList ← NIL};
typeList ← newList};
atoms and REFs to literals
MapLit:
PROC [old: RTBcd.RefLitIndex]
RETURNS [RTBcd.RefLitIndex] ~
INLINE {
RETURN [litMap[old]]};
litList: REF RTBcd.RefLitList;
nextLit: NAT;
litTree: REF 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]; litTree ← 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: REF RTBcd.RefLitList ~ NEW[RTBcd.RefLitList[newLimit]];
IF litList #
NIL
THEN
FOR i: NAT IN [0 .. MIN[oldLimit, newLimit]) DO newList[i] ← litList[i] ENDLOOP;
litList ← newList};
RC maps
rcmOpen: BOOL;
OpenRCMap:
PROC ~ {
IF ~rcmOpen
THEN {
RCMapOps.Initialize[nPages~0, ptr~NIL, expansionOK~TRUE];
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: REF ARRAY HVIndex OF HTIndex;
ht: REF 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: REF HashSeq ~ NEW[HashSeq[newLength]];
IF ht # NIL THEN FOR i: NAT IN [0 .. ht.length) DO newHt[i] ← ht[i] ENDLOOP;
ht ← newHt};
version stamps
stampList: REF 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: REF RTBcd.StampList ~ NEW[RTBcd.StampList[newSize]];
FOR i: NAT IN [1 .. MIN[oldSize, newSize]] DO newList[i] ← stampList[i] ENDLOOP;
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 ~ {
hashVec ← NIL;
ht ← NIL;
litTree ← NIL;
typeTree ← NIL};
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[[LOOPHOLE[LONG[@header], LONG POINTER TO PACKED ARRAY [0..0) OF CHAR], 0, RTHeaderSize*bytesPerWord]];
AdjustLitList[nextLit];
stream.UnsafePutBlock
[[LOOPHOLE[litList, LONG POINTER], 0, litSize*bytesPerWord]];
litList ← NIL;
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
[[LOOPHOLE[stampList, LONG POINTER], 0, stampSize*bytesPerWord]];
stampList ← NIL;
AdjustTypeList[nextType];
stream.UnsafePutBlock
[[LOOPHOLE[typeList, LONG POINTER], 0, typeSize*bytesPerWord]];
typeList ← NIL}};
Initialize:
PUBLIC
PROC [ownTable: Alloc.Handle] ~ {
table ← ownTable; table.AddNotify[Notifier];
litList ← NIL; litTree ← NIL; nextLit ← 0;
textSpace ← NIL; textPages ← 0; textOffset ← textLimit ← 0;
hashVec ← 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 ~ {
table.DropNotify[Notifier]; table ← NIL};
}.