IDENTIFICATION DIVISION.
PROGRAM-ID. SYSTATUS.
*
* DATE-WRITTEN. May 27, 1983.
* AUTHOR. Ken Richardson.
*
* To the glory of God.
*
*********************************************************
*							*
* This program must be linked with STATEDEF and PCBDEF	*
*							*
* These two modules are both in Compassion's		*
* LNK$LIBRARY, ci$library:cilib.olb			*
*							*
*********************************************************

ENVIRONMENT DIVISION.

CONFIGURATION SECTION.

SPECIAL-NAMES.
	SYMBOLIC	CONTROL-R IS 19
			CONTROL-Z IS 27
	.

SOURCE-COMPUTER. VAX-11.
OBJECT-COMPUTER. VAX-11.

DATA DIVISION.

WORKING-STORAGE SECTION.

01  CONSTANTS.
    02  DISPLAY-MODES.
	03  USER-PROCESS-DISPLAY-MODE		PIC X VALUE "U".
	03  COMPREHENSIVE-DISPLAY-MODE		PIC X VALUE "C".
	03  SUBPROCESS-DISPLAY-MODE		PIC X VALUE "S".
    02	getjpi-handler-address			pic s9(9) comp	value is external ci$$getjpi_handler.
    02	jpi$_astcnt				pic s9(9) comp value external jpi$_astcnt.
    02	jpi$_bufio				pic s9(9) comp value external jpi$_bufio.
    02	jpi$_cputim				pic s9(9) comp value external jpi$_cputim.
    02	jpi$_dirio				pic s9(9) comp value external jpi$_dirio.
    02	jpi$_gpgcnt				pic s9(9) comp value external jpi$_gpgcnt.
    02	jpi$_imagname				pic s9(9) comp value external jpi$_imagname.
    02	jpi$_pageflts				pic s9(9) comp value external jpi$_pageflts.
    02	jpi$_pid				pic s9(9) comp value external jpi$_pid.
    02	jpi$_ppgcnt				pic s9(9) comp value external jpi$_ppgcnt.
    02	jpi$_pri				pic s9(9) comp value external jpi$_pri.
    02	jpi$_prib				pic s9(9) comp value external jpi$_prib.
    02	jpi$_proc_index				pic s9(9) comp value external jpi$_proc_index.
    02	jpi$_state				pic s9(9) comp value external jpi$_state.
    02	jpi$_sts				pic s9(9) comp value external jpi$_sts.
    02	jpi$_terminal				pic s9(9) comp value external jpi$_terminal.
    02	jpi$_username				pic s9(9) comp value external jpi$_username.
    02	jpi$_wssize				pic s9(9) comp value external jpi$_wssize.
    02  WS-TRUE					PIC X VALUE "T".
    02  WS-FALSE				PIC X VALUE "F".
    02  CONTROL_Y_MASK				PIC S9(9) COMP VALUE EXTERNAL LIB$M_CLI_CTRLY.
    02  BATCH_JOB_BIT_POSITION			PIC S9(9) COMP VALUE EXTERNAL PCB$V_BATCH.
    02  BATCH_JOB_MASK				PIC S9(9) COMP.
    02  HIGH_PRIORITY				PIC S9(9) COMP VALUE 16.
    02  NULL-CHAR				PIC X VALUE LOW-VALUES.
    02  CONTROL-R-CHAR				PIC X VALUE CONTROL-R.
    02  CONTROL-Z-CHAR				PIC X VALUE CONTROL-Z.
    02  TERMINAL-BUFFER-SIZE			PIC S9(9) COMP VALUE 1.
    02  TERMINAL-TIMEOUT-SECONDS		PIC S9(9) COMP VALUE 9.
    02  QIOW-WAIT-PERIOD			PIC S9(9) COMP VALUE 9.
    02  event-flags.
	03  general-event-flag				pic s9(9) comp value 32.
	03  get-process-info-event-flag			pic s9(9) comp value 33.
	03  terminal-event-flag				pic s9(9) comp value 34.
    02  COLUMN_01				PIC S9(9) COMP VALUE 1.
    02  LINE_01					PIC S9(9) COMP VALUE 1.
    02  LINE_02					PIC S9(9) COMP VALUE 2.
    02  LINE_24					PIC S9(9) COMP VALUE 24.
    02  ONE_LINE				PIC S9(9) COMP VALUE 1.
    02  NINE-SECOND-LIT				PIC X(7) VALUE "0 0:0:9".
    02  DEFAULT-LOCK-TIME			PIC 9 VALUE 9.
    02  LOCK-TIME-LIT.
	03  FILLER				PIC X(6) VALUE "0 0:0:".
	03  LOCK-TIME				PIC 9.
    02  CLUNKS_PER_SECOND			PIC S9(9) COMP VALUE 10000000.
    02  OUTPUT_IMAGNAME_SIZE			PIC S9(9) COMP VALUE 19.
    02  ss$_nomoreproc			pic s9(9) comp value external ss$_nomoreproc.
    02  SCREEN_HEADING.
	03  FILLER				PIC X(6) VALUE	"".
	03  FILLER				PIC X(17) VALUE "TERMINAL ".
	03  FILLER				PIC X(21) VALUE "USERNAME     ".
	03  FILLER				PIC X(14) VALUE "PRIO  ".
	03  FILLER				PIC X(13) VALUE "WSET ".
	03  FILLER				PIC X(13) VALUE "WQUO ".
	03  FILLER				PIC X(14) VALUE "STATE ".
	03  FILLER				PIC X(13) VALUE "CPU% ".
	03  FILLER				PIC X(12) VALUE "DIO ".
	03  FILLER				PIC X(12) VALUE "BIO ".
	03  FILLER				PIC X(12) VALUE "FLT ".
	03  FILLER				PIC X(27) VALUE "IMAGE              ".


01  timer-things.
    02 	time-delay-variable.
	03  filler				pic x(6) value "0 0:0:".
	03  seconds-to-delay			pic x(4) value "00.1".
    02  delta_time				comp-2.


01  TERMINAL-RELATED-DATA.
    02  TERMINAL-BUFFER				PIC X(1).
    02  TERMINAL-CHANNEL			PIC S9(9) COMP.
    02  SPECIAL-READ-COMMAND			PIC S9(9) COMP.
    02  READ-COMMAND				PIC S9(9) COMP VALUE EXTERNAL IO$_READVBLK.
    02  CVTLOW-READ-MODIFIER			PIC S9(9) COMP VALUE EXTERNAL IO$M_CVTLOW.
    02  NOECHO-READ-MODIFIER			PIC S9(9) COMP VALUE EXTERNAL IO$M_NOECHO.
    02  NOFILTR-READ-MODIFIER			PIC S9(9) COMP VALUE EXTERNAL IO$M_NOFILTR.
    02  TIMED-READ-MODIFIER			PIC S9(9) COMP VALUE EXTERNAL IO$M_TIMED.
    02  TRMNOECHO-READ-MODIFIER			PIC S9(9) COMP VALUE EXTERNAL IO$M_TRMNOECHO.

    02  IOSB.
	03  IOSTATUS				PIC S9(4) COMP.
	    88  NORMAL-STATUS			VALUE EXTERNAL SS$_NORMAL.
	03  IOBYTES				PIC S9(4) COMP.
	03  IOTERMINATOR			PIC S9(4) COMP.
	03  IOTERMINATOR-SIZE			PIC S9(4) COMP.

