Return to unix_resource_usage.adb CVS log

Up to [local] / OpenXM_contrib / PHC / Ada / System

Import the second public release of PHCpack.

OKed by Jan Verschelde.

package body Unix_Resource_Usage is

  package C_Interfaces is

    times_map : constant array (times_enum)
    		of integer
	      := (self => 0, children => -1);

    function getrusage (who : integer;
    			rusage : system.address)
	return integer;
    pragma interface (C, getrusage);

    function timeval_to_duration (tv : timeval)
        return duration;

  end C_Interfaces;

    function Get_Process_Times (who : times_enum := self)
	return Process_Times
    is
      answer : Process_Times;
      c_result : integer;
    begin
      c_result := C_Interfaces.getrusage
			(who => C_Interfaces.times_map(who),
			 rusage => answer'address);
      if (c_result = -1) then
	raise program_error;	-- something broke in Unix!
      else
	return answer;
      end if;
    end Get_Process_Times;

    function Total_Time_of (Times: in Process_Times)
        return duration
    is
    begin
      return user_cpu_time_of (times) + system_cpu_time_of (times);
    end;

    function User_CPU_Time_Of (Times: in Process_Times)
        return Duration
    is
    begin
      return C_Interfaces.timeval_to_duration (times.ru_utime);
    end User_CPU_Time_Of;

    function System_CPU_Time_Of (Times: in Process_Times)
        return Duration
    is
    begin
      return C_Interfaces.timeval_to_duration (times.ru_stime);
    end System_CPU_Time_Of;

    function Max_Resident_Set_Size_of (Times: in Process_Times)
        return natural
    is
    begin
      return times.ru_maxrss;
    end max_resident_set_size_of;

    function Shared_Pages_Value_of (Times: in Process_Times)
        return page_seconds
    is
    begin
      return page_seconds(times.ru_ixrss);
    end;

    function Unshared_Data_Pages_Value_of (Times: in Process_Times)
    	return page_seconds
    is
    begin
      return page_seconds(times.ru_idrss);
    end;

    function Stack_Pages_Value_of (Times: in Process_Times)
        return page_seconds
    is
    begin
      return page_seconds(times.ru_isrss);
    end;

    function Non_IO_Page_Faults_of (Times: in Process_Times)
        return natural
    is
    begin
      return times.ru_minflt;
    end;

    function IO_Page_Faults_of (Times: in Process_Times)
    	return natural
    is
    begin
      return times.ru_majflt;
    end;

    function Swaps_of (Times : in Process_Times)
        return natural
    is
    begin
      return times.ru_nswap;
    end;

    function Input_Blocks_of (Times : in Process_Times)
        return natural
    is
    begin
      return times.ru_inblock;
    end;

    function Output_Blocks_of (Times : in Process_Times)
        return natural
    is
    begin
      return times.ru_outblock;
    end;

    function Socket_Messages_Sent_of (Times : in Process_Times)
    	return natural
    is
    begin
      return times.ru_msgsnd;
    end;

    function Socket_Messages_Received_of (Times : in Process_Times)
        return natural
    is
    begin
      return times.ru_msgrcv;
    end;

    function Signals_Delivered_of (Times : in Process_Times)
        return natural
    is
    begin
      return times.ru_nsignals;
    end;

    function Voluntary_Context_Switches_of (Times: in Process_Times)
        return natural
    is
    begin
      return times.ru_nvcsw;
    end;

    function Involuntary_Context_Switches_of (Times: in Process_Times)
        return natural
    is
    begin
      return times.ru_nivcsw;
    end;

  package body C_Interfaces is

    function timeval_to_duration (tv : timeval)
        return duration
    is
      answer : duration;
    begin
      -- on a sun:
        answer := duration(tv.tv_sec) + duration(tv.tv_usec)/1_000_000;
      -- on a dec:
      -- answer := duration(tv.tv_sec);
      -- if float(tv.tv_usec) <= duration'large
      --  then answer := answer + duration(tv.tv_usec)/1_000_000;
      --  else answer := answer + duration(tv.tv_usec/100)/10_000;
      -- end if;
      -- because of the strange fact that on a dec
      -- duration'large is about 2.14E+5 < 1_000_000;
      -- with the following trials, only the seconds were printed:
      --  answer := duration(tv.tv_sec + tv.tv_usec/1_000_000);
      --  answer := duration(tv.tv_sec) + duration(tv.tv_usec/1_000_000);
      return answer;
    end timeval_to_duration;

  end C_Interfaces;

end Unix_Resource_Usage;