![]() ![]() | ![]() |
File: [local] / OpenXM_contrib / PHC / Ada / System / unix_resource_usage.adb (download)
Revision 1.1.1.1 (vendor branch), Sun Oct 29 17:45:34 2000 UTC (23 years, 10 months ago) by maekawa
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;