SymLiteralOpsImpl.mesa
Copyright Ó 1985, 1986, 1987, 1988, 1991 by Xerox Corporation. All rights reserved.
Satterthwaite, June 18, 1986 12:22:45 pm PDT
Russ Atkinson (RRA) June 21, 1989 11:47:36 am PDT
DIRECTORY
Alloc USING [AddNotify, DropNotify, Handle, Notifier, Top, Units],
ConvertUnsafe USING [SubString],
LiteralOps USING [FindCard],
Literals USING [STIndex],
MimData USING [idATOM, idINT, interface, mainCtx, ownSymbols, typeRefANY],
RTMob USING [RefLitIndex, TypeIndex],
SymbolOps USING [ClusterSe, CtxLevel, DecodeBitAddr, DecodeType, EncodeCard, EncodeTreeIndex, EnterString, FirstCtxSe, FromType, MakeCtxSe, MakeNonCtxSe, NextSe, own, TypeForm, UnderType],
Symbols USING [Base, BitAddress, CSEIndex, CTXIndex, CTXNull, ctxType, FirstStandardCtx, ISEIndex, ISENull, LastStandardCtx, lZ, MDIndex, MDNull, Name, nullType, OwnMdi, SERecord, seType, Type, typeANY],
SymbolSegment USING [atType],
SymLiteralOps USING [RefLitItem, RefLitsVisitor, TypesVisitor],
Table USING [Base, IndexRep, Selector],
Target: TYPE MachineParms USING [bitOrder, bitsPerWord],
Tree USING [Link, nullIndex],
TreeOps USING [PopTree, PushLit, PushNode, PushSe, SetAttr, SetInfo],
Types USING [Equivalent];
SymLiteralOpsImpl: PROGRAM
IMPORTS Alloc, MimData, LiteralOps, SymbolOps, TreeOps, Types
EXPORTS SymLiteralOps = {
OPEN Symbols;
RefLitItem: TYPE = SymLiteralOps.RefLitItem;
bitsPerWord: NAT = Target.bitsPerWord;
Types
SymLitRecord: TYPE = RECORD [
used: BOOL,
cases: SELECT tag: * FROM
type => [typeCode: Type, canonical: BOOL],
lit => [type: Type, 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 ¬ NIL;
atType: Table.Selector = SymbolSegment.atType;
slb: Table.Base ¬ NIL;
seb: Symbols.Base ¬ NIL;
ctxb: Symbols.Base ¬ NIL;
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] = {
DO
IF key = entry THEN RETURN [TRUE];
WITH type1: seb[key] SELECT FROM
id => RETURN [SymbolOps.ClusterSe[SymbolOps.own, key]
= SymbolOps.ClusterSe[SymbolOps.own, entry]];
cons =>
WITH type2: seb[entry] SELECT FROM
cons =>
WITH t1: type1 SELECT FROM
record =>
WITH t2: type2 SELECT FROM
record => {
IF t1.fieldCtx = t2.fieldCtx THEN RETURN [TRUE];
IF t1.painted OR t2.painted THEN RETURN [FALSE];
IF SIGNAL Matched[key, entry] THEN RETURN [TRUE];
RETURN [IsoFields[t1.fieldCtx, t2.fieldCtx
! Matched => IF m1=key AND m2=entry THEN RESUME [TRUE]]];
};
ENDCASE;
ref =>
WITH t2: type2 SELECT FROM
ref =>
IF (t1.counted = t2.counted) AND (t1.ordered = t2.ordered)
AND (t1.readOnly = t2.readOnly)
AND (t1.length = t2.length) THEN {
key ¬ t1.refType;
entry ¬ t2.refType;
LOOP;
};
ENDCASE;
any => WITH t2: type2 SELECT FROM
any => RETURN [TRUE];
ENDCASE;
ENDCASE => RETURN [key = entry];
ENDCASE;
ENDCASE;
RETURN [FALSE];
ENDLOOP;
};
IsoFields: PROC [ctx1, ctx2: CTXIndex] RETURNS [BOOL] = {
sei1: ISEIndex ¬ SymbolOps.FirstCtxSe[SymbolOps.own, ctx1];
sei2: ISEIndex ¬ SymbolOps.FirstCtxSe[SymbolOps.own, 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[SymbolOps.own, sei1];
sei2 ¬ SymbolOps.NextSe[SymbolOps.own, sei2];
ENDLOOP;
RETURN [sei1 = sei2];
};
Equivalent: PROC [key, entry: Type] RETURNS [BOOL] = {
RETURN [(key = entry) OR (
Types.Equivalent[
[MimData.ownSymbols, SymbolOps.UnderType[SymbolOps.own, key]],
[MimData.ownSymbols, SymbolOps.UnderType[SymbolOps.own, entry]]]
AND ~Fuzzy[key, entry])]
};
Fuzzy: PROC [sei1, sei2: Type] RETURNS [BOOL] = INLINE {
RETURN [SymbolOps.TypeForm[SymbolOps.own, 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[SymbolOps.own, type];
WITH se: seb[sei] SELECT FROM
id => {
ctx: CTXIndex = se.idCtx;
WITH c: ctxb[ctx] SELECT FROM
included =>
IF SymbolOps.CtxLevel[SymbolOps.own, 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;
};
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
nTypes: CARDINAL ¬ 0;
nTypeRefs: CARDINAL ¬ 0;
typeMapId: ISEIndex ¬ ISENull;
EnterType: PUBLIC PROC [type: Type, canonical: BOOL, used: BOOL] = {
sei: Type = SymbolOps.ClusterSe[SymbolOps.own, type];
slLimit: SymLitIndex = table.Top[SymbolSegment.atType];
nTypeRefs ¬ nTypeRefs + 1;
IF alwaysCanonical THEN canonical ¬ TRUE;
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 {
IF used THEN s.used ¬ TRUE;
EXIT;
};
ENDCASE;
REPEAT
FINISHED => InsertType[sei, canonical, used];
ENDLOOP
};
TypeIndex: PUBLIC PROC [type: Type, canonical: BOOL, used: BOOL]
RETURNS [RTMob.TypeIndex] = {
sei: Type = SymbolOps.ClusterSe[SymbolOps.own, type];
i: CARDINAL ¬ 0;
IF alwaysCanonical THEN canonical ¬ TRUE;
FOR sli: SymLitIndex ¬ SymLitIndex.FIRST, sli+SymLitRecord.SIZE WHILE i < nTypes DO
WITH s: slb[sli] SELECT FROM
type => {
tc: Type ¬ s.typeCode;
IF tc = type THEN GO TO found;
SELECT canonical FROM
TRUE =>
We are looking for an equivalent type.
IF Equivalent[sei, tc] THEN GO TO found;
ENDCASE =>
We are looking for name equality.
IF NameEqual[sei, tc] THEN GO TO found;
EXITS found => {
IF used THEN s.used ¬ TRUE;
RETURN [[i]];
};
};
ENDCASE;
i ¬ i+1;
ENDLOOP;
ERROR;
};
alwaysCanonical: BOOL ¬ TRUE;
RRA: I think that this is a rather strange little remnant of the distinction between canonical types and types distinguuished by name as well. For using a type index it should be just fine to use any equivalent type index. HOWEVER, watch out for testing for equivalent types too early, since subranges (and therefore true type equality) are not completely evaluated until Pass 4, and the types have to be entered in Pass 3!
TypeRef: PUBLIC PROC [type: Type, canonical: BOOL] RETURNS [Tree.Link] = {
sei: Type = SymbolOps.ClusterSe[SymbolOps.own, type];
i: CARDINAL ¬ 0;
IF alwaysCanonical THEN canonical ¬ TRUE;
RETURN [IndexedRef[typeMapId, TypeIndex[type, canonical, TRUE], typeANY]];
};
DescribeTypes: PUBLIC PROC RETURNS [offset, length: CARD] = {
RETURN [offset: BitOffset[typeMapId], length: nTypes];
};
EnumerateTypes: PUBLIC PROC [scan: SymLiteralOps.TypesVisitor] = {
i: CARDINAL ¬ 0;
FOR sli: SymLitIndex ¬ SymLitFirst, sli+SymLitRecord.SIZE WHILE i < nTypes DO
WITH s: slb[sli] SELECT FROM
type => IF s.typeCode # Symbols.nullType THEN scan[s.typeCode, s.canonical, s.used];
ENDCASE;
i ¬ i + 1;
ENDLOOP
};
InsertType: PROC [type: Type, canonical: BOOL, used: BOOL] = {
sli: SymLitIndex = table.Units[atType, SymLitRecord.SIZE];
slb[sli] ¬ [used, type[canonical: canonical, typeCode: type]];
nTypes ¬ nTypes + 1;
};
Atoms and REFs to literals
nLits: CARDINAL ¬ 0;
nLitRefs: CARDINAL ¬ 0;
firstLit: SymLitIndex ¬ SymLitFirst; -- tight bound after Reset
litMapId: ISEIndex ¬ ISENull;
EnterLit: PROC [type: Type, item: RefLitItem] = {
slLimit: SymLitIndex = table.Top[SymbolSegment.atType];
nLitRefs ¬ nLitRefs + 1;
EnterType[type, alwaysCanonical, TRUE];
FOR sli: SymLitIndex ¬ SymLitFirst, sli+SymLitRecord.SIZE UNTIL sli = slLimit DO
WITH s: slb[sli] SELECT FROM
lit => IF s.info = item THEN EXIT;
ENDCASE;
REPEAT
FINISHED => InsertLit[item, type];
ENDLOOP
};
LitIndex: PROC [item: RefLitItem, used: BOOL ¬ FALSE] RETURNS [RTMob.RefLitIndex] = {
i: CARDINAL ¬ 0;
FOR sli: SymLitIndex ¬ firstLit, sli+SymLitRecord.SIZE WHILE i < nLits DO
WITH s: slb[sli] SELECT FROM
lit => IF s.info = item THEN {
IF used THEN s.used ¬ TRUE;
RETURN [[i]];
};
ENDCASE;
i ¬ i+1;
ENDLOOP;
ERROR;
};
InsertLit: PROC [item: RefLitItem, type: Type] = {
sli: SymLitIndex = table.Units[atType, SymLitRecord.SIZE];
slb[sli] ¬ [FALSE, lit[type, item]];
nLits ¬ nLits + 1;
};
EnterAtom: PUBLIC PROC [name: Name] = {
EnterLit[MimData.idATOM, [atom[pName: name]]];
};
AtomIndex: PUBLIC PROC [name: Name] RETURNS [RTMob.RefLitIndex] = {
RETURN [LitIndex[[atom[pName: name]], FALSE]];
};
AtomRef: PUBLIC PROC [name: Name] RETURNS [Tree.Link] = {
RETURN [IndexedRef[litMapId, LitIndex[[atom[pName: name]], TRUE], MimData.idATOM]];
};
EnterText: PUBLIC PROC [sti: Literals.STIndex, type: Type] = {
EnterLit[type, [text[value: sti]]];
};
TextIndex: PUBLIC PROC [sti: Literals.STIndex] RETURNS [RTMob.RefLitIndex] = {
RETURN [LitIndex[[text[value: sti]]]];
};
TextRef: PUBLIC PROC [sti: Literals.STIndex] RETURNS [Tree.Link] = {
RETURN [IndexedRef[litMapId, LitIndex[[text[value: sti]], TRUE], MimData.typeRefANY]];
};
DescribeRefLits: PUBLIC PROC RETURNS [offset, length: CARD] = {
temp: INT ¬ BitOffset[litMapId];
RETURN [offset: LOOPHOLE[temp, CARD], length: nLits];
};
EnumerateRefLits: PUBLIC PROC [scan: SymLiteralOps.RefLitsVisitor] = {
i: CARDINAL ¬ 0;
FOR sli: SymLitIndex ¬ firstLit, sli+SymLitRecord.SIZE WHILE i < nLits DO
WITH s: slb[sli] SELECT FROM
lit => {scan[s.info, s.type, s.used]; i ¬ i+1};
ENDCASE;
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] = {
IF nTypes # 0 THEN {
slLimit: SymLitIndex = table.Top[atType];
lastType: SymLitIndex ¬ 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: SymLitRecord ¬ slb[firstLit];
slb[firstLit] ¬ slb[lastType];
slb[lastType] ¬ t;
};
ENDLOOP;
IF ~MimData.interface THEN
typeMapId ¬ CreateMap["&types"L, typeANY, nTypes, nTypeRefs];
};
IF nLits # 0 THEN
IF NOT MimData.interface THEN
litMapId ¬ CreateMap["&refs"L, MimData.typeRefANY, nLits, nLitRefs];
};
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], MimData.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;
};
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: MimData.idINT,
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,
bitOrder: IF Target.bitOrder = msBit THEN msBit ELSE lsBit,
indexType: iType,
componentType: cType];
seb[mapType].mark3 ¬ seb[mapType].mark4 ¬ TRUE;
};
BitOffset: PROC [sei: ISEIndex] RETURNS [offset: CARD ¬ 0] = INLINE {
IF sei # ISENull THEN {
addr: BitAddress = SymbolOps.DecodeBitAddr[seb[sei].idValue];
offset ¬ addr;
};
};
IndexedRef: PROC [array: ISEIndex, item: CARDINAL, type: Type] RETURNS [Tree.Link] = {
TreeOps.PushSe[array];
TreeOps.PushLit[LiteralOps.FindCard[item]];
TreeOps.PushNode[index, 2];
TreeOps.SetAttr[2, FALSE];
TreeOps.SetInfo[SymbolOps.FromType[type]];
RETURN [TreeOps.PopTree[]];
};
}.