01  pid_itemlist.
    02  pid_record.
        03  jpi_pid_buffer_len			pic s9(04) comp value 4.
        03  jpi_pid_item_code			pic s9(04) comp value external jpi$_pid.
        03  jpi_pid_buffer_adr			usage pointer value reference ws_currently_active_pid.
        03  jpi_pid_return_adr			pic s9(09) comp value zero.
    02  proc_index_record.
        03  jpi_pid_buffer_len			pic s9(04) comp value 4.
        03  jpi_pid_item_code			pic s9(04) comp value external jpi$_proc_index.
        03  jpi_pid_buffer_adr			usage pointer value reference ws_currently_active_proc_index.
        03  jpi_pid_return_adr			pic s9(09) comp value zero.
    02  end_record.
        03  filler				pic s9(09) comp value zero.

01  astcnt_itemlist.
    02  astcnt_record.
        03  jpi_astcnt_buffer_len			pic s9(04) comp value 4.
        03  jpi_astcnt_item_code			pic s9(04) comp value external jpi$_astcnt.
        03  jpi_astcnt_buffer_adr			usage pointer value reference max_ast_count.
        03  jpi_astcnt_return_adr			pic s9(09) comp value zero.
    02  end_record.
        03  filler				pic s9(09) comp value zero.

01  complete_itemlist_array.
    02  complete_itemlist	occurs 512.
	03  bufio_record.
	    04	jpi_bufio_buffer_len		pic s9(04) comp.
	    04	jpi_bufio_item_code		pic s9(04) comp.
	    04	jpi_bufio_buffer_adr		usage pointer.
	    04	jpi_bufio_return_adr		pic s9(09) comp.
	03  cputim_record.
	    04	jpi_cputim_buffer_len		pic s9(04) comp.
	    04	jpi_cputim_item_code		pic s9(04) comp.
	    04	jpi_cputim_buffer_adr		usage pointer.
	    04	jpi_cputim_return_adr		pic s9(09) comp.
	03  dirio_record.
	    04	jpi_dirio_buffer_len		pic s9(04) comp.
	    04	jpi_dirio_item_code		pic s9(04) comp.
	    04	jpi_dirio_buffer_adr		usage pointer.
	    04	jpi_dirio_return_adr		pic s9(09) comp.
	03  gpgcnt_record.
	    04	jpi_gpgcnt_buffer_len		pic s9(04) comp.
	    04	jpi_gpgcnt_item_code		pic s9(04) comp.
	    04	jpi_gpgcnt_buffer_adr		usage pointer.
	    04	jpi_gpgcnt_return_adr		pic s9(09) comp.
	03  imagname_record.
	    04	jpi_imagname_buffer_len		pic s9(04) comp.
	    04	jpi_imagname_item_code		pic s9(04) comp.
	    04	jpi_imagname_buffer_adr		usage pointer.
	    04	jpi_imagname_return_adr		usage pointer.
	03  pageflts_record.
	    04	jpi_pageflts_buffer_len		pic s9(04) comp.
	    04	jpi_pageflts_item_code		pic s9(04) comp.
	    04	jpi_pageflts_buffer_adr		usage pointer.
	    04	jpi_pageflts_return_adr		pic s9(09) comp.
	03  ppgcnt_record.
	    04	jpi_ppgcnt_buffer_len		pic s9(04) comp.
	    04	jpi_ppgcnt_item_code		pic s9(04) comp.
	    04	jpi_ppgcnt_buffer_adr		usage pointer.
	    04	jpi_ppgcnt_return_adr		pic s9(09) comp.
	03  pri_record.
	    04	jpi_pri_buffer_len		pic s9(04) comp.
	    04	jpi_pri_item_code		pic s9(04) comp.
	    04	jpi_pri_buffer_adr		usage pointer.
	    04	jpi_pri_return_adr		pic s9(09) comp.
	03  prib_record.
	    04	jpi_prib_buffer_len		pic s9(04) comp.
	    04	jpi_prib_item_code		pic s9(04) comp.
	    04	jpi_prib_buffer_adr		usage pointer.
	    04	jpi_prib_return_adr		pic s9(09) comp.
	03  state_record.
	    04	jpi_state_buffer_len		pic s9(04) comp.
	    04	jpi_state_item_code		pic s9(04) comp.
	    04	jpi_state_buffer_adr		usage pointer.
	    04	jpi_state_return_adr		pic s9(09) comp.
	03  sts_record.
	    04	jpi_sts_buffer_len		pic s9(04) comp.
	    04	jpi_sts_item_code		pic s9(04) comp.
	    04	jpi_sts_buffer_adr		usage pointer.
	    04	jpi_sts_return_adr		pic s9(09) comp.
	03  terminal_record.
	    04	jpi_terminal_buffer_len		pic s9(04) comp.
	    04	jpi_terminal_item_code		pic s9(04) comp.
	    04	jpi_terminal_buffer_adr		usage pointer.
	    04	jpi_terminal_return_adr		usage pointer.
	03  username_record.
	    04	jpi_username_buffer_len		pic s9(04) comp.
	    04	jpi_username_item_code		pic s9(04) comp.
	    04	jpi_username_buffer_adr		usage pointer.
	    04	jpi_username_return_adr		pic s9(09) comp.
	03  wssize_record.
	    04	jpi_wssize_buffer_len		pic s9(04) comp.
	    04	jpi_wssize_item_code		pic s9(04) comp.
	    04	jpi_wssize_buffer_adr		usage pointer.
	    04	jpi_wssize_return_adr		pic s9(09) comp.
	03  end_record.
	    04	end_record_buffer_len		pic s9(09) comp.

01  bold-final-output-string.
    02	filler					pic x(4) value "".
    02	final-output-string			pic x(90).

01  OUTPUT_STRING.
    02  OUTPUT_LINE_COUNT		PIC Z9.
    02  FILLER				PIC X VALUE SPACE.
    02  OUTPUT_TERMINAL			PIC X(5).
    02  FILLER				PIC X VALUE SPACE.
    02  OUTPUT_USERNAME			PIC X(12).
    02  FILLER				PIC X VALUE SPACE.
    02  OUTPUT_PRI			PIC Z9.
    02  FILLER				PIC X VALUE "/".
    02  OUTPUT_PRIB			PIC Z9.
    02  FILLER				PIC X VALUE SPACE.
    02  OUTPUT_WSET			PIC Z(3)9.
    02  FILLER				PIC X VALUE SPACE.
    02  OUTPUT_WSSIZE			PIC Z(3)9.
    02  FILLER				PIC X VALUE SPACE.
    02  OUTPUT_STATE			PIC X(5).
    02  FILLER				PIC X VALUE SPACE.
    02  OUTPUT_CPU_GROUP.
	03  OUTPUT_LARGE_CPUPCT		PIC Z(2)9.
	03  OUTPUT_SMALL_CPUPCT REDEFINES OUTPUT_LARGE_CPUPCT
					PIC Z.9.
	03  OUTPUT_PERCENT_SIGN		PIC X.
    02  OUTPUT_CPU_DASHES REDEFINES OUTPUT_CPU_GROUP
					PIC X(4).
    02  OUTPUT_DIODIF			PIC Z(4).
    02  OUTPUT_DIO_DASHES REDEFINES OUTPUT_DIODIF
					PIC X(4).
    02  OUTPUT_BIODIF			PIC Z(4).
    02  OUTPUT_BIO_DASHES REDEFINES OUTPUT_BIODIF
					PIC X(4).
    02  OUTPUT_FLTDIF			PIC Z(4).
    02  OUTPUT_FLT_DASHES REDEFINES OUTPUT_FLTDIF
					PIC X(4).
    02  FILLER				PIC X VALUE SPACE.
    02  OUTPUT_IMAGNAME			PIC X(19).

