-- file LogPack.Mesa
-- last modified by Satterthwaite, December 12, 1979  8:35 AM

DIRECTORY
  CharIO: FROM "chario"
    USING [ControlZ, CR, PutChar, PutDecimal, PutNumber, PutString],
  ComData: FROM "comdata"
    USING [
      bodyIndex, errorStream, nErrors, nWarnings, sourceStream,
      switches, textIndex],
  CompilerUtil: FROM "compilerutil" USING [error, TableSegment],
  ErrorTable: FROM "errortable" USING [CSRptr],
  LiteralOps: FROM "literalops" USING [Value, StringValue],
  Log: FROM "log" USING [ErrorCode],
  SegmentDefs: FROM "segmentdefs"
    USING [FileSegmentHandle, SegmentAddress, SwapIn, Unlock],
  StreamDefs: FROM "streamdefs"
    USING [
      StreamIndex,
      CloseDiskStream, ModifyIndex, NormalizeIndex, OpenDiskStream, SetIndex],
  StringDefs: FROM "stringdefs" USING [SubString, SubStringDescriptor],
  Symbols: FROM "symbols"
    USING [seType, bodyType, HTIndex, ISEIndex, HTNull, SENull, BTNull],
  SymbolOps: FROM "symbolops" USING [SubStringForHash],
  Table: FROM "table" USING [Base, Bounds],
  Tree: FROM "tree" USING [Index, Link, NodeName, Scan, Null, treeType],
  TreeOps: FROM "treeops" USING [ScanList];

