IMPLEMENTATION MODULE YcStorm;           

FROM Conversions           IMPORT IntConversions;
FROM YaflCfg               IMPORT YaflCfg, CurrentSpot;
FROM YaflClasses           IMPORT ClassDeclaration;
FROM YaflCompiler          IMPORT Compiler;
FROM YaflModules           IMPORT DefinitionModule, ImplementationModule;
FROM YaflClDefinition      IMPORT ClassDefinition;
FROM YaflClImplementation  IMPORT ClassImplementation;
FROM YaflMethods           IMPORT MethodDeclaration;
FROM YaflMetImplementation IMPORT MethodImplementation;
FROM YaflMetDefinition     IMPORT MethodDefinition;
FROM YaflParser            IMPORT NonTerminal;
FROM YaflPredefined        IMPORT PredefCreateMethod,PredefMethod,PredefItems;
FROM YaflType              IMPORT Type;
FROM YaflStatements        IMPORT Statement;
FROM YaflPragmas           IMPORT Pragma, CallBackPragma;
FROM YaflError             IMPORT MainErrorHandler;
FROM YaflWorlds            IMPORT DefaultWorld;
FROM YaflProject           IMPORT ProjectFile, ProjectModule;
FROM Ycc                   IMPORT Yc, CompilationRun, MultiLineMapper;
FROM Streams               IMPORT StdOut, StdErr, InputStream, OutputStream;
FROM Set                   IMPORT Set; 
FROM List                  IMPORT List, StringElement, StringList;
FROM Ref                   IMPORT Ref;
FROM Stack                 IMPORT Stack;
FROM ModuleTable           IMPORT ModuleTable;
FROM Space                 IMPORT Space;
FROM SYSTEM                IMPORT SYSTEM;
FROM String                IMPORT String;

FROM StoConfig             IMPORT StoConfig;
FROM StoCreator            IMPORT StoObjectCreator;
FROM StoMetImplementation  IMPORT StoMetImplementation; 
FROM StoClaImplementation  IMPORT StoClaImplementation;
FROM StoModImplementation  IMPORT StoModImplementation;
FROM StoClaDefinition      IMPORT StoClaDefinition;
FROM StoMetQueue           IMPORT MethodQueue;
FROM StoDictionary        IMPORT ClassDictionary, 
                                  MethodDictionary,
                                  EntryDictionary,
                                  CallDictionary,
                                  MethodReference,
                                  ClassReference;