01  OTHER_OUTPUT_STRING.
    02  FILLER				PIC X(5) VALUE " ".
    02  DISPLAY_CURRENT_PAUSE		PIC 9.
    02  FILLER				PIC X(7) VALUE SPACES.
    02  OTHER_OUTPUT_DAYTIME		PIC X(20).
    02  FILLER				PIC X(3) VALUE SPACES.
    02  FILLER				PIC X(11) VALUE "OTHER JOBS:".
    02  FILLER				PIC X(4) VALUE "".
    02  other_output_cpupct		pic ---9 value zero.
    02  other_output_percent_sign	pic x.
    02  OTHER_OUTPUT_DIODIF		PIC Z(4).
    02  OTHER_OUTPUT_BIODIF		PIC Z(4).
    02  OTHER_OUTPUT_FLTDIF		PIC Z(4).
    02  FILLER				PIC X(1) VALUE SPACE.
    02  FILLER				PIC X(4) VALUE "".
    02  filler				pic x value spaces.
    02  filler				pic x(5) value "SCAN:".
    02  display-insufficient-ast-count	pic z9.
    02  filler				pic x(2) value spaces.
    02  filler				pic x(5) value "WAIT:".
    02  display-catchup-cycle-count	pic z9.
    02  filler				pic x value spaces.
    02  FILLER				PIC X(4) VALUE "".
*   This space erases any residual character on the last line of the display.
    02  FILLER				PIC X(1) VALUE SPACE.


01  jpi-array-size				pic s9(9) comp value 512.

01  currently_active_pid_array.
    02  currently_active_pid_entry		occurs 512.
	03  currently_active_pid		pic s9(9) comp.
	03  currently_active_proc_index		pic s9(9) comp.

copy	"systatus.ext".


01  VARIABLES.
    02  actual-jpi-array-sub			pic s9(9) comp.
    02  array-sub 				pic s9(9) comp.
    02  catchup-cycle-count			pic s9(9) comp.
    02  currently_active_pid_count		pic s9(9) comp.
    02  currently_active_pid_sub		pic s9(9) comp.
    02  final-output-string-length		pic s9(9) comp.
    02  insufficient-ast-count			pic s9(9) comp.
    02  max_ast_count				pic s9(9) comp.
    02  my_previous_priority			pic s9(9) comp.

    02  OLD_BUFFER			PIC S9(9) COMP.
    02  PRIOR_TIME			PIC S9(18) COMP.
    02  CURRENT_TIME			PIC S9(18) COMP.
    02  ELAPSED_SECONDS			PIC S9(5)V9(4) COMP.
    02  LOCKED_TERMINAL_WAIT_TIME	COMP-2.
    02  PID				PIC S9(9) COMP.
    02  TEMP_CPUDIFF			PIC S9(9) COMP.
    02  TEMP_CPUPCT			PIC S9(5)V9(4) COMP.
    02  CUMULATIVE_CPUPCT		PIC S9(5)V9(4) COMP.
    02  CUMULATIVE_DIODIF		PIC S9(9) COMP.
    02  CUMULATIVE_BIODIF		PIC S9(9) COMP.
    02  CUMULATIVE_FLTDIF		PIC S9(9) COMP.
    02  MY_PROCESS_PID			PIC S9(9) COMP.
    02  WS_IMAGNAME_START		PIC S9(9) COMP.
    02  WS_IMAGNAME_MIDDLE		PIC S9(9) COMP.
    02  WS_IMAGNAME_END			PIC S9(9) COMP.
    02  WS_SHORT_IMAGNAME_SIZE		PIC S9(9) COMP.
    02  TEMP_STS			PIC S9(9) COMP.
    02  VALID_WS_STATES.
	03  CEF				PIC S9(9) COMP VALUE EXTERNAL SCH$C_CEF.
	03  COM				PIC S9(9) COMP VALUE EXTERNAL SCH$C_COM.
	03  COMO			PIC S9(9) COMP VALUE EXTERNAL SCH$C_COMO.
	03  CUR				PIC S9(9) COMP VALUE EXTERNAL SCH$C_CUR.
	03  COLPG			PIC S9(9) COMP VALUE EXTERNAL SCH$C_COLPG.
	03  FPG				PIC S9(9) COMP VALUE EXTERNAL SCH$C_FPG.
	03  HIB				PIC S9(9) COMP VALUE EXTERNAL SCH$C_HIB.
	03  HIBO			PIC S9(9) COMP VALUE EXTERNAL SCH$C_HIBO.
	03  LEF				PIC S9(9) COMP VALUE EXTERNAL SCH$C_LEF.
	03  LEFO			PIC S9(9) COMP VALUE EXTERNAL SCH$C_LEFO.
	03  MWAIT			PIC S9(9) COMP VALUE EXTERNAL SCH$C_MWAIT.
	03  PFW				PIC S9(9) COMP VALUE EXTERNAL SCH$C_PFW.
	03  SUSP			PIC S9(9) COMP VALUE EXTERNAL SCH$C_SUSP.
	03  SUSPO			PIC S9(9) COMP VALUE EXTERNAL SCH$C_SUSPO.
    02  PROCESS_STATE_TABLE.
	03  PROCESS_STATE_DESCRIPTION	OCCURS 14 PIC X(5).
    02  CURRENT_LINE_COUNT		PIC S9(9) COMP VALUE ZERO.
    02  PRIOR_LINE_COUNT		PIC S9(9) COMP VALUE ZERO.
    02  FIRST_LINE_TO_ERASE		PIC S9(9) COMP.
    02  ws_currently_active_pid		pic s9(9) comp.
    02  ws_currently_active_proc_index	pic s9(9) comp.

01  SWITCHES.
    02  CTRLC-ENTERED-FLAG		PIC X VALUE "F".
    02  DONE-SW				PIC X VALUE "F".
    02  CURRENT-DISPLAY-MODE		PIC X.
    02  REFRESH-SW			PIC X VALUE "T".
    02	TERMINAL-AVAILABLE-SW		PIC X.
    02	total-cpu-is-certain-sw		pic x.
    02  CALL_STATUS			PIC S9(9) COMP.
	88  NO_MORE_PROCESSES		VALUE EXTERNAL SS$_NOMOREPROC.
    02  getjpi_call_status		pic s9(9) comp.
    02  WAIT-IS-REASONABLE-SW		PIC X.

01  help-screen.
    02	filler	pic x(43) value "SYSTEM STATUS MONITOR V4.0
".
    02	filler	pic x(02) value "
".
    02	filler	pic x(11) value "COMMANDS:
".
    02	filler	pic x(02) value "
".
    02	filler	pic x(30) value "    1-9  -  Set delay period
".
    02	filler	pic x(51) value "<SPACE>  -  Normal display (non-system processes)
".
    02	filler	pic x(51) value "      C  -  Comprehensive display (all processes)
".
    02	filler	pic x(52) value "      S  -  Subprocess display (subprocesses only)
".
    02	filler	pic x(60) value "      L  -  Locked display (ignore further terminal input)
".
    02	filler	pic x(26) value "      H  -  Help display
".
    02	filler	pic x(18) value "      E  -  Exit
".
    02	filler	pic x(18) value "     ^Z  -  Exit
".
    02	filler	pic x(21) value "     ^R  -  Refresh
".
    02	filler	pic x(02) value "
".
    02	filler	pic x(29) value "Press <RETURN> when ready:  ".

*   SCREEN_BUFFER should be at the end of working storage.
01  SCREEN_BUFFER			PIC X(10240).

PROCEDURE DIVISION.

00000_deliver_system_status.
	display ""

	perform 10000_init_program

	perform 20000_display_screen
		until	done-sw = ws-true

	call	"lib$set_scroll"
		using	by reference	line_01
			by reference	line_24

	display ""

	stop	run
	.

