DIRECTORY
Alloc: TYPE USING [Handle, Notifier, AddNotify, DropNotify, Top, Words],
ComData: TYPE USING [
idINT, interface, mainCtx, ownSymbols, 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, StandardContext, lZ, OwnMdi, MDNull,
typeANY, ctxType, seType],
SymbolOps: TYPE USING [
ClusterSe, EnterString, FirstCtxSe, MakeCtxSe, MakeNonCtxSe, NextSe, TypeForm,
UnderType],
SymbolSegment: TYPE USING [atType],
SymLiteralOps: TYPE USING [RefLitItem],
Table: TYPE USING [Base, Limit, 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;


SymLitRecord: TYPE = RECORD [
SELECT tag: * FROM
type => [canonical: BOOL, typeCode: Type],
lit => [info: RefLitItem]
ENDCASE];

SymLitIndex: TYPE = Table.Base RELATIVE ORDERED POINTER[0..Table.Limit) TO SymLitRecord;


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]};



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)]};



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 c.level = lZ THEN {index _ sei; mdi _ OwnMdi}
ELSE {index _ 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 StandardContext THEN MDNull ELSE OwnMdi,
record => IF t.fieldCtx IN StandardContext THEN MDNull ELSE OwnMdi,
opaque => IF Predeclared[t.id] THEN MDNull ELSE OwnMdi,
ENDCASE => OwnMdi};
ENDCASE;
RETURN};

Predeclared: PROC [type: Type] RETURNS [BOOL] = {
RETURN [type = nullType OR (
WITH se: seb[type] SELECT FROM
id => se.idCtx IN (CTXNull .. StandardContext.LAST],
ENDCASE => FALSE)]};



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 _ SymLitIndex.FIRST, 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 _ SymLitIndex.FIRST, 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 _ SymLitIndex.FIRST, 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}};



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[item]];
slLimit: SymLitIndex = table.Top[SymbolSegment.atType];
nLitRefs _ nLitRefs + 1;
FOR sli: SymLitIndex _ SymLitIndex.FIRST, sli+SymLitRecord.SIZE UNTIL sli = slLimit DO
IF slb[sli] = key THEN EXIT;
REPEAT
FINISHED => InsertLit[item];
ENDLOOP};

LitIndex: PROC [item: RefLitItem] RETURNS [RTBcd.RefLitIndex] = {
key: SymLitRecord = [lit[item]];
i: CARDINAL _ 0;
FOR sli: SymLitIndex _ firstLit, sli+SymLitRecord.SIZE WHILE i < nLits DO
IF slb[sli] = key THEN EXIT;  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] = {
RETURN [offset: WordOffset[litMapId], 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}};



Initialize: PUBLIC PROC [ownTable: Alloc.Handle] = {
table _ ownTable; table.AddNotify[UpdateBases];
nLits _ nLitRefs _ 0;  nTypes _ nTypeRefs _ 0;
firstLit _ SymLitIndex.FIRST;	-- see Reset
typeMapId _ litMapId _ ISENull};

Reset: PUBLIC PROC [pad: BOOL] = {
PadTypes[pad];  PadRefLits[pad];
IF nLits # 0 AND ~dataPtr.interface THEN
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};



CreateMap: PROC [id: LONG STRING, cType: Type, nEntries, nRefs: CARDINAL]
RETURNS [sei: ISEIndex] = {
desc: ConvertUnsafe.SubString _ [base:id, offset:0, length:id.length];
mapType, iType: CSEIndex;
sei _ SymbolOps.MakeCtxSe[SymbolOps.EnterString[desc], dataPtr.mainCtx];
iType _ SymbolOps.MakeNonCtxSe[SERecord.cons.subrange.SIZE];
seb[iType].typeInfo _ subrange[
filled: TRUE, empty: FALSE,
rangeType: dataPtr.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, indexType: iType, componentType: cType];
seb[mapType].mark3 _ seb[mapType].mark4 _ TRUE;
seb[sei].idType _ mapType;
seb[sei].public _ seb[sei].extended _ seb[sei].constant _ seb[sei].linkSpace _ FALSE;
seb[sei].immutable _ TRUE;
seb[sei].idValue _ Tree.NullIndex;  seb[sei].idInfo _ nRefs;
seb[sei].mark3 _ seb[sei].mark4 _ TRUE;
RETURN};

