10	!***************************************************************&
	!								&
	!			    IMAGES				&
	!								&
	! Scan the list of processes and display statistical info about	&
	! each one.							&
	!								&
	! NOTE: This program must be linked with the definition macros:	&
	!								&
	!	FSCNDEF (SYS$LIBRARY:STARLET.MLB)			&
	!	STATEDEF (SYS$LIBRARY:LIB.MLB)				&
	!								&
	!---------------------------------------------------------------&
	!								&
	!		Creation date:	July 1985			&
	!		Author:		KRM				&
	!								&
	!		Modification history				&
	!								&
	!	Date	Description of change(s)			&
	!								&
	!								&
	!***************************************************************&
	!								&
	! Copyright (c) 1985 -	Ken Messer, Allied Electronics, Inc.,	&
	!			401 E. 8th St., Ft. Worth, TX  76102	&
	!								&
	! This software may be copied and distributed freely to anyone	&
	! for non-commerical use provided that this copyright notice is &
	! included.							&
	!---------------------------------------------------------------&

	OPTION 	TYPE = REAL,						&
		SIZE = (REAL DOUBLE,INTEGER WORD)

	ON ERROR GOTO Error_Trap

	!***************************************************************&
	!								&
	!		D A T A   D E C L A R A T I O N S		&
	!								&
	!***************************************************************&

	DECLARE BYTE CONSTANT	True = -1,				&
				False = 0

	DECLARE WORD		Username_len,				&
				Processname_len,			&
				Imagename_len,				&
				Logintime_len,				&
				State_len,				&
				Term_len,				&
				Pid_len,				&
				Current_day,				&
				Command_line_length,			&
				Period_pos,				&
				End_pos,				&
				Start_pos

	DECLARE LONG		Return_Status,				&
				Seedpid,				&
				Row,					&
				Select_row,				&
				Prev_select_row,			&
				Timeout,				&
				Default_timeout,			&
				Deccrt,					&
				Save_Pid(19),				&
				Spawn_flags

	DECLARE LONG CONSTANT	NoAttr = 0,				&
				Blink = 1,				&
				Bold = 2,				&
				Reverse = 4,				&
				Underline = 8,				&
				Cvt_flag = 1,				&
				Min_digits = 6

	EXTERNAL LONG FUNCTION	SYS$GetjpiW,				&
				SYS$Filescan

	EXTERNAL SUB		SYS$Numtim,				&
				SYS$Asctim,				&
				LIB$Get_Foreign,			&
				LIB$Getjpi,				&
				LIB$Spawn,				&
				OTS$Cvt_L_TZ

	EXTERNAL LONG CONSTANT	CLI$M_Noclisym,				&
				CLI$M_Nolognam,				&
				JPI$_Username,				&
				JPI$_Pid,				&
				JPI$_Prcnam,				&
				JPI$_Imagname,				&
				JPI$_Logintim,				&
				JPI$_State,				&
				JPI$_Terminal,				&
				JPI$C_Listend,				&
				SS$_Normal,				&
				SS$_Nomoreproc,				&
				SS$_Suspended,				&
				SCH$C_Cef,				&
				SCH$C_Com,				&
				SCH$C_Como,				&
				SCH$C_Cur,				&
				SCH$C_Colpg,				&
				SCH$C_Fpg,				&
				SCH$C_Hib,				&
				SCH$C_Hibo,				&
				SCH$C_Lef,				&
				SCH$C_Lefo,				&
				SCH$C_Mwait,				&
				SCH$C_Pfw,				&
				SCH$C_Susp,				&
				SCH$C_Suspo,				&
				FSCN$_Name,				&
				DVI$_TT_Deccrt

	DECLARE STRING		Inpstr,					&
				Statecode,				&
				Login_time,				&
				Datemsg,				&
				Filename,				&
				Current_date,				&
				Command_line,				&
				Foreign_command,			&
				Terminal_name,				&
				New_cycle_time,				&
				Save_username(19),			&
				Spawn_command

	DECLARE STRING CONSTANT						&
									&
	Header = "Username      Process name     Image              State  Term  Login time     "

	EXTERNAL BYTE FUNCTION		Numeric(STRING)

	EXTERNAL STRING FUNCTION	Today,				&
					Get_Error_Message(LONG)

	!***************************************************************&
	!								&
	!		   M A P   S T A T E M E N T S			&
	!								&
	!			  C O M M O N S				&
	!								&
	!***************************************************************&

	RECORD JPIBUF
		WORD Buf_len1
		WORD Item_code1
		LONG Buf_adr1
		LONG Ret_len_adr1
		WORD Buf_len2
		WORD Item_code2
		LONG Buf_adr2
		LONG Ret_len_adr2
		WORD Buf_len3
		WORD Item_code3
		LONG Buf_adr3
		LONG Ret_len_adr3
		WORD Buf_len4
		WORD Item_code4
		LONG Buf_adr4
		LONG Ret_len_adr4
		WORD Buf_len5
		WORD Item_code5
		LONG Buf_adr5
		LONG Ret_len_adr5
		WORD Buf_len6
		WORD Item_code6
		LONG Buf_adr6
		LONG Ret_len_adr6
		WORD Buf_len7
		WORD Item_code7
		LONG Buf_adr7
		LONG Ret_len_adr7
		LONG List_Terminator
	END RECORD JPIBUF

	RECORD Filescan
		WORD Component_length
		WORD Item_code
		LONG Component_address
		LONG List_terminator
	END RECORD Filescan

	DECLARE Jpibuf		Itemlist
	DECLARE Filescan	Filescan_Itemlist

	MAP (Dummy)	STRING 	Username = 12,				&
				Processname = 15,			&
				Imagename_desc = 128,			&
				Term = 7,				&
				Asctim_buf = 11,			&
				Hex_Pid = 6,				&
			WORD	State,					&
				Logintime(3),				&
			LONG	Pid

	MAP (Dummy1)	WORD	Timbuf(6)
	MAP (Dummy1)	WORD	Year,					&
				Month,					&
				Day,					&
				Hour,					&
				Minute,					&
				Second,					&
				Hundredth

	%include "SYS$MANAGER:SMGDECLARE.INC"

	!***************************************************************&
	!								&
	!		M A I N   P R O G R A M   L O G I C		&
	!								&
	!***************************************************************&

 Set_spawn_flags:

	! Set up flag bits for the SPAWN command
	! Avoid passing symbols and logical names - this will speed things up

	Spawn_flags = CLI$M_Noclisym OR CLI$M_Nolognam

 Determine_term_type:

	! This program must be executed on an ANSI terminal with
	! line_drawing capability
	! The device characteristic DEC_CRT must be set

	CALL LIB$Getjpi(JPI$_Terminal,,,,Terminal_name,)
	CALL LIB$Getdvi(DVI$_TT_Deccrt,,Terminal_name,Deccrt,,)

	IF Deccrt = 0   THEN
	   PRINT Bel + "Sorry - this program must be run on a DEC terminal"
	   PRINT "or compatible with the DECCRT characteristic set"
	   GOTO Done
	END IF

 Check_for_foreign_command:

	! User may set the cycle time by means of a foreign command
	! Default is 30 seconds, but user may specify 1-99

	Default_timeout = 30

	CALL LIB$Get_Foreign(Command_line,,Command_line_length,)

	SELECT Command_line_length
	   CASE 2,3
		Foreign_command = SEG$(Command_line,2,Command_line_length)
		Default_timeout = VAL%(Foreign_command)			&
		   IF Numeric(Foreign_command)
	   CASE ELSE
		! take the default
	END SELECT

	CALL SMG_OPEN(" ",1)

	Current_date = Today
	Current_day = VAL%(SEG$(Today,5,6))

	GOSUB Load_up_the_record

  Start:

	CALL SMG_UNPASTE(0)
	CALL SMG_CHANGE_VIRTUAL_DISPLAY(22,78,1,NoAttr,0)
	CALL SMG_PASTE(2,2,0)

	CALL SYS$Asctim(,Asctim_buf,,Cvt_flag BY VALUE)

	CALL SMG_LABEL_BORDER("Cycle time is " + NUM1$(Default_timeout) + &
		" seconds  " + SEG$(Asctim_buf,1,8),1,Reverse,0)

	CALL SMG_DISP(Header,1,1,Bold+Reverse+Underline,0)
	CALL SMG_BEGIN_DISPLAY_BATCHING(0)

	Row = 1
	Seedpid = -1

 Call_GETJPI:

	GOSUB Get_job_info

 Convert_filename:

	Return_status = SYS$Filescan(Imagename_desc,Filescan_Itemlist BY REF,)

	IF Return_Status AND SS$_NORMAL	= 0   THEN
		PRINT "Error in FILESCAN ==> ";
		PRINT Get_Error_Message(Return_Status)
		STOP
	END IF

 Convert_the_time:
	
	CALL SYS$Numtim(Timbuf(0),Logintime(0))

 Print_results:

	GOSUB Pause	IF Row > 18

	Username = SPACE$(12)	IF EDIT$(Username,6) = ""
	Processname = EDIT$(Processname,6)

	Login_time = FORMAT$(Hour,"##:") + FORMAT$(Minute,"<0>#")

	IF Current_day <> Day  THEN
	  Datemsg = NUM1$(Month) + "/" + NUM1$(Day) + "/" + NUM1$(Year-1900)
	ELSE
	  Datemsg = SP
	END IF

	Term = EDIT$(Term,6)
	Term = SPACE$(7)	IF Term = ""

	Period_pos = I%		IF SEG$(Imagename_desc,I%,I%) = "."	&
		FOR I% = 1 TO Imagename_len

	IF Period_pos	THEN
	  Start_pos = Period_pos - Filescan_Itemlist::Component_length
	  End_pos = Period_pos - 1

	  Filename = SEG$(Imagename_desc,Start_pos,End_pos)
	ELSE
	  Filename = SP
	END IF

	Row = Row + 1

	CALL SMG_DISP(Username,Row,1,NoAttr,0)
	CALL SMG_DISP(Processname,Row,15,NoAttr,0)
	CALL SMG_DISP(Filename,Row,32,NoAttr,0)
	CALL SMG_DISP(FORMAT$(Statecode,"'CCCC"),Row,51,NoAttr,0)
	CALL SMG_DISP(Term,Row,58,NoAttr,0)
	CALL SMG_DISP(Login_time,Row,64,NoAttr,0)
	CALL SMG_DISP(Datemsg,Row,71,NoAttr,0)

	Save_username(Row) = TRM$(Username)
	Save_Pid(Row) = Pid

	GOTO Call_GETJPI

 Pause:

	CALL SMG_DISP("Return",22,1,Bold+Reverse,0)
	CALL SMG_DISP("PF1",22,18,Bold+Reverse,0)
	CALL SMG_DISP("Observe process",22,22,Bold+Blink,0)
	CALL SMG_DISP("PF2",22,38,Bold+Reverse,0)
	CALL SMG_DISP("Change cycle time",22,42,Bold+Blink,0)
	CALL SMG_DISP("Any other key",22,60,Bold+Reverse,0)
	CALL SMG_DISP("Quit",22,74,Bold+Blink,0)

	IF Return_Status = SS$_Nomoreproc	THEN
	   CALL SMG_DISP("Redisplay",22,8,Bold+Blink,0)
	ELSE
	   CALL SMG_DISP("Next Page",22,8,Bold+Blink,0)
	END IF

	CALL SMG_END_DISPLAY_BATCHING(0)

	CALL SYS$Asctim(,Asctim_buf,,Cvt_flag BY VALUE)

	CALL SMG_LABEL_BORDER("Cycle time is " + NUM1$(Default_timeout) + &
		" seconds  " + SEG$(Asctim_buf,1,8),1,Reverse,0)

	! wait for specified number of seconds, then go on if no input

	Timeout = Default_timeout
	CALL SMG_ONE_CHAR("",22,78,Inpstr,Timeout,0,0)

	SELECT ASCII(Inpstr)
	   CASE 0
		! do it again
	   CASE ELSE
		SELECT Inpstr
		   CASE "~PF1~"
			Select_row = 2
			CALL SMG_BEGIN_DISPLAY_BATCHING(0)
			CALL SMG_POS_CLEAR(22,1,1,2,0)
			CALL SMG_CHANGE_RENDITION(Select_row,1,1,	&
			   LEN(Save_username(Select_row)),Reverse,0)
			CALL SMG_DISP("Select a process and press",22,1,Noattr,0)
			CALL SMG_DISP("Return",22,28,Bold+Reverse,0)
			CALL SMG_DISP("or press",22,35,Noattr,0)
			CALL SMG_DISP("PF1",22,44,Bold+Reverse,0)
			CALL SMG_DISP("to exit",22,48,NoAttr,0)
			CALL SMG_END_DISPLAY_BATCHING(0)
			GOSUB Display_individual_process
			CALL SMG_POS_CLEAR(22,1,1,2,0)
		   CASE "~PF2~"
			CALL SMG_POS_CLEAR(22,1,1,2,0)
			CALL SMG_INPUT_CLR("Enter new cycle time",22,1,2, &
			   New_cycle_time,0,0)

			IF Numeric(New_cycle_time)   THEN
			   SELECT VAL(New_cycle_time)
				CASE 1 TO 99
				   Default_timeout = VAL%(New_cycle_time)
				   CALL SMG_DISP("Cycle time is " + 	&
					NUM1$(Default_timeout) + 	&
					" seconds ",1,1,NoAttr,1)
				CASE ELSE
				   CALL SMG_ERRMSG("Cycle time not changed",Noattr)
			   END SELECT
			ELSE
			   CALL SMG_ERRMSG("Invalid value - cycle time not changed",Noattr)
			END IF

		   CASE ELSE
			GOTO Done
		END SELECT
	END SELECT

	Row = 1

	CALL SMG_BEGIN_DISPLAY_BATCHING(0)

	CALL SMG_POS_CLEAR(2,1,0,0,0)

	RETURN

 Load_up_the_record:

	Itemlist::Buf_len1	= 12
	Itemlist::Item_code1	= JPI$_Username
	Itemlist::Buf_adr1	= LOC(Username)
	Itemlist::Ret_len_adr1	= LOC(Username_len)
	Itemlist::Buf_len2	= 15
	Itemlist::Item_code2	= JPI$_Prcnam
	Itemlist::Buf_adr2	= LOC(Processname)
	Itemlist::Ret_len_adr2    = LOC(Processname_len)
	Itemlist::Buf_len3	= 128
	Itemlist::Item_code3	= JPI$_Imagname
	Itemlist::Buf_adr3	= LOC(Imagename_desc)
	Itemlist::Ret_len_adr3	= LOC(Imagename_len)
	Itemlist::Buf_len4	= 8
	Itemlist::Item_code4	= JPI$_Logintim
	Itemlist::Buf_adr4	= LOC(Logintime(0))
	Itemlist::Ret_len_adr4	= LOC(Logintime_len)
	Itemlist::Buf_len5	= 4
	Itemlist::Item_code5	= JPI$_State
	Itemlist::Buf_adr5	= LOC(State)
	Itemlist::Ret_len_adr5	= LOC(State_len)
	Itemlist::Buf_len6	= 7
	Itemlist::Item_code6	= JPI$_Terminal
	Itemlist::Buf_adr6	= LOC(Term)
	Itemlist::Ret_len_adr6	= LOC(Term_len)
	Itemlist::Buf_len7	= 4
	Itemlist::Item_code7	= JPI$_Pid
	Itemlist::Buf_adr7	= LOC(Pid)
	Itemlist::Ret_len_adr7	= LOC(Pid_len)
	Itemlist::List_Terminator = JPI$C_Listend

	Filescan_Itemlist::Item_code 	     = FSCN$_Name
	Filescan_Itemlist::List_terminator   = 0

	RETURN

 Get_job_info:

	Return_Status = SYS$GetjpiW(,Seedpid BY REF,,Itemlist BY REF,,,)

	SELECT Return_Status

		CASE SS$_Normal
			! OK
		CASE SS$_Nomoreproc
			GOSUB Pause
			Seedpid = -1
			GOTO Get_job_info
		CASE SS$_Suspended
			! OK
		CASE ELSE
			PRINT "Error in GETJPI ==> ";
			PRINT Get_Error_Message(Return_Status)
			STOP
	END SELECT

	SELECT EDIT$(Processname,6)
	  CASE "NULL","SWAPPER"
		GOTO Get_job_info
	  CASE ELSE
	END SELECT

	GOSUB Figure_State_Code

	RETURN

 Figure_State_Code:

	SELECT State

		CASE SCH$C_CEF
			Statecode = "CEF"
		CASE SCH$C_COM
			Statecode = "COM"
		CASE SCH$C_COMO
			Statecode = "COMO"
		CASE SCH$C_CUR
			Statecode = "CUR"
		CASE SCH$C_COLPG
			Statecode = "COLPG"
		CASE SCH$C_FPG
			Statecode = "FPG"
		CASE SCH$C_HIB
			Statecode = "HIB"
		CASE SCH$C_HIBO
			Statecode = "HIBO"
		CASE SCH$C_LEF
			Statecode = "LEF"
		CASE SCH$C_LEFO
			Statecode = "LEFO"
		CASE SCH$C_MWAIT
			Statecode = "MWAIT"
		CASE SCH$C_PFW
			Statecode = "PFW"
		CASE SCH$C_SUSP
			Statecode = "SUSP"
		CASE SCH$C_SUSPO
			Statecode = "SUSPO"
	END SELECT

	RETURN

 Display_individual_process:

	! Let the user select the process he wants to observe
	! time out at 10 seconds and leave if no input
	! Once we have it, we need to convert the process PID to
	! hex string form so the DCL command can use it
	! Fortunately, we have an OTS routine to make the conversion
	! Next, we save the screen and exit to DCL via a spawned process
	! After returning, we restore the screen and continue

	Timeout = 10
	CALL SMG_ONE_CHAR("",22,78,Up_down$,Timeout,0,0)

	IF Timeout 	THEN
	   CALL SMG_ERRMSG("No input - returning to monitor mode",Bold+Blink)
	   CALL SMG_CHANGE_RENDITION(Select_row,1,1,LEN(Save_username(Select_row)),NoAttr,0)
	   GOTO Exit_routine
	END IF

	SELECT Up_down$
	   CASE ""
		CALL OTS$Cvt_L_TZ(Save_Pid(Select_row),Hex_Pid,Min_digits BY VALUE,)
		Spawn_command = "SHOW PROCESS/CONTINUOUS/ID=" +	Hex_Pid
		CALL SMG_SAVE_SCREEN
		CALL LIB$Spawn(Spawn_command,,,Spawn_flags)
		CALL SMG_RESTORE_SCREEN
	   CASE "~PF1~"
		CALL SMG_CHANGE_RENDITION(Select_row,1,1,		&
			LEN(Save_username(Select_row)),NoAttr,0)
		GOTO Exit_routine
	   CASE "~UP~"
		Prev_select_row = Select_row
		Select_row = Select_row - 1
		Select_row = Row	IF Select_row = 1
	   CASE "~DOWN~"
		Prev_select_row = Select_row
		Select_row = Select_row + 1
		Select_row = 2		IF Select_row > Row
	   CASE ELSE
		PRINT Bel
		GOTO Display_individual_process
	END SELECT

	CALL SMG_CHANGE_RENDITION(Prev_select_row,1,1,			&
		LEN(Save_username(Prev_select_row)),NoAttr,0)
	CALL SMG_CHANGE_RENDITION(Select_row,1,1,			&
		LEN(Save_username(Select_row)),Reverse,0)

	GOTO Display_individual_process

 Exit_routine:

	RETURN

	!***************************************************************&
	!								&
	!		   E R R O R   H A N D L E R			&
	!								&
	!***************************************************************&

 Error_Trap:

30000	CALL SMG_UNPASTE(1)
	CALL SMG_POS_CLEAR(21,1,0,0,0)
	CALL SMG_DISP("Error " + NUM1$(ERR) + " ( " + ERT$(ERR) +	&
		") at line " + NUM1$(ERL),21,2,Bold+Blink,0)
	CALL SMG_ONE_CHAR("Press any key to exit",22,2,Dum$,0,0,0)

	RESUME 32700

 Done:

32700	CALL SMG_CLOSE(1)
32767	END