10000_INIT_PROGRAM.
	MOVE	USER-PROCESS-DISPLAY-MODE TO CURRENT-DISPLAY-MODE
	MOVE	"LEF"	TO PROCESS_STATE_DESCRIPTION ( LEF )
	MOVE	"HIB"	TO PROCESS_STATE_DESCRIPTION ( HIB )
	MOVE	"COM"	TO PROCESS_STATE_DESCRIPTION ( COM )
	MOVE	"CUR"	TO PROCESS_STATE_DESCRIPTION ( CUR )
	MOVE	"PFW"	TO PROCESS_STATE_DESCRIPTION ( PFW )
	MOVE	"HIBO"	TO PROCESS_STATE_DESCRIPTION ( HIBO )
	MOVE	"LEFO"	TO PROCESS_STATE_DESCRIPTION ( LEFO )
	MOVE	"MWAIT"	TO PROCESS_STATE_DESCRIPTION ( MWAIT )
	MOVE	"SUSP"	TO PROCESS_STATE_DESCRIPTION ( SUSP )
	MOVE	"SUSPO"	TO PROCESS_STATE_DESCRIPTION ( SUSPO )
	MOVE	"COMO"	TO PROCESS_STATE_DESCRIPTION ( COMO )
	MOVE	"CEF"	TO PROCESS_STATE_DESCRIPTION ( CEF )
	MOVE	"COLPG"	TO PROCESS_STATE_DESCRIPTION ( COLPG )
	MOVE	"FPG"	TO PROCESS_STATE_DESCRIPTION ( FPG )

	perform 11000-init-arrays

*	Set up the mask for checking if jobs are batch jobs.

	COMPUTE BATCH_JOB_MASK = 2 ** BATCH_JOB_BIT_POSITION

	CALL	"SYS$BINTIM"
		USING	BY DESCRIPTOR	TIME-DELAY-VARIABLE
			BY REFERENCE	DELTA_TIME

	CALL	"SYS$GETTIM"
		USING	BY REFERENCE	CURRENT_TIME
*	Force a valid ELAPSED_TIME the first time around, (to avoid a divide-by-zero),
*	by pretending that we started one second ago.
	SUBTRACT CLUNKS_PER_SECOND FROM CURRENT_TIME

	CALL	"SYS$BINTIM"
		USING	BY DESCRIPTOR	NINE-SECOND-LIT,
			BY REFERENCE	LOCKED_TERMINAL_WAIT_TIME

	move	zero to outstanding-getjpi-count

	COMPUTE SPECIAL-READ-COMMAND =	READ-COMMAND +
					CVTLOW-READ-MODIFIER +
					NOECHO-READ-MODIFIER +
					NOFILTR-READ-MODIFIER +
					TIMED-READ-MODIFIER +
					TRMNOECHO-READ-MODIFIER
	CALL	"SYS$ASSIGN"	USING
		BY DESCRIPTOR	"SYS$INPUT:"
		BY REFERENCE	TERMINAL-CHANNEL,
		BY VALUE	0,
		BY VALUE	0
		GIVING		IOSTATUS
	IF	NORMAL-STATUS
		MOVE	WS-TRUE TO TERMINAL-AVAILABLE-SW
	ELSE
		MOVE	WS-FALSE TO TERMINAL-AVAILABLE-SW
	END-IF

*	Enable a true/false CTRL-C AST.
	CALL	"CI$ENABLE_CTRLC_AST"
		USING	BY REFERENCE	CTRLC-ENTERED-FLAG

*	Enable an event-flag CTRL-C AST.
	CALL	"CI$ENABLE_LEF_CTRLC_AST"
		USING	BY REFERENCE	GENERAL-EVENT-FLAG

*	Get my own process id.
	call	"sys$getjpi"
		using	by value	general-event-flag
			by value	zero
			by value	zero
			by reference	pid_itemlist
			by value	zero
			by value	zero
			by value	zero
		giving	getjpi_call_status
	move	ws_currently_active_pid to my_process_pid

*	By the way, how many ASTs can I have active?
*	(This must be done AFTER enabling the CTRL-C ASTs above.)
	call	"sys$getjpi"
		using	by value	general-event-flag
			by value	zero
			by value	zero
			by reference	astcnt_itemlist
			by value	zero
			by value	zero
			by value	zero
		giving	getjpi_call_status
	if	max_ast_count not > zero
	then
		move	ws-true to done-sw
*		This display probably won't work, because it needs an AST of its own.
		display "Inadequate AST quota.  Program aborting."
**	else
**		display max_ast_count with conversion " ASTs available."
	end-if

	perform 12000_load_first_getjpi_array
	.

11000-init-arrays.
	perform varying array-sub from 1 by 1
		until	array-sub > jpi-array-size

		move	ws-false to getjpi-in-progress-sw ( array-sub )
		move	zero to prior_pid ( array-sub )

*		init bufio_record.
		move	4 to jpi_bufio_buffer_len ( array-sub )
		move	jpi$_bufio to jpi_bufio_item_code ( array-sub )
	        set	jpi_bufio_buffer_adr ( array-sub ) to reference current_bufio ( array-sub )
		move	zero to jpi_bufio_return_adr ( array-sub )

*		init cputim_record.
		move	4 to jpi_cputim_buffer_len ( array-sub )
		move	jpi$_cputim to jpi_cputim_item_code ( array-sub )
	        set	jpi_cputim_buffer_adr ( array-sub ) to reference current_cputim ( array-sub )
		move	zero to jpi_cputim_return_adr ( array-sub )

*		init dirio_record.
		move	4 to jpi_dirio_buffer_len ( array-sub )
		move	jpi$_dirio to jpi_dirio_item_code ( array-sub )
	        set	jpi_dirio_buffer_adr ( array-sub ) to reference current_dirio ( array-sub )
		move	zero to jpi_dirio_return_adr ( array-sub )

*		init gpgcnt_record.
		move	4 to jpi_gpgcnt_buffer_len ( array-sub )
		move	jpi$_gpgcnt to jpi_gpgcnt_item_code ( array-sub )
	        set	jpi_gpgcnt_buffer_adr ( array-sub ) to reference current_gpgcnt ( array-sub )
		move	zero to jpi_gpgcnt_return_adr ( array-sub )

*		init imagname_record.
		move	128 to jpi_imagname_buffer_len ( array-sub )
		move	jpi$_imagname to jpi_imagname_item_code ( array-sub )
	        set	jpi_imagname_buffer_adr ( array-sub ) to reference current_imagname ( array-sub )
	        set	jpi_imagname_return_adr ( array-sub ) to reference current_imagname_size ( array-sub )

*		init pageflts_record.
		move	4 to jpi_pageflts_buffer_len ( array-sub )
		move	jpi$_pageflts to jpi_pageflts_item_code ( array-sub )
	        set	jpi_pageflts_buffer_adr ( array-sub ) to reference current_pageflts ( array-sub )
		move	zero to jpi_pageflts_return_adr ( array-sub )

*		init ppgcnt_record.
		move	4 to jpi_ppgcnt_buffer_len ( array-sub )
		move	jpi$_ppgcnt to jpi_ppgcnt_item_code ( array-sub )
	        set	jpi_ppgcnt_buffer_adr ( array-sub ) to reference current_ppgcnt ( array-sub )
		move	zero to jpi_ppgcnt_return_adr ( array-sub )

*		init pri_record.
		move	4 to jpi_pri_buffer_len ( array-sub )
		move	jpi$_pri to jpi_pri_item_code ( array-sub )
	        set	jpi_pri_buffer_adr ( array-sub ) to reference current_pri ( array-sub )
		move	zero to jpi_pri_return_adr ( array-sub )

