MODULE DswCompilerCPfrontMain;

  IMPORT Kernel, HostFiles, Files, Console, Strings, DswDocuments,
    DevCPM, DevCPT, DevCPB, DevCPP, DevCPE, DevCPH, DevCPV := CPfrontCPV, DevCPG := CPfrontCPG,
    DevCPR;

  CONST
    (* compiler options: *)
    checks = 0; allchecks = 1; assert = 2; obj = 3; ref = 4; allref = 5;
    srcpos = 6; reallib = 7; signatures = 8;
    (* pVarInd = 14; bigEnd = 15; *) ctime = 16;
    mainprog = 20; include0 = 21;
    hint = 29; oberon = 30; errorTrap = 31;
    (* defopt = {checks, assert, obj, ref, allref, srcpos, signatures, ctime}; *)
    defopt = {checks, assert, obj, ctime};

    version = "0.3";

    emulong = 0;
    defopt2 = {};

  TYPE
    Elem = POINTER TO RECORD
      dir, name, path: Files.Name;
      outsym, outcode: Files.Name; (* dir *)
      insym: DevCPM.Directory;
      found: BOOLEAN; (* COM Aware *)
      opts, opts2: SET;
      next: Elem
    END;

    Def = POINTER TO RECORD
      name: DevCPT.Name;
      val: BOOLEAN;
      next: Def
    END;

  VAR
    u: Elem;
    d: Def;

  PROCEDURE GetPath (IN path: ARRAY OF CHAR; OUT dir, name: Files.Name);
    VAR i, j, len: INTEGER;
  BEGIN
    len := LEN(path$);
    i := len - 1;
    WHILE (i >= 0) & (path[i] # '/') DO DEC(i) END;
    IF i >= 0 THEN
      FOR i := 0 TO i - 1 DO
        dir[i] := path[i]
      END;
      dir[i] := 0X
    ELSE
      dir := ""
    END;
    j := i + 1; i := 0;
    WHILE path[j] # 0X DO
      name[i] := path[j];
      INC(i); INC(j)
    END;
    name[i] := 0X
  END GetPath;

  PROCEDURE InitOptions;
    VAR
      i: INTEGER;
      found: BOOLEAN;
      insym, sym: DevCPM.Directory;
      outsym, outcode: Files.Name;
      p: ARRAY 256 OF CHAR;
      h, t: Elem;
      opts, opts2: SET;

    PROCEDURE Check;
    BEGIN
      IF i >= Kernel.argc THEN
        Console.WriteStr("required more parameters for ");
        Console.WriteStr(p); Console.WriteLn;
        Kernel.Quit(1)
      END
    END Check;

    PROCEDURE Define (IN name: DevCPT.Name; val: BOOLEAN);
      VAR def: Def;
    BEGIN
      NEW(def); def.name := name$; def.val := val; def.next := d; d := def
    END Define;

  BEGIN
    outsym := ""; outcode := "";
    opts := defopt; opts2 := defopt2; found := FALSE;
    h := NIL; t := NIL; insym := NIL;
    i := 1; 
    WHILE i < Kernel.argc DO
      IF Kernel.argv[i, 0] = "-" THEN
        p := Kernel.argv[i]$;
        INC(i);
        IF p = "-legacy" THEN
          DevCPM.legacy := TRUE
        ELSIF p = "-outsym" THEN
          Check;
          outsym := Kernel.argv[i]$;
          INC(i)
        ELSIF p = "-outcode" THEN
          Check;
          outcode := Kernel.argv[i]$;
          INC(i)
        ELSIF p = "-symdir" THEN
          Check;
          sym := insym;
          NEW(insym);
          insym.path := Kernel.argv[i]$;
          insym.legacy := FALSE;
          insym.next := sym;
          INC(i)
        ELSIF p = "-legacysymdir" THEN
          Check;
          sym := insym;
          NEW(insym);
          insym.path := Kernel.argv[i]$;
          insym.legacy := TRUE;
          insym.next := sym;
          INC(i)
        ELSIF p = "-allchecks" THEN
          INCL(opts, allchecks)
        ELSIF p = "-no-allchecks" THEN
          EXCL(opts, allchecks)
        ELSIF p = "-srcpos" THEN
          INCL(opts, srcpos)
        ELSIF p = "-no-srcpos" THEN
          EXCL(opts, srcpos)
        ELSIF p = "-structref" THEN
          INCL(opts, allref)
        ELSIF p = "-no-structref" THEN
          EXCL(opts, allref)
        ELSIF p = "-ref" THEN
          INCL(opts, ref)
        ELSIF p = "-no-ref" THEN
          EXCL(opts, ref)
        ELSIF p = "-obj" THEN
          INCL(opts, obj)
        ELSIF p = "-no-obj" THEN
          EXCL(opts, obj)
        ELSIF p = "-assert" THEN
          INCL(opts, assert)
        ELSIF p = "-no-assert" THEN
          EXCL(opts, assert)
        ELSIF p = "-checks" THEN
          INCL(opts, checks)
        ELSIF p = "-no-checks" THEN
          EXCL(opts, checks)
        ELSIF p = "-hints" THEN
          INCL(opts, hint)
        ELSIF p = "-no-hints" THEN
          EXCL(opts, hint)
        ELSIF p = "-trap" THEN
          Kernel.intTrap := TRUE;
          INCL(opts, errorTrap)
        ELSIF p = "-no-trap" THEN
          EXCL(opts, errorTrap)
        ELSIF p = "-oberon" THEN
          INCL(opts, oberon)
        ELSIF p = "-no-oberon" THEN
          EXCL(opts, oberon)
        ELSIF p = "-com-aware" THEN
          found := TRUE
        ELSIF p = "-no-com-aware" THEN
          found := FALSE
        ELSIF (p = "-v") OR (p = "-verbose") THEN
          DevCPM.verbose := MIN(DevCPM.verbose + 1, 3)
        ELSIF p = "-main" THEN
          INCL(opts, mainprog)
        ELSIF p = "-no-main" THEN
          EXCL(opts, mainprog)
        ELSIF p = "-include0" THEN
          INCL(opts, include0)
        ELSIF p = "-no-include0" THEN
          EXCL(opts, include0)
	ELSIF p = "-includedir" THEN
          Check;
          DevCPG.includePath := Kernel.argv[i]$;
          INC(i)
        ELSIF p = "-long-calls" THEN
          INCL(opts2, emulong)
        ELSIF p = "-no-long-calls" THEN
          EXCL(opts2, emulong)
        ELSIF p = "-version" THEN
          Console.WriteStr(version); Console.WriteLn;
          Kernel.Quit(0)
        ELSIF p = "-use-time" THEN
          INCL(opts, ctime)
        ELSIF p = "-no-use-time" THEN
          EXCL(opts, ctime)
        ELSIF p = "-define+" THEN
          Check; Define(Kernel.argv[i]$, TRUE); INC(i)
        ELSIF p = "-define-" THEN
          Check; Define(Kernel.argv[i]$, FALSE); INC(i)
        ELSE
          Console.WriteStr("unknown option ");
          Console.WriteStr(p); Console.WriteLn;
          Kernel.Quit(1)
        END
      ELSE
        IF h = NIL THEN NEW(h); t := h
        ELSE NEW(t.next); t := t.next
        END;
        t.path := Kernel.argv[i]$;
        t.outcode := outcode;
        t.outsym := outsym;
        t.insym := insym;
        t.found := found;
        t.opts := opts;
        t.opts2 := opts2;
        GetPath(t.path, t.dir, t.name);
        IF t.name = "" THEN
          Console.WriteStr("specified path to directory"); Console.WriteLn;
          Kernel.Quit(1)
        END;
        INC(i)
      END
    END;
    u := h
  END InitOptions;

  PROCEDURE Module (source: POINTER TO ARRAY OF CHAR; m: Elem; OUT error: BOOLEAN);
    VAR ext, new: BOOLEAN; p: DevCPT.Node; def: Def;
  BEGIN
    DevCPG.opt := {}; (* !!! *)
    DevCPM.Init(source);
    DevCPM.symList := m.insym;
    DevCPM.codePath := m.outcode;
    DevCPM.symPath := m.outsym;
    DevCPM.name := m.path;
    INCL(DevCPM.options, 10); (* !!! allow [ccall] *)
    INCL(DevCPM.options, DevCPM.allSysVal); (* !!! make nodes for all SYSTEM.VAL *)
    INCL(DevCPG.opt, DevCPG.ansi); (* !!! *)
    IF m.found THEN INCL(DevCPM.options, DevCPM.comAware) END;
    IF errorTrap IN m.opts THEN INCL(DevCPM.options, DevCPM.trap) END;
    IF oberon IN m.opts THEN INCL(DevCPM.options, DevCPM.oberon) END;
    IF mainprog IN m.opts THEN INCL(DevCPG.opt, DevCPG.mainprog) END;
    IF include0 IN m.opts THEN INCL(DevCPG.opt, DevCPG.include0) END;
    IF ctime IN m.opts THEN INCL(DevCPG.opt, DevCPG.ctime) END;
    DevCPT.Init(m.opts);
    (* DevCPB.typSize := DevCPV.TypeSize; *)
    DevCPB.typSize := DevCPV.TypSize;
    DevCPT.processor := DevCPV.processor;
    DevCPR.Init;
    def := d;
    WHILE def # NIL DO
      DevCPR.Set(def.name, def.val);
      def := def.next
    END;
    DevCPP.Module(p);
    DevCPR.Check;
    IF DevCPM.noerr THEN
      IF DevCPT.libName # "" THEN EXCL(m.opts, obj) END;
      DevCPV.Init(m.opts); DevCPV.AdrAndSize(DevCPT.topScope); DevCPT.Export(ext, new);
      IF DevCPM.noerr & (obj IN m.opts) THEN
        DevCPG.OpenFiles(DevCPT.SelfName);
        IF emulong IN m.opts2 THEN
          DevCPH.UseCalls(p, {DevCPH.longMop, DevCPH.longDop, DevCPH.longConv, DevCPH.longOdd});
        END;
        DevCPV.Module(p)
      END;
      (* DevCPV.Close *)
    END;
    IF DevCPM.noerr & (DevCPG.mainprog IN DevCPG.opt) & (DevCPG.modName # "SYSTEM") THEN
      DevCPM.DeleteNewSym;
      IF DevCPM.verbose > 0 THEN
        DevCPM.LogWStr("  main program"); DevCPM.LogWLn
      END
    ELSIF DevCPM.noerr & (new OR ext) THEN
      DevCPM.RegisterNewSym
    ELSE
      DevCPM.DeleteNewSym
    END;
    IF obj IN m.opts THEN
      DevCPG.CloseFiles
    END;
    DevCPR.Close;
    DevCPT.Close;
    error := ~DevCPM.noerr;
    IF error THEN
      DevCPM.InsertMarks;
      IF DevCPM.verbose > 0 THEN DevCPM.LogWStr(" ") END;
      IF DevCPM.errors = 1 THEN
        DevCPM.LogWStr("one error detected");
      ELSE
        DevCPM.LogWNum(DevCPM.errors, 0); DevCPM.LogWStr(" errors detected")
      END;
      DevCPM.LogWLn
    ELSE
      IF hint IN m.opts THEN DevCPM.InsertMarks END
    END;
    DevCPM.Close;
    p := NIL;
    Kernel.FastCollect
  END Module;

  PROCEDURE ReadText (s: Elem): POINTER TO ARRAY OF CHAR;
    VAR
      i, res: INTEGER;
      m: DswDocuments.Model;
      r: DswDocuments.Reader;
      loc: Files.Locator;
      src: POINTER TO ARRAY OF CHAR;
      num: ARRAY 32 OF CHAR;
  BEGIN
    loc := Files.dir.This(s.dir);
    DswDocuments.Open(loc, s.name, m, res);
    IF m # NIL THEN
      r := m.NewReader(NIL);
      NEW(src, m.Length() + 1);
      IF src # NIL THEN
        FOR i := 0 TO m.Length() - 1 DO
          r.Read; src[i] := r.char
        END
      END
    ELSIF DevCPM.verbose > 0 THEN
      Strings.IntToString(res, num);
      Console.WriteStr("document error ");
      Console.WriteStr(num);
      Console.WriteLn
    END;
    IF src = NIL THEN
      Console.WriteStr("unable to open file ");
      Console.WriteStr(s.path);
      Console.WriteLn;
      Kernel.Quit(1)
    END;
    RETURN src
  END ReadText;

  PROCEDURE CompileAll;
    VAR loc: Files.Locator; m: Elem; error: BOOLEAN; src: POINTER TO ARRAY OF CHAR;
  BEGIN
    m := u;
    WHILE m # NIL DO
      IF DevCPM.verbose > 0 THEN
        Console.WriteStr("compiling "); Console.WriteStr(m.path); Console.WriteLn
      END;
      src := ReadText(m);
      Module(src, m, error);
      IF error THEN Kernel.Quit(1) END;
      m := m.next
    END
  END CompileAll;

  PROCEDURE Init;
  BEGIN
    IF Kernel.trapCount # 0 THEN Kernel.Quit(1) END;
    HostFiles.SetRootDir(".");
    InitOptions;
    CompileAll;
    Kernel.Quit(0)
  END Init;

BEGIN
  Kernel.intTrap := FALSE;
  Kernel.Start(Init)
END DswCompilerCPfrontMain.