PreviousUpNext

15.4.555  src/lib/compiler/front/basics/stats/compile-statistics.pkg

## compile-statistics.pkg
#
# Support code for tracking and printing the CPU
# time used by various parts of the compile process.

# Compiled by:
#     src/lib/compiler/front/basics/basics.sublib



###             "We are all in the gutter, but
###              some of us are looking at the stars."
###
###                        -- Oscar Wilde


stipulate
    package at  =  runtime_internals::at;                                       # runtime_internals     is from   src/lib/std/src/nj/runtime-internals.pkg
    package cp  =  control_print;                                               # control_print         is from   src/lib/compiler/front/basics/print/control-print.pkg
    package ct  =  cpu_timer;                                                   # cpu_timer             is from   src/lib/std/src/cpu-timer.pkg
    package tm  =  time;                                                        # time                  is from   src/lib/std/time.pkg
herein

    package   compile_statistics
    :         Compile_Statistics                                                # Compile_Statistics    is from   src/lib/compiler/front/basics/stats/compile-statistics.api
    {
        time_to_string
            =
            tm::format 2;

        Counter
            =
            COUNTER
              { count:                  Ref( Int ),                             # Primary count associated with the counter.
                secondary_counters:     List( Counter )                         # We also increment these whenever we increment the primary value.
              };

        Counterssum
            =
            COUNTERSSUM
              { name:                   String,
                counters:                       List( Counter )
              };

        all_statistics = REF (NIL:  List( Counterssum ));                       # More icky thread-hostile mutable global state. :-(    XXX BUGGO FIXME


        # Search by name in a list of counterssum (in practice, all_statistics),
        # return NULL if not found:
        #
        fun find_statistic (name, NIL)
                =>
                NULL;

            find_statistic (name, (p as COUNTERSSUM { name=>n, ... } ) ! rest)
                => 
                if (name == n)   THE p;
                else             find_statistic (name, rest);
                fi;
        end;


        # Add statistic to a list (in practice, all_statistics):
        #
        fun insert ( p as COUNTERSSUM { name => pn, ... },
                    (q as COUNTERSSUM { name => qn, ... } )  !  rest
                   )
                =>
                if (pn < qn)   p ! q ! rest;
                else           q ! insert (p, rest);
                fi;

            insert (p, NIL)
                =>
                p ! NIL;
        end;


        fun make_counter secondary_counters
            =
            COUNTER { count => REF 0,
                      secondary_counters
                    };

        fun increment_counter_by  (COUNTER { count, secondary_counters })  n
            =
            {   count :=  *count + n;                                           # Increment our primary count.
                #
                apply                                                           # Increment any secondary counts we were given.
                    (\\ count =  increment_counter_by count n)
                    secondary_counters;
            };

        fun get_counter_value (COUNTER { count => REF counter_value, ... } )
            =
            counter_value;

        fun make_counterssum (name, counters)
            =
            COUNTERSSUM { name, counters };

        fun note_counterssum (p as COUNTERSSUM { name, counters } )
            = 
            case (find_statistic (name, *all_statistics))
                #
                THE p =>  ();
                NULL  =>  all_statistics :=  insert (p, *all_statistics);
            esac;

        fun make_counterssum'  name
            =
            case (find_statistic (name, *all_statistics))
                #         
                THE p =>  p;
                #
                NULL => {   p =  make_counterssum (name, [ make_counter [] ]);
                            #
                            all_statistics :=  insert (p,*all_statistics); p;
                        };
            esac;

        fun increment_counterssum_by  (COUNTERSSUM { counters => (counter ! _), ... } )  n  =>   increment_counter_by counter n;
            increment_counterssum_by  (COUNTERSSUM { counters => [],            ... } )  _  =>   ();
        end;

        say   =  cp::say;
        flush =  cp::flush;

        # NOTE: we should be able to rewrite this using the timer package   XXX BUGGO FIXME

        Times = { usr: tm::Time,
                  sys: tm::Time,
                  gc:  tm::Time
                };

        zeros = { usr =>  tm::zero_time,
                  sys =>  tm::zero_time,
                  gc  =>  tm::zero_time
                };

        Compiler_Phase
            =
            COMPILER_PHASE
              { name:       String,
                cumulative: Ref( Times ),
                this:       Ref( Times )
              };


        all_compiler_phases =  REF (NIL:  List(Compiler_Phase));                                        # XXX BUGGO FIXME Another icky bit of global mutable state.



        stipulate
            # Search by name in all_compiler_phases, return compiler_phase else NULL:
            #
            fun find_compiler_phase (name, NIL)
                    =>
                    NULL;

                find_compiler_phase (name, (p as COMPILER_PHASE { name=>n, ... } ) ! rest)
                    => 
                    if (name == n)   THE p;
                    else             find_compiler_phase (name, rest);
                    fi;
            end;

            # Add named compiler_phase to all_compiler_phases:
            #
            fun insert_compiler_phase (  p as COMPILER_PHASE { name=>pn, ... },
                                        (q as COMPILER_PHASE { name=>qn, ... } ) ! rest
                             )
                    =>
                    if (pn < qn)    p ! q ! rest;
                    else            q ! insert_compiler_phase (p, rest);
                    fi;

                insert_compiler_phase (p, NIL)
                    =>
                    p ! NIL;
            end;
        herein

            fun make_compiler_phase name
                =
                case (find_compiler_phase (name, *all_compiler_phases))
                    #     
                    THE p =>  p;
                    #
                    NULL  =>  p
                              where
                                  p = COMPILER_PHASE {   name,
                                                cumulative => REF zeros,
                                                this  => REF zeros
                                            };

                                  all_compiler_phases :=  insert_compiler_phase (p, *all_compiler_phases);
                              end;
                esac;
        end;

        current          =  REF (make_compiler_phase "Other");          # Global mutable state. XXX BUGGO FIXME

        keep_time        =  REF TRUE;                           # Global mutable state. XXX BUGGO FIXME
        approx_time      =  REF TRUE;                           # Global mutable state. XXX BUGGO FIXME
        #
        # At the moment these three are controlled by hardwired logic in
        #     src/app/makelib/compile/compile-in-dependency-order-g.pkg
        # -- look for show_compile_compiler_phase_runtimes_for():
        #
        say_begin        =  REF FALSE;                  # By default, do not narrate start of each compiler phase.                                                                      # Global mutable state. XXX BUGGO FIXME
        say_end          =  REF FALSE;                  # By default, do not narrate end   of each compiler phase, with CPU seconds used.                                               # Global mutable state. XXX BUGGO FIXME
# say_begin = log::debugging;                           # By default, do not narrate start of each compiler phase.                                                                      # Global mutable state. XXX BUGGO FIXME
# say_end   = log::debugging;                           # By default, do not narrate end   of each compiler phase, with CPU seconds used.                                               # Global mutable state. XXX BUGGO FIXME
        say_when_nonzero =  REF FALSE;                  # By default, even if previous is *TRUE, do not narrate end of compiler phases with 0.00 seconds of CPU usage.                  # Global mutable state. XXX BUGGO FIXME

        infix my 70 +++ ;   my (+++) = time::(+) ;
        infix my 70 --- ;   my (---) = time::(-) ;

        infix my 70  ++++ ;

        fun { usr, sys, gc }++++{ usr=>u, sys=>s, gc=>g }
            =
            { usr =>  usr+++u,
              sys =>  sys+++s,
              gc  =>  gc+++g
            };

        infix my 70  ---- ;

        fun { usr, sys, gc }----{ usr=>u, sys=>s, gc=>g }
            = 
            if (time::(<) (usr, u))
                #
                zeros; 
            else
                { usr =>  usr---u,
                  sys =>  sys---s,
                  gc  =>  gc---g
                };
            fi;

        stipulate
            fun gettime ()
                =
                {   (ct::get_elapsed_heapcleaner_and_program_usermode_and_kernelmode_cpu_seconds (ct::get_cpu_timer ()))
                        ->
                        { program, heapcleaner };
                

                    # This is a hack.
                    # (This module deserves a complete rewrite!!)                       XXX SUCKO FIXME

                    { usr =>  time::from_float_seconds  program.usermode_cpu_seconds,
                      sys =>  time::from_float_seconds (program.kernelmode_cpu_seconds + heapcleaner.kernelmode_cpu_seconds),
                      gc  =>  time::from_float_seconds  heapcleaner.usermode_cpu_seconds
                    };
                };

            last   = REF (gettime());                                                   # More icky thread-hostile global mutable state.                XXX SUCKO FIXME
        herein 
            fun reset ()
                =
                {   last :=  gettime ();

                    apply
                        (\\ COMPILER_PHASE { this, cumulative, ... } =  { this := zeros;   cumulative := zeros; }) 
                        *all_compiler_phases;

                    # Zero all counts, both primary and secondary counters:
                    #
                    apply
                        (\\ COUNTERSSUM { counters, ... } =   apply  (\\ COUNTER { count, ... } =  count := 0)  counters)
                        *all_statistics;
                };


                                                                                    my _ = 
            at::schedule
                (
                  "compile-statistics.pkg:  reset",                             # Arbitrary label

                  [ at::STARTUP_PHASE_8_RESET_COMPILER_STATISTICS ],            # When to run the function.

                  \\ _ =  { reset(); }                                          # Function to run.
                );

                                                                                    my _ = 
            at::schedule
                (
                  "compile-statistics.pkg:  last := zeros",                     # Arbitrary label

                  [ at::SHUTDOWN_PHASE_5_ZERO_COMPILE_STATISTICS ],             # When to run the function.

                  \\ _ = { last := zeros; }
                );

            fun since()
                =
                {
      #          x = if *approxTime
      #                 then let
      #                   t1 = *lastcollect
      #                   u1 = *System::Runtime::minorcollections
      #                   in lastcollect := u1; u1!=t1 end
      #                 else TRUE;

                    x = TRUE;

                    if x
                        t =  *last;
                        u =  gettime();

                        last := u;
                        (u ---- t);
                    else
                        zeros;
                    fi;
                };

        end;                                                    # stipulate

        # Call f(x) n times:                                    # Shouldn't this move to standard.lib somewhere?
        #
        fun repeat 0 f x
                =>
                ();

           repeat n f x
                =>
                {   f x;
                    repeat (n - 1) f x;
                };
        end;

        fun sayfield (n, string)                                # Print 'string', pad to length 'n' with trailing blanks.
            =
            {    say string;
                #
                 repeat (int::max (0, n - size(string)))  say " ";
            };


        # Call f(x) while tracking and maybe
        # printing its CPU time consumption:
        #
        fun do_compiler_phase (p as COMPILER_PHASE { name, this, cumulative }) f x
            =
            {   (*current)
                    ->
                    prev as COMPILER_PHASE { this=>t', ... };

                fun end_time ()
                    =
                    {   (since() ++++ *this)
                            ->
                            x as { usr, sys, gc };

                        this  :=  zeros;
                        cumulative :=  *cumulative ++++ x;

                        usr +++ sys +++ gc;
                    };

                fun finish ()
                    =
                    {   current :=  prev;
                        #
                        if *say_end
                            #
                            time = time_to_string (end_time ());
                            #
                            if (time != "0.00" or *say_when_nonzero)
                                #
                                say "End   ";
                                sayfield (40, name);

                                if *keep_time   apply say ["    ", time, " sec\n"];
                                else            say "\n";
                                fi;

                                flush();
                            fi;
                        else
                            end_time();
                            ();
                        fi;
                    };

                if *keep_time
                    #
                    t' :=  since() ++++ *t';
                fi;

                current :=  p;

                if *say_begin
                    #
                    apply say ["Begin ", name, "\n"];
                    flush();
                fi;

                (   (f x)
                    except
                        e =  {   finish ();
                                 raise exception e;
                             }
                )
                then
                    finish ();
            };

        fun compute_sum_of_counters (COUNTERSSUM { counters, ... } )                    # Sum primary values of our counters.
            =
            fold_forward
                (\\ (counter, sum) =   get_counter_value counter  +  sum)
                0
                counters;

        fun show_statistic (s as COUNTERSSUM { name, counters } )
            =
            {   sayfield (40, name);
                say (int::to_string (compute_sum_of_counters s));
                say "\n";
            };

        fun show_compiler_phase (COMPILER_PHASE { name, this, cumulative } )
            =
            {   (*this ++++ *cumulative)
                    ->
                    { usr, sys, gc };

                sayfield (40, name); 

                say (time_to_string usr);  say "u  ";
                say (time_to_string sys);  say "s  ";
                say (time_to_string gc );  say "g  ";

                say "\n";
            };

        fun summary ()
            =
            {   sum = fold_backward
                          (\\ (COMPILER_PHASE { cumulative, ... }, t) =  *cumulative ++++ t)
                          zeros
                          *all_compiler_phases;

                apply  show_statistic  *all_statistics; 

                apply
                    show_compiler_phase
                    (*all_compiler_phases @ [COMPILER_PHASE { name=>"TOTAL", this=>REF zeros, cumulative=>REF sum } ]);
            };

        fun show_compiler_phase_sp (COMPILER_PHASE { name, this, cumulative } )
            =
            {   (*this ++++ *cumulative)
                    ->
                    { usr, sys, gc };

                case (tm::compare (usr+++sys+++gc, tm::zero_time))
                    #
                    EQUAL => ();
                    #
                    _     => {   sayfield (40, name); 
                                 say (time_to_string (usr+++sys));  say "u  ";
#                                say (time_to_string sys);          say "s  "; 
                                 say (time_to_string gc);           say "g  ";
                                 say "\n";
                             };
                esac;
            };

        fun summary_sp ()                                                               # Apparently never called.  No clue what "sp" means.
            =
            {   sum = fold_backward
                          (\\ (COMPILER_PHASE { cumulative, ... }, t) =   *cumulative++++t)
                          zeros
                          *all_compiler_phases;

                apply show_statistic *all_statistics; 

                apply show_compiler_phase_sp
                  (   *all_compiler_phases
                      @
                      [ COMPILER_PHASE { name  =>  "TOTAL",
                                         this  =>  REF zeros,
                                         cumulative =>  REF sum
                                       }
                      ]
                  );
            };

    };                                                                                  # package compile_statistics 
end;


Comments and suggestions to: bugs@mythryl.org

PreviousUpNext