WordOffset: PROC [sei: ISEIndex] RETURNS [offset: CARDINAL] = {
IF sei = ISENull THEN offset _ 0
ELSE {
addr: BitAddress = seb[sei].idValue;
offset _ addr.wd};
RETURN};

IndexedRef: PROC [array: ISEIndex, item: CARDINAL, type: CSEIndex] RETURNS [Tree.Link] = {
OPEN TreeOps;
PushSe[array];  PushLit[LiteralOps.Find[item]];  PushNode[index, 2];
SetAttr[2, FALSE];  SetInfo[type];
RETURN [PopTree[]]};

}.




file SymLiteralPack.mesa
last modified by Satterthwaite, April 15, 1983 1:28 pm
Last Edited by: Maxwell, July 28, 1983 10:21 am
types
bases
auxiliary type predicates
universal type fingers
typeIds
atoms and REFs to literals
state transitions
utility routines
�Ê
јJš
œ™Jš
œ6™6J™/J˜š
Ïk	˜	Jšœ�œ
�œ7˜Hšœ	�œ
�œ˜J˜=—Jšœ�œ
�œ
˜&Jšœ
�œ
�œ˜Jšœ�œ
�œ˜Jšœ�œ
�œ˜+šœ	�œ
�œ˜J˜J˜>J˜@J˜—šœ�œ
�œ˜J˜NJ˜—Jšœ�œ
�œ
˜#Jšœ�œ
�œ˜'Jšœ�œ
�œ˜*Jšœ�œ
�œ˜#Jšœ	�œ
�œ8˜KJšœ�œ
�œ˜J˜—šœ�˜š
�˜J˜-J˜—Jš�œ˜Jš�œ	˜
J˜Jšœ�œ˜,J˜Jš
œ™˜šœ�œ�œ˜š�œ�˜Jšœ�œ˜*J˜Jš�œ˜	J˜——Jšœ
�œ�œ
�œ
�œ�œ˜XJ˜—Jš
œ™˜J˜J˜J˜.J˜J˜J˜J˜˜J˜)J˜(J˜J˜——Jš
œ™˜Jš	œ	�œ�œ�œ�œ
˜5J˜šÏn	œ�œ�œ�œ˜5Jš�œ�œ%�œ�œ˜PJ˜—šž
œ�œ�œ�œ˜6š�œ�œ�œ
�˜(J˜>˜š�œ�œ
�˜"˜š�œ�œ
�˜˜	š�œ�œ
�˜˜	šœ�˜šœ
�œ
�œ˜"šœ
�œ˜Jš
�˜˜"Jšœ�œ�œ
�œ
�œ�œ˜<—————Jš�œ�œ
˜——˜š�œ�œ
�˜˜šœ�œ�˜;Jšœ�œ$˜C——Jš�œ�œ
˜——˜š�œ�œ
�˜J˜/Jš�œ�œ
˜——Jš
œ�œ�œ
�œ�œ�œ�œ
˜@Jš�œ˜——Jš�œ�œ
˜——Jš�œ�œ˜J˜——šž	œ�œ�œ�œ˜9J˜,J˜,š�œ
�˜š�œ!�œ1�˜ZJš�œ�œ˜—J˜>Jš�œ
˜—Jš�œ˜J˜J˜—šž
œ�œ�œ�œ˜6š�œ�œ˜˜J˜/J˜1Jš�œ˜J˜———š
žœ�œ�œ�œ�œ˜8Jš�œ#�œ�œ˜VJ˜J˜——Jš
œ™˜šžœ�œ
�œ�œ ˜IJ˜&š�œ�œ
�˜˜J˜š�œ�œ
�˜˜Jš�œ�œ˜0Jš�œ&˜*—š�œ˜J˜Jšœ�œ�œ�œ
˜4———˜	J˜šœ�œ�œ
�˜J˜Jš	œ�œ�œ�œ�œ˜GJš	œ
�œ�œ�œ�œ˜CJšœ
�œ�œ�œ˜7Jš�œ˜——Jš�œ
˜—Jš�œ˜J˜—šžœ�œ�œ�œ˜1š�œ�œ˜š�œ�œ
�˜Jšœ�œ�œ˜4Jš�œ�œ˜J˜J˜————Jš
œ™˜Jšœ
�œÏc<˜TJ˜Jšœ�œ
˜Jšœ�œ
˜J˜J˜šž	œ�œ
�œ�œ˜8J˜&J˜7J˜š	�œ �œ�œ
�œ�˜Vš�œ
�œ
�˜˜š�œ�˜Jšœ
�œ�œ�œ�œ
�œ
˜I——Jš�œ
˜—š
�˜Jš�œ˜'—Jš�œ˜	J˜——š
ž	œ�œ
�œ�œ�œ˜RJ˜&Jšœ�œ˜š	�œ �œ�œ
�œ�˜Sš�œ
�œ
�˜˜š�œ�˜Jšœ
�œ�œ�œ�œ
�œ
˜I——Jš�œ
˜—J˜š
�˜Jš�œ�œ
˜—Jš�œ
˜—Jš�œ˜J˜—š
žœ�œ
�œ�œ�œ˜JJš�œ?˜EJ˜—š
ž
œ�œ
�œ
�œ�œ˜AJš�œ2˜8J˜—š
žœ�œ
�œ�œ
�œ˜JJšœ�œ˜š	�œ �œ�œ
�œ�˜Sš�œ
�œ
�˜J˜&Jš�œ
˜—J˜
Jš�œ˜	J˜J˜——šž
œ�œ�œ˜2Jšœ4�œ˜:J˜8J˜J˜—šžœ�œ�œ�œ˜%š�œ�œ˜Jš	œ�œ�œ�œ�œ	˜Bš	�œ�œ
�œ�œ�˜6Jšœ�œ�œ˜.J˜J˜————Jš
œ™˜Jšœ�œŸ?˜YJ˜Jšœ�œ
˜Jšœ
�œ
˜JšœŸ˜1J˜J˜šžœ�œ˜%J˜ J˜7J˜š	�œ �œ�œ
�œ�˜VJš�œ�œ
�œ
˜š
�˜Jš�œ˜—Jš�œ˜	J˜——šžœ�œ�œ˜AJ˜ Jšœ�œ˜š�œ/�œ
�œ�˜IJš�œ�œ
�œ˜&š
�˜Jš�œ�œ
˜—Jš�œ
˜—Jš�œ˜J˜—šž	œ�œ˜&Jšœ4�œ˜:J˜J˜J˜J˜—Jšž	œ�œ
�œ0˜FJ˜šž	œ�œ
�œ�œ˜CJš�œ"˜(J˜—šžœ�œ
�œ�œ˜9Jš�œ<˜BJ˜J˜—Jšž	œ�œ
�œ:˜PJ˜šž	œ�œ
�œ�œ˜NJš�œ!˜'J˜—šžœ�œ
�œ�œ˜DJš�œ=˜CJ˜J˜—š
žœ�œ
�œ
�œ�œ˜CJš�œ0˜6J˜—šžœ�œ
�œ�œ˜;Jšœ�œ˜š�œ/�œ
�œ�˜Iš�œ
�œ
�˜J˜Jš�œ
˜—Jš�œ˜	J˜——šž
œ�œ�œ�œ˜'š�œ�œ˜Jš	œ�œ�œ�œ�œ˜?JšœŸ˜.J˜Jšžœ�œ'˜4J˜J˜š	�œ�œ
�œ�œ�˜6Jšœ�œ˜J˜J˜————Jš
œ™˜šž
œ�œ
�œ˜4J˜/J˜.Jšœ�œŸ˜*J˜ J˜—šžœ�œ
�œ�œ˜"J˜ š�œ�œ�˜(J˜D—š�œ�œ˜J˜)J˜J˜Jšœ"�œ
˜'š
�˜š�œ�œ�˜6Jšœ#�œ
�œ
˜0—š�œ�˜!Jšœ#�œ
�œ
˜0—Jš�œ�œ
�œ
˜!J˜FJš�œ
˜—š�œ˜Jš�œ@˜DJ˜———Jšžœ�œ
�œ+�œ˜EJ˜J˜—Jš
œ™˜š
ž	œ�œ�œ
�œ �œ
˜IJš�œ˜J˜FJ˜J˜HJšœ6�œ˜<˜Jšœ�œ	�œ
˜J˜J˜—Jšœ&�œ
˜+Jšœ5�œ˜;Jšœ&�œ*˜UJšœ*�œ
˜/J˜JšœO�œ
˜UJšœ�œ
˜J˜<Jšœ"�œ
˜'Jš�œ˜J˜—šž
œ�œ�œ
�œ˜?Jš�œ�œ˜ š�œ˜J˜$J˜—Jš�œ˜J˜—šž
œ�œ�œ�œ˜ZJš�œ	˜
J˜DJšœ�œ˜"Jš�œ˜J˜—J˜J˜J˜———…—*¶9‘