-- ErrorImpl.mesa  
--   Last edited by Lewis on  4-Jan-82 17:58:04
--   last edited by Satterthwaite, December 29, 1982 11:52 am

DIRECTORY
  BcdDefs USING [FTIndex, FTNull, MTIndex, NameRecord, VersionStamp],
  CharIO USING [NumberFormat, PutChar, PutNumber, PutString],
  Error,
  FileStream: TYPE USING [SetIndex],
  HashOps USING [HTIndex, htNull, SubStringForHash],
  PackagerDefs USING [globalData, nullSourceIndex],
  SourceBcd: TYPE
    USING [bcdBases, ComponentKind, CTreeIndex, nullCTreeIndex, Father, Name],
  Stream: TYPE USING [GetChar, EndOfStream],
  String USING [SubString, SubStringDescriptor],
  Table USING [Base],
  Time USING [Append, Packed, Unpack];

ErrorImpl: PROGRAM
    IMPORTS CharIO, FileStream, HashOps, PackagerDefs, SourceBcd, Stream, Time
    EXPORTS Error =
  BEGIN OPEN PackagerDefs, Error;

  SubStringDescriptor: TYPE = String.SubStringDescriptor;
  SubString: TYPE = String.SubString;
  

 -- 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, '\n]};
  Space: PROC = INLINE {CharIO.PutChar[globalData.errorStream, ' ]};

  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;
      FileStream.SetIndex[globalData.packStream, lineIndex];
      IF (globalData.packStream).GetChar[] = '\n THEN EXIT;
      start _ lineIndex;
      ENDLOOP;
    FileStream.SetIndex[globalData.packStream, start];
    THROUGH [1..100] DO
      char _ (globalData.packStream).GetChar[ ! Stream.EndOfStream => GOTO out];
      SELECT char FROM
	'\n, '\032 => EXIT;	-- ^Z for Bravo trailers
	ENDCASE => WriteChar[char];
      REPEAT
        out => NULL;
      ENDLOOP;
    WriteChar['\n];
    END;

  WriteHti: PROC [hti: HashOps.HTIndex] =
    BEGIN
    ss: SubStringDescriptor;
    IF hti = HashOps.htNull THEN RETURN;
    HashOps.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 [v: BcdDefs.VersionStamp, paren: BOOL_FALSE] = {
    IF paren THEN WriteString["(version "L];
    IF v.time = 0 THEN WriteString["<null version>"L]
    ELSE {
      StampWords: CARDINAL~BcdDefs.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[')]};

  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: HashOps.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;

WrongFileVersion: PUBLIC PROC [
      class: ErrorClass, 
      fti: BcdDefs.FTIndex, 
      requiredVersion, actualVersion: BcdDefs.VersionStamp] =
    BEGIN
    Prefix[class];
    WriteString["File "L];
    WriteName[SourceBcd.bcdBases.ftb[fti].name];
    WriteString[" was required in version "L];
    WriteVersion[requiredVersion];
    WriteString[", but was found in version "L];
    WriteVersion[actualVersion];
    ErrorLog[class];
    END;

  UnknownComponent: PUBLIC PROC [
      class: ErrorClass, 
      kind: SourceBcd.ComponentKind, 
      mainPartOfCompId: HashOps.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
    
    WriteQualifiedName: PROC [cNode: SourceBcd.CTreeIndex] =
      BEGIN
      IF cNode.Father # SourceBcd.nullCTreeIndex THEN
        {WriteQualifiedName[cNode.Father];  WriteChar['.]};
      WriteName[cNode.Name[kind]];
      END;

    Prefix[class];
    WriteString["Ambiguous component reference: "L];
    WriteString["two interpretations are\n"L];
    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: HashOps.HTIndex, 
      module: BcdDefs.MTIndex] =
    BEGIN
    Prefix[class];
    WriteString["A component's procedures may only be abbreviated once: \n"L];
    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: HashOps.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 tablecompiled and must be included as a unit"L];
    ErrorLog[class];
    END;

  NotProcInModule: PUBLIC PROC [
      class: ErrorClass, 
      procName: HashOps.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: HashOps.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: HashOps.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;
 
  EmptyCodePack: PUBLIC PROC [
      class: ErrorClass, 
      cpId: HashOps.HTIndex] =
    BEGIN
    Prefix[class];
    WriteString["The code pack "L];
    WriteHti[cpId];
    WriteString[" is empty"L];
    ErrorLog[class];
    END;

  FrameInTwoFramePacks: PUBLIC PROC [
      class: ErrorClass, 
      module: BcdDefs.MTIndex, 
      fpId1, fpId2: HashOps.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;
 
  EVNotFirst: PUBLIC PROC [
      class: ErrorClass, 
      module: BcdDefs.MTIndex] =
    BEGIN
    Prefix[class];
    WriteString["A procedure or the catch code of module "L];
    WriteName[SourceBcd.bcdBases.mtb[module].name];
    WriteString[" appears before its entry vector"L];
    ErrorLog[class];
    END;
    
  EVInDiscardCodePack: PUBLIC PROC [
      class: ErrorClass, 
      module: BcdDefs.MTIndex] =
    BEGIN
    Prefix[class];
    WriteString["The entry vector of module "L];
    WriteName[SourceBcd.bcdBases.mtb[module].name];
    WriteString[" appears in a discard code pack"L];
    ErrorLog[class];
    END;
 
  SegmentTooLarge: PUBLIC PROC [
      class: ErrorClass, 
      segId: String.SubString] =
    BEGIN
    Prefix[class];
    WriteString["The code segment "L];
    WriteSubString[segId];
    WriteString[" is larger than 32K words"L];
    ErrorLog[class];
    END;

  END.