-- ErrorImpl.mesa Last edited by Lewis on 2-Apr-81 14:40:33
-- last edited by Levin on July 6, 1982 3:45 pm
DIRECTORY
Alloc USING [Bounds],
BcdDefs USING [FTIndex, FTNull, MTIndex, NameRecord, VersionStamp],
CharIO USING [
ControlZ, CR, NumberFormat, SP, PutChar, PutNumber, PutString],
Error,
PackagerDefs USING [globalData, NullSourceIndex, packctreetype],
SourceBcd USING [bcdBases, ComponentKind, CTreeIndex, NullCTreeIndex],
SymTabDefs USING [HTIndex, HTNull],
SymTabOps USING [SubStringForHash],
Streams USING [GetByte, End, SetIndex],
Strings USING [SubString, SubStringDescriptor],
Table USING [Base],
Time USING [Append, Packed, Unpack];
ErrorImpl: PROGRAM
IMPORTS Alloc, CharIO, PackagerDefs, SourceBcd, Streams, SymTabOps, Time
EXPORTS Error =
BEGIN OPEN PackagerDefs, Error;
SubStringDescriptor: TYPE = Strings.SubStringDescriptor;
SubString: TYPE = Strings.SubString;
CR: CHARACTER = CharIO.CR;
SP: CHARACTER = CharIO.SP;
ControlZ: CHARACTER = CharIO.ControlZ;
-- Utility Prints
WriteString: PROC [s: STRING] = INLINE
{CharIO.PutString[globalData.errorStream, s]};
WriteChar: PROC [c: CHARACTER] = INLINE
{CharIO.PutChar[globalData.errorStream, c]};
WriteEOL: PROC = INLINE
{CharIO.PutChar[globalData.errorStream, CR]};
Space: PROC = INLINE
{CharIO.PutChar[globalData.errorStream, SP]};
Prefix: PROC [class: ErrorClass] =
BEGIN
WriteEOL[];
IF class = warning THEN WriteString["Warning: "L];
END;
ErrorLog: PROC [class: ErrorClass] =
BEGIN
IF globalData.textIndex # PackagerDefs.NullSourceIndex THEN
BEGIN
WriteString[", at ["L];
CharIO.PutNumber[
globalData.errorStream,
globalData.textIndex,
[base:10, columns:1, unsigned:TRUE, zerofill: FALSE]];
WriteChar[']];
WriteEOL[];
PrintTextLine[globalData.textIndex];
END
ELSE WriteEOL[];
SELECT class FROM
error =>
{globalData.errors ← TRUE; globalData.nErrors ← globalData.nErrors+1};
warning =>
{globalData.warnings ← TRUE; globalData.nWarnings ← globalData.nWarnings+1};
ENDCASE;
END;
PrintTextLine: PROC [origin: LONG CARDINAL] =
BEGIN
start, lineIndex: LONG CARDINAL ← origin;
char: CHARACTER;
THROUGH [1..100] UNTIL lineIndex = 0 DO
lineIndex ← lineIndex - 1;
Streams.SetIndex[globalData.packStream, lineIndex];
IF Streams.GetByte[globalData.packStream] = CR THEN EXIT;
start ← lineIndex;
ENDLOOP;
Streams.SetIndex[globalData.packStream, start];
THROUGH [1..100] DO
char ← Streams.GetByte[globalData.packStream ! Streams.End[] => GOTO out];
SELECT char FROM
CR, ControlZ => EXIT;
ENDCASE => WriteChar[char];
REPEAT
out => NULL;
ENDLOOP;
WriteChar[CR];
END;
WriteHti: PROC [hti: SymTabDefs.HTIndex] =
BEGIN
ss: SubStringDescriptor;
IF hti = SymTabDefs.HTNull THEN RETURN;
SymTabOps.SubStringForHash[@ss, hti];
FOR i: CARDINAL IN [ss.offset..ss.offset+ss.length) DO
WriteChar[ss.base[i]];
ENDLOOP;
END;
WriteName: PROC [name: BcdDefs.NameRecord] =
BEGIN
nameSubStr: SubString ← @nameDesc;
nameDesc: SubStringDescriptor ← [
base: @SourceBcd.bcdBases.ssb.string,
offset: name, length: SourceBcd.bcdBases.ssb.size[name]];
WriteSubString[nameSubStr];
END;
WriteSubString: PROC [ss: SubString] =
BEGIN
FOR i: CARDINAL IN [ss.offset..ss.offset+ss.length) DO
WriteChar[ss.base[i]]
ENDLOOP;
END;
WriteVersion: PROC [version: BcdDefs.VersionStamp] =
BEGIN
octal: CharIO.NumberFormat = [8,FALSE,FALSE,1];
WriteChar['(];
IF version.time = 0 THEN WriteString ["Null Version"L]
ELSE
BEGIN
WriteTime[LOOPHOLE[version.time, Time.Packed]]; WriteChar[' ];
CharIO.PutNumber[globalData.errorStream, version.net, octal];
WriteChar['#];
CharIO.PutNumber[globalData.errorStream, version.host, octal];
WriteChar['#];
END;
WriteChar[')];
END;
WriteTime: PROC [t: Time.Packed] =
BEGIN
s: STRING ← [20];
Time.Append[s, Time.Unpack[t]];
WriteString[s];
END;
-- Error Reporting Procedures
Error: PUBLIC PROC [class: ErrorClass, s: STRING] =
BEGIN
Prefix[class];
WriteString[s];
ErrorLog[class];
END;
ErrorFile: PUBLIC PROC [class: ErrorClass, s: STRING, fti: BcdDefs.FTIndex] =
BEGIN
Prefix[class];
IF fti = BcdDefs.FTNull THEN WriteString["(null)"L]
ELSE WriteName[SourceBcd.bcdBases.ftb[fti].name];
Space[]; WriteString[s];
ErrorLog[class];
END;
ErrorHti: PUBLIC PROC [class: ErrorClass, s: STRING, hti: SymTabDefs.HTIndex] =
BEGIN
Prefix[class];
WriteHti[hti]; Space[]; WriteString[s];
ErrorLog[class];
END;
ErrorName: PUBLIC PROC [
class: ErrorClass, s: STRING, name: BcdDefs.NameRecord] =
BEGIN
Prefix[class];
WriteName[name]; Space[]; WriteString[s];
ErrorLog[class];
END;
WrongSymbolsVersion: PUBLIC PROC [
class: ErrorClass,
module: BcdDefs.MTIndex,
requiredVersion, actualVersion: BcdDefs.VersionStamp] =
BEGIN
Prefix[class];
WriteString["Symbols for module "L];
WriteName[SourceBcd.bcdBases.mtb[module].name];
WriteString[" were required in version "L];
WriteVersion[requiredVersion];
WriteString[", but were found in version "L];
WriteVersion[actualVersion];
ErrorLog[class];
END;
UnknownComponent: PUBLIC PROC [
class: ErrorClass,
kind: SourceBcd.ComponentKind,
mainPartOfCompId: SymTabDefs.HTIndex] =
BEGIN
Prefix[class];
WriteString["Component "L]; WriteHti[mainPartOfCompId];
WriteString[" is not a module or configuration "L];
IF kind = instance THEN WriteString["instance "L];
WriteString["in the source Bcd"L];
ErrorLog[class];
END;
AmbiguousComponent: PUBLIC PROC [
class: ErrorClass,
kind: SourceBcd.ComponentKind,
compNode1, compNode2: SourceBcd.CTreeIndex] =
BEGIN
ctreeb: Table.Base;
WriteQualifiedName: PROC [cNode: SourceBcd.CTreeIndex] =
BEGIN
IF ctreeb[cNode].father # SourceBcd.NullCTreeIndex THEN
{WriteQualifiedName[ctreeb[cNode].father]; WriteChar['.]};
IF kind = instance THEN
WITH ctreeb[cNode] SELECT FROM
instance => WriteName[instanceName];
prototype => WriteName[prototypeName];
ENDCASE
ELSE WriteName[ctreeb[cNode].prototypeName];
END;
Prefix[class];
WriteString["Ambiguous component reference: "L];
WriteString["two interpretations are"L]; WriteEOL[];
ctreeb ← (PackagerDefs.globalData.ownTable).Bounds[PackagerDefs.packctreetype].base;
IF compNode1 # SourceBcd.NullCTreeIndex THEN
{WriteString[" "L]; WriteQualifiedName[compNode1]; WriteEOL[]};
IF compNode2 # SourceBcd.NullCTreeIndex THEN
{WriteString[" "L]; WriteQualifiedName[compNode2]; WriteEOL[]};
ErrorLog[class];
END;
-- One of the code packs excepted by an implicit component description has
-- itself an implicit c.d. including a module of the original c.d.
ImplicitCDIncludesModule: PUBLIC PROC [
class: ErrorClass,
componentId, codePackId: SymTabDefs.HTIndex,
module: BcdDefs.MTIndex] =
BEGIN
Prefix[class];
WriteString["A component's procedures may only be abbreviated once: "L];
WriteEOL[];
WriteString["The component "L]; WriteHti[componentId];
WriteString[" in code pack "L]; WriteHti[codePackId];
WriteString[" also contains "L];
WriteName[SourceBcd.bcdBases.mtb[module].name];
ErrorLog[class];
END;
ModuleInTwoSegments: PUBLIC PROC [
class: ErrorClass,
module: BcdDefs.MTIndex,
segId1, segId2: SymTabDefs.HTIndex] =
BEGIN
Prefix[class];
WriteString["The module "L];
WriteName[SourceBcd.bcdBases.mtb[module].name];
WriteString[" is contained in two code segments: "L]; WriteHti[segId1];
WriteString[" and "L]; WriteHti[segId2];
ErrorLog[class];
END;
ModuleAlreadyPacked: PUBLIC PROC [
class: ErrorClass,
module: BcdDefs.MTIndex] =
BEGIN
Prefix[class];
WriteString["The module "L];
WriteName[SourceBcd.bcdBases.mtb[module].name];
WriteString[" has already been packed"L];
ErrorLog[class];
END;
TableCompModuleNotIncAsUnit: PUBLIC PROC [
class: ErrorClass,
module: BcdDefs.MTIndex] =
BEGIN
Prefix[class];
WriteString["The module "L];
WriteName[SourceBcd.bcdBases.mtb[module].name];
WriteString[" is table-compiled and must be included as a unit"L];
ErrorLog[class];
END;
NotProcInModule: PUBLIC PROC [
class: ErrorClass,
procName: SymTabDefs.HTIndex,
module: BcdDefs.MTIndex] =
BEGIN
Prefix[class];
WriteHti[procName]; WriteString[" is not an outermost procedure in module "L];
WriteName[SourceBcd.bcdBases.mtb[module].name];
ErrorLog[class];
END;
ProcPlacedTwice: PUBLIC PROC [
class: ErrorClass,
procId: SubString,
module: BcdDefs.MTIndex,
cpId1, cpId2: SymTabDefs.HTIndex] =
BEGIN
Prefix[class];
WriteString["The procedure "L];
WriteSubString[procId]; WriteString[" from module "L];
WriteName[SourceBcd.bcdBases.mtb[module].name];
WriteString[" appears in two code packs: "L];
WriteHti[cpId1]; WriteString[" and "L]; WriteHti[cpId2];
ErrorLog[class];
END;
ProcNotPlaced: PUBLIC PROC [
class: ErrorClass,
procId: SubString,
module: BcdDefs.MTIndex] =
BEGIN
Prefix[class];
WriteString["The procedure "L];
WriteSubString[procId]; WriteString[" from module "L];
WriteName[SourceBcd.bcdBases.mtb[module].name];
WriteString[" was never placed in a code pack"L];
ErrorLog[class];
END;
NoProcFromModuleInCP: PUBLIC PROC [
class: ErrorClass,
module: BcdDefs.MTIndex,
cpId: SymTabDefs.HTIndex] =
BEGIN
Prefix[class];
WriteString["No procedure from module "L];
WriteName[SourceBcd.bcdBases.mtb[module].name];
WriteString[" was placed in code pack "L]; WriteHti[cpId];
ErrorLog[class];
END;
FrameInTwoFramePacks: PUBLIC PROC [
class: ErrorClass,
module: BcdDefs.MTIndex,
fpId1, fpId2: SymTabDefs.HTIndex] =
BEGIN
Prefix[class];
WriteString["The global frame of module "L];
WriteName[SourceBcd.bcdBases.mtb[module].name];
WriteString[" is contained in two frame packs: "L]; WriteHti[fpId1];
WriteString[" and "L]; WriteHti[fpId2];
ErrorLog[class];
END;
FrameNotPlaced: PUBLIC PROC [
class: ErrorClass,
module: BcdDefs.MTIndex] =
BEGIN
Prefix[class];
WriteString["The global frame of module "L];
WriteName[SourceBcd.bcdBases.mtb[module].name];
WriteString[" was never placed in a frame pack"L];
ErrorLog[class];
END;
SegmentTooLarge: PUBLIC PROC [
class: ErrorClass,
segId: Strings.SubString] =
BEGIN
Prefix[class];
WriteString["The code segment "L];
WriteSubString[segId];
WriteString[" is larger than 32K words"L];
ErrorLog[class];
END;
END.