-- BindErrors.mesa
-- Last edited by Satterthwaite on December 22, 1982 12:22 pm
-- Last edited by Lewis on 23-Jan-81 10:41:54

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, NullName, sstype, sttype, VersionStamp],
  BcdErrorDefs: TYPE USING [
    ErrorClass, InterfaceId, ExportItemName, ImportItemName],
  BcdOps: TYPE USING [NameString],
  CharIO: TYPE USING [NumberFormat, PutChar, PutDecimal, PutNumber, PutString],
  FileStream: TYPE USING [FileByteIndex, EndOf, SetIndex],
  HashOps: TYPE USING [SubStringForHash],
  Stream: TYPE USING [GetChar],
  Strings: TYPE USING [SubString, SubStringDescriptor],
  Symbols: TYPE USING [HTIndex, htNull, STIndex, stNull],
  Table: TYPE USING [Base];

BindErrors: PROGRAM
    IMPORTS
      Alloc, BcdErrorDefs, CharIO, FileStream, HashOps, Stream,
      data: BcdComData
    EXPORTS BcdErrorDefs SHARES BcdErrorDefs = {
  OPEN Symbols, BcdDefs, BcdErrorDefs, CharIO;

  SubStringDescriptor: TYPE~Strings.SubStringDescriptor;
  SubString: TYPE~Strings.SubString;

  GetModule: PUBLIC SIGNAL RETURNS [errorMti: MTIndex, linkOffset: CARDINAL] ~ CODE;
  GetSti: PUBLIC SIGNAL RETURNS [errorSti: STIndex] ~ CODE;

  StreamIndex: TYPE~FileStream.FileByteIndex;

  PrintTextLine: PROC [origin: StreamIndex] ~ {
    start, lineIndex: StreamIndex _ origin;
    char: CHAR;
    THROUGH [1..100] UNTIL lineIndex=0 DO
      lineIndex _ lineIndex-1;
      FileStream.SetIndex[data.sourceStream, lineIndex];
      IF (data.sourceStream).GetChar[] = '\n THEN EXIT;
      start _ lineIndex;
      ENDLOOP;
    FileStream.SetIndex[data.sourceStream, start];
    THROUGH [1..100] UNTIL FileStream.EndOf[data.sourceStream] DO
      char _ (data.sourceStream).GetChar[];
      SELECT char FROM
	'\n, '\032 => EXIT;
	ENDCASE => PutChar[data.errorStream, char];
      ENDLOOP;
    PutChar[data.errorStream, '\n];  RETURN};

  WriteChar: PROC [char: CHAR] ~ INLINE {PutChar[data.errorStream, char]};
  WriteString: PROC [s: STRING] ~ {PutString[data.errorStream, s]};
  Space: PROC ~ INLINE {PutChar[data.errorStream, ' ]};

  ErrorLog: PROC [class: ErrorClass] ~ {
    IF data.textIndex # BcdControlDefs.nullSourceIndex THEN {
      WriteString[", at "L];
      WriteName[data.currentName];
      WriteChar['[];
      PutNumber[data.errorStream, data.textIndex,
      	[base~10, columns~1, unsigned~TRUE, zerofill~FALSE]];
      WriteString["]\n"L];
      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 WriteString["Warning: "L]};

  WriteNameBase: PROC [name: NameRecord, s: BcdOps.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 WriteString["(version "L];
    IF v.time = 0 THEN WriteString["<null version>"L]
    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: SubStringDescriptor;
      HashOps.SubStringForHash[@ss, 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 {WriteString[" (in "L]; 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 {WriteString["(item "L]; PutDecimal[data.errorStream, ep]; WriteChar[')]};
    WriteString[" in interface "L];
    IF export.name # NullName THEN WriteName[export.name]
    ELSE IF export.fti # FTNull THEN {WriteString["from file "L]; WriteName[ftb[export.fti].name]}
    ELSE WriteString["(unknown)"L];
    Space[]; WriteString[s];
    IF sti # stNull THEN {WriteString[" (in "L]; 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 {WriteString[" (in "L]; 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 {WriteString["(item "L]; PutDecimal[data.errorStream, ep]; WriteChar[')]};
    WriteString[" from "L];
    IF import.name # NullName THEN WriteName[import.name]
    ELSE IF import.fti # FTNull THEN {
      WriteString[" file "L];  WriteName[ftb[import.fti].name]}
    ELSE WriteString["(unknown)"L];
    Space[]; WriteString[s];
    IF mti # MTNull THEN { 
      WriteString[" (imported by "L]; WriteName[ModuleName[mti]]; WriteChar[')]};
    ErrorLog[class]};

  ErrorNameBase: PUBLIC PROC [
      class: ErrorClass, s: STRING, name: NameRecord, base: BcdOps.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];
    WriteString[" is referenced in two versions: "L];
    WriteVersion[v1];  WriteString[" and "L];  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]};

  }.