FROM StoDesignator         IMPORT StoDesigElement;
FROM StoUtils              IMPORT StoUtils;
FROM StoOutput             IMPORT StoOutput, TextOutput;

  CLASS Optimizer;                        
    INHERITS Yc;
  
  --------------------------  
  -- Tag all modules of the program
  --------------------------    
  METHOD BuildTables (Prj     : ProjectFile; 
                      Modules : StringList(ProjectModule)) : BOOLEAN;
    i         : INTEGER;
      ClassName, ModuleName: ARRAY OF CHAR;
    BEGIN
    RESULT := TRUE;
    Output.Display ("Building tables", 0);
    FOR i := 0 TO Modules.Size - 1 WHILE RESULT DO
      CheckMemory;
      Output.Display (ToString(i+1) + '/' + ToString(Modules.Size) + ':' +
               Modules.Get(i).Get, 0);
      CompRun.CREATE(Modules.Get(i).Get, TRUE);
      CurrentSpot.SetCurrentCompilationRun (CompRun);
      WHAT CompRun.CompiledModule OF
        IN StoModImplementation:
          TAG.BuildTables;
          TAG.MarkOnceClasses;
          ------------------------
          -- If TAG refers to the Root module, visit the
          -- main class CREATE method.
          ------------------------
          ModuleName := Space.StoreString (Prj.RootModule.Get);
          ClassName := Space.StoreString (Prj.RootClass);
          RootClassRef := ClassDictionary.FindClass (ModuleName,
                                                      ClassName);
          END;
        END;          
      CurrentSpot.SetCurrentCompilationRun (VOID);
      CompRun.EraseCompiledModule;
      RESULT := RESULT AND CompRun.Ok;
      CompRun := VOID;
      END; -- FOR     
    ASSERT RootClassRef <> VOID;
    CallDictionary.FillStructure;
    MethodDictionary.FillStructure;
    END BuildTables;
    
  --------------------------
  -- Visit the parse tree and mark all used methods and classes
  --------------------------
  METHOD VisitParseTree (Prj: ProjectFile);
    BEGIN    
    -----------------------------
    -- With each method in ToVisit, one can access to
    -- other methods to put in ToVisit, etc...
    ----------------------------- 
    RootClassRef.MarkCreated;
    ClassDictionary.VisitOnceClasses;
    WHILE (MethodQueue.Size > 0) DO
      MethodQueue.VisitTop;
      k := k + 1;
      IF k MOD 256 = 0 THEN
        Output.Display ("Visiting methods: " + 
                         ToString (k) + ' Waiting: ' +
                         ToString (MethodQueue.Size), 0); 
        END;
      END;
    END VisitParseTree;
    
  --------------------------------
  -- Visit the parse tree :
  --   * Mark unused classes and methods
  --   * Visit the method calls
  --------------------------------
  METHOD Visit(Prj: ProjectFile);
                        
      METHOD Dump (Pass : INTEGER);
        BEGIN
        a := IntConversions.IntToString (Pass, 0);
        ClassDictionary.Dump (YaflCfg.NameMapper.
                                 BuildTargetFileName("","clas", a, "storm"));
        MethodDictionary.Dump (YaflCfg.NameMapper.
                                 BuildTargetFileName("","meth", a, "storm"));
        EntryDictionary.Dump (YaflCfg.NameMapper.
                                 BuildTargetFileName("","entr", a, "storm"));
        CallDictionary.Dump (YaflCfg.NameMapper.
                                 BuildTargetFileName("","call", a, "storm"));
        END Dump;
      
      METHOD DoVisit;
        BEGIN
        CallDictionary.Clear;
        EntryDictionary.Clear;
        MethodDictionary.Clear;
        ClassDictionary.Clear;
        
        VisitParseTree (Prj);         
        
        CallDictionary.RemoveUseless;
        EntryDictionary.RemoveUseless;
        MethodDictionary.RemoveUseless;
        ClassDictionary.RemoveUseless;
        
        Dump(Pass);
        Pass := Pass + 1;
        END DoVisit;    
        
    BEGIN            
    Output.Display ("Visiting Program...", 0);
    OldCardinality := -1;                     
    DoVisit;
    WHILE (OldCardinality <> MethodDictionary.UsefulCount) DO
      OldCardinality := MethodDictionary.UsefulCount;
      DoVisit;
      END; -- While 
    MethodDictionary.MarkCallReferences;
    CallDictionary.InitMonomorphableFlag;
    Dump(Pass);
    END Visit;
    
  ----------------------------------------
  -- Generates the C code for the entire project
  ----------------------------------------  
  METHOD GenerateCode (Prj : ProjectFile): BOOLEAN;
    i         : INTEGER;
      Modules : StringList(ProjectModule);
      MainModule: ImplementationModule;
      MainClass: ClassDefinition;
    BEGIN
    RESULT := TRUE;
    Modules := Prj.Modules;
    Output.Display ("Generating code", 0);
    FOR i := 0 TO Modules.Size - 1 WHILE RESULT DO
      CheckMemory;
      Output.Display (ToString(i+1) + '/' + ToString(Modules.Size) + ':' +
               Modules.Get(i).Get, 0);
      CompRun.CREATE(Modules.Get(i).Get, TRUE);
      CurrentSpot.SetCurrentCompilationRun (CompRun);
      WHAT CompRun.CompiledModule OF
        IN StoModImplementation:
          TAG.AttachToCurrentWorld;
          TAG.CodeGeneration;
          END;
        END;          
      RESULT := RESULT AND CompRun.Ok;
      CompRun.EraseCompiledModule;
      CompRun := VOID;
      END; -- FOR     
    CheckMemory;
    CompRun.CREATE(Prj.RootModule.Get, TRUE);
    MainModule := CompRun.CompiledModule;
    MainClass := MainModule.DefModule.Classes.Find(
                                             Space.StoreString(Prj.RootClass));
    IF MainClass = VOID THEN
      Error ("Could ot find class "+ Prj.RootClass);
      END;
    GenerateStub (Prj, MainModule, MainClass);
    END GenerateCode; 

  METHOD ShowResults : BOOLEAN;
    BEGIN           
    RESULT := TRUE;
    IF StoConfig.StatsStream <> VOID THEN
      Output.Display ("Generating Results", 0);  
      ClassDictionary.Stats (StoConfig.StatsStream);
      MethodDictionary.Stats (StoConfig.StatsStream);
      EntryDictionary.Stats (StoConfig.StatsStream);
      CallDictionary.Stats (StoConfig.StatsStream);
      END;
    END ShowResults;

  --------------------------------------
  -- Converts an INTEGER into an ARRAY OF CHAR
  -------------------------------------- 
  METHOD ToString (i: INTEGER): ARRAY OF CHAR;
    BEGIN
    RESULT := IntConversions.IntToString (i, 0);
    END ToString;  
    
  --------------------------------------
  -- Handles the compilation of the entire project
  --------------------------------------
  REDEFINE METHOD ExecutePrj (Prj : ProjectFile) : BOOLEAN;
    BEGIN         
    RESULT := TRUE;
    Prj.ClearTimeStamps;
    Prj.SetPatterns (GetMapper);   
    Modules := Prj.Modules;
    RESULT := BuildTables (Prj, Modules);
    IF NOT RESULT THEN
      Error ("Building tables phase aborted");
      END;          
    Visit(Prj);
    
    CleanUpMemory;
    RESULT := RESULT AND GenerateCode (Prj);
    IF NOT RESULT THEN
      Error ("C code not generated");
      END;
            
    RESULT := RESULT AND CompileStub(Prj);
    IF NOT RESULT THEN
      Error ("Stub compilation phase aborded");
      END;                             
      
    RESULT := RESULT AND CompileC(Prj, Modules);
    IF NOT RESULT THEN 
      Error ("C compilation phase aborded");
      END;
      
    RESULT := RESULT AND Link(Prj);
    IF NOT RESULT THEN
      Error ("Link phase aborded");
      END;
                  
    RESULT := RESULT AND ShowResults;
    IF NOT RESULT THEN
      Error ("No results available");
      END;      
    END ExecutePrj;

  REDEFINE METHOD CREATE;
    BEGIN
    YaflCfg.SetDirPrefix("storm");
    BASE;
    END CREATE;

  END Optimizer;
  -----------------------------------
  CLASS YStorm;    
    INHERITS Optimizer;

  VAR 
    TheOutput : TextOutput;

  REDEFINE METHOD CREATE;
    BEGIN
    TheOutput.CREATE (StdOut);
    StoUtils.SetOutput (TheOutput);
    BASE;
    END CREATE;           
    
  REDEFINE METHOD Disclaimer : ARRAY OF CHAR;
    BEGIN
    RESULT := "ystorm - YAFL global optimizer - Version " + OptVersion + 
                 " [" + Yc.Version + "]";
    END Disclaimer;             
    
  REDEFINE METHOD Output : StoOutput;
    BEGIN      
    RESULT := TheOutput;
    END Output;
    
  METHOD ProcessOptimizerFlag (Arg : ARRAY OF CHAR);
    BEGIN
      CASE Arg[2] OF
        'l', 'L' :                                   
          Output.Display ("Generate direct link optimization", 0);
          StoConfig.GenerateDirectLink (TRUE);
          END;
        'i', 'I' : 
          Output.Display ("GenerateInLine optimization", 0);
          StoConfig.GenerateInLine (TRUE);
          END;
        'r', 'R' :
          Output.Display ("Remove methods optimization", 0);
          StoConfig.RemoveMethods (TRUE);
          END;
        'd', 'D' : 
          Output.Display ("Remove ASSERTs and DEBUGs", 0);
          StoConfig.RemoveDebug (TRUE);
          END;
        's', 'S' : 
          Output.Display ("Optimize value stack handling", 0);
          StoConfig.OptimizeValueStack (TRUE);
          END;
        'a', 'A' :
          Output.Display ("All optimizations", 0);
          StoConfig.GenerateDirectLink (TRUE);
          StoConfig.GenerateInLine (TRUE);
