--++ -- Creation Date: 02-Mar-1991 -- -- Author: Alan Cohn -- -- Modification History: -- -- Functional Description: -- -- This program (Watch) displays process information for the specified -- process every two seconds. The information is displayed on -- the users VT terminal. The user must have WORLD priviledge. -- To terminate Watch press any key on the terminal. -- This program was created with VAX Ada 2.1. -- -- Calling Format: -- -- Watch is a foreign command. Define it with a symbol as: -- WATCH == "$" + f$search("WATCH.EXE") -- Then envoke watch with: -- WATCH PID !PID is the hexadecimal ID of the process to watch. -- --- with system; --Ada/VMS spec. use system; with starlet; --VMS Ada starlet spec. use starlet; with integer_text_io; --VMS integer text io use integer_text_io; with text_io; --Ada text io. use text_io; with condition_handling; --Processes status from VMS calls. use condition_handling; with lib; --Contains VMS LIB$ specs. with ots; --Contains VMS OTS$ specs. ---------------------------------------------------------------------- function Watch return Condition_Handling.Cond_Value_Type is Channel : Starlet.channel_type; Error_cnt : integer := 0; Iosb : Iosb_type; Pidadr : Starlet.process_id_type; Prvnew : Mask_privileges_type := Prv_type_init; --Reset All Priv's Prvold : Mask_privileges_type; Qio_status : Condition_handling.cond_value_type; Qio_buffer : Integer; Status : Condition_handling.cond_value_type; Timlen : Unsigned_word; Timbuf : Starlet.Time_Name_Type(1..50); Timbuf_size : Unsigned_word; Timadr : Starlet.Date_Time_Type; Timadr_size : Unsigned_word; Whole_pid_string : String(1..8); --VTxxx screen commands bell : constant string := ascii.bel & ""; Cls : constant string := ascii.esc & "[J"; eeol : constant string := ascii.esc & "[K"; home : constant string := ascii.esc & "[1;1H"; norm : constant string := ascii.esc & "[0m"; nosee_cur : constant string := ascii.esc & "[?25l"; rev : constant string := ascii.esc & "[7m"; see_cur : constant string := ascii.esc & "[?25h"; tab : constant string := ascii.ht & ""; -- array of strings Jobtype_desc : Constant Array (0..5) Of String(1..8) := ( ("Detached"), ("Network "), ("Batch "), ("Local "), ("Dialup "), ("Remote ") ); Jobmode_desc : Constant Array (0..3) Of String(1..11) := ( ("Other "), ("Network "), ("Batch "), ("Interactive") ); State_desc : Constant Array (1..14) Of String(1..5) := ( ("COLPG"), ("MWAIT"), ("CEF "), ("PFW "), ("LEF "), ("LEFO "), ("HIB "), ("HIBO "), ("SUSP "), ("SUSPO"), ("FPG "), ("COM "), ("COMO "), ("CUR ") ); Biocnt : integer; Biocnt_size : Unsigned_word; Biolm : integer; Biolm_size : Unsigned_word; Bufio : integer; Bufio_size : Unsigned_word; Bytcnt : integer; Bytcnt_size : Unsigned_word; Bytlm : integer; Bytlm_size : Unsigned_word; Cputim : integer; Cputim_size : Unsigned_word; Dfwscnt : integer; Dfwscnt_size : Unsigned_word; Diocnt : integer; Diocnt_size : Unsigned_word; Diolm : integer; Diolm_size : Unsigned_word; Enqcnt : integer; Enqcnt_size : Unsigned_word; Enqlm : integer; Enqlm_size : Unsigned_word; Filcnt : integer; Filcnt_size : Unsigned_word; Fillm : integer; Fillm_size : Unsigned_word; Freptecnt : integer; Freptecnt_size : Unsigned_word; Gpgcnt : integer; Gpgcnt_size : Unsigned_word; Image_name : String(1..80); Image_name_size : Unsigned_word; Itmlst : Item_list_type(1..35); Jobtype : integer; Jobtype_size : Unsigned_word; Mode : integer; Mode_size : Unsigned_word; Pageflts : integer; Pageflts_size : Unsigned_word; Pagfilcnt : integer; Pagfilcnt_size : Unsigned_word; Pgflquota : integer; Pgflquota_size : Unsigned_word; Pid : Unsigned_longword; Pid_prompt : constant string := "Enter PID> "; Pid_prompt_flag : constant Unsigned_longword := 0; Pid_size : Unsigned_word; Pid_string : String(1..20); Pid_string_size : Unsigned_word; Ppgcnt : integer; Ppgcnt_size : Unsigned_word; Pri : integer; Pri_size : Unsigned_word; Prib : integer; Prib_size : Unsigned_word; Process_name : String(1..15); Process_name_size : Unsigned_word; State : integer; State_size : Unsigned_word; Terminal_name : String(1..7); Terminal_name_size: Unsigned_word; Username : String(1..12); Username_size : Unsigned_word; Virtpeak : integer; Virtpeak_size : Unsigned_word; Wsextent : integer; Wsextent_size : Unsigned_word; Wsquota : integer; Wsquota_size : Unsigned_word; Wssize : integer; Wssize_size : Unsigned_word; ----------------------------------------------------------------------------- -- This function converts an integer to string and returns string without -- leading space. function Integer_Image( Int : integer ) return string is Int_Length : integer := integer'image( int )'length; begin return integer'image( Int )( 2 .. Int_Length ); --return all but first char end; --------------------------------------------------------------------------- -- This function returns a file name without the disk, directory, -- extension, or version part. function file_name( fn : string ) return string is start_fn : natural := 1; end_fn : natural := fn'length; -- in case no version ';' begin for x in reverse 1..Fn'Length loop --search backwards for ']' if fn(x) = ']' then start_fn := x+1; --use next character exit; end if; end loop; for x in reverse Start_Fn..Fn'Length loop --search backwards for ';' if fn( x ) = ';' then end_fn := x - 5; -- backup over ".EXE;" exit; end if; end loop; if fn( end_fn-3 .. end_fn ) = ".EXE" then --make sure last 4 chara's end_fn := end_fn - 4; --are not ".EXE" end if; return Fn( Start_Fn .. End_Fn); end; --------------------------------------------------------------------------- begin -- watch -- Prvnew.World := true; --requested priviledge WORLD. Starlet.Setprv ( Status => Status, Enbflg => True, --Enable Priv World Prvadr => Prvnew, --List Of New Priv's Prmflg => False, --Not Permenant Prvprv => Prvold); --Old Priv World if not Condition_Handling.Success( Status ) then return Status; end if; Lib.get_foreign( Status => Status, --Get Command Pid Resultant_string => Pid_string, Prompt_string => Pid_prompt, Resultant_length => Pid_string_size); if not Condition_Handling.Success( Status ) then return Status; end if; Ots.Cvt_Tz_L ( Status => Status, --convert hex string to long Fixed_Or_Dynamic_Input_String => Pid_String( 1..integer( Pid_String_Size)), Varying_Output_Value => Pidadr); if not Condition_Handling.Success( Status ) then return Status; end if; Starlet.Assign (Status => Qio_Status, -- connect to vt terminal Devnam => "TT:", Chan => Channel); if not Condition_Handling.Success( Qio_Status ) then return Qio_Status; end if; -- initialize GetJpi item list Itmlst( Itmlst'last).buf_len := 0; --mark end of list Itmlst( Itmlst'last).item_code := Jpi_C_Listend; Itmlst( 1 ).Buf_len := Process_name'length; Itmlst( 1 ).Item_code := Starlet.Jpi_Prcnam; Itmlst( 1 ).Buf_address := Process_name'address; Itmlst( 1 ).Ret_address := Process_name_size'address; Itmlst( 2 ).Buf_len := 4; Itmlst( 2 ).Item_code := Starlet.Jpi_Biocnt; Itmlst( 2 ).Buf_address := Biocnt'address; Itmlst( 2 ).Ret_address := Biocnt_size'address; Itmlst( 3 ).Buf_len := 4; Itmlst( 3 ).Item_code := Starlet.Jpi_Biolm; Itmlst( 3 ).Buf_address := Biolm'address; Itmlst( 3 ).Ret_address := Biolm_size'address; Itmlst( 4 ).Buf_len := 4; Itmlst( 4 ).Item_code := Starlet.Jpi_Bufio; Itmlst( 4 ).Buf_address := Bufio'address; Itmlst( 4 ).Ret_address := Bufio_size'address; Itmlst( 5 ).Buf_len := 4; Itmlst( 5 ).Item_code := Starlet.Jpi_Cputim; Itmlst( 5 ).Buf_address := Cputim'address; Itmlst( 5 ).Ret_address := Cputim_size'address; Itmlst( 6 ).Buf_len := 4; Itmlst( 6 ).Item_code := Starlet.Jpi_Diocnt; Itmlst( 6 ).Buf_address := Diocnt'address; Itmlst( 6 ).Ret_address := Diocnt_size'address; Itmlst( 7 ).Buf_len := 4; Itmlst( 7 ).Item_code := Starlet.Jpi_Diolm; Itmlst( 7 ).Buf_address := Diolm'address; Itmlst( 7 ).Ret_address := Diolm_size'address; Itmlst( 8 ).Buf_len := Image_name'length; Itmlst( 8 ).Item_code := Starlet.Jpi_Imagname; Itmlst( 8 ).Buf_address := Image_name'address; Itmlst( 8 ).Ret_address := Image_name_size'address; Itmlst( 9 ).Buf_len := 4; Itmlst( 9 ).Item_code := Starlet.Jpi_Jobtype; Itmlst( 9 ).Buf_address := Jobtype'address; Itmlst( 9 ).Ret_address := Jobtype_size'address; Itmlst( 10).buf_len := 4; Itmlst( 10).item_code := Starlet.Jpi_Mode; Itmlst( 10).buf_address := Mode'address; Itmlst( 10).ret_address := Mode_size'address; Itmlst( 11).buf_len := 4; Itmlst( 11).item_code := Starlet.Jpi_Pageflts; Itmlst( 11).buf_address := Pageflts'address; Itmlst( 11).ret_address := Pageflts_size'address; Itmlst( 12).buf_len := 4; Itmlst( 12).item_code := Starlet.Jpi_Pgflquota; Itmlst( 12).buf_address := Pgflquota'address; Itmlst( 12).ret_address := Pgflquota_size'address; Itmlst( 13 ).Buf_len := Username'length; Itmlst( 13 ).Item_code := Starlet.Jpi_Username; Itmlst( 13 ).Buf_address := Username'address; Itmlst( 13 ).Ret_address := Username_size'address; Itmlst( 14 ).Buf_len := 4; Itmlst( 14 ).Item_code := Starlet.Jpi_Wsextent; Itmlst( 14 ).Buf_address := Wsextent'address; Itmlst( 14 ).Ret_address := Wsextent_size'address; Itmlst( 15 ).Buf_len := 4; Itmlst( 15 ).Item_code := Starlet.Jpi_Dfwscnt; Itmlst( 15 ).Buf_address := Dfwscnt'address; Itmlst( 15 ).Ret_address := Dfwscnt_size'address; Itmlst( 16 ).Buf_len := 4; Itmlst( 16 ).Item_code := Starlet.Jpi_Wsquota; Itmlst( 16 ).Buf_address := Wsquota'address; Itmlst( 16 ).Ret_address := Wsquota_size'address; Itmlst( 17 ).Buf_len := Terminal_name'length; Itmlst( 17 ).Item_code := Starlet.Jpi_Terminal; Itmlst( 17 ).Buf_address := Terminal_name'address; Itmlst( 17 ).Ret_address := Terminal_name_size'address; Itmlst( 18 ).Buf_len := 4; Itmlst( 18 ).Item_code := Starlet.Jpi_Wssize; Itmlst( 18 ).Buf_address := Wssize'address; Itmlst( 18 ).Ret_address := Wssize_size'address; Itmlst( 19 ).Buf_len := 4; Itmlst( 19 ).Item_code := Starlet.Jpi_Freptecnt; Itmlst( 19 ).Buf_address := Freptecnt'address; Itmlst( 19 ).Ret_address := Freptecnt_size'address; Itmlst( 20 ).Buf_len := 4; Itmlst( 20 ).Item_code := Starlet.Jpi_State; Itmlst( 20 ).Buf_address := State'address; Itmlst( 20 ).Ret_address := State_size'address; Itmlst( 21 ).Buf_len := 4; Itmlst( 21 ).Item_code := Starlet.Jpi_Enqcnt; Itmlst( 21 ).Buf_address := Enqcnt'address; Itmlst( 21 ).Ret_address := Enqcnt_size'address; Itmlst( 22 ).Buf_len := 4; Itmlst( 22 ).Item_code := Starlet.Jpi_Enqlm; Itmlst( 22 ).Buf_address := Enqlm'address; Itmlst( 22 ).Ret_address := Enqlm_size'address; Itmlst( 23 ).Buf_len := 4; Itmlst( 23 ).Item_code := Starlet.Jpi_Ppgcnt; Itmlst( 23 ).Buf_address := Ppgcnt'address; Itmlst( 23 ).Ret_address := Ppgcnt_size'address; Itmlst( 24 ).Buf_len := 4; Itmlst( 24 ).Item_code := Starlet.Jpi_Gpgcnt; Itmlst( 24 ).Buf_address := Gpgcnt'address; Itmlst( 24 ).Ret_address := Gpgcnt_size'address; Itmlst( 25 ).Buf_len := 8; --Quadword Itmlst( 25 ).Item_code := Starlet.Jpi_Logintim; Itmlst( 25 ).Buf_address := Timadr'address; Itmlst( 25 ).Ret_address := Timadr_size'address; Itmlst( 26 ).Buf_len := 4; Itmlst( 26 ).Item_code := Starlet.Jpi_Pri; Itmlst( 26 ).Buf_address := Pri'address; Itmlst( 26 ).Ret_address := Pri_size'address; Itmlst( 27 ).Buf_len := 4; Itmlst( 27 ).Item_code := Starlet.Jpi_Prib; Itmlst( 27 ).Buf_address := Prib'address; Itmlst( 27 ).Ret_address := Prib_size'address; Itmlst( 28 ).Buf_len := 4; Itmlst( 28 ).Item_code := Starlet.Jpi_Pagfilcnt; Itmlst( 28 ).Buf_address := Pagfilcnt'address; Itmlst( 28 ).Ret_address := Pagfilcnt_size'address; Itmlst( 29 ).Buf_len := 4; Itmlst( 29 ).Item_code := Starlet.Jpi_Filcnt; Itmlst( 29 ).Buf_address := Filcnt'address; Itmlst( 29 ).Ret_address := Filcnt_size'address; Itmlst( 30 ).Buf_len := 4; Itmlst( 30 ).Item_code := Starlet.Jpi_Fillm; Itmlst( 30 ).Buf_address := Fillm'address; Itmlst( 30 ).Ret_address := Fillm_size'address; Itmlst( 31 ).Buf_len := 4; Itmlst( 31 ).Item_code := Starlet.Jpi_Virtpeak; Itmlst( 31 ).Buf_address := Virtpeak'address; Itmlst( 31 ).Ret_address := Virtpeak_size'address; Itmlst( 32 ).Buf_len := 4; Itmlst( 32 ).Item_code := Starlet.Jpi_Pid; Itmlst( 32 ).Buf_address := Pid'address; Itmlst( 32 ).Ret_address := Pid_size'address; Itmlst( 33 ).Buf_len := 4; Itmlst( 33 ).Item_code := Starlet.Jpi_Bytcnt; Itmlst( 33 ).Buf_address := Bytcnt'address; Itmlst( 33 ).Ret_address := Bytcnt_size'address; Itmlst( 34 ).Buf_len := 4; Itmlst( 34 ).Item_code := Starlet.Jpi_Bytlm; Itmlst( 34 ).Buf_address := Bytlm'address; Itmlst( 34 ).Ret_address := Bytlm_size'address; Put_Line( Nosee_Cur & Home & Cls ); --turn off cursor and home position loop put( home ); --home cursor Starlet.Gettim( Status, Timadr ); --Get Time Starlet.Asctim( Status => Status, Timlen => Timlen, Timbuf => Timbuf, Timadr => Timadr); Put( Timbuf( 1..integer( Timlen-3 ) ) ); Put_line( Eeol ); --erase to end of line New_line; Starlet.GetJpiw ( Status => Status, --Get Process Information Pidadr => Pidadr, Itmlst => Itmlst, Iosb => Iosb); -- GetJpiw request must fail 3 times before giving up. if not Condition_Handling.Success( Status ) then Error_Cnt := Error_Cnt + 1; --bump error count. put_line( bell ); --ring vt bell for error if Error_Cnt = 3 then Put_Line( See_Cur ); --turn vt cursor on Starlet.Dassgn( Qio_Status, Channel ); --deassging vt channel return Status; -- return bad status end if; else Error_Cnt := 0; end if; if Error_Cnt = 0 then --don't display if errors for x in reverse Username'range loop if Username(x) /= ' ' then Put( "Username: " & Username(1..x) ); exit; end if; end loop; PUT(" Process: " & Process_Name(1.. integer( Process_Name_Size))); --convert long to hex string Ots.Cvt_L_Tz( status => status, varying_input_value => PID, fixed_length_resultant_string => whole_PID_string, number_of_digits => whole_PID_string'length, input_value_size => 4); -- bytes in Put(" PID: " & Whole_Pid_String); if Terminal_Name_Size > 0 then Put(" Terminal: " & Terminal_Name(1..integer( Terminal_Name_Size))); end if; Put_Line( Eeol ); Put("Job Type: " & Jobtype_Desc( Jobtype )); Put(" Mode: " & Jobmode_Desc( Mode )); Asctim( Status => Status, Timlen => Timlen, Timbuf => Timbuf, Timadr => Timadr); Put(" Login: " & Timbuf( 1.. integer( Timlen))); Put_Line( Eeol ); New_Line; if Image_Name_Size > 0 then Put("Image: " & File_Name(Image_Name( 1..integer( Image_Name_Size)))); else Put("Image: *None*"); end if; Put_Line( Eeol ); new_line; Put("Free PTE Count: " & Integer_Image( freptecnt)); Put(" State: " & State_Desc( State)); Put(" CPU Time: " & Integer_Image( Cputim) ); Put(" Priority/Base: " & Integer_Image( Pri ) & "/" & Integer_Image( prib )); put_line( eeol ); new_line; Put("BIO Count/Limit: " & Integer_Image( Biolm-Biocnt) & "/" & Integer_Image( biolm)); Put(" BUF IO Operations: " & Integer_Image( bufio) ); Put(" DIO Count/Limit: " & Integer_Image( Diolm-Diocnt) & "/" & Integer_Image( Diolm)); Put_Line( eeol ); Put("Enq Count/Limit: " & Integer_Image( Enqlm-Enqcnt) & "/" & Integer_Image( Enqlm)); Put_Line( eeol ); Put("File Count/Limit: " & Integer_Image( Fillm-filcnt) & "/" & Integer_Image( fillm)); Put(" Buffered Byte Count/Limit: " & Integer_Image( Bytlm-Bytcnt) & "/" & Integer_Image( Bytlm)); Put_Line( eeol ); new_line; Put("Page Faults: " & Integer_Image( pageflts)); Put(" Virtural Peak: " & Integer_Image( virtpeak)); Put_Line( eeol ); Put("Page File Count/Quota: " & Integer_Image( pagfilcnt) & "/" & Integer_Image( pgflquota ) ); Put(" Page File Used: " & Integer_Image( pgflquota-pagfilcnt) ); Put_Line( eeol ); Put("WS Size: " & Integer_Image( wssize)); Put(" WS Default: " & Integer_Image( dfwscnt)); Put(" WS Quota: " & Integer_Image( wsquota)); Put(" WS Extent: " & Integer_Image( wsextent)); Put_Line( eeol ); Put("Total Page Count: " & Integer_Image( Ppgcnt + Gpgcnt)); Put(" Process Page Count: " & Integer_Image( Ppgcnt)); Put(" Global Page Count: " & Integer_Image( Gpgcnt)); Put_Line( eeol ); end if; --wait up to two seconds for any Input. Starlet.Qiow ( Status => Status, Chan => Channel, Func => System.Unsigned_Word( Starlet.Io_Readvblk + Starlet.Io_M_Timed ), iosb => Iosb, P1 => System.To_Unsigned_Longword( Qio_Buffer'Address), P2 => 1, --read 1 character P3 => 2 ); --Seconds to wait exit when Iosb.Status /= Ss_Timeout; --Exit when key pressed end loop; Starlet.Dassgn ( Qio_Status, Channel); Put_Line( See_Cur ); --turn cursor on return Status; --return to VMS end;