-- 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.