DIRECTORY
Alloc: TYPE USING [AddNotify, DropNotify, Notifier],
BcdComData: TYPE USING [commandArgs, currentName, table, textIndex],
BcdControlDefs: TYPE USING [],
BcdDefs: TYPE USING [cttype, cxtype, FTIndex, FTNull, NameRecord, sttype, treetype],
BcdUtilDefs: TYPE USING [EnterFile, NameForSti, NewContext, NewSemanticEntry],
CommandUtil: TYPE USING [GetNthPair, ListLength],
ConvertUnsafe: TYPE USING [SubString, SubStringToRope],
HashOps: TYPE USING [EnterString, SubStringForHash],
Rope: TYPE USING [Flatten, Length, ROPE],
Symbols: TYPE USING [CXIndex, HTIndex, STIndex, stNull],
Table: TYPE USING [Base],
Tree: TYPE USING [Index, Link, Map, null],
TreeOps: TYPE USING [FreeNode, GetNode, UpdateList];

BcdSEBuild: PROGRAM
  IMPORTS
Alloc, BcdUtilDefs, CommandUtil, ConvertUnsafe, HashOps, Rope, TreeOps, data: BcdComData
  EXPORTS BcdControlDefs = {
OPEN BcdDefs, Symbols;

BuildSEError: PUBLIC ERROR ~ CODE;

tb, stb, ctb, cxb: Table.Base;

Notifier: Alloc.Notifier ~ {
tb  _ base[treetype]; stb _ base[sttype];  
cxb _ base[cxtype]; ctb _ base[cttype]};


currentCtx, directoryCtx: CXIndex;

BuildSemanticEntries: PUBLIC PROC[root: Tree.Link] ~ {
node: Tree.Index;
(data.table).AddNotify[Notifier];
node _ TreeOps.GetNode[root];
IF tb[node].name # $source THEN ERROR BuildSEError;
currentCtx _ directoryCtx _ BcdUtilDefs.NewContext[];
IF (data.commandArgs).ListLength > 0 THEN EnterArgsAsDirItems[];
tb[node].son[1] _ TreeOps.UpdateList[tb[node].son[1], DirItem];
currentCtx _ BcdUtilDefs.NewContext[];
tb[node].son[2] _ TreeOps.UpdateList[tb[node].son[2], PackId];
currentCtx _ BcdUtilDefs.NewContext[];
tb[node].son[3] _ Stmt[tb[node].son[3]];
(data.table).DropNotify[Notifier]};

Stmt: Tree.Map ~ {
WITH t SELECT FROM
hash => v _ Item[t];
symbol => v _ Item[t];
subtree => {
node: Tree.Index ~ index;
saveIndex: CARDINAL ~ data.textIndex;
data.textIndex _ tb[node].info;
v _ SELECT tb[node].name FROM
$list   =>  TreeOps.UpdateList[t, Stmt],
$item   =>  Item[t],
$config =>  Config[node],
$assign =>  Assign[node],
$plus, $then => Expression[t],
$module =>  Module[node],
ENDCASE => ERROR BuildSEError;
data.textIndex _ saveIndex};
ENDCASE => ERROR BuildSEError;
RETURN};

PackId: Tree.Map ~ {
RETURN [WITH t SELECT FROM
hash => SemanticEntry[t],
subtree => TreeOps.UpdateList[t, PackId],
ENDCASE => ERROR BuildSEError]
};

ProcessItem: PROC[t: Tree.Link] RETURNS[tl: Tree.Link, st1,st2: STIndex] ~ {
stl: Tree.Link.symbol;
st2 _ stNull;
WITH tt~~t SELECT FROM
symbol => {tl _ tt; st1 _ tt.index};
hash => {tl _ stl _ SemanticEntry[t]; st1 _ stl.index};
subtree => {
OPEN tb[tt.index];
tl _ t;
son[1] _ stl _ SemanticEntry[son[1]];  st1 _ stl.index;
IF son[2] # Tree.null THEN {
stb[st1].filename _ FALSE;
son[2] _ stl _ SemanticEntry[son[2]];  st2 _ stl.index;
stb[st1].body _ external[pointer~instance[st2], map~[unknown[]]]}};
ENDCASE => ERROR BuildSEError;
RETURN};

SetFilename: PROC[sti: STIndex] ~ {
OPEN stb[sti];
IF ~stb[sti].filename AND stb[sti].type = $unknown THEN {
stb[sti].filename _ TRUE;
stb[sti].body _ external[pointer~file[FTNull], map~[unknown[]]]}
};

