(* Copyright (C) 1992, Digital Equipment Corporation           *)
(* All rights reserved.                                        *)
(* See the file COPYRIGHT for a full description.              *)

(* File: Host.m3                                               *)
(* Last modified on Mon Sep 21 08:10:10 PDT 1992 by kalsow     *)
(*      modified on Sat Mar 16 01:44:52 1991 by muller         *)

UNSAFE MODULE Host;

IMPORT String, Rd, Wr, RTArgs, M3toC, FileStream, Stdio, Error, Fmt;
IMPORT Text, Emit, RTMisc, Thread, ETimer, Scanner, Unit;

TYPE ArgNode = REF RECORD next: ArgNode;  arg: TEXT END;
TYPE ArgList = REF RECORD head, tail: ArgNode := NIL;  cnt := 0 END;

VAR
  sourceName   : TEXT := NIL;
  outputName   : TEXT := NIL;
  linkName     : TEXT := NIL;
  search_timer : ETimer.T := NIL;
  first_reset  : BOOLEAN := TRUE;
  server_mode  : BOOLEAN := FALSE;

PROCEDURE OpenFile (name: TEXT): Rd.T =
  (* open file in the current directory *)
  BEGIN
    TRY
      RETURN FileStream.OpenRead (name);
    EXCEPT Rd.Failure =>
      RETURN NIL;
    END;
  END OpenFile;

