?? RIGHT := 110 ??
?? NEWTITLE := 'NOS/VE Display Processor : System Console Interface' ??
MODULE dpm$system_console_interface;

{ PURPOSE:
{   This module contains the lowest level job mode interfaces to display data on the system console.

?? NEWTITLE := 'Global Declarations Referenced by This Module', EJECT ??
?? PUSH (LISTEXT := ON) ??
*copyc dpe$error_codes
*copyc dpt$critical_window_date_time
*copyc dpt$number_of_window_lines
*copyc dpt$rb_display_request
*copyc dpt$window
*copyc ost$wait
?? POP ??
*copyc dsp$allocate_continuous_memory
*copyc i#call_monitor
*copyc lgp$add_entry_to_critical_log
*copyc osp$monitor_fault_to_status
*copyc osp$set_status_abnormal
*copyc pmp$delay
*copyc pmp$get_date
*copyc pmp$get_time
*copyc pmp$zero_out_table
*copyc syp$disestablish_cond_handler
*copyc syp$establish_condition_handler
?? EJECT ??
*copyc dpv$180_operator_action
*copyc dpv$critical_display_id
*copyc dpv$scd_block_p
*copyc dpv$top_window_p
*copyc mtv$nosve_control_status
*copyc osv$mainframe_wired_cb_heap
?? OLDTITLE ??
?? NEWTITLE := 'Global Declarations Declared by This Module', EJECT ??

  VAR
    dpv$system_core_display: [XDCL, #GATE] dpt$window_id,
    v$loop_count_of_20_reached: boolean := FALSE;
?? OLDTITLE ??
?? NEWTITLE := 'dpp$change_window', EJECT ??

{ PURPOSE;
{   This procedure allows the caller to change the window's kind and class.

  PROCEDURE [XDCL, #GATE] dpp$change_window
    (    window_id: dpt$window_id;
         class: dpt$window_class;
         kind: dpt$window_kind;
     VAR status: ost$status);

    VAR
      rb: dpt$rb_display_request,
      window_p: ^dpt$window;

    status.normal := TRUE;

    window_p := dpv$top_window_p;
    WHILE (window_p <> NIL) AND (window_p^.window_id <> window_id) DO
      window_p := window_p^.next_window_p;
    WHILEND;
    IF window_p = NIL THEN
      osp$set_status_abnormal (dpc$display_processor_id, dpe$window_not_found, '', status);
      RETURN;
    IFEND;

    { Cannot change the window kind from interactive.

    IF (window_p^.kind = dpc$wk_interactive) AND (kind <> dpc$wk_interactive) THEN
      osp$set_status_abnormal (dpc$display_processor_id, dpe$no_change_from_interactive, '', status);
      RETURN;
    IFEND;

    { Change the true class to reflect the changed class.

    window_p^.true_class := class;
    window_p^.table_starting_line_in_window := 1;
    window_p^.table_last_line_used_in_window := 1;

    { Check if no real change then return.

    IF (class = window_p^.class) AND (kind = window_p^.kind) THEN
      RETURN;
    IFEND;

    window_p^.class := class;

    IF kind <> window_p^.kind THEN
      window_p^.present_window_line_number := 0;
      window_p^.table_next_available_line := 1;
      window_p^.kind := kind;
      rb.action := dpc$da_clear_window;
    ELSE
      rb.action := dpc$da_change_window;
    IFEND;

    rb.reqcode := syc$rc_update_system_display;
    rb.window_p := window_p;
    i#call_monitor (#LOC (rb), #SIZE (rb));

  PROCEND dpp$change_window;
?? OLDTITLE ??
?? NEWTITLE := 'dpp$clear_window', EJECT ??

{ PURPOSE:
{   This procedure clears a window.  If the window is a table it clears the window lines that are not being
{   used (ie: it clears from the end of the table to the end of the window lines).  If the window is a log
{   or interactive window, it displays a window of blank lines.  It will wait for existing lines to be
{   displayed before overwriting them.

  PROCEDURE [XDCL, #GATE] dpp$clear_window
    (    window_id: dpt$window_id;
     VAR status: ost$status);

    VAR
      index: dpt$number_of_window_lines,
      rb: dpt$rb_display_request,
      starting_clear_line: integer,
      window_p: ^dpt$window;

    status.normal := TRUE;

    window_p := dpv$top_window_p;
    WHILE (window_p <> NIL) AND (window_p^.window_id <> window_id) DO
      window_p := window_p^.next_window_p;
    WHILEND;
    IF window_p = NIL THEN
      osp$set_status_abnormal (dpc$display_processor_id, dpe$window_not_found, '', status);
      RETURN;
    IFEND;

    rb.reqcode := syc$rc_update_system_display;
    rb.action := dpc$da_queue_line;
    rb.window_p := window_p;

    CASE window_p^.kind OF
    = dpc$wk_table =
      starting_clear_line := window_p^.table_next_available_line -
            window_p^.table_starting_line_in_window + 1;
      IF starting_clear_line < 1 THEN
        starting_clear_line := 1;
      IFEND;
      FOR index := starting_clear_line TO dpc$number_of_window_lines DO
        IF window_p^.lines [index].text_size <> 0 THEN
          window_p^.lines [index].text_size := 0;
          window_p^.lines [index].text := ' ';
          IF window_p^.lines [index].ending_console_row_number <> 0 THEN
            rb.line_p := ^window_p^.lines [index];
            i#call_monitor (#LOC (rb), #SIZE (rb));
          IFEND;
        IFEND;
      FOREND;
      window_p^.table_last_line_used_in_window := window_p^.table_next_available_line;
      window_p^.table_next_available_line := 1;

    ELSE {= dpc$wk_interactive, dpc$wk_log =}
      window_p^.present_window_line_number := 0;
      FOR index := 1 TO dpc$number_of_window_lines DO

        { Wait until the line has been displayed by SCD.

        WHILE (window_p^.lines [index].next_line_rma <> dpc$rma_scd_finished) DO
          pmp$delay (100, status);
        WHILEND;
        window_p^.lines [index].text_size := 0;
        window_p^.lines [index].text := ' ';
      FOREND;

      { Display a window of blank lines.

      FOR index := 1 TO window_p^.ending_console_row_number - window_p^.starting_console_row_number + 1 DO
        rb.line_p := ^window_p^.lines [index];
        i#call_monitor (#LOC (rb), #SIZE (rb));
      FOREND;

    CASEND;

  PROCEND dpp$clear_window;
?? OLDTITLE ??
?? NEWTITLE := 'dpp$close_window', EJECT ??

{ PURPOSE:
{   This procedure closes a window and removes it from the window linked list.

  PROCEDURE [XDCL, #GATE] dpp$close_window
    (VAR window_id: dpt$window_id;
     VAR status: ost$status);

    VAR
      rb: dpt$rb_display_request,
      window_p: ^dpt$window;

    status.normal := TRUE;

    window_p := dpv$top_window_p;
    WHILE (window_p <> NIL) AND (window_p^.window_id <> window_id) DO
      window_p := window_p^.next_window_p;
    WHILEND;
    IF window_p = NIL THEN
      osp$set_status_abnormal (dpc$display_processor_id, dpe$window_not_found, '', status);
      RETURN;
    IFEND;

    rb.reqcode := syc$rc_update_system_display;
    rb.action := dpc$da_delete_window;
    rb.window_p := window_p;
    i#call_monitor (#LOC (rb), #SIZE (rb));

    { Wait for monitor to delete the window.

    REPEAT
      pmp$delay (500, status);
    UNTIL window_p^.window_id = 0;

    FREE window_p IN osv$mainframe_wired_cb_heap^;
    window_id := 0;

  PROCEND dpp$close_window;
?? OLDTITLE ??
?? NEWTITLE := 'dpp$configure_system_console', EJECT ??

{ PURPOSE:
{   This procedure configures the system console.  It first allocates space for the SCD communication block
{   and then calls monitor to fill in appropriate information in the SCI parameter table.

  PROCEDURE [XDCL] dpp$configure_system_console;

    VAR
      dp_rb: dpt$rb_display_request,
      scd_seq_p: ^SEQ ( * );

    dsp$allocate_continuous_memory (osv$mainframe_wired_cb_heap, #SIZE (dpt$scd_communications_block),
          scd_seq_p);
    RESET scd_seq_p;
    NEXT dpv$scd_block_p IN scd_seq_p;
    pmp$zero_out_table (#LOC (dpv$scd_block_p^), #SIZE (dpv$scd_block_p^));

    dp_rb.reqcode := syc$rc_update_system_display;
    dp_rb.action := dpc$da_configure_console;
    i#call_monitor (#LOC (dp_rb), #SIZE (dp_rb));

  PROCEND dpp$configure_system_console;
?? OLDTITLE ??
?? NEWTITLE := 'dpp$get_number_lines_in_window', EJECT ??

{ PURPOSE:
{   This procedure retrieves the number of lines that are currently displayed on the console for the
{   specified window.

  PROCEDURE [XDCL, #GATE] dpp$get_number_lines_in_window
    (    window_id: dpt$window_id;
     VAR number_of_lines: dpt$number_of_window_lines;
     VAR status: ost$status);

    VAR
      window_p: ^dpt$window;

    status.normal := TRUE;
    number_of_lines := 0;

    window_p := dpv$top_window_p;
    WHILE (window_p <> NIL) AND (window_p^.window_id <> window_id) DO
      window_p := window_p^.next_window_p;
    WHILEND;
    IF window_p = NIL THEN
      osp$set_status_abnormal (dpc$display_processor_id, dpe$window_not_found, '', status);
      RETURN;
    IFEND;

    number_of_lines := window_p^.ending_console_row_number - window_p^.starting_console_row_number;

  PROCEND dpp$get_number_lines_in_window;
?? OLDTITLE ??
?? NEWTITLE := 'dpp$get_next_line', EJECT ??

{ PURPOSE:
{   This procedure retrieves a line of data from the system console.  One of the parameters is a wait
{   parameter.  If the procedure is called with the wait selected, the procedure will wait until a line
{   is received from the system console.

  PROCEDURE [XDCL, #GATE] dpp$get_next_line
    (    window_id: dpt$window_id;
         wait: ost$wait;
     VAR line: string ( * );
     VAR line_received: boolean);

    VAR
      ignore_status: ost$status,
      rb: dpt$rb_display_request,
      window_p: ^dpt$window;

    window_p := dpv$top_window_p;
    WHILE (window_p <> NIL) AND (window_p^.window_id <> window_id) DO
      window_p := window_p^.next_window_p;
    WHILEND;

    IF (window_p = NIL)
{ } OR (window_p^.kind <> dpc$wk_interactive)
{ } OR ((wait = osc$nowait) AND (window_p^.input_line.text_kind <> dpc$tk_input_ready)) THEN
      line_received := FALSE;
      RETURN;
    IFEND;

    { Wait for the input line.

    WHILE window_p^.input_line.text_kind <> dpc$tk_input_ready DO
      pmp$delay (500, ignore_status);
    WHILEND;

    { Retrieve the input line.

    line := window_p^.input_line.text (1, window_p^.input_line.text_size);
    line_received := TRUE;

    { Wait until the input_ready line has been processed and then change the line kind from input ready
    { to input.

    WHILE (window_p^.input_line.next_line_rma <> dpc$rma_scd_finished) DO
      pmp$delay (100, ignore_status);
    WHILEND;

    rb.reqcode := syc$rc_update_system_display;
    rb.action := dpc$da_queue_line;
    rb.window_p := window_p;
    rb.line_p := ^window_p^.input_line;
    rb.line_p^.text_kind := dpc$tk_input;
    rb.line_p^.text_size := 0;
    rb.line_p^.text := ' ';
    i#call_monitor (#LOC (rb), #SIZE (rb));

  PROCEND dpp$get_next_line;
?? OLDTITLE ??
?? NEWTITLE := 'dpp$get_starting_line', EJECT ??

{  PURPOSE:
{    This procedure returns the value of the starting line of the window.  The table's next available line is
{    changed to the starting line in the window so that new lines can be added to the window.  The last line
{    used in the window is set to the previous next available line of the window so the maximum number of data
{    is known.  This procedure can only be used with windows that are tables.

  PROCEDURE [XDCL, #GATE] dpp$get_starting_line
    (    window_id: dpt$window_id;
     VAR starting_line: integer;
     VAR status: ost$status);

    VAR
      window_p: ^dpt$window;

    status.normal := TRUE;

    window_p := dpv$top_window_p;
    WHILE (window_p <> NIL) AND (window_p^.window_id <> window_id) DO
      window_p := window_p^.next_window_p;
    WHILEND;
    IF window_p = NIL THEN
      osp$set_status_abnormal (dpc$display_processor_id, dpe$window_not_found, '', status);
      RETURN;
    IFEND;

    IF window_p^.kind <> dpc$wk_table THEN
      osp$set_status_abnormal (dpc$display_processor_id, dpe$window_not_table, '', status);
      RETURN;
    IFEND;

    starting_line := window_p^.table_starting_line_in_window;

    window_p^.table_last_line_used_in_window := window_p^.table_next_available_line;
    window_p^.table_next_available_line := starting_line;

  PROCEND dpp$get_starting_line;
?? OLDTITLE ??
?? NEWTITLE := 'dpp$open_window', EJECT ??

{ PURPOSE:
{   This procedure creates a window.

  PROCEDURE [XDCL, #GATE] dpp$open_window
    (    class: dpt$window_class;
         kind: dpt$window_kind;
         title: string ( * );
     VAR window_id: dpt$window_id;
     VAR status: ost$status);

    VAR
      index: dpt$number_of_window_lines,
      rb: dpt$rb_display_request,
      window_p: ^dpt$window;

    status.normal := TRUE;

    ALLOCATE window_p IN osv$mainframe_wired_cb_heap^;

    window_p^.next_window_p := NIL;
    window_p^.window_id := 0;

    window_p^.starting_console_row_number := 0;
    window_p^.ending_console_row_number := 0;
    window_p^.true_class := class;
    window_p^.class := class;
    window_p^.kind := kind;
    window_p^.table_starting_line_in_window := 1;
    window_p^.table_last_line_used_in_window := 1;
    window_p^.table_next_available_line := 1;
    window_p^.present_window_line_number := 0;

    window_p^.title.ending_console_row_number := 0;
    window_p^.title.text_size := 0;
    window_p^.title.text_kind := dpc$tk_title;
    window_p^.title.next_line_rma := dpc$rma_scd_finished;

    window_p^.input_line.ending_console_row_number := 0;
    window_p^.input_line.text_size := 0;
    window_p^.input_line.text_kind := dpc$tk_input;
    window_p^.input_line.next_line_rma := dpc$rma_scd_finished;

    FOR index := 1 TO dpc$number_of_window_lines DO
      window_p^.lines [index].starting_console_row_number := 0;
      window_p^.lines [index].ending_console_row_number := 0;
      window_p^.lines [index].text_size := 0;
      window_p^.lines [index].text_kind := dpc$tk_display;
      window_p^.lines [index].next_line_rma := dpc$rma_scd_finished;
    FOREND;

    rb.reqcode := syc$rc_update_system_display;
    rb.action := dpc$da_add_window;
    rb.window_p := window_p;
    i#call_monitor (#LOC (rb), #SIZE (rb));

    window_id := window_p^.window_id;
    dpp$set_title (window_id, title, status);

  PROCEND dpp$open_window;
?? OLDTITLE ??
?? NEWTITLE := 'dpp$put_critical_message', EJECT ??

{ PURPOSE:
{   This procedure writes the current time and the incoming string to the critical window
{   and to the critical window log.

  PROCEDURE [XDCL, #GATE] dpp$put_critical_message
    (    message: string ( * <= osc$max_string_size);
     VAR status: ost$status);

    VAR
      actual_line_size: 0 .. dpc$console_row_size,
      date: ost$date,
      date_time_string: dpt$critical_window_date_time,
      ignore_status: ost$status,
      message_line: string (dpc$console_row_size),
      line: string (osc$max_string_size),
      line_index: integer,
      line_size: 0 .. osc$max_string_size,
      time: ost$time;

?? OLDTITLE ??
?? NEWTITLE := 'condition_handler', EJECT ??

{ PURPOSE: Intercept monitor errors and pass back to procedure who
{          called dpp$put_critical_message.

    PROCEDURE condition_handler
      (    monitor_fault: ost$monitor_fault;
           save_area: ^ost$minimum_save_area;
       VAR continue: syt$continue_option);

      osp$monitor_fault_to_status (monitor_fault, save_area, status);
      EXIT dpp$put_critical_message;

    PROCEND condition_handler;
?? OLDTITLE ??

    syp$establish_condition_handler (^condition_handler);
    status.normal := TRUE;
    time.time_format := osc$hms_time;
    pmp$get_time (time.time_format, time, status);
    date.date_format := osc$mdy_date;
    pmp$get_date (date.date_format, date, status);
    date_time_string.string_part := ' ';
    date_time_string.hms := time.hms;
    date_time_string.mdy := date.mdy;

    IF (#SIZE (message) = 0) OR (message = ' ') THEN
      line := ' ';
      line_size := 1;
    ELSE

     /trim_message/
      FOR line_index := #SIZE (message) DOWNTO 1 DO
        IF message (line_index) <> ' ' THEN
          line_size := line_index;
          line := message (1, line_size);
          EXIT /trim_message/;
        IFEND;
      FOREND /trim_message/;
    IFEND;

    line_index := 1;
    WHILE line_size > 0 DO
      IF line_size > dpc$critical_window_msg_size THEN
        actual_line_size := dpc$critical_window_msg_size;
        line_size := line_size - dpc$critical_window_msg_size;
      ELSE
        actual_line_size := line_size;
        line_size := 0;
      IFEND;
      message_line := ' ';
      message_line (1, dpc$date_time_size):= date_time_string.string_part;
      message_line ((dpc$date_time_size + 1), *):= line (line_index, actual_line_size);
      line_index := line_index + actual_line_size;
      dpp$put_next_line (dpv$critical_display_id, message_line, status);
      lgp$add_entry_to_critical_log (message_line, ignore_status);
    WHILEND;
    syp$disestablish_cond_handler;

  PROCEND dpp$put_critical_message;
?? OLDTITLE ??
?? NEWTITLE := 'dpp$put_next_line', EJECT ??

{ PURPOSE:
{   This procedure puts a line on the system console.

  PROCEDURE [XDCL, #GATE] dpp$put_next_line
    (    window_id: dpt$window_id;
         line: string ( * );
     VAR status: ost$status);

    VAR
      first: integer,
      line_length: integer,
      line_p: ^dpt$console_line,
      line_position: integer,
      loop_count: 0 .. 20,
      rb: dpt$rb_display_request,
      window_p: ^dpt$window;

    status.normal := TRUE;

    window_p := dpv$top_window_p;
    WHILE (window_p <> NIL) AND (window_p^.window_id <> window_id) DO
      window_p := window_p^.next_window_p;
    WHILEND;
    IF window_p = NIL THEN
      osp$set_status_abnormal (dpc$display_processor_id, dpe$window_not_found, '', status);
      RETURN;
    IFEND;

    first := 1;
    line_length := STRLENGTH (line);

    rb.reqcode := syc$rc_update_system_display;
    rb.action := dpc$da_queue_line;
    rb.window_p := window_p;

    WHILE line_length <> 0 DO
      CASE window_p^.kind OF
      = dpc$wk_table =
        IF line_length > dpc$console_row_size THEN
          line_length := dpc$console_row_size;
          osp$set_status_abnormal (dpc$display_processor_id, dpe$line_truncated, '', status);
        IFEND;
        window_p^.table_next_available_line := window_p^.table_next_available_line + 1;
        line_position := window_p^.table_next_available_line - window_p^.table_starting_line_in_window;
        IF (line_position < 1) OR (line_position > dpc$number_of_window_lines) THEN

          { The line does not fit in the actual window being viewed, skip the line.

          RETURN;
        IFEND;
        line_p := ^window_p^.lines [line_position];
        IF line_p^.text = line (1, line_length) THEN
          RETURN;
        IFEND;

      ELSE { = dpc$wk_interactive, dpc$wk_log = }
        window_p^.present_window_line_number := window_p^.present_window_line_number MOD
              dpc$number_of_window_lines + 1;
        line_p := ^window_p^.lines [window_p^.present_window_line_number];
        loop_count := 1;
        WHILE (line_p^.next_line_rma <> dpc$rma_scd_finished) DO
          pmp$delay (100, status);
          IF (line_p^.next_line_rma <> dpc$rma_scd_finished) AND
                ((mtv$nosve_control_status.idle_state <> mtc$system_not_idle) OR
                (mtv$nosve_control_status.step_state <> mtc$system_not_stepped)) THEN
            IF (loop_count = 20) OR v$loop_count_of_20_reached THEN
              v$loop_count_of_20_reached := TRUE;
              RETURN;
            ELSE
              loop_count := loop_count + 1;
            IFEND;
          IFEND;
        WHILEND;
        v$loop_count_of_20_reached := FALSE;
      CASEND;

      IF line_length > dpc$console_row_size THEN
        line_p^.text := line (first, dpc$console_row_size);
        line_p^.text_size := dpc$console_row_size;
        line_length := line_length - dpc$console_row_size;
        first := first + dpc$console_row_size;
      ELSE
        line_p^.text := line (first, line_length);
        line_p^.text_size := line_length;
        line_length := 0;
      IFEND;

      IF line_p^.ending_console_row_number <> 0 THEN
        rb.line_p := line_p;
        i#call_monitor (#LOC (rb), #SIZE (rb));
      IFEND;
    WHILEND;

  PROCEND dpp$put_next_line;
?? OLDTITLE ??
?? NEWTITLE := 'dpp$set_180_operator_action', EJECT ??

  PROCEDURE [XDCL, #GATE] dpp$set_180_operator_action
    (    actions_present: boolean);

    dpv$180_operator_action := actions_present;

  PROCEND dpp$set_180_operator_action;
?? OLDTITLE ??
?? NEWTITLE := 'dpp$set_title', EJECT ??

{ PURPOSE:
{   This procedure centers the incoming title on the desired window's title line.

  PROCEDURE [XDCL, #GATE] dpp$set_title
    (    window_id: dpt$window_id;
         title: string ( * );
     VAR status: ost$status);

    VAR
      centered_starting_point: integer,
      rb: dpt$rb_display_request,
      title_size: integer,
      window_p: ^dpt$window;

    status.normal := TRUE;

    window_p := dpv$top_window_p;
    WHILE (window_p <> NIL) AND (window_p^.window_id <> window_id) DO
      window_p := window_p^.next_window_p;
    WHILEND;
    IF window_p = NIL THEN
      osp$set_status_abnormal (dpc$display_processor_id, dpe$window_not_found, '', status);
      RETURN;
    IFEND;

    window_p^.title.text_size := dpc$console_row_size;
    window_p^.title.text_kind := dpc$tk_title;

    { Center the title on the title line.  If a title that is larger then 80 characters is sent to this
    { routine then the centered starting point will be negative.  In this case, the incoming title is
    { truncated to 80 characters and a warning message is returned to the caller.

    title_size := STRLENGTH (title);
    IF title_size > dpc$console_row_size THEN
      osp$set_status_abnormal (dpc$display_processor_id, dpe$line_truncated, '', status);
    IFEND;
    centered_starting_point := ((dpc$console_row_size - title_size) DIV 2) + 1;
    window_p^.title.text := ' ';
    IF centered_starting_point > 0 THEN
      window_p^.title.text (centered_starting_point, title_size) := title;
    ELSE
      window_p^.title.text := title;
    IFEND;

    rb.reqcode := syc$rc_update_system_display;
    rb.action := dpc$da_queue_line;
    rb.window_p := window_p;
    rb.line_p := ^window_p^.title;
    i#call_monitor (#LOC (rb), #SIZE (rb));

  PROCEND dpp$set_title;
MODEND dpm$system_console_interface;