*		init prib_record.
		move	4 to jpi_prib_buffer_len ( array-sub )
		move	jpi$_prib to jpi_prib_item_code ( array-sub )
	        set	jpi_prib_buffer_adr ( array-sub ) to reference current_prib ( array-sub )
		move	zero to jpi_prib_return_adr ( array-sub )

*		init state_record.
		move	4 to jpi_state_buffer_len ( array-sub )
		move	jpi$_state to jpi_state_item_code ( array-sub )
	        set	jpi_state_buffer_adr ( array-sub ) to reference current_state ( array-sub )
		move	zero to jpi_state_return_adr ( array-sub )

*		init sts_record.
		move	4 to jpi_sts_buffer_len ( array-sub )
		move	jpi$_sts to jpi_sts_item_code ( array-sub )
	        set	jpi_sts_buffer_adr ( array-sub ) to reference current_sts ( array-sub )
		move	zero to jpi_sts_return_adr ( array-sub )

*		init terminal_record.
		move	5 to jpi_terminal_buffer_len ( array-sub )
		move	jpi$_terminal to jpi_terminal_item_code ( array-sub )
	        set	jpi_terminal_buffer_adr ( array-sub ) to reference current_terminal ( array-sub )
	        set	jpi_terminal_return_adr ( array-sub ) to reference current_terminal_size ( array-sub )

*		init username_record.
		move	12 to jpi_username_buffer_len ( array-sub )
		move	jpi$_username to jpi_username_item_code ( array-sub )
	        set	jpi_username_buffer_adr ( array-sub ) to reference current_username ( array-sub )
		move	zero to jpi_username_return_adr ( array-sub )

*		init wssize_record.
		move	4 to jpi_wssize_buffer_len ( array-sub )
		move	jpi$_wssize to jpi_wssize_item_code ( array-sub )
	        set	jpi_wssize_buffer_adr ( array-sub ) to reference current_wssize ( array-sub )
		move	zero to jpi_wssize_return_adr ( array-sub )

*		init end_record.
		move	zero to end_record_buffer_len ( array-sub )

	end-perform
	.

12000_load_first_getjpi_array.
	call	"lib$disable_ctrl"
		using	by reference	control_y_mask

	call	"sys$setpri"
		using	by value	zero
			by value	zero
			by value	high_priority
			by reference	my_previous_priority

	perform C-load-getjpi-array

	perform varying currently-active-pid-sub from 1 by 1
		until	currently_active_pid_sub > currently_active_pid_count
			or
			ctrlc-entered-flag = ws-true

		compute actual-jpi-array-sub = currently_active_proc_index ( currently_active_pid_sub )

*		Copy and reset data items for this process.
		move	current_pid ( actual-jpi-array-sub )		to prior_pid ( actual-jpi-array-sub )
		move	current_cputim ( actual-jpi-array-sub )		to prior_cputim ( actual-jpi-array-sub )
		move	current_dirio ( actual-jpi-array-sub )		to prior_dirio ( actual-jpi-array-sub )
		move	current_bufio ( actual-jpi-array-sub )		to prior_bufio ( actual-jpi-array-sub )
		move	current_pageflts ( actual-jpi-array-sub )	to prior_pageflts ( actual-jpi-array-sub )
		move	zero						to getjpi-calls-completed-count ( actual-jpi-array-sub )

	end-perform

	call	"sys$setpri"
		using	by value	zero
			by value	zero
			by value	my_previous_priority
			by value	zero
	call	"lib$enable_ctrl"
		using	by reference	control_y_mask
	.

20000_DISPLAY_SCREEN.
	CALL	"LIB$SET_BUFFER"
		USING	BY DESCRIPTOR	SCREEN_BUFFER,
			BY REFERENCE	OLD_BUFFER

	IF	REFRESH-SW = WS-TRUE

		call	"lib$set_scroll"
			using	by reference	line_02
				by reference	line_24

		CALL	"LIB$SET_CURSOR"
			USING	BY REFERENCE	LINE_01,
				BY REFERENCE	COLUMN_01

		CALL	"LIB$PUT_LINE"
			USING	BY DESCRIPTOR	SCREEN_HEADING
				BY REFERENCE	ONE_LINE,
				BY VALUE	ZERO
	END-IF

	CALL	"LIB$SET_CURSOR"
		USING	BY REFERENCE	LINE_02,
			BY REFERENCE	COLUMN_01

	MOVE	CURRENT_LINE_COUNT	TO PRIOR_LINE_COUNT
	MOVE	ZERO	TO CURRENT_LINE_COUNT

	MOVE	ZERO	TO CUMULATIVE_CPUPCT
	MOVE	ZERO	TO CUMULATIVE_DIODIF
	MOVE	ZERO	TO CUMULATIVE_BIODIF
	MOVE	ZERO	TO CUMULATIVE_FLTDIF

	MOVE	CURRENT_TIME TO PRIOR_TIME

	CALL	"LIB$DISABLE_CTRL"
		USING	BY REFERENCE	CONTROL_Y_MASK

	CALL	"SYS$SETPRI"
		USING	BY VALUE	ZERO
			BY VALUE	ZERO
			BY VALUE	HIGH_PRIORITY
			BY REFERENCE	MY_PREVIOUS_PRIORITY

	CALL	"SYS$GETTIM"
		USING	BY REFERENCE	CURRENT_TIME

	COMPUTE ELAPSED_SECONDS = (CURRENT_TIME - PRIOR_TIME) / CLUNKS_PER_SECOND

	perform C-load-getjpi-array

*	Display all known process data.

	move	ws-true to total-cpu-is-certain-sw
	move	zero to currently_active_pid_sub
	perform 21000_scan_process
		until	currently_active_pid_sub = currently_active_pid_count
			or
			ctrlc-entered-flag = ws-true

	call	"sys$setpri"
		using	by value	zero
			by value	zero
			by value	my_previous_priority
			by value	zero

	call	"lib$enable_ctrl"
		using	by reference	control_y_mask

	IF	CTRLC-ENTERED-FLAG = WS-TRUE
	THEN
		MOVE	WS-TRUE TO DONE-SW
	ELSE
		PERFORM 22000_DISPLAY_OTHER_TOTALS

		IF	PRIOR_LINE_COUNT > CURRENT_LINE_COUNT
			OR
			REFRESH-SW = WS-TRUE
			COMPUTE FIRST_LINE_TO_ERASE = CURRENT_LINE_COUNT + 3
			IF	FIRST_LINE_TO_ERASE NOT > 24
				CALL	"LIB$ERASE_PAGE"
					USING	BY REFERENCE	FIRST_LINE_TO_ERASE,
						BY REFERENCE	COLUMN_01
			END-IF
			MOVE	WS-FALSE TO REFRESH-SW
		END-IF

		CALL	"LIB$PUT_BUFFER"
			USING	BY REFERENCE	OLD_BUFFER

		IF	TERMINAL-AVAILABLE-SW = WS-FALSE
			CALL	"SYS$SETIMR"
				USING	BY VALUE	GENERAL-EVENT-FLAG
					BY REFERENCE	LOCKED_TERMINAL_WAIT_TIME
					BY VALUE	ZERO
					BY VALUE	ZERO
			CALL	"SYS$WAITFR"
				USING	BY VALUE	GENERAL-EVENT-FLAG
		ELSE
			MOVE	WS-FALSE TO WAIT-IS-REASONABLE-SW
			PERFORM	23000-WAIT-REASONABLY-LONG
				WITH	TEST AFTER
				UNTIL	WAIT-IS-REASONABLE-SW = WS-TRUE
		END-IF
	END-IF
	.