PROCEDURE CloseRd (rd: Rd.T) =
  BEGIN
    IF (rd # NIL) THEN
      TRY Rd.Close (rd) EXCEPT ELSE END;
    END;
  END CloseRd;

PROCEDURE CloseWr (wr: Wr.T) =
  BEGIN
    IF (wr # NIL) THEN
      TRY Wr.Close (wr) EXCEPT ELSE END;
    END;
  END CloseWr;

PROCEDURE FlushWr (wr: Wr.T) =
  BEGIN
    IF (wr # NIL) THEN
      TRY Wr.Flush (wr) EXCEPT ELSE END;
    END;
  END FlushWr;

PROCEDURE OpenUnit (name: String.T; interface, generic: BOOLEAN;
                                          VAR(*OUT*) filename: String.T): Rd.T=
  VAR rd: Rd.T;
  BEGIN
    ETimer.Push (search_timer);
    rd := Unit.Open (name, interface, generic, filename);
    ETimer.Pop ();
    RETURN rd;
  END OpenUnit;

PROCEDURE OpenWriter (name: TEXT): Wr.T =
  <*FATAL Wr.Failure, Thread.Alerted*>
  BEGIN
    IF (name = NIL) THEN
      Error.Msg ("missing output file");
      RETURN NIL;
    END;
    TRY
      RETURN FileStream.OpenWrite (name);
    EXCEPT Wr.Failure =>
      Error.Msg ("unable to open output file");
      Wr.PutText (errors, "  \"" & name & "\": ??\n");
      RETURN NIL;
    END;
  END OpenWriter;

PROCEDURE Halt (e: INTEGER) =
  BEGIN
    IF (e = 0) THEN Emit.Op ("\003"); END;
    FlushWr (errors);
    FlushWr (output);
    FlushWr (linkOutput);
    IF (errors # Stdio.stderr) THEN CloseWr (errors) END;
    IF (output # Stdio.stdout) THEN CloseWr (output) END;
    IF (linkOutput # Stdio.stdout) THEN CloseWr (linkOutput) END;
    IF (e # 0) THEN RTMisc.Exit (e) END;
  END Halt;

PROCEDURE Initialize () =
  BEGIN
    errors     := Stdio.stderr;
    output     := NIL;
    linkOutput := NIL;
    source     := NIL;
    verbose    := FALSE;
    Clines     := FALSE;
    errorDie   := -1;
    standard   := TRUE;
    warnings   := 2;
    coverage   := FALSE;
    inlines    := FALSE;
    ProcessOptions ();
    IF (NOT server_mode) THEN
      IF (source = NIL) THEN
        sourceName := "<stdin>";
        filename := String.Add (sourceName);
        source   := Stdio.stdin;
      END;
      IF (output = NIL) THEN
        outputName := "<stdout>";
        output := Stdio.stdout;
      END;
      IF (linkOutput = NIL) THEN
        IF (outputName # NIL) THEN
          linkName := LinkName (outputName);
          linkOutput := OpenWriter (linkName);
        ELSE
          linkName := "<stdout>";
          linkOutput := Stdio.stdout;
        END;
      END;
    END;
  END Initialize;

PROCEDURE ProcessOptions () =
  VAR args := NEW (ArgList);  arg: UNTRACED REF ADDRESS;
  BEGIN
    FOR i := 1 TO RTArgs.argc-1 DO
      arg := RTArgs.argv + i * ADRSIZE (ADDRESS);
      Append (args, M3toC.StoT (arg^));
    END;
    ProcessArgList (args);
  END ProcessOptions;

PROCEDURE ProcessArgFile (file: TEXT) =
  <*FATAL Rd.Failure, Rd.EndOfFile, Thread.Alerted*>
  VAR rd: Rd.T;  args := NEW (ArgList);
  BEGIN
    rd := OpenFile (file);
    IF (rd = NIL) THEN Die ("unable to open argument file: ", file) END;
    WHILE NOT Rd.EOF (rd) DO
      Append (args, Trim (Rd.GetLine (rd)));
    END;
    CloseRd (rd);
    ProcessArgList (args);
  END ProcessArgFile;

PROCEDURE ProcessArgList (list: ArgList) =
  BEGIN
    WHILE (list.cnt > 0) DO
      ProcessArg (PopArg (list));
    END;
  END ProcessArgList;

PROCEDURE StartTimers () =
  BEGIN
    IF do_timing THEN RETURN END;
    do_timing := TRUE;
    search_timer := ETimer.New ("searching and opening imported files");
    ETimer.Enable ();
  END StartTimers;

PROCEDURE ProcessArg (t: TEXT) =
  <*FATAL Wr.Failure, Thread.Alerted*>
  VAR len: INTEGER;  key: TEXT;
  BEGIN
    key := Text.Sub (t, 0, 2);
    IF Text.Equal (key, "-D") THEN
      len := Text.Length (t) - 2;
      t := Text.Sub (t, 2, len);
      IF (Text.GetChar (t, len - 1) # '/') THEN  t := t & "/"  END;
      Unit.PushDir (t);
    ELSIF Text.Equal (key, "-T") THEN
      len := Text.Length (t) - 2;
      t := Text.Sub (t, 2, len);
      Unit.PushTable (t);
    ELSIF (Text.Equal (t, "-v")) THEN
      verbose := TRUE;
      warnings := -1;
      StartTimers ();
    ELSIF (Text.Equal (t, "-times")) THEN
      StartTimers ();
    ELSIF (Text.Equal (t, "-C")) THEN
      Clines := TRUE;   (* don't generate Modula-3 line numbers *)
    ELSIF (Text.Equal (t, "-S")) THEN
      versionStamps := FALSE;   (* don't generate version stamps *)
    ELSIF (Text.Equal (t, "-NoStd")) THEN
      standard := FALSE; (* ignore extensions *)
    ELSIF (Text.Equal (t, "-w")) THEN
      warnings := 99;
    ELSIF (Text.Equal (key, "-w")) THEN
      warnings := GetInt (t, 2);
    ELSIF (Text.Equal (t, "-builtins")) THEN
      emitBuiltins := TRUE; (* emit the predefined scopes *)
    ELSIF (Text.Equal (t, "-Z")) THEN
      coverage := TRUE; (* generate line profiling *)
    ELSIF (Text.Equal (t, "-I")) THEN
      inlines := TRUE; (* expand inline procedures *)
    ELSIF (Text.Equal (key, "-E")) THEN
      errorDie := GetInt (t, 2);
    ELSIF (Text.Equal (key, "-F")) THEN
      ProcessArgFile (Text.Sub (t, 2, LAST (INTEGER)));
    ELSIF (Text.Equal (key, "-n")) THEN
      outputName := Text.Sub (t, 2, LAST (INTEGER));
    ELSIF (Text.Equal (key, "-o")) THEN
      t := Text.Sub (t, 2, LAST (INTEGER));
      IF outputName = NIL THEN outputName := t; END;
      output := OpenWriter (outputName);
      IF Clines THEN
        Wr.PutText (output, "#line 2 \"" & outputName & "\"\n");
      END;
    ELSIF (Text.Equal (key, "-x")) THEN
      linkName := Text.Sub (t, 2, LAST (INTEGER));
      linkOutput := OpenWriter (linkName);
    ELSIF (Text.Equal (t, "-a")) THEN (* backward compatibility *)
      doAsserts := FALSE;
    ELSIF (Text.Equal (t, "-NoAsserts")) THEN
      doAsserts := FALSE;
    ELSIF (Text.Equal (t, "-NoNarrowChk")) THEN
      doNarrowChk := FALSE;
    ELSIF (Text.Equal (t, "-NoRangeChk")) THEN
      doRangeChk := FALSE;
    ELSIF (Text.Equal (t, "-NoReturnChk")) THEN
      doReturnChk := FALSE;
    ELSIF (Text.Equal (t, "-NoCaseChk")) THEN
      doCaseChk := FALSE;
    ELSIF (Text.Equal (t, "-NoTypecaseChk")) THEN
      doTCaseChk := FALSE;
    ELSIF (Text.Equal (t, "-NoNilChk")) THEN
      doNilChk := FALSE;
    ELSIF (Text.Equal (t, "-NoStackChk")) THEN
      doStackChk := FALSE;
    ELSIF (Text.Equal (t, "-NoRaisesChk")) THEN
      doRaisesChk := FALSE;
    ELSIF (Text.Equal (t, "-NoChecks")) THEN
      doAsserts   := FALSE;
      doNarrowChk := FALSE;
      doRangeChk  := FALSE;
      doReturnChk := FALSE;
      doCaseChk   := FALSE;
      doTCaseChk  := FALSE;
      doNilChk    := FALSE;
      doStackChk  := FALSE;
      doRaisesChk := FALSE;
    ELSIF (Text.Equal (t, "-server")) THEN
      server_mode := TRUE;
    ELSIF (Text.GetChar (t, 0) = '-') THEN
      Die ("unknown option: ", t);
    ELSIF (filename = NIL) THEN
      sourceName := t;
      filename := String.Add (t);
      source := OpenFile (t);
      IF source = NIL THEN Die ("\"", t, "\" does not exist.") END;
    ELSE
      Die ("multiple input files specified: ", t);
    END;
  END ProcessArg;

CONST LinesPerMegabyte = 5000;
VAR   total_lines := 2 * LinesPerMegabyte;

PROCEDURE Reset (): BOOLEAN =
  <*FATAL Wr.Failure, Thread.Alerted*>
  CONST Result = ARRAY BOOLEAN OF CHAR { '0', '1' };
  VAR errs, warns, memory_size: INTEGER;
  BEGIN
    IF (server_mode) THEN

      IF (output # NIL) THEN
        (* tell the driver how the last compilation came out *)
        Error.Count (errs, warns);
        INC (total_lines, Scanner.nLines);
        memory_size := (total_lines DIV LinesPerMegabyte);
        IF NOT Send (Result [errs > 0], Fmt.Int (memory_size)) THEN
          RETURN FALSE;
        END;

        (* close the input and output files from the last compilation *)
        CloseWr (output);
        CloseWr (linkOutput);
        CloseRd (source);
        source := NIL;      sourceName := NIL;
        output := NIL;      outputName := NIL;
        linkOutput := NIL;  linkName := NIL;
      END;

      (* wait for the new files to compile... *)
      IF (source = NIL) THEN
        IF NOT Rcv (sourceName) THEN RETURN FALSE END;
        IF NOT Rcv (outputName) THEN RETURN FALSE END;
        IF NOT Rcv (linkName)   THEN RETURN FALSE END;
        filename   := String.Add (sourceName);
        source     := OpenFile   (sourceName);
        output     := OpenWriter (outputName);
        linkOutput := OpenWriter (linkName);
      END;

      IF (source = NIL) THEN Die ("\"", sourceName, "\" does not exist.") END;
      IF (output = NIL) OR (linkOutput = NIL) THEN RETURN FALSE END;
      
      IF Clines THEN
        Wr.PutText (output, "#line 2 \"" & outputName & "\"\n");
      END;

      RETURN TRUE;

    ELSIF (first_reset) THEN (* non-server mode *)
      first_reset := FALSE;
      RETURN TRUE;

    ELSE (* 2nd reset, not a server *)
      Error.Count (errs, warns);
      IF (errs > 0) THEN Halt (errs) END;
      RETURN FALSE;
    END;
  END Reset;

PROCEDURE Send (a: CHAR;  b: TEXT := NIL): BOOLEAN =
  BEGIN
    TRY
      Wr.PutChar (Stdio.stdout, a);
      IF (b # NIL) THEN Wr.PutText (Stdio.stdout, b) END;
      Wr.PutChar (Stdio.stdout, '\n');
      FlushWr    (Stdio.stdout);
      RETURN TRUE;
    EXCEPT Wr.Failure, Thread.Alerted =>
      RETURN FALSE;
    END;
  END Send;

PROCEDURE Rcv (VAR t: TEXT): BOOLEAN =
  BEGIN
    TRY
      LOOP
        t := Trim (Rd.GetLine (Stdio.stdin));
        IF (Text.Length (t) <= 0) THEN RETURN FALSE END;
        IF NOT Text.Equal (t, "*") THEN RETURN TRUE END;
        (* send a heartbeat reply *)
        IF NOT Send ('*') THEN RETURN FALSE END;
      END;
    EXCEPT Rd.EndOfFile, Rd.Failure, Thread.Alerted =>
      RETURN FALSE;
    END;
  END Rcv;

PROCEDURE Die (a, b, c, d: TEXT := NIL) =
  <*FATAL Wr.Failure, Thread.Alerted*>
  BEGIN
    Wr.PutText (Stdio.stderr, "fatal error: ");
    IF (a # NIL) THEN Wr.PutText (Stdio.stderr, a) END;
    IF (b # NIL) THEN Wr.PutText (Stdio.stderr, b) END;
    IF (c # NIL) THEN Wr.PutText (Stdio.stderr, c) END;
    IF (d # NIL) THEN Wr.PutText (Stdio.stderr, d) END;
    Wr.PutChar (Stdio.stderr, '\n');
    Halt (-1);
  END Die;

PROCEDURE GetInt (t: TEXT;  start: INTEGER): INTEGER =
  VAR c: CHAR;  n: INTEGER := 0;
  BEGIN
    FOR j := start TO Text.Length (t)-1 DO
      c := Text.GetChar (t, j);
      IF (c < '0') OR ('9' < c) THEN RETURN n END;
      n := n * 10 + ORD (c) - ORD ('0');
    END;
    RETURN n;
  END GetInt;

PROCEDURE Trim (t: TEXT): TEXT =
  VAR start := 0;  len := Text.Length (t);
  BEGIN
    WHILE (len > 0) AND (Text.GetChar (t, start) = ' ') DO
      INC (start);
      DEC (len);
    END;
    WHILE (len > 0) AND (Text.GetChar (t, start+len-1) = ' ') DO
      DEC (len);
    END;
    RETURN Text.Sub (t, start, len);
  END Trim;

PROCEDURE Append (list: ArgList;  val: TEXT) =
  VAR n := NEW (ArgNode, next := NIL, arg := val);
  BEGIN
    IF (list.head = NIL)
      THEN list.head := n;
      ELSE list.tail.next := n;
    END;
    list.tail := n;
    INC (list.cnt);
  END Append;

PROCEDURE PopArg (list: ArgList): TEXT =
  VAR txt: TEXT;
  BEGIN
    IF (list = NIL) OR (list.cnt <= 0) THEN RETURN NIL END;
    txt := list.head.arg;
    list.head := list.head.next;
    DEC (list.cnt);
    RETURN txt;
  END PopArg;

PROCEDURE LinkName (t: TEXT): TEXT =
  BEGIN
    RETURN Text.Sub (t, 0, Text.Length (t) - 1) & "x";
  END LinkName;

BEGIN
END Host.