Item: Tree.Map ~ {
st1, st2: STIndex;
[v, st1, st2] _ ProcessItem[t];
SetFilename[IF st2 = stNull THEN st1 ELSE st2];
RETURN}; 

EnterArgsAsDirItems: PROC ~ { 
lhs, rhs: Rope.ROPE;
lhsHti: Symbols.HTIndex;
sti, last: Symbols.STIndex;
rhsFti: BcdDefs.FTIndex;
ss: ConvertUnsafe.SubString;
FOR n: CARDINAL IN [0 .. (data.commandArgs).ListLength) DO {
[lhs, rhs] _ (data.commandArgs).GetNthPair[n]; 
ss.offset _ 0;
ss.length _ lhs.Length[];
ss.base _ LOOPHOLE[lhs.Flatten[]];
lhsHti _ HashOps.EnterString[ss]; 
last _ Symbols.stNull;
FOR sti _ cxb[directoryCtx].link, stb[sti].link UNTIL sti = Symbols.stNull DO
IF stb[sti].hti = lhsHti THEN GOTO AlreadyEntered;
last _ sti;
ENDLOOP;
sti _ BcdUtilDefs.NewSemanticEntry[lhsHti]; 
IF last = Symbols.stNull THEN cxb[directoryCtx].link _ sti
ELSE stb[last].link _ sti;
rhsFti _ BcdUtilDefs.EnterFile[LOOPHOLE[rhs.Flatten[]]];
stb[sti].body _ external[map~[unknown[]], pointer~file[rhsFti]];
EXITS
AlreadyEntered => NULL};
ENDLOOP
}; 

DirItem: Tree.Map ~ {
lhs: Tree.Link;
lhsHti: Symbols.HTIndex;
dirSti, sti: STIndex;
stl: Tree.Link.symbol;
fti: FTIndex;
fileName: Rope.ROPE;
name: ConvertUnsafe.SubString;
WITH t SELECT FROM
subtree => {
lhs _ tb[index].son[1]; 
WITH lhs SELECT FROM
hash => lhsHti _ index;
ENDCASE => ERROR BuildSEError; 
FOR dirSti _ cxb[directoryCtx].link, stb[dirSti].link UNTIL dirSti = Symbols.stNull DO
IF stb[dirSti].hti = lhsHti THEN RETURN [t];  -- already inserted
ENDLOOP;
stl _ SemanticEntry[lhs];
sti _ stl.index;
WITH s2~~tb[index].son[2] SELECT FROM
hash => name _ HashOps.SubStringForHash[s2.index];
ENDCASE};
ENDCASE;
fileName _ name.SubStringToRope;
fti _ BcdUtilDefs.EnterFile[LOOPHOLE[fileName.Flatten[]]];
stb[sti].body _ external[map~[unknown[]], pointer~file[fti]];
RETURN [t]}; 

ImpItem: Tree.Map ~ {
st1: STIndex;
[v, st1, ] _ ProcessItem[t];  stb[st1].imported _ TRUE;
RETURN}; 

ExpItem: Tree.Map ~ {
st1: STIndex;
[v, st1, ] _ ProcessItem[t];  stb[st1].exported _ TRUE;
RETURN}; 

Config: PROC[node: Tree.Index] RETURNS[Tree.Link] ~ {
OPEN tb[node];
saveCx: CXIndex ~ currentCtx;
saveName: NameRecord ~ data.currentName;
SeEntry: Tree.Map ~ {RETURN [SemanticEntry[t]]};
EnterConfig[node];  -- name
son[1] _ TreeOps.UpdateList[son[1], ImpItem];	-- IMPORTS
son[2] _ TreeOps.UpdateList[son[2], ExpItem];	-- EXPORTS
son[3] _ TreeOps.UpdateList[son[3], SeEntry];	-- CONTROL
son[5] _ TreeOps.UpdateList[son[5], Stmt];		-- body
currentCtx _ saveCx;  data.currentName _ saveName;
RETURN [[subtree[node]]]};

AssignItem: Tree.Map ~ {
st1, st2: STIndex;
[v, st1, st2] _ ProcessItem[t];
stb[st1].assigned _ TRUE;
IF stb[st1].filename THEN {
OPEN stb[st1];
filename _ FALSE;
body _ external[pointer~instance[st2], map~[unknown[]]]};
IF st2 # stNull THEN {
OPEN stb[st2];
assigned _ TRUE;
filename _ FALSE;
body _ external[pointer~instance[stNull], map~[unknown[]]]};
RETURN}; 

