#####################################################################
#
# Unicon Profiler v0.7
# Author: Leah Wegner
# Maintainer: Clinton Jeffery, Gigi Young
# March 26, 2018
#
# Notes:
#  The granularity of the timing mechanism on classic Linux was 10 milliseconds.
#  Even after improvements to the code, &time uses 1ms units and can't do better.
#  This causes inaccurate timing results for procedures that typically complete
#  in 0ms, 1ms, or only a few milliseconds. For such procedures, it might
#  be more beneficial to look only at procedure counts instead of run-time.
#
# To Do:
#  Check and correct profiling for programs with co-expressions
#  Design and implement higher-resolution timing mechanisms.
#
####################################################################


link evinit
link evnames
link evsyms
link options
link printf
$include "evdefs.icn"

# Column widths for output formatting
$define PROC_WIDTH	12	# PROCEDURE
$define PTIME_WIDTH	5	# %TIME
$define TIME_WIDTH	7	# TIME
$define CTIME_WIDTH	10	# TIME/CALL
$define CALL_WIDTH	10	# CALLS	
$define RET_WIDTH	10	# RETURNS
$define SUSP_WIDTH	10	# SUSPENDS
$define RESUM_WIDTH	10	# RESUMES
$define FAIL_WIDTH	6	# FAILS

global Proc_stack
global Call_time_stack
global keys
global keys2
record lkey(keyval, timeval)

