-- BcdSEBuild.mesa
-- Last edited by Satterthwaite on September 14, 1982 4:10 pm
-- Last edited by Lewis on 17-Dec-80 16:30:26
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],
CommandUtil: TYPE USING [GetNthPair, ListLength, PairList],
Symbols: TYPE USING [CXIndex, HTIndex, STIndex, STNull],
SymbolOps: TYPE USING [EnterString, SubStringForHash],
BcdUtilDefs: TYPE USING [EnterFile, NameForSti, NewContext, NewSemanticEntry],
Strings: TYPE USING [AppendSubString, String, SubStringDescriptor],
Table: TYPE USING [Base],
Tree: TYPE USING [Index, Link, Map, Null],
TreeOps: TYPE USING [FreeNode, GetNode, UpdateList];
BcdSEBuild: PROGRAM
IMPORTS Alloc, BcdUtilDefs, CommandUtil, Strings, SymbolOps, 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 CommandUtil.ListLength[data.commandArgs] > 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 ~ {
-- enter Idi: FileNamei pairs from command line as DIRECTORY entries
lhs, rhs: Strings.String;
lhsSS: Strings.SubStringDescriptor;
lhsHti: Symbols.HTIndex;
sti, last: Symbols.STIndex;
rhsFti: BcdDefs.FTIndex;
FOR n: CARDINAL IN [0 .. CommandUtil.ListLength[data.commandArgs]) DO {
[lhs, rhs] ← CommandUtil.GetNthPair[list~data.commandArgs, n~n];
lhsSS ← [base~lhs, offset~0, length~lhs.length];
lhsHti ← SymbolOps.EnterString[@lhsSS];
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[rhs];
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];
fileName: STRING ← [40];
fti: FTIndex;
name: Strings.SubStringDescriptor;
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 => SymbolOps.SubStringForHash[@name, s2.index];
ENDCASE};
ENDCASE;
Strings.AppendSubString[fileName, @name];
fti ← BcdUtilDefs.EnterFile[fileName];
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};
}.