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 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: Rope.ROPE;
lhsHti: Symbols.HTIndex;
sti, last: Symbols.STIndex;
rhsFti: BcdDefs.FTIndex;
ss: ConvertUnsafe.SubString;
FOR n:
CARDINAL
IN [0 .. CommandUtil.ListLength[data.commandArgs])
DO {
[lhs, rhs] ← CommandUtil.GetNthPair[list~data.commandArgs, n~n];
ss.offset ← 0;
ss.length ← lhs.Length[];
ss.base ← LOOPHOLE[Rope.Flatten[lhs]];
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[Rope.Flatten[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;
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 ← ConvertUnsafe.SubStringToRope[name];
fti ← BcdUtilDefs.EnterFile[LOOPHOLE[Rope.Flatten[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};
}.