BcdSEBuild.mesa
Copyright © 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
 
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 ~ { 
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 .. (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
 
 
}.