Assign: PROC[node: Tree.Index] RETURNS[Tree.Link] ~ {
tb[node].son[1] _ TreeOps.UpdateList[tb[node].son[1], AssignItem];
tb[node].son[2] _ Expression[tb[node].son[2]];
RETURN [[subtree[node]]]};

Expression: Tree.Map ~ {
WITH t SELECT FROM
symbol => v _ ProcessItem[t].tl;
hash => v _ ProcessItem[t].tl;
subtree =>
SELECT tb[index].name FROM
$item => v _ ProcessItem[t].tl;
$module => v _ Module[index];
$plus, $then => {
OPEN tb[index];
son[1] _ Expression[son[1]];  son[2] _ Expression[son[2]];
v _ t};
ENDCASE => ERROR BuildSEError;
ENDCASE => ERROR BuildSEError;
RETURN};

ModItem: Tree.Map ~ {
RETURN [WITH t SELECT FROM 
symbol => t,
hash => SemanticEntry[t],
ENDCASE => ERROR BuildSEError]};

Module: PROC[node: Tree.Index] RETURNS[Tree.Link] ~ {
tb[node].son[1] _ Item[tb[node].son[1]];
tb[node].son[2] _ TreeOps.UpdateList[tb[node].son[2], ModItem];
RETURN [[subtree[node]]]};

SemanticEntry: PROC[tl: Tree.Link] RETURNS[Tree.Link.symbol] ~ {
sti, dirSti: STIndex;
last: STIndex _ stNull;
WITH t~~tl SELECT FROM
symbol => RETURN [t];
hash => {
FOR sti _ cxb[currentCtx].link, stb[sti].link UNTIL sti = stNull DO
IF stb[sti].hti = t.index THEN RETURN [[symbol[sti]]];
last _ sti;
ENDLOOP;
FOR dirSti _ cxb[directoryCtx].link, stb[dirSti].link UNTIL dirSti = stNull DO
IF stb[dirSti].hti = t.index THEN EXIT  ENDLOOP;
sti _ BcdUtilDefs.NewSemanticEntry[t.index];
IF last = stNull THEN cxb[currentCtx].link _ sti
ELSE stb[last].link _ sti;
IF dirSti # stNull THEN {stb[sti] _ stb[dirSti]; stb[sti].link _ stNull};
RETURN [[symbol[sti]]]};
subtree => {
node: Tree.Index ~ t.index;
l: Tree.Link;
SELECT tb[node].name FROM
$dot => {l _ tb[node].son[1]; tb[node].son[1] _ Tree.null};
$slash => {l _ tb[node].son[2]; tb[node].son[2] _ Tree.null};
ENDCASE => ERROR BuildSEError;
TreeOps.FreeNode[node];
RETURN [SemanticEntry[l]]};
ENDCASE => ERROR BuildSEError};

EnterConfig: PROC[node: Tree.Index] ~ {
sti: STIndex;
stl: Tree.Link.symbol ~ SemanticEntry[tb[node].son[4]];
tb[node].son[4] _ stl;
stb[(sti _ stl.index)].filename _ FALSE;
currentCtx _ BcdUtilDefs.NewContext[];
data.currentName _ BcdUtilDefs.NameForSti[sti];
SELECT stb[sti].type FROM
$unknown => stb[sti].body _ local[info~node, context~currentCtx, map~[unknown[]]];
ENDCASE => ERROR BuildSEError
};

}.


4BcdSEBuild.mesa
Copyright c 1985 by Xerox Corporation.  All rights reserved.
Satterthwaite on March 14, 1986 11:53:21 am PST
Lewis on 17-Dec-80 16:30:26
Maxwell, August 11, 1983 2:46 pm
Russ Atkinson (RRA) March 7, 1985 0:16:28 am PST

