-- file LogPack.Mesa
-- last modified by Satterthwaite, September 9, 1982 1:00 pm

DIRECTORY
  Alloc: TYPE USING [Bounds],
  CharIO: TYPE USING [
    ControlZ, CR, SP,
    GetChar, PutChar, PutDecimal, PutNumber, PutString, PutSubString],
  ComData: TYPE USING [
    bodyIndex, nErrors, nWarnings, switches, table, textIndex],
  CompilerUtil: TYPE USING [
    AcquireStream, AcquireTable, ReleaseStream, ReleaseTable],
  ErrorTable: TYPE USING [CSRptr],
  FileStream: TYPE USING [FileByteIndex, EndOf, SetIndex],
  LiteralOps: TYPE USING [Value, StringValue],
  Log: TYPE USING [ErrorCode],
  Stream: TYPE USING [Handle],
  Strings: TYPE USING [String, SubString, SubStringDescriptor],
  Symbols: TYPE USING [seType, bodyType, HTIndex, ISEIndex, HTNull, SENull, BTNull],
  SymbolOps: TYPE USING [SubStringForHash],
  Tree: TYPE USING [Base, Index, Link, NodeName, Scan, Null, treeType],
  TreeOps: TYPE USING [ScanList];

LogPack: PROGRAM
    IMPORTS
      Alloc, CharIO, CompilerUtil, FileStream, LiteralOps, SymbolOps, TreeOps,
      dataPtr: ComData
    EXPORTS Log = {
  OPEN Symbols;

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

 -- public interface

  Error: PUBLIC PROC [code: ErrorCode] = {
    Enter[]; ErrorLog[code, TRUE]; Exit[]};

  ErrorHti: PUBLIC PROC [code: ErrorCode, hti: HTIndex] = {
    ErrorTree[code, [hash[hti]]]};

  ErrorN: PUBLIC PROC [code: ErrorCode, n: INTEGER] = {
    Enter[];
    CharIO.PutDecimal[errorStream, n];  CharIO.PutChar[errorStream, ' ];
    ErrorLog[code, TRUE];
    Exit[]};

  ErrorNode: PUBLIC PROC [code: ErrorCode, node: Tree.Index] = {
    ErrorTree[code, [subtree[node]]]};

  ErrorSei: PUBLIC PROC [code: ErrorCode, sei: ISEIndex] = {
    ErrorTree[code, [symbol[sei]]]};

  ErrorTree: PUBLIC PROC [code: ErrorCode, t: Tree.Link] = {
    Enter[];
    PrintOperand[t, 0, 0];  CharIO.PutString[errorStream, "  "L];
    ErrorLog[code, TRUE];
    Exit[]};

  Warning: PUBLIC PROC [code: ErrorCode] = {
    IF dataPtr.switches['w] THEN {
      Enter[];
      CharIO.PutString[errorStream, "warning: "L];
      ErrorLog[code, FALSE];
      Exit[]}};

  WarningNode: PUBLIC PROC [code: ErrorCode, node: Tree.Index] = {
    WarningTree[code, [subtree[node]]]};

  WarningSei: PUBLIC PROC [code: ErrorCode, sei: ISEIndex] = {
    WarningTree[code, [symbol[sei]]]};

  WarningSubString: PUBLIC PROC [code: ErrorCode, s: Strings.SubString] = {
    IF dataPtr.switches['w] THEN {
      Enter[];
      CharIO.PutSubString[errorStream, s]; CharIO.PutChar[errorStream, ' ];
      ErrorLog[code, FALSE];
      Exit[]}};

  WarningTree: PUBLIC PROC [code: ErrorCode, t: Tree.Link] = {
    IF dataPtr.switches['w] THEN {
      Enter[];
      CharIO.PutString[errorStream, "warning:  "L];
      PrintOperand[t, 0, 0];  CharIO.PutString[errorStream, "  "L];
      ErrorLog[code, FALSE];
      Exit[]}};

 -- source printing

  PrintTextLine: PROC [i: CARDINAL] = {
    OPEN CharIO;
    start, lineIndex: FileStream.FileByteIndex;
    char: CHARACTER;
    n: [1..100];
    sourceStream: Stream.Handle _ CompilerUtil.AcquireStream[source];
    start _ lineIndex _ i;
    FOR n IN [1..100] UNTIL lineIndex = 0 DO
      lineIndex _ lineIndex - 1;
      FileStream.SetIndex[sourceStream, lineIndex];
      IF CharIO.GetChar[sourceStream] = CR THEN EXIT;
      start _ lineIndex;
      ENDLOOP;
    FileStream.SetIndex[sourceStream, start];
    FOR n IN [1..100] WHILE ~FileStream.EndOf[sourceStream] DO
      SELECT (char _ CharIO.GetChar[sourceStream]) FROM
	CR, ControlZ => EXIT;
	ENDCASE => PutChar[errorStream, char];
      ENDLOOP;
    NewLine[];  
    CompilerUtil.ReleaseStream[source]};


  -- errorStream, CSRp and desc.base are set by Enter

  errorStream: Stream.Handle _ NIL;

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

  Enter: PROC = {
    errorStream _ CompilerUtil.AcquireStream[log];
    CSRp _ CompilerUtil.AcquireTable[error];
    ss.base _ @CSRp[CSRp.stringOffset]};

  Exit: PROC = {
    CompilerUtil.ReleaseTable[error];
    CompilerUtil.ReleaseStream[log];  errorStream _ NIL};


  WriteErrorString: PROC [n: ErrorCode] = {
    ss.offset _ CSRp.ErrorMessages[n].offset;
    ss.length _ CSRp.ErrorMessages[n].length;
    CharIO.PutSubString[errorStream, ss]};

  WriteHti: PROC [hti: HTIndex] = {
    OPEN CharIO;
    desc: Strings.SubStringDescriptor;
    s: SubString = @desc;
    IF hti = HTNull THEN PutString[errorStream, "(anonymous)"L]
    ELSE {SymbolOps.SubStringForHash[s, hti]; PutSubString[errorStream, s]}};

  WriteSei: PROC [sei: ISEIndex] = {
    WriteHti[IF sei=SENull
	THEN HTNull
	ELSE ((dataPtr.table).Bounds[seType].base)[sei].hash]};


  WriteLti: PROC [t: literal Tree.Link] = {
    WITH t.info SELECT FROM
      word => CharIO.PutDecimal[errorStream, LiteralOps.Value[index]];
      string => {
	s: Strings.String = LiteralOps.StringValue[index];
	CharIO.PutChar[errorStream, '"];
	FOR i: CARDINAL IN [0..s.length) DO
	  CharIO.PutChar[errorStream, s[i]] ENDLOOP;
	CharIO.PutChar[errorStream, '"]};
      ENDCASE};


  -- tables used for printing trees


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

  WriteOpName: PROC[n: Tree.NodeName[assignx..uparrow]] = {
    ss.offset _ CSRp.OpName[n].offset;
    ss.length _ CSRp.OpName[n].length;
    CharIO.PutSubString[errorStream, ss]};

    OpPrec: ARRAY Tree.NodeName[assignx..uparrow] OF CARDINAL = [
      1, 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", "NIL"];

  WriteFnName: PROC[n: Tree.NodeName[min..nil]] = {
    ss.offset _ CSRp.FnName[n].offset;  ss.length _ CSRp.FnName[n].length;
    CharIO.PutSubString[errorStream, ss]};

  Cutoff: CARDINAL = 3;

  PrintOperand: PROC [t: Tree.Link, tPrec, depth: CARDINAL] = {
    IF t = Tree.Null THEN RETURN;
    WITH e: t SELECT FROM
      hash => WriteHti[e.index];
      symbol => WriteSei[e.index];
      literal => WriteLti[e];
      subtree => {
	OPEN CharIO;
	node: Tree.Index = e.index;
	tb: Tree.Base _ (dataPtr.table).Bounds[Tree.treeType].base;
	op: Tree.NodeName = tb[node].name;
	IF depth > Cutoff THEN {PutString[errorStream, "..."L]; RETURN};
	SELECT op FROM
	  syserror, syserrorx => PutString[errorStream, "ERROR"L];
	  lengthen, --abs,-- IN [first..succ], IN [length..base], nil => {
	    PrintOperand[tb[node].son[1], OpPrec[dot], depth+1];
	    PutChar[errorStream, '.];
	    WriteFnName[op]};
	  IN [call .. rowcons], stringinit, IN [min .. nil] => {
	    OPEN tb[node];
	    args: Tree.Link;
	    SELECT op FROM
	      IN [call .. rowcons], stringinit => {
	        IF son[1] # Tree.Null THEN PrintOperand[son[1], 0, depth];
	        args _ son[2]};
	      IN [min .. nil] => {WriteFnName[op];  args _ son[1]};
	      ENDCASE;
	    IF args # Tree.Null OR op # nil THEN {
	      PutChar[errorStream, '[];
	      IF depth = Cutoff AND args.tag = subtree THEN
	        PutString[errorStream, "..."L]
	      ELSE PrintOperandList[args, depth+1];
	      IF op IN [call .. joinx] AND nSons > 2 THEN
	        PutString[errorStream, " !..."L];
	      PutChar[errorStream, ']]}};
	  IN [assignx .. uparrow] => {
	    OPEN tb[node];
	    prec: CARDINAL = OpPrec[op];
	    IF prec < tPrec THEN PutChar[errorStream, '(];
	    SELECT op FROM
	      IN [create .. addr] => {WriteOpName[op]; PrintOperand[son[1], prec, depth]};
	      IN [assignx .. dollar] => {
		PrintOperand[son[1], prec, depth+1];
		WriteOpName[op];
		PrintOperand[son[2], prec+1, depth+1]};
	      uparrow => {
		PrintOperand[son[1], prec, depth];
		PutChar[errorStream, '^]};
	      ENDCASE => PutChar[errorStream, '?];
	    IF prec < tPrec THEN PutChar[errorStream, ')]};
	  IN [intOO .. intCC] => {
	    OPEN tb[node];
	    PutChar[errorStream, IF op = intOO OR op = intOC THEN '( ELSE '[];
	    PrintOperand[son[1], 0, depth];
	    PutString[errorStream, ".."L];
	    PrintOperand[son[2], 0, depth];
	    PutChar[errorStream, IF op = intOO OR op = intCO THEN ') ELSE ']]};
	  clit => {
	    c: CHARACTER = WITH e1: tb[node].son[1] SELECT FROM
	      literal =>
		WITH e1.info SELECT FROM
		  word => LiteralOps.Value[index]+0C,
		  ENDCASE => ERROR,
	      ENDCASE => ERROR;
	    IF c >= SP THEN {PutChar[errorStream, '']; PutChar[errorStream, c]}
	    ELSE {
	      PutNumber[errorStream, c-0C,
		[base:8, zerofill:FALSE, unsigned:TRUE, columns:0]];
	      PutChar[errorStream, 'c]}};
	  new, cons, listcons => {
	    IF tb[node].son[1] # Tree.Null THEN {
	      PrintOperand[tb[node].son[1], OpPrec[dot], depth+1];
	      PutChar[errorStream, '.]};
	    PutString[errorStream,
	      SELECT op FROM new => "NEW"L, cons => "CONS"L, ENDCASE => "LIST"L];
	    PutChar[errorStream, '[];
	    IF depth = Cutoff THEN PutString[errorStream, "..."L]
	    ELSE PrintOperandList[tb[node].son[2], depth+1];
	    PutChar[errorStream, ']]};
	  atom => {
	    PutChar[errorStream, '$];
	    WITH e1: tb[node].son[1] SELECT FROM hash => WriteHti[e1.index]; ENDCASE};
	  llit, IN [cast .. openx], thread => PrintOperand[tb[node].son[1], tPrec, depth];
	  item => PrintOperand[tb[node].son[2], tPrec, depth];
	  ENDCASE => PutString[errorStream, "..."L]};
      ENDCASE};

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

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

    TreeOps.ScanList[t, PrintItem]};


 -- error-handling routines

  NewLine: PROC = {CharIO.PutChar[errorStream, CharIO.CR]};

  ErrorLog: PROC [code: ErrorCode, error: BOOLEAN] = {
    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[errorStream, ", at "L];
    IF dataPtr.bodyIndex # BTNull THEN {
      bodyId _ ((dataPtr.table).Bounds[Symbols.bodyType]).base[dataPtr.bodyIndex].id;
      IF bodyId # SENull THEN WriteSei[bodyId]};
    IF index # LAST[CARDINAL] THEN {
      PutChar[errorStream, '[];
      PutNumber[errorStream, index,
	[base:10, zerofill:FALSE, unsigned:TRUE, columns:0]];
      PutChar[errorStream, ']]};
    PutChar[errorStream, ':];  NewLine[];
    IF index # LAST[CARDINAL] THEN PrintTextLine[index]
    ELSE {PutString[errorStream, "(source from inline)"L]; NewLine[]};
    NewLine[]};

  }.