-- ProcessingOrderImpl.mesa
-- Last edited by Lewis on 16-Dec-81 12:32:36
-- Last edited by Satterthwaite, December 30, 1982 9:58 am
DIRECTORY
Alloc: TYPE USING [AddNotify, DropNotify, Handle, Notifier, Words],
BcdDefs: TYPE USING [MTRecord, MTIndex, MTNull],
Error: TYPE USING [ImplicitCDIncludesModule, ModuleInTwoSegments],
PackagerDefs: TYPE USING [
globalData, GlobalData, packtreetype, packsttype, packpotype],
ProcessingOrder: TYPE,
SemanticEntry: TYPE USING [HTIndex, STIndex, STRecord],
SourceBcd: TYPE USING [
ComponentKind, CTreeIndex, EnumerateModules, EnumerateModulesInConfig,
IsModuleInConfig, IsTableCompiled, moduleCount, ModuleNum,
nullModuleNum, ModuleNumForMti],
Table: TYPE USING [Base, Limit],
Tree: TYPE USING [Index, Link, Scan, Test, nullIndex],
TreeOps: TYPE USING [
GetHash, GetNode, GetSe, ListHead, ListLength, ScanList, SearchList];
ProcessingOrderImpl: PROGRAM
IMPORTS Alloc, Error, PackagerDefs, SourceBcd, TreeOps
EXPORTS ProcessingOrder =
BEGIN OPEN ProcessingOrder;
POerror: PROC = {ERROR FindPOerror};
FindPOerror: PUBLIC ERROR = CODE;
gd: PackagerDefs.GlobalData ← NIL; -- set by Determine
table: Alloc.Handle ← NIL;
tb, stb, pob: Table.Base;
Notifier: Alloc.Notifier = {
tb ← base[PackagerDefs.packtreetype];
stb ← base[PackagerDefs.packsttype];
pob ← base[PackagerDefs.packpotype]};
-- ********************* Global Data Structures *********************** --
orderDetermined: BOOL ← FALSE;
-- Head of chain of PORecords for each module
poChainHead: LONG POINTER TO POChainMap;
POChainMap: TYPE = RECORD [SEQUENCE length: CARDINAL OF POIndex];
POIndex: TYPE = Table.Base RELATIVE POINTER[0..Table.Limit) TO PORecord;
poNull: POIndex = POIndex.LAST;
-- Indicates the next component description to process
PORecord: TYPE = RECORD [
treeNode: Tree.Index, -- component description's parse tree node
link: POIndex]; -- next PORecord in module's chain
InitializeChainHeads: PROC = {
poChainHead ← gd.zone.NEW[POChainMap[SourceBcd.moduleCount]];
FOR i: SourceBcd.ModuleNum IN [0..SourceBcd.moduleCount) DO
poChainHead[i] ← poNull;
ENDLOOP};
ReleaseChainHeads: PROC = {
IF poChainHead # NIL THEN gd.zone.FREE[@poChainHead]};
InsertInPOChain: PROC [mti: BcdDefs.MTIndex, cdNode: Tree.Index] = {
-- enter component description tree node in mti's p. o. chain
mNum: SourceBcd.ModuleNum;
newPO, last: POIndex;
IF mti # BcdDefs.MTNull THEN {
mNum ← SourceBcd.ModuleNumForMti[mti];
IF poChainHead[mNum] = poNull THEN { -- empty chain
newPO ← NewPORecord[];
pob[newPO] ← PORecord[treeNode: cdNode, link: poNull];
poChainHead[mNum] ← newPO}
ELSE
FOR p: POIndex ← poChainHead[mNum], pob[p].link UNTIL p = poNull DO
IF pob[p].treeNode = cdNode THEN RETURN; -- already in p.o. chain
last ← p;
REPEAT
FINISHED => {
newPO ← NewPORecord[];
pob[newPO] ← PORecord[treeNode: cdNode, link: poNull];
pob[last].link ← newPO};
ENDLOOP}};
NewPORecord: PROC RETURNS [newPO: POIndex] = {
newPO ← table.Words[PackagerDefs.packpotype, SIZE[PORecord]];
pob[newPO] ← PORecord[treeNode: Tree.nullIndex, link: poNull]};
-- ***************** Module Processing Order Determination ******************
Determine: PUBLIC PROC = {
IF orderDetermined THEN POerror[];
gd ← PackagerDefs.globalData;
table ← gd.ownTable;
table.AddNotify[Notifier];
InitializeChainHeads[];
EnterExplicitComponentDescs[];
EnterImplicitComponentDescs[];
EnterRemainingComponentDescs[]; -- main/ev/catchOfPL (implicit also)
orderDetermined ← TRUE;
VerifyModulesInOneSegment[]};
Destroy: PUBLIC PROC = {
ReleaseChainHeads[];
IF table # NIL THEN {table.DropNotify[Notifier]; table ← NIL};
gd ← NIL;
orderDetermined ← FALSE};
IsEmpty: PUBLIC PROC [mti: BcdDefs.MTIndex] RETURNS [reply: BOOL] = {
-- return TRUE if no component description nodes to be processed for mti
mNum: SourceBcd.ModuleNum = SourceBcd.ModuleNumForMti[mti];
IF ~orderDetermined THEN POerror[];
IF mNum = SourceBcd.nullModuleNum THEN POerror[];
RETURN[ poChainHead[mNum] = poNull ]};
Enumerate: PUBLIC PROC [
mti: BcdDefs.MTIndex,
userProc: PROC [cdNode: Tree.Index] RETURNS [stop: BOOL]] = {
-- output component description nodes to be processed for mti
mNum: SourceBcd.ModuleNum = SourceBcd.ModuleNumForMti[mti];
IF ~orderDetermined THEN POerror[];
IF mNum = SourceBcd.nullModuleNum THEN POerror[];
FOR i: POIndex ← poChainHead[mNum], pob[i].link UNTIL i = poNull DO
IF userProc[pob[i].treeNode] THEN RETURN;
ENDLOOP};
--****** Put Explicit Component Descriptions in Processing Order Chains ******
EnterExplicitComponentDescs: PROC = {
TreeOps.ScanList[gd.root, EnterExplicitCDsInSegments]};
EnterExplicitCDsInSegments: Tree.Scan =
BEGIN
segNode: Tree.Index = TreeOps.GetNode[t];
IF tb[segNode].name = codeSeg THEN EnterExplicitCDsInOneSeg[segNode]
END;
EnterExplicitCDsInOneSeg: PROC [segNode: Tree.Index] =
BEGIN
saveIndex: CARDINAL = gd.textIndex;
gd.textIndex ← tb[segNode].info;
TreeOps.ScanList[tb[segNode].son[2], EnterExplicitCDsInOneCodePack];
gd.textIndex ← saveIndex;
END;
EnterExplicitCDsInOneCodePack: Tree.Scan =
BEGIN
ProcessOneCD: Tree.Scan =
BEGIN
cdNode: Tree.Index = TreeOps.GetNode[t];
saveIndex: CARDINAL = gd.textIndex;
gd.textIndex ← tb[cdNode].info;
SELECT tb[cdNode].name FROM
allComp => EnterAllCompCD[cdNode];
compItems => EnterCompItemsCD[cdNode];
exceptItems => EnterExceptItemsCD[cdNode];
ENDCASE;
gd.textIndex ← saveIndex;
END;
cpNode: Tree.Index = TreeOps.GetNode[t];
TreeOps.ScanList[tb[cpNode].son[2], ProcessOneCD];
END;
EnterAllCompCD: PROC [cdNode: Tree.Index] =
BEGIN -- ComponentDesc ::= Component
EnterOneModule: PROC [mti: BcdDefs.MTIndex] RETURNS [stop: BOOL] =
{InsertInPOChain[mti, cdNode]; RETURN[FALSE]};
componentSE: SemanticEntry.STIndex = TreeOps.GetSe[tb[cdNode].son[1]];
WITH stb[componentSE] SELECT FROM
module => InsertInPOChain[mti, cdNode];
config => SourceBcd.EnumerateModulesInConfig[
kind: prototype, configTreeNode: cNode, userProc: EnterOneModule];
ENDCASE;
END;
EnterCompItemsCD: PROC [cdNode: Tree.Index] =
BEGIN -- ComponentDesc ::= Component [ItemList]
EnterOneItem: Tree.Scan =
BEGIN
EnterOneModule: PROC [mti: BcdDefs.MTIndex] RETURNS [stop: BOOL] =
{InsertInPOChain[mti, cdNode]; RETURN[FALSE]};
itemSE: SemanticEntry.STIndex = TreeOps.GetSe[t];
WITH stb[itemSE] SELECT FROM
module => InsertInPOChain[mti, cdNode];
config => SourceBcd.EnumerateModulesInConfig[
kind: prototype, configTreeNode: cNode, userProc: EnterOneModule];
ENDCASE;
END;
componentSE: SemanticEntry.STIndex = TreeOps.GetSe[tb[cdNode].son[1]];
WITH stb[componentSE] SELECT FROM
module => InsertInPOChain[mti, cdNode];
config => TreeOps.ScanList[tb[cdNode].son[2], EnterOneItem];
ENDCASE;
END;
EnterExceptItemsCD: PROC [cdNode: Tree.Index] =
BEGIN -- ComponentDesc ::= Component EXCEPT [ItemList]
componentSE: SemanticEntry.STIndex = TreeOps.GetSe[tb[cdNode].son[1]];
WITH stb[componentSE] SELECT FROM
module => InsertInPOChain[mti, cdNode];
config => ExcludeItems[cdNode, tb[cdNode].son[2], cNode];
ENDCASE;
END;
ExcludeItems: PROC [
cdNode: Tree.Index,
itemList: Tree.Link, configNode: SourceBcd.CTreeIndex] =
BEGIN -- enter config's modules that are not (in/equal to) any item
EnterModuleIfNotInList: PROC [
module: BcdDefs.MTIndex] RETURNS [stop: BOOL] =
BEGIN
inAnItem: BOOL;
CheckIfModuleInItem: Tree.Test =
BEGIN
SeeIfModuleFound: PROC [mti: BcdDefs.MTIndex] RETURNS [stop: BOOL] =
{IF module = mti THEN inAnItem ← TRUE; RETURN[inAnItem]};
-- item is either a module or a subconfiguration
itemSE: SemanticEntry.STIndex = TreeOps.GetSe[t];
WITH stb[itemSE] SELECT FROM
module => IF module = mti THEN inAnItem ← TRUE;
config => SourceBcd.EnumerateModulesInConfig[
kind: prototype, configTreeNode: cNode, userProc: SeeIfModuleFound];
ENDCASE;
RETURN[inAnItem]; -- continue search until found or end of list
END;
inAnItem ← FALSE;
TreeOps.SearchList[itemList, CheckIfModuleInItem];
IF ~inAnItem THEN InsertInPOChain[module, cdNode];
RETURN[FALSE];
END;
SourceBcd.EnumerateModulesInConfig[
kind: prototype, configTreeNode: configNode, userProc: EnterModuleIfNotInList];
END;
--***** Put Implicit Component Descriptions in Processing Order Chains *****--
EnterImplicitComponentDescs: PROC =
{TreeOps.ScanList[gd.root, EnterImplicitCDsInSegments]};
EnterImplicitCDsInSegments: Tree.Scan =
BEGIN
segNode: Tree.Index = TreeOps.GetNode[t];
IF tb[segNode].name = codeSeg THEN EnterImplicitCDsInOneSeg[segNode];
END;
EnterImplicitCDsInOneSeg: PROC [segNode: Tree.Index] =
BEGIN
saveIndex: CARDINAL = gd.textIndex;
gd.textIndex ← tb[segNode].info;
TreeOps.ScanList[tb[segNode].son[2], EnterImplicitCDsInOneCodePack];
gd.textIndex ← saveIndex;
END;
EnterImplicitCDsInOneCodePack: Tree.Scan =
BEGIN
ProcessOneCD: Tree.Scan =
BEGIN
cdNode: Tree.Index = TreeOps.GetNode[t];
saveIndex: CARDINAL = gd.textIndex;
gd.textIndex ← tb[cdNode].info;
SELECT tb[cdNode].name FROM
exceptPacks => EnterExceptPacksCD[cdNode];
itemsExceptPacks => EnterItemsExceptPacksCD[cdNode];
exceptPacksItems => EnterExceptPacksItemsCD[cdNode];
ENDCASE;
gd.textIndex ← saveIndex;
END;
cpNode: Tree.Index = TreeOps.GetNode[t];
TreeOps.ScanList[tb[cpNode].son[2], ProcessOneCD];
END;
EnterExceptPacksCD: PROC [cdNode: Tree.Index] =
BEGIN -- ComponentDesc ::= Component EXCEPT PackList
EnterOneImplicitCDModule: PROC [
mti: BcdDefs.MTIndex] RETURNS [stop: BOOL] =
BEGIN
InsertImplicitCDModuleInPOChain[mti, cdNode, tb[cdNode].son[2]];
RETURN[FALSE];
END;
componentSE: SemanticEntry.STIndex = TreeOps.GetSe[tb[cdNode].son[1]];
WITH stb[componentSE] SELECT FROM
module => InsertImplicitCDModuleInPOChain[
mti, cdNode, tb[cdNode].son[2]];
config => SourceBcd.EnumerateModulesInConfig[
kind: prototype, configTreeNode: cNode, userProc: EnterOneImplicitCDModule];
ENDCASE;
END;
InsertImplicitCDModuleInPOChain: PROC [
mti: BcdDefs.MTIndex, cdNode: Tree.Index, packList: Tree.Link] =
BEGIN
implicitCDIncludesMti: BOOL ← FALSE;
CheckCDsOfOnePack: Tree.Scan =
BEGIN
cpSE: SemanticEntry.STIndex = TreeOps.GetSe[t];
WITH stb[cpSE] SELECT FROM
codePack =>
implicitCDIncludesMti ← DoesImplicitCDInPackIncludeMti[
cpId: hti, cpNode: treeNode, module: mti];
ENDCASE;
END;
-- check that CDs in PackList that reference module mti are all explicit
TreeOps.ScanList[packList, CheckCDsOfOnePack];
IF ~implicitCDIncludesMti THEN InsertInPOChain[mti, cdNode];
END;
DoesImplicitCDInPackIncludeMti: PROC [
cpId: SemanticEntry.HTIndex, cpNode: Tree.Index, module: BcdDefs.MTIndex]
RETURNS [reply: BOOL] =
BEGIN
ProcessOneCD: Tree.Scan =
BEGIN
cdNode: Tree.Index = TreeOps.GetNode[t];
SELECT tb[cdNode].name FROM
exceptPacks, itemsExceptPacks, exceptPacksItems =>
BEGIN -- see if component includes/is module
componentSE: SemanticEntry.STIndex = TreeOps.GetSe[tb[cdNode].son[1]];
WITH stb[componentSE] SELECT FROM
module =>
IF mti = module THEN
BEGIN
Error.ImplicitCDIncludesModule[
error, hti, cpId, module];
reply ← TRUE;
END;
config =>
IF SourceBcd.IsModuleInConfig[prototype, module, cNode] THEN
BEGIN
Error.ImplicitCDIncludesModule[
error, hti, cpId, module];
reply ← TRUE;
END;
ENDCASE;
END;
ENDCASE; -- not an implicit component description
END;
reply ← FALSE;
TreeOps.ScanList[tb[cpNode].son[2], ProcessOneCD];
END;
EnterItemsExceptPacksCD: PROC [cdNode: Tree.Index] =
BEGIN -- ComponentDesc ::= Component [ItemList] EXCEPT PackList
EnterOneItem: Tree.Scan =
BEGIN
EnterOneImplicitCDModule: PROC [
mti: BcdDefs.MTIndex] RETURNS [stop: BOOL] =
BEGIN
InsertImplicitCDModuleInPOChain[mti, cdNode, tb[cdNode].son[3]];
RETURN[FALSE];
END;
itemSE: SemanticEntry.STIndex = TreeOps.GetSe[t];
WITH stb[itemSE] SELECT FROM
module => InsertImplicitCDModuleInPOChain[
mti, cdNode, tb[cdNode].son[3]];
config => SourceBcd.EnumerateModulesInConfig[
kind: prototype, configTreeNode: cNode, userProc: EnterOneImplicitCDModule];
ENDCASE;
END;
componentSE: SemanticEntry.STIndex = TreeOps.GetSe[tb[cdNode].son[1]];
WITH stb[componentSE] SELECT FROM
config => TreeOps.ScanList[tb[cdNode].son[2], EnterOneItem];
ENDCASE;
END;
EnterExceptPacksItemsCD: PROC [cdNode: Tree.Index] =
BEGIN -- ComponentDesc ::= Component EXCEPT PackList, [ItemList]
componentSE: SemanticEntry.STIndex = TreeOps.GetSe[tb[cdNode].son[1]];
WITH stb[componentSE] SELECT FROM
module => InsertImplicitCDModuleInPOChain[
mti, cdNode, tb[cdNode].son[2]];
config => ExcludeImplicitCDItems[
cdNode, tb[cdNode].son[3], tb[cdNode].son[3], cNode];
ENDCASE;
END;
ExcludeImplicitCDItems: PROC [
cdNode: Tree.Index, packList: Tree.Link,
itemList: Tree.Link, configNode: SourceBcd.CTreeIndex] =
BEGIN -- enter config's modules that are not (in/equal to) any item
EnterModuleIfNotInList: PROC [
module: BcdDefs.MTIndex] RETURNS [stop: BOOL] =
BEGIN
inAnItem: BOOL;
CheckIfModuleInItem: Tree.Test =
BEGIN
SeeIfModuleFound: PROC [mti: BcdDefs.MTIndex] RETURNS [stop: BOOL] =
{IF module = mti THEN inAnItem ← TRUE; RETURN[inAnItem]};
-- item is either a module or a subconfiguration
itemSE: SemanticEntry.STIndex = TreeOps.GetSe[t];
WITH stb[itemSE] SELECT FROM
module => IF module = mti THEN inAnItem ← TRUE;
config => SourceBcd.EnumerateModulesInConfig[
kind: prototype, configTreeNode: cNode, userProc: SeeIfModuleFound];
ENDCASE;
RETURN[inAnItem]; -- continue search until found or end of list
END;
inAnItem ← FALSE;
TreeOps.SearchList[itemList, CheckIfModuleInItem];
IF ~inAnItem THEN
InsertImplicitCDModuleInPOChain[module, cdNode, packList];
RETURN[FALSE];
END;
SourceBcd.EnumerateModulesInConfig[
kind: prototype, configTreeNode: configNode, userProc: EnterModuleIfNotInList];
END;
-- ***** Put MAIN OF Component Descriptions in Processing Order Chains *****
EnterRemainingComponentDescs: PROC = {
TreeOps.ScanList[gd.root, EnterRemainingCDsInSegments]};
EnterRemainingCDsInSegments: Tree.Scan = {
segNode: Tree.Index = TreeOps.GetNode[t];
IF tb[segNode].name = codeSeg THEN EnterRemainingCDsInOneSeg[segNode]};
EnterRemainingCDsInOneSeg: PROC [segNode: Tree.Index] = {
saveIndex: CARDINAL = gd.textIndex;
gd.textIndex ← tb[segNode].info;
TreeOps.ScanList[tb[segNode].son[2], EnterRemainingCDsInOneCodePack];
gd.textIndex ← saveIndex};
EnterRemainingCDsInOneCodePack: Tree.Scan = {
ProcessOneCD: Tree.Scan = {
cdNode: Tree.Index = TreeOps.GetNode[t];
SELECT tb[cdNode].name FROM
mainOfPL, evOfPL, catchOfPL => EnterOneRemainingCD[cdNode];
ENDCASE};
cpNode: Tree.Index = TreeOps.GetNode[t];
TreeOps.ScanList[tb[cpNode].son[2], ProcessOneCD]};
EnterOneRemainingCD: PROC [cdNode: Tree.Index] = {
-- ComponentDesc ::= MAIN OF PackList
-- ComponentDesc ::= ENTRY VECTOR OF PackList
-- ComponentDesc ::= CATCH CODE OF PackList
saveIndex: CARDINAL = gd.textIndex;
packList: Tree.Link = tb[cdNode].son[1];
EnterModulesOfOneOfSegsPacks: Tree.Scan = {
cpNode: Tree.Index = TreeOps.GetNode[t];
InsertModulesOfOnePack[cpNode: cpNode, remainingCdNode: cdNode]};
EnterModulesOfOnePack: Tree.Scan = {
cpSE: SemanticEntry.STIndex = TreeOps.GetSe[t];
WITH stb[cpSE] SELECT FROM
codePack =>
InsertModulesOfOnePack[cpNode: treeNode, remainingCdNode: cdNode];
ENDCASE};
gd.textIndex ← tb[cdNode].info;
IF TreeOps.ListLength[packList] = 1 THEN {
-- packlist might only be name of current code segment
firstInList: Tree.Link = TreeOps.ListHead[packList];
firstSE: SemanticEntry.STIndex = TreeOps.GetSe[firstInList];
WITH stb[firstSE] SELECT FROM
segment => {
segNode: Tree.Index = treeNode;
TreeOps.ScanList[tb[segNode].son[2], EnterModulesOfOneOfSegsPacks];
RETURN};
ENDCASE};
TreeOps.ScanList[packList, EnterModulesOfOnePack];
gd.textIndex ← saveIndex};
InsertModulesOfOnePack: PROC [
cpNode: Tree.Index, remainingCdNode: Tree.Index] = {
-- enter all modules in a code pack referenced by MAIN/ENTRY VECTOR/CATCH OF
InsertAModule: PROC [mti: BcdDefs.MTIndex] RETURNS [BOOL] = {
InsertInPOChain[mti, remainingCdNode]; RETURN[FALSE]};
ProcessOneCD: Tree.Scan = {
cdNode: Tree.Index = TreeOps.GetNode[t];
SELECT tb[cdNode].name FROM
mainOfPL, evOfPL, catchOfPL => NULL;
ENDCASE => {
componentSE: SemanticEntry.STIndex = TreeOps.GetSe[tb[cdNode].son[1]];
WITH stb[componentSE] SELECT FROM
module =>
IF ~SourceBcd.IsTableCompiled[mti] THEN
InsertInPOChain[mti, remainingCdNode];
config =>
SourceBcd.EnumerateModulesInConfig[
kind: prototype, configTreeNode: cNode,
userProc: InsertAModule];
ENDCASE}};
TreeOps.ScanList[tb[cpNode].son[2], ProcessOneCD]};
-- ************ Verify That a Module Appears in Only One Segment ************-
VerifyModulesInOneSegment: PROC = {
SourceBcd.EnumerateModules[VerifyAModuleInOneSegment]};
VerifyAModuleInOneSegment: PROC [mti: BcdDefs.MTIndex] RETURNS [stop: BOOL] =
BEGIN
modulesSeg: Tree.Index;
CheckOneCDNode: PROC [cdNode: Tree.Index] RETURNS [stop: BOOL] =
BEGIN
IF modulesSeg = Tree.nullIndex THEN modulesSeg ← tb[cdNode].seg
ELSE IF modulesSeg # tb[cdNode].seg THEN
BEGIN
segId1: SemanticEntry.HTIndex = TreeOps.GetHash[tb[modulesSeg].son[1]];
segId2: SemanticEntry.HTIndex = TreeOps.GetHash[tb[tb[cdNode].seg].son[1]];
Error.ModuleInTwoSegments[error, mti, segId1, segId2];
RETURN[TRUE];
END;
RETURN[FALSE];
END;
modulesSeg ← Tree.nullIndex;
Enumerate[mti, CheckOneCDNode];
RETURN[FALSE];
END;
END.