21000_scan_process.
	add	1 to currently_active_pid_sub
	compute actual-jpi-array-sub = currently_active_proc_index ( currently_active_pid_sub )

	if	currently_active_pid ( currently_active_pid_sub ) = my_process_pid
		move	my_previous_priority to current_prib ( actual-jpi-array-sub )
	end-if

	evaluate current-display-mode
		when	user-process-display-mode
			if	current_terminal_size ( actual-jpi-array-sub ) > zero
				or
*				Is this job a user's process or subprocess?
				(	current_username ( actual-jpi-array-sub ) not = "JOB_CONTROL "
					and
					current_username ( actual-jpi-array-sub ) not = "SYSTEM      "
				)
			then
*				Either there is a command terminal, or this is a user's subprocess.
				perform 21100_display_line
			else
*				There isn't a command terminal, and this is either JOB_CONTROL or SYSTEM.
*				Is the batch-job bit set in the status longword?
				call	"mth$jiand"
					using	by reference	current_sts ( actual-jpi-array-sub )
						by reference	batch_job_mask
					giving	temp_sts
				if	temp_sts not = zero
*					It's a batch job:
				then
					perform 21100_display_line
				else
*					This one isn't a batch job, it's not a user's process, and there isn't a command terminal.
*					Keep track of totals, even though we aren't displaying this process:
					if	current_pid ( actual-jpi-array-sub ) = prior_pid ( actual-jpi-array-sub )
					then
						compute cumulative_diodif =	cumulative_diodif +
										current_dirio ( actual-jpi-array-sub ) -
										prior_dirio ( actual-jpi-array-sub )
						compute cumulative_biodif =	cumulative_biodif +
										current_bufio ( actual-jpi-array-sub ) -
										prior_bufio ( actual-jpi-array-sub )
						compute cumulative_fltdif =	cumulative_fltdif +
										current_pageflts ( actual-jpi-array-sub ) -
										prior_pageflts ( actual-jpi-array-sub )
					else
						add	current_dirio ( actual-jpi-array-sub ) to cumulative_diodif
						add	current_bufio ( actual-jpi-array-sub ) to cumulative_biodif
						add	current_pageflts ( actual-jpi-array-sub ) to cumulative_fltdif
					end-if
				end-if
			end-if
		when	subprocess-display-mode
			if	current_terminal_size ( actual-jpi-array-sub ) = zero
				and
				current_username ( actual-jpi-array-sub ) not = "JOB_CONTROL "
				and
				current_username ( actual-jpi-array-sub ) not = "SYSTEM      "
			then
*				This is a user's subprocess or batch process.
				perform 21100_display_line
			else
*				This isn't a user's subprocess or batch process.
*				Keep track of totals, even though we aren't displaying this process:
				if	current_pid ( actual-jpi-array-sub ) = prior_pid ( actual-jpi-array-sub )
				then
					compute cumulative_diodif =	cumulative_diodif +
									current_dirio ( actual-jpi-array-sub ) -
									prior_dirio ( actual-jpi-array-sub )
					compute cumulative_biodif =	cumulative_biodif +
									current_bufio ( actual-jpi-array-sub ) -
									prior_bufio ( actual-jpi-array-sub )
					compute cumulative_fltdif =	cumulative_fltdif +
									current_pageflts ( actual-jpi-array-sub ) -
									prior_pageflts ( actual-jpi-array-sub )
				else
					add	current_dirio ( actual-jpi-array-sub ) to cumulative_diodif
					add	current_bufio ( actual-jpi-array-sub ) to cumulative_biodif
					add	current_pageflts ( actual-jpi-array-sub ) to cumulative_fltdif
				end-if
			end-if
		when	comprehensive-display-mode
			perform 21100_display_line
		when	other
			display "Unknown mode in 21000.  Program aborting."
			move	ws-true to ctrlc-entered-flag
	end-evaluate

*	We're finished with this process.
*	Copy and reset data items for this process.
	move	current_pid ( actual-jpi-array-sub )		to prior_pid ( actual-jpi-array-sub )
	move	current_cputim ( actual-jpi-array-sub )		to prior_cputim ( actual-jpi-array-sub )
	move	current_dirio ( actual-jpi-array-sub )		to prior_dirio ( actual-jpi-array-sub )
	move	current_bufio ( actual-jpi-array-sub )		to prior_bufio ( actual-jpi-array-sub )
	move	current_pageflts ( actual-jpi-array-sub )	to prior_pageflts ( actual-jpi-array-sub )
	move	zero						to getjpi-calls-completed-count ( actual-jpi-array-sub )
	.

21100_display_line.
** All references to getjpi-in-progress-sw ( actual-jpi-array-sub ) and getjpi-calls-completed-count ( actual-jpi-array-sub )
** in this paragraph depend on the switch remaining unchanged throughout the execution of this paragraph,
** i.e. this paragraph must execute at a sufficiently high priority to supercede the AST from being delivered while
** the paragraph is in execution.

	add	1	to current_line_count
	move	current_line_count	to output_line_count

**	Load output_terminal
	if	current_terminal_size ( actual-jpi-array-sub ) = zero
*		Is it a batch job?
		call	"mth$jiand"
			using	by reference	current_sts ( actual-jpi-array-sub )
				by reference	batch_job_mask
			giving	temp_sts
		if	temp_sts not = zero
*			It's a batch job:
			move	"batch"	to output_terminal
		else
*			It's not a batch job:
			move	spaces	to output_terminal
		end-if
	else
		move	current_terminal ( actual-jpi-array-sub ) to output_terminal
	end-if

**	Load output_username
	move	current_username ( actual-jpi-array-sub ) to output_username

**	Load output_state
	if	current_state ( actual-jpi-array-sub ) not < 1
		and
		current_state ( actual-jpi-array-sub ) not > 14
	then
		move	process_state_description ( current_state ( actual-jpi-array-sub ) ) to output_state
	else
		move	"  ?  "	to output_state
	end-if

**	Load output_pri
	move	current_pri ( actual-jpi-array-sub )		to	output_pri

**	Load output_prib
	move	current_prib ( actual-jpi-array-sub )		to	output_prib

**	Load output_wset
	add	current_ppgcnt ( actual-jpi-array-sub )
		current_gpgcnt ( actual-jpi-array-sub )		giving	output_wset

**	Load output_wssize
	move	current_wssize ( actual-jpi-array-sub )		to	output_wssize

**	Load output_cpu_group or output_large_cpupct or output_small_cpupct
**	Load output_diodif
**	Load output_biodif
**	Load output_fltdif
	if	current_state ( actual-jpi-array-sub ) not = susp
		and
		current_state ( actual-jpi-array-sub ) not = suspo
	then
		compute temp_cpudiff = current_cputim ( actual-jpi-array-sub ) - prior_cputim ( actual-jpi-array-sub )
		if	temp_cpudiff = zero
			move	zero to temp_cpupct
			if	getjpi-in-progress-sw ( actual-jpi-array-sub ) = ws-false
				and
				getjpi-calls-completed-count ( actual-jpi-array-sub ) = 1
			then
				move	spaces to output_cpu_group
			else
				move	ws-false to total-cpu-is-certain-sw
				move	zero to output_large_cpupct
				move	"?" to output_percent_sign
			end-if
		else
			compute temp_cpupct = temp_cpudiff / elapsed_seconds
			add	temp_cpupct to cumulative_cpupct 
			if	temp_cpupct < 1
				move	temp_cpupct to output_small_cpupct
			else
				move	temp_cpupct to output_large_cpupct
			end-if
			if	getjpi-in-progress-sw ( actual-jpi-array-sub ) = ws-false
				and
				getjpi-calls-completed-count ( actual-jpi-array-sub ) = 1
			then
				move	"%" to output_percent_sign
			else
				move	ws-false to total-cpu-is-certain-sw
				move	"?" to output_percent_sign
			end-if
		end-if

		compute output_diodif = current_dirio ( actual-jpi-array-sub ) - prior_dirio ( actual-jpi-array-sub )
		compute output_biodif = current_bufio ( actual-jpi-array-sub ) - prior_bufio ( actual-jpi-array-sub )
		compute output_fltdif = current_pageflts ( actual-jpi-array-sub ) - prior_pageflts ( actual-jpi-array-sub )
	else
		move	spaces to output_cpu_dashes
		move	spaces to output_dio_dashes
		move	spaces to output_bio_dashes
		move	spaces to output_flt_dashes
	end-if

