DIRECTORY
Alloc: TYPE USING [Bounds],
BcdComData: TYPE USING [currentName, errors, errorStream, nErrors, nWarnings, sourceStream, table, textIndex, warnings],
BcdControlDefs: TYPE USING [nullSourceIndex],
BcdDefs: TYPE USING [FTIndex, FTNull, fttype, MTIndex, MTNull, mttype, NameRecord, NameString, NullName, sstype, sttype, VersionStamp],
BcdErrorDefs: TYPE USING [ErrorClass, InterfaceId, ExportItemName, ImportItemName],
ConvertUnsafe: TYPE USING [SubString, ToRope],
HashOps: TYPE USING [SubStringForHash],
IO: TYPE USING [card, EndOf, GetChar, PutChar, PutF, PutRope, SetIndex],
Rope: TYPE USING [ROPE],
Symbols: TYPE USING [HTIndex, htNull, STIndex, stNull],
Table: TYPE USING [Base];
BindErrors:
PROGRAM
IMPORTS Alloc, BcdErrorDefs, ConvertUnsafe, HashOps, IO, data: BcdComData
EXPORTS BcdErrorDefs = {
OPEN Symbols, BcdDefs, BcdErrorDefs;
SubString: TYPE~ConvertUnsafe.SubString;
GetModule: PUBLIC SIGNAL RETURNS[errorMti: MTIndex, linkOffset: CARDINAL] ~ CODE;
GetSti: PUBLIC SIGNAL RETURNS[errorSti: STIndex] ~ CODE;
StreamIndex: TYPE~INT; -- FileStream.FileByteIndex
PrintTextLine:
PROC[origin: StreamIndex] ~ {
start, lineIndex: StreamIndex ← origin;
char: CHAR;
THROUGH [1..100]
UNTIL lineIndex=0
DO
lineIndex ← lineIndex-1;
(data.sourceStream).SetIndex[lineIndex];
IF (data.sourceStream).GetChar[] = '\n THEN EXIT;
start ← lineIndex;
ENDLOOP;
(data.sourceStream).SetIndex[start];
THROUGH [1..100]
UNTIL
(data.sourceStream
).EndOf
DO
char ← (data.sourceStream).GetChar[];
SELECT char
FROM
'\n, '\032 => EXIT;
ENDCASE => (data.errorStream).PutChar[char];
ENDLOOP;
(data.errorStream).PutChar['\n]; RETURN};
WriteChar: PROC[char: CHAR] ~ INLINE {(data.errorStream).PutChar[char]};
WriteRope: PROC[s: Rope.ROPE] ~ {(data.errorStream).PutRope[s]};
WriteString: PROC[s: STRING] ~ {(data.errorStream).PutRope[ConvertUnsafe.ToRope[s]]};
Space: PROC ~ INLINE {(data.errorStream).PutChar[' ]};
ErrorLog:
PROC [class: ErrorClass] ~ {
IF data.textIndex # BcdControlDefs.nullSourceIndex
THEN {
WriteRope[", at "];
WriteName[data.currentName];
(data.errorStream).PutF["[%d]\n", IO.card[data.textIndex]];
(data.errorStream),PutNumber[data.textIndex,
[base~10, columns~1, unsigned~TRUE, zerofill~FALSE]];
PrintTextLine[data.textIndex]};
SELECT class
FROM
$error => {data.errors ← TRUE; data.nErrors ← data.nErrors+1};
$warning => {data.warnings ← TRUE; data.nWarnings ← data.nWarnings+1};
ENDCASE};
Prefix:
PROC [class: ErrorClass] ~ {
WriteChar['\n];
IF class = $warning THEN WriteRope["Warning: "]};
WriteNameBase:
PROC [name: NameRecord, s: BcdDefs.NameString] ~ {
offset: CARDINAL~name;
length: CARDINAL~s.size[name];
IF offset+length > s.string.length THEN RETURN;
FOR i: CARDINAL IN [offset..offset+MIN[length,100]) DO WriteChar[s.string.text[i]] ENDLOOP};
WriteName:
PROC [name: NameRecord] ~ {
WriteNameBase[name, LOOPHOLE[(data.table).Bounds[sstype].base]]};
WriteVersion:
PROC [v: VersionStamp, paren:
BOOL←
FALSE] ~ {
IF paren THEN WriteRope["(version "];
IF v.time = 0 THEN WriteRope["<null version>"]
ELSE {
StampWords: CARDINAL~VersionStamp.SIZE;
str: PACKED ARRAY [0..4*StampWords) OF [0..16) ~ LOOPHOLE[v];
digit: STRING~"0123456789abcdef"L;
WriteChar['"];
FOR i: NAT IN [0..4*StampWords) DO WriteChar[digit[str[i]]] ENDLOOP;
WriteChar['"]};
IF paren THEN WriteChar[')]};
WriteHti:
PROC [hti: HTIndex] ~ {
IF hti # htNull
THEN {
ss: SubString;
ss ← HashOps.SubStringForHash[hti];
FOR i: CARDINAL IN [ss.offset..ss.offset+ss.length) DO WriteChar[ss.base[i]] ENDLOOP}};
HtiForSti:
PROC [sti: STIndex]
RETURNS [HTIndex] ~ {
RETURN [IF sti = stNull THEN htNull ELSE (data.table).Bounds[sttype].base[sti].hti]};
ModuleName:
PROC [mti: MTIndex]
RETURNS [NameRecord] ~ {
RETURN [IF mti = MTNull THEN NullName ELSE (data.table).Bounds[mttype].base[mti].name]};
Error:
PUBLIC
PROC [class: ErrorClass, s:
STRING] ~ {
Prefix[class]; WriteString[s];
ErrorLog[class]};
ErrorSti:
PUBLIC
PROC [class: ErrorClass, s:
STRING, sti: STIndex] ~ {
Prefix[class]; WriteHti[HtiForSti[sti]]; Space[]; WriteString[s];
ErrorLog[class]};
ErrorHti:
PUBLIC
PROC [class: ErrorClass, s:
STRING, hti: HTIndex] ~ {
sti: STIndex~(SIGNAL GetSti[]);
Prefix[class]; WriteHti[hti]; Space[]; WriteString[s];
IF sti # stNull THEN {WriteRope[" (in "]; WriteHti[HtiForSti[sti]]; WriteChar[')]};
ErrorLog[class]};
ErrorName:
PUBLIC
PROC [class: ErrorClass, s:
STRING, name: NameRecord] ~ {
Prefix[class];
WriteName[name]; Space[]; WriteString[s];
ErrorLog[class]};
ErrorItem:
PUBLIC
PROC [class: ErrorClass, s:
STRING, export: InterfaceId, ep:
CARDINAL] ~ {
sti: STIndex~(SIGNAL GetSti[]);
printed: BOOL←FALSE;
ftb: Table.Base~(data.table).Bounds[fttype].base;
PrintItem:
PROC [s: SubString] ~ {
FOR i: CARDINAL IN [s.offset .. s.offset+s.length) DO WriteChar[s.base[i]] ENDLOOP;
printed ← TRUE};
Prefix[class];
BcdErrorDefs.ExportItemName[export~export, ep~ep, userProc~PrintItem];
IF ~printed THEN (data.errorStream).PutF["(item %d)", IO.card[ep]];
WriteRope[" in interface "];
IF export.name # NullName THEN WriteName[export.name]
ELSE IF export.fti # FTNull THEN {WriteRope["from file "]; WriteName[ftb[export.fti].name]}
ELSE WriteRope["(unknown)"];
Space[]; WriteString[s];
IF sti # stNull THEN {WriteRope[" (in "]; WriteHti[HtiForSti[sti]]; WriteChar[')]};
ErrorLog[class]};
ErrorModule:
PUBLIC
PROC [class: ErrorClass, s:
STRING, mti: MTIndex] ~ {
sti: STIndex~(SIGNAL GetSti[]);
Prefix[class]; WriteName[ModuleName[mti]]; Space[]; WriteString[s];
IF sti # stNull THEN {WriteRope[" (in "]; WriteHti[HtiForSti[sti]]; WriteChar[')]};
ErrorLog[class]};
ErrorInterface:
PUBLIC
PROC [
class: ErrorClass, s: STRING, import: InterfaceId, ep: CARDINAL] ~ {
mti: MTIndex;
linkOffset: CARDINAL;
printed: BOOL←FALSE;
ftb: Table.Base~(data.table).Bounds[fttype].base;
PrintItem:
PROC [s: SubString] ~ {
FOR i: CARDINAL IN [s.offset .. s.offset+s.length) DO WriteChar[s.base[i]] ENDLOOP;
printed ← TRUE};
[mti, linkOffset] ← SIGNAL GetModule[];
Prefix[class];
IF mti # MTNull
THEN
BcdErrorDefs.ImportItemName[
import~import, ep~ep,
clientMti~mti, linkOffset~linkOffset,
userProc~PrintItem];
IF ~printed THEN (data.errorStream).PutF["(item %d)", IO.card[ep]];
WriteRope[" from "];
IF import.name # NullName THEN WriteName[import.name]
ELSE
IF import.fti # FTNull
THEN {
WriteRope[" file "]; WriteName[ftb[import.fti].name]}
ELSE WriteRope["(unknown)"];
Space[]; WriteString[s];
IF mti # MTNull
THEN {
WriteRope[" (imported by "]; WriteName[ModuleName[mti]]; WriteChar[')]};
ErrorLog[class]};
ErrorNameBase:
PUBLIC
PROC [
class: ErrorClass, s: STRING, name: NameRecord, base: BcdDefs.NameString] ~ {
Prefix[class]; WriteNameBase[name, base]; Space[]; WriteString[s];
ErrorLog[class]};
Error2Versions:
PUBLIC
PROC [
class: ErrorClass, fileName: NameRecord, v1, v2: VersionStamp] ~ {
ftb: Table.Base~(data.table).Bounds[fttype].base;
Prefix[class];
WriteName[fileName];
WriteRope[" is referenced in two versions: "];
WriteVersion[v1]; WriteRope[" and "]; WriteVersion[v2];
ErrorLog[class]};
ErrorFile:
PUBLIC
PROC [class: ErrorClass, s:
STRING, fti: FTIndex] ~ {
ftb: Table.Base~(data.table).Bounds[fttype].base;
Prefix[class]; WriteName[ftb[fti].name]; Space[]; WriteString[s];
ErrorLog[class]};
Error2Files:
PUBLIC
PROC [class: ErrorClass, s:
STRING, ft1, ft2: FTIndex] ~ {
ftb: Table.Base~(data.table).Bounds[fttype].base;
Prefix[class];
WriteName[ftb[ft1].name]; WriteVersion[ftb[ft1].version, TRUE];
Space[]; WriteString[s]; Space[];
WriteName[ftb[ft2].name]; WriteVersion[ftb[ft2].version, TRUE];
ErrorLog[class]};
}.