procedure main(args)
   #Declarations
   local opts
   local symmap
   local val
   local outfile, output

   local Proc_calls := table(0)
   local Proc_fails := table(0)
   local Proc_returns := table(0)
   local Proc_suspends := table(0)
   local Proc_resumes := table(0)

   local Proc_time := table(0)
   local Proc_alone_time := table(0)
   local proc_start_time := 0
   local proc_end_time := 0
   local mask := ProcMask
   local lastline, lines
   local line_time := table(0), line_count := table(0)
   local longest_filename_length := 0
   
   if (*args=0) | (args[1] == ("--help"|"-help")) then
       stop("Usage: uprof [-l] [-o outfile] prog args\n",
	    "\n",
	    "  -l \t\tEnables line-level time sampling\n",
	    "  -o outfile \tWwrites output to file 'outfile'\n")

   if args[1] == "-l" then { pop(args); lines := 1; mask ++:= E_Line }

   if args[1] == "-o" then { 
      pop(args)
      output := pop(args) | stop("no output file specified for -o option")
      if *args = 0 then
        stop("*** cannot open program to monitor")

      # create a new file in write mode
      outfile := open(output, "c") | stop("could not open ",outfile)
   }

   #initializations
   symmap := evsyms()
   Proc_stack := list()
   Call_time_stack := list()

   EvInit(args) | stop("*** cannot open program to monitor")

   while EvGet(mask) do {
      val := &eventvalue

   #Build the tables
      case &eventcode of {
	 E_Line: {
	     linetime := keyword("time", Monitored)
	     linefile := keyword("file", Monitored)
	     longest_filename_length <:= *linefile
	     line_count[linefile||":"||&eventvalue] +:= 1
	     if delta := (0 < linetime-\last_linetime) then {
		 line_time[linefile||":"||&eventvalue] +:= delta
	     }
	     last_linetime := linetime
	 }

         #CALL
         E_Pcall: {
            push(Proc_stack, val)
            push(Call_time_stack, (keyword("&time", Monitored)))
	    Proc_calls[val] +:= 1
         }

         #FAIL
         E_Pfail: {
            Current_proc := pop(Proc_stack)
            proc_start_time := pop(Call_time_stack)
            proc_end_time := keyword("&time", Monitored)

            Proc_fails[val] +:= 1

            curr_proc_time := proc_end_time - proc_start_time
            Proc_time[Current_proc] +:= curr_proc_time

            if *Proc_stack > 0 then {
                # subtract this proc's runtime from next proc on stack 
                Proc_time[Proc_stack[1]] -:= curr_proc_time 
            }
         }

         #RETURN
         E_Pret: {
            Current_proc := pop(Proc_stack)
            proc_start_time := pop(Call_time_stack)
            proc_end_time := keyword("&time", Monitored)

            Proc_returns[Current_proc] +:= 1

            curr_proc_time := proc_end_time - proc_start_time
            Proc_time[Current_proc] +:= curr_proc_time

            if *Proc_stack > 0 then {
                # subtract this proc's runtime from next proc on stack 
                Proc_time[Proc_stack[1]] -:= curr_proc_time
            }
         }

         #SUSPEND
         E_Psusp: {
            Current_proc := pop(Proc_stack)
            proc_start_time := pop(Call_time_stack)
            proc_end_time := keyword("&time", Monitored)

            Proc_suspends[Current_proc] +:= 1

            curr_proc_time := proc_end_time - proc_start_time
            Proc_time[Current_proc] +:= curr_proc_time

            if *Proc_stack > 0 then {
                # subtract this proc's runtime from next proc on stack 
                Proc_time[Proc_stack[1]] -:= curr_proc_time
            }

         }

         #RESUME
         E_Presum: {
            push(Proc_stack, val)
            Proc_resumes[val] +:= 1

            push(Call_time_stack, (keyword("&time", Monitored)))
         }
      }
   }

   if *Proc_stack > 0 then {
      write("Execution left ", *Proc_stack, " frames.")
      while *Proc_stack > 0 do {
         Current_proc := pop(Proc_stack)
         proc_start_time := pop(Call_time_stack)
         Proc_fails[Current_proc] +:= 1

         proc_end_time := keyword("&time", Monitored)

         curr_proc_time := proc_end_time - proc_start_time
         Proc_time[Current_proc] +:= curr_proc_time 
         if *Proc_stack > 0 then {
             # subtract this proc's runtime from next proc on stack 
             Proc_time[Proc_stack[1]] -:= curr_proc_time 
         }
      }
   }

   # calculate total time
   total := 0
   every y := key(Proc_time) do total +:= Proc_time[y]

   #sort the output
   keys := list()
   every y := key(Proc_time) do {
      x := lkey(y, divimage(Proc_time[y]*100,total))
      push(keys, x)
      }
   keys := reverse(sortf(keys, 2))

   #mxname := 15
   #every mxname <:= *image((!keys).keyval)[10:0]

   if \outfile then {
      write(outfile, left("PROCEDURE",PROC_WIDTH), 
            right("%TIME", PTIME_WIDTH), 
            right("TIME", TIME_WIDTH), 
            right("TIME/CALL", CTIME_WIDTH),
            right("CALLS", CALL_WIDTH), 
            right("RETURNS", RET_WIDTH),
            right("SUSPENDS", SUSP_WIDTH), 
            right("RESUMES",RESUM_WIDTH), 
            right("FAILS", FAIL_WIDTH) 
           )
      write(outfile, left("",PROC_WIDTH), 
            right("", PTIME_WIDTH), 
            right("(ms)", TIME_WIDTH), 
            right("(ms)", CTIME_WIDTH),
            right("", CALL_WIDTH), 
            right("", RET_WIDTH),
            right("", SUSP_WIDTH), 
            right("",RESUM_WIDTH), 
            right("", FAIL_WIDTH)
           )
       write(outfile)

       every y := (!keys).keyval do {
         write(outfile, left((image(y))[10:0], PROC_WIDTH),
               right(divimage(Proc_time[y]*100,total), PTIME_WIDTH),
               right(Proc_time[y], TIME_WIDTH),
               right(sprintf("%.3r",
                          divimage(Proc_time[y],real(
                          Proc_fails[y]+Proc_returns[y]+Proc_suspends[y]))
                         ),
                     CTIME_WIDTH),
               right(Proc_calls[y], CALL_WIDTH), 
               right(Proc_returns[y], RET_WIDTH),
               right(Proc_suspends[y], SUSP_WIDTH),
	       right(Proc_resumes[y], RESUM_WIDTH),
	       right(Proc_fails[y], FAIL_WIDTH)
              )
      }

      write(outfile, "\nTOTAL RUNTIME: ",sprintf("%.3r",real(total)*0.001),"s\n")

      if \lines then {
         write(outfile, sprintf("%"||(longest_filename_length+1)||"s %8s %8s %8s %8s",
	       "FILE", "LINE", "TIME", "LINE ", "TIME/LN"))
         write(outfile, sprintf("%"||(longest_filename_length+1)||"s %8s %8s %8s %8s",
	       "    ", "    ", "(ms)", "COUNT", "  (ms) "))
         L := reverse(sort(line_time,2))
         every le := !L do {
            write(outfile, sprintf("%"||(longest_filename_length+1)||"s %8d %8d %8d   %.3r",
	          le[1][1:find(":",le[1])], le[1][find(":",le[1])+1:0],
                  le[2], line_count[le[1]],
                  divimage(le[2], real(line_count[le[1]]))))
         }
      }
      close(outfile)
   }

   # print to stdout
   else {

      write(left("PROCEDURE",PROC_WIDTH), 
            right("%TIME", PTIME_WIDTH), 
            right("TIME", TIME_WIDTH), 
            right("TIME/CALL", CTIME_WIDTH),
            right("CALLS", CALL_WIDTH), 
            right("RETURNS", RET_WIDTH),
            right("SUSPENDS", SUSP_WIDTH), 
            right("RESUMES",RESUM_WIDTH), 
            right("FAILS", FAIL_WIDTH) 
           )
      write(left("",PROC_WIDTH), 
            right("", PTIME_WIDTH), 
            right("(ms)", TIME_WIDTH), 
            right("(ms)", CTIME_WIDTH),
            right("", CALL_WIDTH), 
            right("", RET_WIDTH),
            right("", SUSP_WIDTH), 
            right("",RESUM_WIDTH), 
            right("", FAIL_WIDTH)
           )
       write()

       every y := (!keys).keyval do {
         write(left((image(y))[10:0], PROC_WIDTH),
               right(divimage(Proc_time[y]*100,total), PTIME_WIDTH),
               right(Proc_time[y], TIME_WIDTH),
               right(sprintf("%.3r",
                          divimage(Proc_time[y],real(
                          Proc_fails[y]+Proc_returns[y]+Proc_suspends[y]))
                         ),
                     CTIME_WIDTH),
               right(Proc_calls[y], CALL_WIDTH), 
               right(Proc_returns[y], RET_WIDTH),
               right(Proc_suspends[y], SUSP_WIDTH),
	       right(Proc_resumes[y], RESUM_WIDTH),
	       right(Proc_fails[y], FAIL_WIDTH)
              )
      }

      write("\nTOTAL RUNTIME: ",sprintf("%.3r",real(total)*0.001),"s\n")

      if \lines then {
         write(sprintf("%"||(longest_filename_length+1)||"s %8s %8s %8s %8s",
	       "FILE", "LINE", "TIME", "LINE ", "TIME/LN"))
         write(sprintf("%"||(longest_filename_length+1)||"s %8s %8s %8s %8s",
	       "    ", "    ", "(ms)", "COUNT", "  (ms) "))
         L := reverse(sort(line_time,2))
         every le := !L do {
            write(sprintf("%"||(longest_filename_length+1)||"s %8d %8d %8d   %.3r",
	          le[1][1:find(":",le[1])], le[1][find(":",le[1])+1:0],
	          le[2], line_count[le[1]],
	          divimage(le[2], real(line_count[le[1]]))))
         }
      }
   }

end

#
# return an image of a division
#
procedure divimage(num,denom)
    if num = 0 then return 0
    else if denom = 0 then return 0
    else return num/denom
end