**	Load output_imagname
	if	current_imagname_size ( actual-jpi-array-sub ) = zero
		move	spaces to output_imagname
	else
		call	"lib$locc"
			using	by descriptor	"["
				by descriptor	current_imagname ( actual-jpi-array-sub )
						( 1 : current_imagname_size ( actual-jpi-array-sub ) )
			giving	ws_imagname_start

		call	"lib$locc"
			using	by descriptor	"]"
				by descriptor	current_imagname ( actual-jpi-array-sub )
						( ws_imagname_start : current_imagname_size ( actual-jpi-array-sub ) )
			giving	ws_imagname_middle

		call	"lib$locc"
			using	by descriptor	"."
				by descriptor	current_imagname ( actual-jpi-array-sub )
				( ws_imagname_start + ws_imagname_middle : current_imagname_size ( actual-jpi-array-sub ) )
			giving	ws_imagname_end

		compute ws_short_imagname_size = ws_imagname_middle + ws_imagname_end - 1
		if	ws_short_imagname_size > output_imagname_size
			compute ws_imagname_start = ws_imagname_start + ws_short_imagname_size - output_imagname_size
			move	output_imagname_size to ws_short_imagname_size
		end-if

		move	current_imagname ( actual-jpi-array-sub ) ( ws_imagname_start : ws_short_imagname_size )
			to output_imagname
	end-if

	if	output-string ( 77 : ) = spaces
	then
		call	"str$trim"
			using	by descriptor	final-output-string
				by descriptor	output-string
				by reference	final-output-string-length
		move	"" to final-output-string ( final-output-string-length + 1 : 3 )
		add	3 to final-output-string-length
	else
		move	output-string to final-output-string
		move	80 to final-output-string-length
	end-if

	if	current_pid ( actual-jpi-array-sub ) = prior_pid ( actual-jpi-array-sub )
	then
		call	"lib$put_line"
			using	by descriptor	final-output-string ( 1 : final-output-string-length )
				by reference	one_line
				by value	zero
	else
		move	"" to final-output-string ( final-output-string-length + 1 : 3 )
		add	3 to final-output-string-length
		call	"lib$put_line"
			using	by descriptor	bold-final-output-string ( 1 : final-output-string-length + 4 )
				by reference	one_line
				by value	zero
	end-if
	.

22000_DISPLAY_OTHER_TOTALS.
*	ADD	1	TO CURRENT_LINE_COUNT

*	MOVE	CURRENT_LINE_COUNT	TO OTHER_OUTPUT_LINE_COUNT

	MOVE	TERMINAL-TIMEOUT-SECONDS TO DISPLAY_CURRENT_PAUSE

	move	insufficient-ast-count to display_insufficient-ast-count
	move	catchup-cycle-count to display-catchup-cycle-count

	compute other_output_cpupct = 100 - cumulative_cpupct
	if	total-cpu-is-certain-sw = ws-true
	then
		move	"%" to other_output_percent_sign
	else
		move	"?" to other_output_percent_sign
	end-if

	MOVE	CUMULATIVE_DIODIF TO OTHER_OUTPUT_DIODIF
	MOVE	CUMULATIVE_BIODIF TO OTHER_OUTPUT_BIODIF
	MOVE	CUMULATIVE_FLTDIF TO OTHER_OUTPUT_FLTDIF

	CALL	"LIB$DATE_TIME"
		USING	BY DESCRIPTOR	OTHER_OUTPUT_DAYTIME

	CALL	"LIB$PUT_SCREEN"
		USING	BY DESCRIPTOR	OTHER_OUTPUT_STRING
			BY VALUE	ZERO,
			BY VALUE	ZERO,
			BY VALUE	ZERO
	.

23000-WAIT-REASONABLY-LONG.
	MOVE	NULL-CHAR TO TERMINAL-BUFFER
        CALL	"SYS$QIOW" USING
		BY VALUE	TERMINAL-EVENT-FLAG,
		BY VALUE	TERMINAL-CHANNEL,
		BY VALUE	SPECIAL-READ-COMMAND,
		BY REFERENCE	IOSB,
		BY VALUE	ZERO,
		BY VALUE	ZERO,
		BY REFERENCE	TERMINAL-BUFFER,
		BY VALUE	TERMINAL-BUFFER-SIZE,
		BY VALUE	QIOW-WAIT-PERIOD,
		BY VALUE	ZERO,
		BY VALUE	ZERO,
		BY VALUE	ZERO,
		GIVING		IOSTATUS
*
*	Restore the long-term wait period, in case a short-term (one second) wait was in effect
	MOVE	TERMINAL-TIMEOUT-SECONDS TO QIOW-WAIT-PERIOD

	IF	NORMAL-STATUS
		EVALUATE TERMINAL-BUFFER
			WHEN	NULL-CHAR
				MOVE	WS-TRUE TO WAIT-IS-REASONABLE-SW
			WHEN	SPACE
				MOVE	USER-PROCESS-DISPLAY-MODE TO CURRENT-DISPLAY-MODE
				MOVE	1 TO QIOW-WAIT-PERIOD
			WHEN	"C"
				MOVE	COMPREHENSIVE-DISPLAY-MODE TO CURRENT-DISPLAY-MODE
				MOVE	1 TO QIOW-WAIT-PERIOD
			WHEN	"S"
				MOVE	SUBPROCESS-DISPLAY-MODE TO CURRENT-DISPLAY-MODE
				MOVE	1 TO QIOW-WAIT-PERIOD
			WHEN	"1"
				MOVE	1 TO TERMINAL-TIMEOUT-SECONDS
				MOVE	1 TO QIOW-WAIT-PERIOD
			WHEN	"2"
				MOVE	2 TO TERMINAL-TIMEOUT-SECONDS
				MOVE	1 TO QIOW-WAIT-PERIOD
			WHEN	"3"
				MOVE	3 TO TERMINAL-TIMEOUT-SECONDS
				MOVE	1 TO QIOW-WAIT-PERIOD
			WHEN	"4"
				MOVE	4 TO TERMINAL-TIMEOUT-SECONDS
				MOVE	1 TO QIOW-WAIT-PERIOD
			WHEN	"5"
				MOVE	5 TO TERMINAL-TIMEOUT-SECONDS
				MOVE	1 TO QIOW-WAIT-PERIOD
			WHEN	"6"
				MOVE	6 TO TERMINAL-TIMEOUT-SECONDS
				MOVE	1 TO QIOW-WAIT-PERIOD
			WHEN	"7"
				MOVE	7 TO TERMINAL-TIMEOUT-SECONDS
				MOVE	1 TO QIOW-WAIT-PERIOD
			WHEN	"8"
				MOVE	8 TO TERMINAL-TIMEOUT-SECONDS
				MOVE	1 TO QIOW-WAIT-PERIOD
			WHEN	"9"
				MOVE	9 TO TERMINAL-TIMEOUT-SECONDS
				MOVE	1 TO QIOW-WAIT-PERIOD
			WHEN	CONTROL-R-CHAR
				MOVE	WS-TRUE TO REFRESH-SW
				MOVE	1 TO QIOW-WAIT-PERIOD
			WHEN	"H"
				PERFORM 23100_DISPLAY_HELP_SCREEN
				MOVE	WS-TRUE TO WAIT-IS-REASONABLE-SW
				MOVE	WS-TRUE TO REFRESH-SW
			WHEN	"E"
				MOVE	WS-TRUE TO WAIT-IS-REASONABLE-SW
				MOVE	WS-TRUE TO DONE-SW
			WHEN	CONTROL-Z-CHAR
				MOVE	WS-TRUE TO WAIT-IS-REASONABLE-SW
				MOVE	WS-TRUE TO DONE-SW
			WHEN	"L"
				MOVE	WS-TRUE TO WAIT-IS-REASONABLE-SW
				MOVE	WS-FALSE TO TERMINAL-AVAILABLE-SW
				MOVE	TERMINAL-TIMEOUT-SECONDS TO LOCK-TIME
				CALL	"SYS$BINTIM"
					USING	BY DESCRIPTOR	LOCK-TIME-LIT,
						BY REFERENCE	LOCKED_TERMINAL_WAIT_TIME
			WHEN	OTHER
				DISPLAY	"" WITH NO ADVANCING
				MOVE	1 TO QIOW-WAIT-PERIOD
		END-EVALUATE
	ELSE
		MOVE	WS-TRUE TO WAIT-IS-REASONABLE-SW
		MOVE	WS-FALSE TO TERMINAL-AVAILABLE-SW
		MOVE	DEFAULT-LOCK-TIME TO	LOCK-TIME
						TERMINAL-TIMEOUT-SECONDS
		CALL	"SYS$BINTIM"
			USING	BY DESCRIPTOR	LOCK-TIME-LIT,
				BY REFERENCE	LOCKED_TERMINAL_WAIT_TIME
	END-IF
	.