enter Idi: FileNamei pairs from command line as DIRECTORY entries
ΚY˜
codeš
œ™Kšœ
Οm
œ1™<Kš
œ/™/Kš
œ™Kš
œ ™ K™0—K™š
Οk	˜	Kšœžœ
žœ#˜4Kšœžœ
žœ.˜DKšœžœ
žœ˜Kšœ	žœ
žœA˜TKšœ
žœ
žœ7˜NKšœ
žœ
žœ˜1Kšœžœ
žœ˜7Kšœ	žœ
žœ!˜4Kšœžœ
žœžœ˜)Kšœ	žœ
žœ%˜8Kšœžœ
žœ˜Kšœžœ
žœ˜*Kšœ	žœ
žœ!˜4K˜—šœž˜š
ž	˜	Kš
œX˜X—Kšž	œ˜Kšžœ˜K˜Kšœžœ
žœžœ
˜"K˜K˜K˜˜K˜+K˜(K˜K˜—K˜"K˜šΟnœžœ
žœ˜6K˜K˜!K˜Kšžœžœ
žœ˜3K˜5Kšžœ#žœ˜@K˜?K˜&K˜>K˜&K˜(K˜#K˜—˜šžœžœ
ž˜K˜K˜˜K˜Kšœžœ˜%K˜šœžœž˜K˜(K˜K˜K˜K˜K˜Kšžœžœ˜—K˜—Kšžœžœ˜—Kšžœ˜K˜—˜šžœžœžœ
ž˜K˜K˜)Kšžœžœ˜—š
œ˜K˜——šŸœžœžœ%˜LK˜K˜
šžœžœ
ž˜K˜$K˜7˜Kšžœ˜K˜K˜7šžœžœ˜Kšœžœ
˜K˜7K˜C——Kšžœžœ˜—Kšžœ˜K˜—šŸœžœ˜#Kšžœ
˜šžœžœžœ˜9Kšœžœ
˜K˜@—˜K˜——˜K˜K˜Kšœžœžœžœ˜/Kšžœ˜	K˜—šŸœžœ˜Kš
œA™AKšœžœ
˜K˜K˜K˜K˜šžœžœ
žœ&žœ˜<K˜/K˜Kš
œ˜Kšœ
žœ˜"Kš
œ"˜"K˜šžœ-žœž˜MKšžœžœ
žœ˜2K˜Kšžœ
˜—K˜,šžœžœ˜:Kšžœ˜—Kšœžœ˜8K˜@š
ž˜Kšœžœ˜—Kš
ž˜—š
œ˜K˜——˜K˜K˜K˜K˜K˜
Kšœžœ
˜K˜šžœžœ
ž˜˜K˜šžœžœ
ž˜K˜Kšžœžœ˜—šžœ3žœž˜VKšžœžœ
žœΟc˜AKšžœ
˜—K˜K˜šžœžœ
ž˜%K˜2Kšžœ˜	——Kšžœ
˜—K˜ Kšœžœ˜:K˜=Kšžœ˜
K˜—˜K˜
Kšœ2žœ
˜7Kšžœ˜	K˜—˜K˜
Kšœ2žœ
˜7Kšžœ˜	K˜—šŸœžœžœ˜5Kšžœ
˜K˜K˜(Kšœžœ˜0Kšœ ˜Kšœ. 
˜8Kšœ. 
˜8Kšœ. 
˜8Kšœ, ˜3K˜2Kšžœ˜K˜—˜K˜K˜Kšœžœ
˜šžœžœ˜Kšžœ
˜Kšœžœ
˜K˜9—šžœžœ˜Kšžœ
˜Kšœžœ
˜Kšœžœ
˜K˜<—Kšžœ˜	K˜—šŸœžœžœ˜5K˜BK˜.Kšžœ˜K˜—˜šžœžœ
ž˜K˜ K˜˜
šžœž˜K˜K˜˜Kšžœ˜K˜:K˜—Kšžœžœ˜——Kšžœžœ˜—Kšžœ˜K˜—˜šžœžœžœ
žœ
˜K˜K˜Kšžœžœ˜ K˜——šŸœžœžœ˜5K˜(K˜?Kšžœ˜K˜—šŸ
œžœžœ˜@K˜K˜šžœžœ
ž˜Kšœ
žœ˜˜	šžœ+žœž˜CKšžœžœ
žœ˜6K˜Kšžœ
˜—šžœ3žœž˜NKšžœžœ
žœžœ
˜0—K˜,šžœžœ˜0Kšžœ˜—Kšžœžœ2˜IKšžœ˜—˜K˜K˜
šžœž˜K˜;K˜=Kšžœžœ˜—K˜Kšžœ˜—Kšžœžœ˜K˜——šŸœžœ˜'K˜
K˜7K˜Kšœ"žœ
˜(K˜&K˜/šžœž˜K˜RKšžœžœ
˜—š
œ˜K˜——K˜K˜——…— )§