--          StoConfig.RemoveMethods (TRUE);
          StoConfig.RemoveDebug (TRUE);
          StoConfig.OptimizeValueStack (TRUE);
          END;
       ELSE
        Error ("Unrecognized optimizer option" + Arg);
        END;
    END ProcessOptimizerFlag;
    
  -------------------------------
  -- Find MainClassName And MainModuleName
  -- in arguments of program
  -------------------------------    
  REDEFINE METHOD ProcessArgument (Arg: ARRAY OF CHAR): BOOLEAN;
    BEGIN
    RESULT := TRUE;
    ASSERT Arg <> VOID;
    ASSERT Arg.SIZE > 0;
    IF Arg[0] = '-' THEN
      IF Arg.SIZE < 2 THEN
        Error ("Unrecognized option: " + Arg);
       ELSE
        CASE Arg[1] OF
          'h', 'H', '?':
            Help;
            END;
          'q', 'Q' :
            ProcessOptimizerFlag (Arg);
            END;
          'r', 'R' :
            IF Arg.SIZE > 2 THEN
              TheOutputStream.CREATE;
              TheOutputStream.Create (Arg.SLICE(2, Arg.SIZE - 2),
                                      TheOutputStream.WriteAccess);
              StoConfig.ShowResults (TheOutputStream);                              
             ELSE
              StoConfig.ShowResults (StdOut);
              END;
            END;
         ELSE
          RESULT := BASE (Arg);
          END;
        END;
     ELSIF Arg[0] = '?' THEN
      Help;         
     ELSE 
      Error ("Syntax error, unrecognized argument:" + Arg);
      END;
    END ProcessArgument;

  ------------------------------------
  REDEFINE METHOD ProcessArguments : BOOLEAN;
    BEGIN        
    RESULT := BASE;
    YaflCfg.SetPleaseTag(TRUE);
    YaflCfg.SetGenerateCode(FALSE);
    YaflCfg.SetGenerateYamCode(FALSE);
    YaflCfg.SetGenerateMetrics(FALSE);
    YaflCfg.SetPleaseLint(FALSE);
    END ProcessArguments;

  ------------------------------------
  REDEFINE METHOD Help;
    BEGIN         
    BASE;                 
    StdOut.WriteLn;
    StdOut.WriteLine ("                        Global optimization flags:");
    StdOut.WriteLine ("                        --------------------------");
    StdOut.WriteLine ("  -h, -H, -? : display this help information");
    StdOut.WriteLine ("  -r, -R     : display optimizations results");
    StdOut.WriteLine ("  -ql        : optimize method call");
    StdOut.WriteLine ("  -qi        : generate in line");
    StdOut.WriteLine ("  -qr        : remove unused methods");
    StdOut.WriteLine ("  -qd        : remove ASSERTs and DEBUGs");
    StdOut.WriteLine ("  -qs        : optimize value stack handling");
    StdOut.WriteLine ("  -qa        : optimize all");
    SYSTEM.HALT;
    END Help;

  END YStorm;
  
END YcStorm;