23100_display_help_screen.
	call	"lib$set_buffer"
		using	by descriptor	screen_buffer
			by reference	old_buffer

	call	"lib$put_screen"
		using	by descriptor	help-screen
			by value	zero
			by value	zero
			by value	zero

	call	"lib$put_buffer"
		using	by reference	old_buffer

	accept	terminal-buffer
		at end
		move	ws-true to done-sw
	end-accept
	.

C_get_next_pid.
	call	"sys$getjpi"
		using	by value	general-event-flag
			by reference	pid
			by value	zero
			by reference	pid_itemlist
			by value	zero
			by value	zero
			by value	zero
		giving	getjpi_call_status

	call	"sys$waitfr"
		using	by value	general-event-flag
	.

C-load-getjpi-array.

**	First load an array with the process ids for all processes.

	move	-1	to pid
	perform C_get_next_pid
	perform varying currently_active_pid_sub from 1 by 1
		until	getjpi_call_status = ss$_nomoreproc
			or
			ctrlc-entered-flag = ws-true

		move	ws_currently_active_pid to currently_active_pid ( currently_active_pid_sub )
		move	ws_currently_active_pid to current_pid ( ws_currently_active_proc_index )
		move	ws_currently_active_proc_index to currently_active_proc_index ( currently_active_pid_sub ) 

		perform C_get_next_pid

	end-perform
	compute	currently_active_pid_count = currently_active_pid_sub - 1

**	Initiate asynchronous getjpi calls to scan all known processes for data.

	perform varying currently_active_pid_sub from 1 by 1
		until	currently_active_pid_sub > currently_active_pid_count
			or
			ctrlc-entered-flag = ws-true

		compute actual-jpi-array-sub = currently_active_proc_index ( currently_active_pid_sub )

		if	current_pid ( actual-jpi-array-sub ) not = prior_pid ( actual-jpi-array-sub )
		then
			move	zero to current_bufio ( actual-jpi-array-sub )
			move	zero to current_cputim ( actual-jpi-array-sub )
			move	zero to current_dirio ( actual-jpi-array-sub )
			move	zero to current_gpgcnt ( actual-jpi-array-sub )
			move	spaces to current_imagname ( actual-jpi-array-sub )
			move	zero to current_imagname_size ( actual-jpi-array-sub )
			move	zero to current_pageflts ( actual-jpi-array-sub )
			move	zero to current_ppgcnt ( actual-jpi-array-sub )
			move	zero to current_pri ( actual-jpi-array-sub )
			move	zero to current_prib ( actual-jpi-array-sub )
			move	zero to current_state ( actual-jpi-array-sub )
			move	zero to current_sts ( actual-jpi-array-sub )
			move	spaces to current_terminal ( actual-jpi-array-sub )
			move	zero to current_terminal_size ( actual-jpi-array-sub )
			move	"?" to current_username ( actual-jpi-array-sub )
			move	zero to current_wssize ( actual-jpi-array-sub )
			move	zero to getjpi-calls-completed-count ( actual-jpi-array-sub )
***			Listed for completeness:
***			move	zero to prior_pid ( actual-jpi-array-sub )
			move	zero to prior_cputim ( actual-jpi-array-sub )
			move	zero to prior_dirio ( actual-jpi-array-sub )
			move	zero to prior_bufio ( actual-jpi-array-sub )
			move	zero to prior_pageflts ( actual-jpi-array-sub )
		end-if

		move	zero to insufficient-ast-count
		if	getjpi-in-progress-sw ( actual-jpi-array-sub ) = ws-false
		then
*			Wait until an AST is available.
			perform until	outstanding-getjpi-count < max_ast_count
*				Sleep to let getjpi catch up.
				add	1 to insufficient-ast-count
				call	"sys$setimr"
					using	by value	general-event-flag
						by reference	delta_time
						by value	zero
						by value	zero

				call	"sys$waitfr"
					using	by value	general-event-flag
			end-perform

			move	ws-true to getjpi-in-progress-sw ( actual-jpi-array-sub )
			add	1 to outstanding-getjpi-count

			call	"sys$getjpi"
				using	by value	get-process-info-event-flag
					by reference	currently_active_pid ( currently_active_pid_sub )
					by value	zero
					by reference	complete_itemlist ( actual-jpi-array-sub )
					by value	zero
					by value	getjpi-handler-address
					by reference	currently_active_proc_index ( currently_active_pid_sub )

				giving	call_status
*		else
*			display "getjpi in progress for "
*				currently_active_pid ( currently_active_pid_sub ) with conversion
		end-if

	end-perform

	move	zero to catchup-cycle-count
	perform with test after
		until	catchup-cycle-count = 5
			or
			outstanding-getjpi-count = zero
			or
			outstanding-getjpi-count not < prior-outstanding-getjpi-count

		add	1 to catchup-cycle-count
		move	outstanding-getjpi-count to prior-outstanding-getjpi-count
*		Sleep to let getjpi catch up.
		call	"sys$setimr"
			using	by value	general-event-flag
				by reference	delta_time
				by value	zero
				by value	zero

		call	"sys$waitfr"
			using	by value	general-event-flag
	end-perform
	.

END PROGRAM SYSTATUS.


IDENTIFICATION DIVISION.
PROGRAM-ID.  CI$$GETJPI_HANDLER.

DATA DIVISION.

WORKING-STORAGE SECTION.

01  ws-false					pic x value "F".
copy "systatus.ext".

LINKAGE SECTION.

01  getjpi-sub				pic s9(9) comp.


PROCEDURE DIVISION using getjpi-sub.

000-handle-getjpi-ast.

*	Reset the getjpi-in-progress switch, increment the completed-call count, and decrement the outstanding count.


	move	ws-false to getjpi-in-progress-sw ( getjpi-sub )
	add	1 to getjpi-calls-completed-count ( getjpi-sub )

	subtract 1 from outstanding-getjpi-count

	exit	program
	.

END PROGRAM CI$$GETJPI_HANDLER.