LogPack: PROGRAM
    IMPORTS
      CharIO, CompilerUtil, LiteralOps, SegmentDefs, StreamDefs,
      SymbolOps, Table, TreeOps,
      dataPtr: ComData
    EXPORTS Log =
  BEGIN
  OPEN Symbols;

  ErrorCode: TYPE = Log.ErrorCode;
  SubString: TYPE = StringDefs.SubString;

 -- public interface

  Error: PUBLIC PROCEDURE [code: ErrorCode] =
    BEGIN LockStringTable[]; ErrorLog[code, TRUE]; UnlockStringTable[] END;

  ErrorHti: PUBLIC PROCEDURE [code: ErrorCode, hti: HTIndex] =
    BEGIN ErrorTree[code, Tree.Link[hash[hti]]] END;

  ErrorN: PUBLIC PROCEDURE [code: ErrorCode, n: INTEGER] =
    BEGIN  OPEN CharIO;
    LockStringTable[];
    PutDecimal[dataPtr.errorStream, n];  PutChar[dataPtr.errorStream, ' ];
    ErrorLog[code, TRUE];
    UnlockStringTable[];
    END;

  ErrorNode: PUBLIC PROCEDURE [code: ErrorCode, node: Tree.Index] =
    BEGIN ErrorTree[code, Tree.Link[subtree[node]]] END;

  ErrorSei: PUBLIC PROCEDURE [code: ErrorCode, sei: ISEIndex] =
    BEGIN ErrorTree[code, Tree.Link[symbol[sei]]] END;

  ErrorString: PUBLIC PROCEDURE [code: ErrorCode, s: STRING] =
    BEGIN  OPEN CharIO;
    LockStringTable[];
    PutString[dataPtr.errorStream, s];  PutChar[dataPtr.errorStream, ' ];
    ErrorLog[code, TRUE];
    UnlockStringTable[];
    END;

  ErrorTree: PUBLIC PROCEDURE [code: ErrorCode, t: Tree.Link] =
    BEGIN  OPEN CharIO;
    LockStringTable[];
    PrintOperand[t, 0, 0];  PutString[dataPtr.errorStream, "  "L];
    ErrorLog[code, TRUE];
    UnlockStringTable[];
    END;

  Warning: PUBLIC PROCEDURE [code: ErrorCode] =
    BEGIN
    IF dataPtr.switches['w] THEN
      BEGIN
      LockStringTable[];
      CharIO.PutString[dataPtr.errorStream, "warning: "L];
      ErrorLog[code, FALSE];
      UnlockStringTable[];
      END;
    END;

  WarningNode: PUBLIC PROCEDURE [code: ErrorCode, node: Tree.Index] =
    BEGIN WarningTree[code, Tree.Link[subtree[node]]] END;

  WarningSei: PUBLIC PROCEDURE [code: ErrorCode, sei: ISEIndex] =
    BEGIN WarningTree[code, Tree.Link[symbol[sei]]] END;

  WarningTree: PUBLIC PROCEDURE [code: ErrorCode, t: Tree.Link] =
    BEGIN
    IF dataPtr.switches['w] THEN
      BEGIN  OPEN CharIO;
      LockStringTable[];
      PutString[dataPtr.errorStream, "warning:  "L];
      PrintOperand[t, 0, 0];  PutString[dataPtr.errorStream, "  "L];
      ErrorLog[code, FALSE];
      UnlockStringTable[];
      END;
    END;

 -- source printing

  PrintTextLine: PROCEDURE [i: CARDINAL] =
    BEGIN  OPEN StreamDefs, CharIO;
    start, lineIndex: StreamIndex;
    char: CHARACTER;
    n: [1..100];
    OpenDiskStream[dataPtr.sourceStream];
    start _ lineIndex _ NormalizeIndex[[page:0, byte:i]];
    FOR n IN [1..100] UNTIL lineIndex = [0, 0]
      DO
      lineIndex _ ModifyIndex[lineIndex, -1];
      SetIndex[dataPtr.sourceStream, lineIndex];
      IF dataPtr.sourceStream.get[dataPtr.sourceStream] = CR THEN EXIT;
      start _ lineIndex;
      ENDLOOP;
    SetIndex[dataPtr.sourceStream, start];
    FOR n IN [1..100] WHILE ~dataPtr.sourceStream.endof[dataPtr.sourceStream]
      DO
      SELECT (char _ dataPtr.sourceStream.get[dataPtr.sourceStream]) FROM
	CR, ControlZ => EXIT;
	ENDCASE => PutChar[dataPtr.errorStream, char];
      ENDLOOP;
    NewLine[];  
    CloseDiskStream[dataPtr.sourceStream];
    END;


  -- CSRp and desc.base are set by LockStringTable

  errorSeg: SegmentDefs.FileSegmentHandle =
    CompilerUtil.TableSegment[CompilerUtil.error];

  CSRp: ErrorTable.CSRptr;
  desc: StringDefs.SubStringDescriptor;
  ss: SubString = @desc;

  LockStringTable: PROCEDURE =
    BEGIN
    SegmentDefs.SwapIn[errorSeg];
    CSRp _ LOOPHOLE[SegmentDefs.SegmentAddress[errorSeg]];
    ss.base _ @CSRp[CSRp.stringOffset];
    END;

  UnlockStringTable: PROCEDURE = BEGIN SegmentDefs.Unlock[errorSeg] END;


  WriteSubString: PROCEDURE [ss: SubString] =
    BEGIN
    i: CARDINAL;
    FOR i IN [ss.offset..ss.offset + ss.length)
      DO  CharIO.PutChar[dataPtr.errorStream, ss.base[i]]  ENDLOOP;
    END;

  WriteErrorString: PROCEDURE [n: ErrorCode] =
    BEGIN
    ss.offset _ CSRp.ErrorMessages[n].offset;
    ss.length _ CSRp.ErrorMessages[n].length;
    WriteSubString[ss];
    END;

  WriteHti: PROCEDURE [hti: HTIndex] =
    BEGIN  OPEN CharIO;
    desc: StringDefs.SubStringDescriptor;
    s: SubString = @desc;
    IF hti = HTNull
      THEN  PutString[dataPtr.errorStream, "(anonymous)"L]
      ELSE  BEGIN SymbolOps.SubStringForHash[s, hti]; WriteSubString[s] END;
    END;

  WriteSei: PROCEDURE [sei: ISEIndex] =
    BEGIN
    WriteHti[IF sei=SENull
	THEN HTNull
	ELSE (Table.Bounds[seType].base)[sei].hash];
    END;


  WriteLti: PROCEDURE [t: literal Tree.Link] =
    BEGIN  OPEN CharIO;
    WITH t.info SELECT FROM
      word =>  PutDecimal[dataPtr.errorStream, LiteralOps.Value[index]];
      string =>
	BEGIN
	PutChar[dataPtr.errorStream, '"];
	PutString[dataPtr.errorStream, LiteralOps.StringValue[index]];
	PutChar[dataPtr.errorStream, '"];
	END;
      ENDCASE;
    END;


  -- tables used for printing trees


--   OpName: ARRAY Tree.NodeName[assignx..uparrow] OF STRING _
--     ["_",
--      " OR ", " AND ", "=", "#", "<", ">=", ">", "<=", " IN ", " ~IN ",
--      "+", "-", "*", "/", " MOD ",
--      ".", ".", ".",
--      " NEW ", "~", "-", "@", "^"];

  WriteOpName: PROCEDURE[n: Tree.NodeName[assignx..uparrow]] =
    BEGIN
    ss.offset _ CSRp.OpName[n].offset;
    ss.length _ CSRp.OpName[n].length;
    WriteSubString[ss];
    END;

    OpPrec: ARRAY Tree.NodeName[assignx..uparrow] OF CARDINAL =
     [1, 
      2, 3, 5, 5, 5, 5, 5, 5, 5, 5,
      6, 6, 7, 7, 7,
      10, 10, 10,
      1, 4, 8, 9, 10];


--   FnName: ARRAY Tree.NodeName[min..loophole] OF STRING _
--     ["MIN", "MAX", "LONG", "ABS", "ALL", "SIZE", "FIRST", "LAST",
--      "DESCRIPTOR", "LENGTH", "BASE", "LOOPHOLE"];

  WriteFnName: PROCEDURE[n: Tree.NodeName[min..loophole]] =
    BEGIN
    ss.offset _ CSRp.FnName[n].offset;  ss.length _ CSRp.FnName[n].length;
    WriteSubString[ss];
    END;

  Cutoff: CARDINAL = 3;

  PrintOperand: PROCEDURE [t: Tree.Link, tPrec, depth: CARDINAL] =
    BEGIN
    node: Tree.Index;
    prec: CARDINAL;
    op: Tree.NodeName;
    args: Tree.Link;
    tb: Table.Base;
    IF t = Tree.Null THEN RETURN;
    WITH e: t SELECT FROM
      hash =>  WriteHti[e.index];
      symbol =>  WriteSei[e.index];
      literal =>  WriteLti[e];
      subtree =>
	BEGIN  OPEN CharIO;
	tb _ Table.Bounds[Tree.treeType].base;
	node _ e.index;  op _ tb[node].name;
	IF depth > Cutoff THEN
	  BEGIN PutString[dataPtr.errorStream, "..."L]; RETURN END;
	SELECT op FROM
	  syserror, syserrorx =>
	    PutString[dataPtr.errorStream, "ERROR"L];
	  IN [call .. rowcons], stringinit, IN [min .. loophole] =>
	    BEGIN  OPEN tb[node];
	    SELECT op FROM
	      IN [call .. rowcons], stringinit =>
	        BEGIN
	        IF son[1] # Tree.Null THEN PrintOperand[son[1], 0, depth];
	        args _ son[2];
	        END;
	      IN [min .. loophole] =>
		BEGIN  WriteFnName[op];  args _ son[1]  END;
	      ENDCASE;
	    PutChar[dataPtr.errorStream, '[];
	    IF depth = Cutoff AND args.tag = subtree
	      THEN PutString[dataPtr.errorStream, "..."L]
	      ELSE PrintOperandList[args, depth+1];
	    IF op IN [call .. joinx] AND nSons > 2
	      THEN PutString[dataPtr.errorStream, " !..."L];
	    PutChar[dataPtr.errorStream, ']];
	    END;
	  IN [assignx .. uparrow] =>
	    BEGIN  OPEN tb[node];
	    prec _ OpPrec[op];
	    IF prec < tPrec THEN PutChar[dataPtr.errorStream, '(];
	    SELECT op FROM
	      IN [new .. addr] =>
		BEGIN WriteOpName[op]; PrintOperand[son[1], prec, depth] END;
	      IN [assignx .. dollar] =>
		BEGIN
		PrintOperand[son[1], prec, depth+1];
		WriteOpName[op];
		PrintOperand[son[2], prec+1, depth+1];
		END;
	      uparrow =>
		BEGIN
		PrintOperand[son[1], prec, depth];
		PutChar[dataPtr.errorStream, '^];
		END;
	      ENDCASE =>  PutChar[dataPtr.errorStream, '?];
	    IF prec < tPrec THEN PutChar[dataPtr.errorStream, ')];
	    END;
	  IN [intOO .. intCC] =>
	    BEGIN  OPEN tb[node];
	    PutChar[dataPtr.errorStream,
		IF op = intOO OR op = intOC THEN '( ELSE '[];
	    PrintOperand[son[1], 0, depth];
	    PutString[dataPtr.errorStream, ".."L];
	    PrintOperand[son[2], 0, depth];
	    PutChar[dataPtr.errorStream,
		IF op = intOO OR op = intCO THEN ') ELSE ']];
	    END;
	  clit =>
	    BEGIN  PutChar[dataPtr.errorStream, ''];
	    WITH e1: tb[node].son[1] SELECT FROM
	      literal =>
		WITH e1.info SELECT FROM
		  word =>
		    PutChar[dataPtr.errorStream, LiteralOps.Value[index]+0C];
		  ENDCASE;
	      ENDCASE;
	    END;
	  llit, IN [cast .. openx], thread =>
	    PrintOperand[tb[node].son[1], tPrec, depth];
	  item =>
	    PrintOperand[tb[node].son[2], tPrec, depth];
	  ENDCASE =>  PutString[dataPtr.errorStream, "..."L];
	END;
      ENDCASE;
    END;

  PrintOperandList: PROCEDURE [t: Tree.Link, depth: CARDINAL] =
    BEGIN
    firstSon: BOOLEAN _ TRUE;

    PrintItem: Tree.Scan =
      BEGIN  OPEN CharIO;
      IF ~firstSon THEN PutString[dataPtr.errorStream, ", "L];
      firstSon _ FALSE;
      IF t # Tree.Null THEN PrintOperand[t, 0, depth];
      END;

    TreeOps.ScanList[t, PrintItem];
    END;


 -- error-handling routines

  NewLine: PROCEDURE =
    BEGIN OPEN CharIO;  PutChar[dataPtr.errorStream, CR]  END;

  ErrorLog: PROCEDURE [code: ErrorCode, error: BOOLEAN] =
    BEGIN  OPEN CharIO;
    bodyId: ISEIndex;
    index: CARDINAL = dataPtr.textIndex;
    WriteErrorString[code];
    IF error
      THEN  dataPtr.nErrors _ dataPtr.nErrors + 1
      ELSE  dataPtr.nWarnings _ dataPtr.nWarnings + 1;
    PutString[dataPtr.errorStream, ", at "L];
    IF dataPtr.bodyIndex # BTNull
      THEN
	BEGIN
	bodyId _ Table.Bounds[bodyType].base[dataPtr.bodyIndex].id;
	IF bodyId # SENull THEN WriteSei[bodyId];
	END;
    IF index # LAST[CARDINAL] THEN
      BEGIN
      PutChar[dataPtr.errorStream, '[];
      PutNumber[dataPtr.errorStream, index,
	[base:10, zerofill:FALSE, unsigned:TRUE, columns:0]];
      PutChar[dataPtr.errorStream, ']];
      END;
    PutChar[dataPtr.errorStream, ':];  NewLine[];
    IF index # LAST[CARDINAL]
      THEN  PrintTextLine[index]
      ELSE
	BEGIN
	PutString[dataPtr.errorStream, "(source from inline)"L]; NewLine[];
	END;
    NewLine[];
    END;

  END.