[ivy]<Satterthwaite>Mimosa>SymLiteralPack.mesa!5

SymLiteralPack.mesa
Copyright © 1985 by Xerox Corporation. All rights reserved.
Satterthwaite, June 18, 1986 12:22:45 pm PDT
Maxwell, July 28, 1983 10:21 am
Russ Atkinson (RRA) March 7, 1985 4:46:52 am PST
DIRECTORY
Alloc: TYPE USING [Handle, Notifier, AddNotify, DropNotify, Top, Words],
Basics: TYPE USING [bitsPerWord],
ComData: TYPE USING [idINTEGER, interface, mainCtx, ownSymbols, switches, typeATOM, typeRefANY],
ConvertUnsafe: TYPE USING [SubString],
Literals: TYPE USING [STIndex],
LiteralOps: TYPE USING [Find],
RTBcd: TYPE USING [RefLitIndex, TypeIndex],
Symbols: TYPE USING [Base, SERecord, Name, Type, ISEIndex, CSEIndex, CTXIndex, MDIndex, BitAddress, nullType, ISENull, CTXNull, FirstStandardCtx, LastStandardCtx, lZ, OwnMdi, MDNull, typeANY, ctxType, seType],
SymbolOps: TYPE USING [ClusterSe, CtxLevel, DecodeBitAddr, DecodeType, EncodeCard, EncodeTreeIndex, EnterString, FirstCtxSe, FromType, MakeCtxSe, MakeNonCtxSe, NextSe, TypeForm, UnderType],
SymbolSegment: TYPE USING [atType],
SymLiteralOps: TYPE USING [RefLitItem],
Table: TYPE USING [Base, IndexRep, Selector],
Tree: TYPE USING [Link, nullIndex],
TreeOps: TYPE USING [PopTree, PushLit, PushNode, PushSe, SetAttr, SetInfo],
Types: TYPE USING [Equivalent];
SymLiteralPack: PROGRAM
IMPORTS Alloc, LiteralOps, SymbolOps, TreeOps, Types, dataPtr: ComData
EXPORTS SymLiteralOps = {
OPEN Symbols;
RefLitItem: TYPE = SymLiteralOps.RefLitItem;
bitsPerWord: NAT = Basics.bitsPerWord;
types
SymLitRecord: TYPE = RECORD [
SELECT tag: * FROM
type => [canonical: BOOL, typeCode: Type],
lit => [info: RefLitItem]
ENDCASE];
SymLitIndex: TYPE = Table.Base RELATIVE LONG ORDERED POINTER TO SymLitRecord;
SymLitFirst: SymLitIndex = LOOPHOLE[Table.IndexRep[tag: 0, highBits:0, lowBits:0]];
bases
table: Alloc.Handle;
atType: Table.Selector = SymbolSegment.atType;
slb: Table.Base;
seb: Symbols.Base;
ctxb: Symbols.Base;
UpdateBases: Alloc.Notifier = {
seb ← base[seType]; ctxb ← base[ctxType];
slb ← base[atType]; seb ← base[seType]};
auxiliary type predicates
Matched: SIGNAL[m1, m2: Type] RETURNS[BOOL] = CODE;
NameEqual: PROC[key, entry: Type] RETURNS[BOOL] = {
RETURN[(key = entry) OR Isomorphic[key, entry ! Matched => {RESUME [FALSE]}]]};
Isomorphic: PROC[key, entry: Type] RETURNS[BOOL] = {
RETURN[WITH type1: seb[key] SELECT FROM
id => (SymbolOps.ClusterSe[key] = SymbolOps.ClusterSe[entry]),
cons =>
WITH type2: seb[entry] SELECT FROM
cons =>
WITH t1: type1 SELECT FROM
record =>
WITH t2: type2 SELECT FROM
record =>
(t1.fieldCtx = t2.fieldCtx) OR
(~t1.painted AND ~t2.painted AND (
(SIGNAL Matched[key, entry])
OR
IsoFields[t1.fieldCtx, t2.fieldCtx
! Matched => {IF m1=key AND m2=entry THEN RESUME [TRUE]}])),
ENDCASE => FALSE,
ref =>
WITH t2: type2 SELECT FROM
ref =>
(t1.counted = t2.counted) AND (t1.ordered = t2.ordered) AND
(t1.readOnly = t2.readOnly) AND Isomorphic[t1.refType, t2.refType],
ENDCASE => FALSE,
long =>
WITH t2: type2 SELECT FROM
long => Isomorphic[t1.rangeType, t2.rangeType],
ENDCASE => FALSE,
any => WITH t2: type2 SELECT FROM any => TRUE, ENDCASE => FALSE,
ENDCASE => (key = entry),
ENDCASE => FALSE,
ENDCASE => ERROR]
};
IsoFields: PROC[ctx1, ctx2: CTXIndex] RETURNS[BOOL] = {
sei1: ISEIndex ← SymbolOps.FirstCtxSe[ctx1];
sei2: ISEIndex ← SymbolOps.FirstCtxSe[ctx2];
UNTIL sei1 = sei2 DO
IF seb[sei1].hash # seb[sei2].hash OR ~Isomorphic[seb[sei1].idType, seb[sei2].idType] THEN
RETURN[FALSE];
sei1 ← SymbolOps.NextSe[sei1]; sei2 ← SymbolOps.NextSe[sei2];
ENDLOOP;
RETURN[sei1 = sei2]};
Equivalent: PROC[key, entry: Type] RETURNS[BOOL] = {
RETURN[(key = entry) OR (
Types.Equivalent[
[dataPtr.ownSymbols, SymbolOps.UnderType[key]],
[dataPtr.ownSymbols, SymbolOps.UnderType[entry]]]
AND ~Fuzzy[key, entry])]
};
Fuzzy: PROC[sei1, sei2: Type] RETURNS[BOOL] = INLINE {
RETURN[SymbolOps.TypeForm[sei1] = array AND (~seb[sei1].mark4 OR ~seb[sei2].mark4)]};
universal type fingers
UTypeId: PUBLIC PROC[type: Type] RETURNS[mdi: MDIndex, index: Type] = {
sei: Type = SymbolOps.ClusterSe[type];
WITH se: seb[sei] SELECT FROM
id => {
ctx: CTXIndex = se.idCtx;
WITH c: ctxb[ctx] SELECT FROM
included =>
IF SymbolOps.CtxLevel[ctx] = lZ THEN {index ← sei; mdi ← OwnMdi}
ELSE {index ← SymbolOps.DecodeType[se.idValue]; mdi ← c.module};
ENDCASE => {
index ← sei;
mdi ← IF Predeclared[sei] THEN MDNull ELSE OwnMdi}};
cons => {
index ← sei;
mdi ← WITH t: se SELECT FROM
basic => MDNull,
enumerated =>
IF t.valueCtx IN [FirstStandardCtx .. LastStandardCtx] THEN MDNull ELSE OwnMdi,
record =>
IF t.fieldCtx IN [FirstStandardCtx .. LastStandardCtx] THEN MDNull ELSE OwnMdi,
opaque => IF Predeclared[t.id] THEN MDNull ELSE OwnMdi,
ENDCASE => OwnMdi};
ENDCASE;
RETURN};
Predeclared: PROC[type: Type] RETURNS[BOOL] = INLINE {
RETURN[type = nullType OR (
WITH se: seb[type] SELECT FROM
id => se.idCtx IN (CTXNull .. LastStandardCtx],
ENDCASE => FALSE)]
};
typeIds
minTypes: CARDINAL = 2; -- type fragment, if any, at least this big (avoid global 0)
nTypes: CARDINAL;
nTypeRefs: CARDINAL;
typeMapId: ISEIndex;
EnterType: PUBLIC PROC[type: Type, canonical: BOOL] = {
sei: Type = SymbolOps.ClusterSe[type];
slLimit: SymLitIndex = table.Top[SymbolSegment.atType];
nTypeRefs ← nTypeRefs + 1;
FOR sli: SymLitIndex ← SymLitFirst, sli+SymLitRecord.SIZE UNTIL sli = slLimit DO
WITH s: slb[sli] SELECT FROM
type =>
IF canonical = s.canonical AND
(IF canonical THEN Equivalent ELSE NameEqual)[sei, s.typeCode] THEN EXIT;
ENDCASE;
REPEAT
FINISHED => InsertType[sei, canonical];
ENDLOOP
};
TypeIndex: PUBLIC PROC[type: Type, canonical: BOOL] RETURNS[RTBcd.TypeIndex] = {
sei: Type = SymbolOps.ClusterSe[type];
i: CARDINAL ← 0;
FOR sli: SymLitIndex ← SymLitFirst, sli+SymLitRecord.SIZE WHILE i < nTypes DO
WITH s: slb[sli] SELECT FROM
type =>
IF canonical = s.canonical AND
(IF canonical THEN Equivalent ELSE NameEqual)[sei, s.typeCode] THEN EXIT;
ENDCASE;
i ← i+1;
REPEAT
FINISHED => ERROR;
ENDLOOP;
RETURN[[i]]};
TypeRef: PUBLIC PROC[type: Type, canonical: BOOL] RETURNS[Tree.Link] = {
RETURN[IndexedRef[typeMapId, TypeIndex[type, canonical], typeANY]]};
DescribeTypes: PUBLIC PROC RETURNS[offset, length: CARDINAL] = {
RETURN[offset: WordOffset[typeMapId], length: nTypes]};
EnumerateTypes: PUBLIC PROC[scan: PROC[canonical: BOOL, type: Type]] = {
i: CARDINAL ← 0;
FOR sli: SymLitIndex ← SymLitFirst, sli+SymLitRecord.SIZE WHILE i < nTypes DO
WITH s: slb[sli] SELECT FROM
type => scan[s.canonical, s.typeCode];
ENDCASE;
i ← i + 1;
ENDLOOP
};
InsertType: PROC[type: Type, canonical: BOOL] = {
sli: SymLitIndex = table.Words[atType, SymLitRecord.SIZE];
slb[sli] ← [type[canonical: canonical, typeCode: type]];
nTypes ← nTypes + 1};
PadTypes: PROC[pad: BOOL] = INLINE {
IF nTypes # 0 THEN {
totalTypes: CARDINAL = (IF pad THEN ((nTypes+3)/4)*4 ELSE nTypes);
FOR i: NAT IN [nTypes .. MAX[minTypes, totalTypes]) DO
InsertType[Symbols.nullType, FALSE] ENDLOOP}
};
atoms and REFs to literals
minLitRefs: CARDINAL = 1;-- ref lit fragment, if any, at least this big (avoid global 0)
nLits: CARDINAL;
nLitRefs: CARDINAL;
firstLit: SymLitIndex;-- tight bound after Reset
litMapId: ISEIndex;
EnterLit: PROC[item: RefLitItem] = {
key: SymLitRecord.lit = [lit[item]];
slLimit: SymLitIndex = table.Top[SymbolSegment.atType];
nLitRefs ← nLitRefs + 1;
FOR sli: SymLitIndex ← SymLitFirst, sli+SymLitRecord.SIZE UNTIL sli = slLimit DO
WITH s: slb[sli] SELECT FROM
lit => IF s = key THEN EXIT;
ENDCASE;
REPEAT
FINISHED => InsertLit[item];
ENDLOOP
};
LitIndex: PROC[item: RefLitItem] RETURNS[RTBcd.RefLitIndex] = {
key: SymLitRecord.lit = [lit[item]];
i: CARDINAL ← 0;
FOR sli: SymLitIndex ← firstLit, sli+SymLitRecord.SIZE WHILE i < nLits DO
WITH s: slb[sli] SELECT FROM
lit => IF s = key THEN EXIT;
ENDCASE;
i ← i+1;
REPEAT
FINISHED => ERROR;
ENDLOOP;
RETURN[[i]]};
InsertLit: PROC[item: RefLitItem] = {
sli: SymLitIndex = table.Words[atType, SymLitRecord.SIZE];
slb[sli] ← [lit[item]];
nLits ← nLits + 1};
EnterAtom: PUBLIC PROC[name: Name] = {EnterLit[[atom[pName: name]]]};
AtomIndex: PUBLIC PROC[name: Name] RETURNS[RTBcd.RefLitIndex] = {
RETURN[LitIndex[[atom[pName: name]]]]};
AtomRef: PUBLIC PROC[name: Name] RETURNS[Tree.Link] = {
RETURN[IndexedRef[litMapId, AtomIndex[name], dataPtr.typeATOM]]};
EnterText: PUBLIC PROC[sti: Literals.STIndex] = {EnterLit[[text[value: sti]]]};
TextIndex: PUBLIC PROC[sti: Literals.STIndex] RETURNS[RTBcd.RefLitIndex] = {
RETURN[LitIndex[[text[value: sti]]]]};
TextRef: PUBLIC PROC[sti: Literals.STIndex] RETURNS[Tree.Link] = {
RETURN[IndexedRef[litMapId, TextIndex[sti], dataPtr.typeRefANY]]};
DescribeRefLits: PUBLIC PROC RETURNS[offset, length: CARDINAL] = {
temp: INTEGER ← WordOffset[litMapId];
IF dataPtr.switches['z] THEN temp ← - temp;
RETURN[offset: LOOPHOLE[temp, CARDINAL], length: nLits]};
EnumerateRefLits: PUBLIC PROC[scan: PROC[RefLitItem]] = {
i: CARDINAL ← 0;
FOR sli: SymLitIndex ← firstLit, sli+SymLitRecord.SIZE WHILE i < nLits DO
WITH s: slb[sli] SELECT FROM
lit => {scan[s.info]; i ← i+1};
ENDCASE;
ENDLOOP
};
PadRefLits: PROC[pad: BOOL] = INLINE {
IF nLits # 0 THEN {
totalLits: CARDINAL = (IF pad THEN ((nLits+3)/4)*4 ELSE nLits);
someLit: RefLitItem;-- need a null RefLitItem
FindLit: PROC[item: RefLitItem] = {someLit ← item};
EnumerateRefLits[FindLit];
FOR i: NAT IN [nLits .. MAX[minLitRefs, totalLits]) DO InsertLit[someLit] ENDLOOP}
};
state transitions
Initialize: PUBLIC PROC[ownTable: Alloc.Handle] = {
table ← ownTable; table.AddNotify[UpdateBases];
nLits ← nLitRefs ← 0; nTypes ← nTypeRefs ← 0;
firstLit ← SymLitFirst;-- see Reset
typeMapId ← litMapId ← ISENull};
Reset: PUBLIC PROC[pad: BOOL] = {
PadTypes[pad]; PadRefLits[pad];
IF nLits # 0 AND ~dataPtr.interface THEN {
IF dataPtr.switches['z] THEN {-- the new way
mapType: CSEIndex = CreateUnnamedMap[dataPtr.typeRefANY, nLits+1];
intermediateType ← mapType;
Hold on to this type in order to generate the double indirection
litMapId ← CreateMap["&map"L, dataPtr.typeRefANY, 1, 1];
Now the literal is a REF to an array (with a dummy word in front) that will hold the actual references
}
ELSE litMapId ← CreateMap["&refs"L, dataPtr.typeRefANY, nLits, nLitRefs]};
IF nTypes # 0 THEN {
slLimit: SymLitIndex = table.Top[atType];
lastType: SymLitIndex;
t: SymLitRecord;
lastType ← slLimit - SymLitRecord.SIZE;
DO
UNTIL firstLit = slLimit OR slb[firstLit].tag = lit DO
firstLit ← firstLit + SymLitRecord.SIZE ENDLOOP;
UNTIL slb[lastType].tag = type DO
lastType ← lastType - SymLitRecord.SIZE ENDLOOP;
IF lastType < firstLit THEN EXIT;
t ← slb[firstLit]; slb[firstLit] ← slb[lastType]; slb[lastType] ← t;
ENDLOOP;
IF ~dataPtr.interface
THEN typeMapId ← CreateMap["&types"L, typeANY, nTypes, nTypeRefs]}
};
Finalize: PUBLIC PROC = {table.DropNotify[UpdateBases]; table ← NIL};
utility routines
CreateMap: PROC[id: LONG STRING, cType: Type, nEntries, nRefs: CARDINAL]
RETURNS[sei: ISEIndex] = {
desc: ConvertUnsafe.SubString ← [base:id, offset:0, length:id.length];
mapType: CSEIndex ← CreateUnnamedMap[cType, nEntries];
sei ← SymbolOps.MakeCtxSe[SymbolOps.EnterString[desc], dataPtr.mainCtx];
seb[sei].idType ← mapType;
seb[sei].public ← seb[sei].extended ← seb[sei].constant ← seb[sei].linkSpace ← FALSE;
seb[sei].immutable ← TRUE;
seb[sei].idValue ← SymbolOps.EncodeTreeIndex[Tree.nullIndex];
seb[sei].idInfo ← SymbolOps.EncodeCard[nRefs];
seb[sei].mark3 ← seb[sei].mark4 ← TRUE;
RETURN};
CreateUnnamedMap: PROC[cType: Type, nEntries: CARDINAL]
RETURNS[mapType: CSEIndex] = {
iType: CSEIndex ← SymbolOps.MakeNonCtxSe[SERecord.cons.subrange.SIZE];
seb[iType].typeInfo ← subrange[
filled: TRUE, empty: FALSE, biased: TRUE,
rangeType: dataPtr.idINTEGER,
origin: 0, range: nEntries-1];
seb[iType].mark3 ← seb[iType].mark4 ← TRUE;
mapType ← SymbolOps.MakeNonCtxSe[SERecord.cons.array.SIZE];
seb[mapType].typeInfo ← array[packed: FALSE, indexType: iType, componentType: cType];
seb[mapType].mark3 ← seb[mapType].mark4 ← TRUE;
RETURN};
intermediateType: Type;
WordOffset: PROC[sei: ISEIndex] RETURNS[offset: CARDINAL] = INLINE {
IF sei = ISENull THEN offset ← 0
ELSE {
addr: BitAddress = SymbolOps.DecodeBitAddr[seb[sei].idValue];
offset ← addr / bitsPerWord};
RETURN};
IndexedRef: PROC[array: ISEIndex, item: CARDINAL, type: CSEIndex] RETURNS[Tree.Link] = {
OPEN TreeOps;
IF dataPtr.switches['z] AND type # typeANY THEN { -- must go one level indirect
PushSe[array]; PushNode[uparrow, 1];
SetAttr[1, TRUE]; SetAttr[2, TRUE];
SetInfo[SymbolOps.FromType[intermediateType]];
PushLit[LiteralOps.Find[item+1]]; PushNode[index, 2]}
ELSE {PushSe[array]; PushLit[LiteralOps.Find[item]]; PushNode[index, 2]};
SetAttr[2, FALSE]; SetInfo[SymbolOps.FromType[type]];
RETURN[PopTree[]]};
}.