MODULE dum$change_dump_environment;
?? RIGHT := 110 ??

{ PURPOSE:
{   This module contains the SCL command to change some values of the dump_environment variable
{   which sits in the start of the first restart_file of a restart_file set.
{
{ NOTE:
{   This thing is far away from beeing perfect - but who is anyway?
{   Ex. When we restore the saved environment, we do not change the modified. Now, when we exit,
{       we will use the wrong environment, when we did a USE before.
{       When we come back, we have changed=false and we will always be off.
{       => We would have to more properly maintain the changed flag and/or update the modified
{          environment.
{       Anyway, when we once did a use, we have no easy way to go back and point to the file.
{       Except, write the utility environment to the file. But this is not the one we looked at
{       when we went back to ANAD last time.
{
{   But who the heck cares - hopefully, we don't have to use this too intensivly ;-)

?? NEWTITLE := 'Global Declarations Referenced By This Module', EJECT ??
?? PUSH (LISTEXT := ON) ??
*copyc due$exception_condition_codes
*copyc dut$dump_environment
*copyc ost$halfword
*copyc ost$status
?? POP ??
*copyc clp$begin_utility
*copyc clp$close_display
*copyc clp$end_include
*copyc clp$end_utility
*copyc clp$evaluate_parameters
*copyc clp$include_file
*copyc clp$open_display_reference
*copyc clp$put_display
*copyc dup$new_page_procedure
*copyc osp$disestablish_cond_handler
*copyc osp$establish_block_exit_hndlr
*copyc osp$set_status_abnormal
*copyc osp$set_status_condition
*copyc duv$dump_environment_p
*copyc duv$execution_environment
?? OLDTITLE ??
?? NEWTITLE := 'Global Declarations Declared By This Module', EJECT ??

  CONST
    c$utility_name = 'CHANGE_DUMP_ENVIRONMENT        ';

{ table n=duv$chade_commands t=command
{ command n=(change_central_memory_record, chacmr) p=p$change_cm_record_command cm=local
{ command n=(display_change_environment, disce) p=p$display_change_envir_command cm=local
{ command n=(reset_changes, resc) p=p$reset_changes_command cm=local
{ command n=(quit, qui,end_change_dump_environment, endcde) p=p$quit_command cm=local
{ tablend

?? PUSH (LISTEXT := ON) ??

  VAR
    duv$chade_commands: [STATIC, READ] ^clt$command_table := ^duv$chade_commands_entries,

    duv$chade_commands_entries: [STATIC, READ] array [1 .. 10] of clt$command_table_entry := [
          {} ['CHACMR                         ', clc$abbreviation_entry, clc$normal_usage_entry, 1,
          clc$automatically_log, clc$linked_call, ^p$change_cm_record_command],
          {} ['CHANGE_CENTRAL_MEMORY_RECORD   ', clc$nominal_entry, clc$normal_usage_entry, 1,
          clc$automatically_log, clc$linked_call, ^p$change_cm_record_command],
          {} ['DISCE                          ', clc$abbreviation_entry, clc$normal_usage_entry, 2,
          clc$automatically_log, clc$linked_call, ^p$display_change_envir_command],
          {} ['DISPLAY_CHANGE_ENVIRONMENT     ', clc$nominal_entry, clc$normal_usage_entry, 2,
          clc$automatically_log, clc$linked_call, ^p$display_change_envir_command],
          {} ['ENDCDE                         ', clc$abbreviation_entry, clc$normal_usage_entry, 4,
          clc$automatically_log, clc$linked_call, ^p$quit_command],
          {} ['END_CHANGE_DUMP_ENVIRONMENT    ', clc$alias_entry, clc$normal_usage_entry, 4,
          clc$automatically_log, clc$linked_call, ^p$quit_command],
          {} ['QUI                            ', clc$alias_entry, clc$normal_usage_entry, 4,
          clc$automatically_log, clc$linked_call, ^p$quit_command],
          {} ['QUIT                           ', clc$nominal_entry, clc$normal_usage_entry, 4,
          clc$automatically_log, clc$linked_call, ^p$quit_command],
          {} ['RESC                           ', clc$abbreviation_entry, clc$normal_usage_entry, 3,
          clc$automatically_log, clc$linked_call, ^p$reset_changes_command],
          {} ['RESET_CHANGES                  ', clc$nominal_entry, clc$normal_usage_entry, 3,
          clc$automatically_log, clc$linked_call, ^p$reset_changes_command]];

?? POP ??

{ table n=duv$chade_commands_mod t=command
{ command n=(change_central_memory_record, chacmr) p=p$change_cm_record_command cm=local
{ command n=(display_change_environment, disce) p=p$display_change_envir_command cm=local
{ command n=(reset_changes, resc) p=p$reset_changes_command cm=local
{ command n=(restore_environment, rese) p=p$restore_environment_command cm=local
{ command n=(quit, qui,end_change_dump_environment, endcde) p=p$quit_command cm=local
{ tablend

?? PUSH (LISTEXT := ON) ??

  VAR
    duv$chade_commands_mod: [STATIC, READ] ^clt$command_table := ^duv$chade_commands_mod_entries,

    duv$chade_commands_mod_entries: [STATIC, READ] array [1 .. 12] of clt$command_table_entry := [
          {} ['CHACMR                         ', clc$abbreviation_entry, clc$normal_usage_entry, 1,
          clc$automatically_log, clc$linked_call, ^p$change_cm_record_command],
          {} ['CHANGE_CENTRAL_MEMORY_RECORD   ', clc$nominal_entry, clc$normal_usage_entry, 1,
          clc$automatically_log, clc$linked_call, ^p$change_cm_record_command],
          {} ['DISCE                          ', clc$abbreviation_entry, clc$normal_usage_entry, 2,
          clc$automatically_log, clc$linked_call, ^p$display_change_envir_command],
          {} ['DISPLAY_CHANGE_ENVIRONMENT     ', clc$nominal_entry, clc$normal_usage_entry, 2,
          clc$automatically_log, clc$linked_call, ^p$display_change_envir_command],
          {} ['ENDCDE                         ', clc$abbreviation_entry, clc$normal_usage_entry, 5,
          clc$automatically_log, clc$linked_call, ^p$quit_command],
          {} ['END_CHANGE_DUMP_ENVIRONMENT    ', clc$alias_entry, clc$normal_usage_entry, 5,
          clc$automatically_log, clc$linked_call, ^p$quit_command],
          {} ['QUI                            ', clc$alias_entry, clc$normal_usage_entry, 5,
          clc$automatically_log, clc$linked_call, ^p$quit_command],
          {} ['QUIT                           ', clc$nominal_entry, clc$normal_usage_entry, 5,
          clc$automatically_log, clc$linked_call, ^p$quit_command],
          {} ['RESC                           ', clc$abbreviation_entry, clc$normal_usage_entry, 3,
          clc$automatically_log, clc$linked_call, ^p$reset_changes_command],
          {} ['RESE                           ', clc$abbreviation_entry, clc$normal_usage_entry, 4,
          clc$automatically_log, clc$linked_call, ^p$restore_environment_command],
          {} ['RESET_CHANGES                  ', clc$nominal_entry, clc$normal_usage_entry, 3,
          clc$automatically_log, clc$linked_call, ^p$reset_changes_command],
          {} ['RESTORE_ENVIRONMENT            ', clc$nominal_entry, clc$normal_usage_entry, 4,
          clc$automatically_log, clc$linked_call, ^p$restore_environment_command]];

?? POP ??

  TYPE
    t$utility_state = (c$us_not_init, c$us_init, c$us_quit_no_write, c$us_quit_use, c$us_quit_write);

  TYPE
    t$control = record
      changed_by_this_session: boolean,
      restart_changed: boolean,
      current_dump_environment_p: ^dut$dump_environment,
      restart_dump_environment_p: ^dut$dump_environment,
      original_dump_environment: dut$dump_environment,
      modified_dump_environment: dut$dump_environment,
      utility_dump_environment: dut$dump_environment,
      utility_state: t$utility_state,
    recend;

  VAR
    v$control: [STATIC] t$control := [
{ CHANGED_BY_THIS_SESSION              } FALSE,
{ RESTART_CHANGED                      } FALSE,
{ CURRENT_DUMP_ENVIRONMENT_P           } NIL,
{ RESTART_DUMP_ENVIRONMENT_P           } NIL,
{ ORIGINAL_DUMP_ENVIRONMENT            } * ,
{ MODIFIED_DUMP_ENVIRONMENT            } * ,
{ UTILITY_DUMP_ENVIRONMENT             } * ,
{ UTILITY_STATE                        } c$us_not_init];

?? OLDTITLE ??
?? NEWTITLE := 'P$CHANGE_CM_RECORD_COMMAND', EJECT ??

  PROCEDURE p$change_cm_record_command
    (    parameter_list: clt$parameter_list;
     VAR status: ost$status);

{ PROCEDURE p$change_cm_record_command (
{   first_byte, fb: integer 0..2147483647 = $optional
{   last_byte, lb: integer 0..2147483647 = $optional
{   bias, b: integer 0..2147483647 = $optional
{   status)

?? PUSH (LISTEXT := ON) ??
?? FMT (FORMAT := OFF) ??

  VAR
    pdt: [STATIC, READ, cls$declaration_section] record
      header: clt$pdt_header,
      names: array [1 .. 7] of clt$pdt_parameter_name,
      parameters: array [1 .. 4] of clt$pdt_parameter,
      type1: record
        header: clt$type_specification_header,
        qualifier: clt$integer_type_qualifier,
      recend,
      type2: record
        header: clt$type_specification_header,
        qualifier: clt$integer_type_qualifier,
      recend,
      type3: record
        header: clt$type_specification_header,
        qualifier: clt$integer_type_qualifier,
      recend,
      type4: record
        header: clt$type_specification_header,
      recend,
    recend := [
    [1,
    [102, 3, 21, 17, 25, 34, 434],
    clc$command, 7, 4, 0, 0, 0, 0, 4, ''], [
    ['B                              ',clc$abbreviation_entry, 3],
    ['BIAS                           ',clc$nominal_entry, 3],
    ['FB                             ',clc$abbreviation_entry, 1],
    ['FIRST_BYTE                     ',clc$nominal_entry, 1],
    ['LAST_BYTE                      ',clc$nominal_entry, 2],
    ['LB                             ',clc$abbreviation_entry, 2],
    ['STATUS                         ',clc$nominal_entry, 4]],
    [
{ PARAMETER 1
    [4, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name, clc$specify_positionally],
    clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 20, clc$optional_parameter,
  0, 0],
{ PARAMETER 2
    [5, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name, clc$specify_positionally],
    clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 20, clc$optional_parameter,
  0, 0],
{ PARAMETER 3
    [2, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name, clc$specify_positionally],
    clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 20, clc$optional_parameter,
  0, 0],
{ PARAMETER 4
    [7, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name],
    clc$pass_by_reference, clc$immediate_evaluation, clc$standard_parameter_checking, 3,
  clc$optional_parameter, 0, 0]],
{ PARAMETER 1
    [[1, 0, clc$integer_type], [0, 2147483647, 10]],
{ PARAMETER 2
    [[1, 0, clc$integer_type], [0, 2147483647, 10]],
{ PARAMETER 3
    [[1, 0, clc$integer_type], [0, 2147483647, 10]],
{ PARAMETER 4
    [[1, 0, clc$status_type]]];

?? FMT (FORMAT := ON) ??
?? POP ??

    CONST
      p$first_byte = 1,
      p$last_byte = 2,
      p$bias = 3,
      p$status = 4;

    VAR
      pvt: array [1 .. 4] of clt$parameter_value;

    clp$evaluate_parameters (parameter_list, #SEQ (pdt), NIL, ^pvt, status);
    IF NOT status.normal THEN
      RETURN; {---->
    IFEND;

    IF NOT duv$dump_environment_p^.central_memory.available THEN
      osp$set_status_condition (due$central_memory_not_avail, status);
      RETURN; {----->
    IFEND;

    IF (pvt [p$first_byte].specified) AND (pvt [p$first_byte].value <> NIL) THEN
      duv$dump_environment_p^.central_memory.first_byte := pvt [p$first_byte].value^.integer_value.value;
      v$control.changed_by_this_session := TRUE;
    IFEND;

    IF (pvt [p$last_byte].specified) AND (pvt [p$last_byte].value <> NIL) THEN
      duv$dump_environment_p^.central_memory.last_byte := pvt [p$last_byte].value^.integer_value.value;
      v$control.changed_by_this_session := TRUE;
    IFEND;

    IF (pvt [p$bias].specified) AND (pvt [p$bias].value <> NIL) THEN
      duv$dump_environment_p^.central_memory.bias := pvt [p$bias].value^.integer_value.value;
      v$control.changed_by_this_session := TRUE;
    IFEND;

  PROCEND p$change_cm_record_command;
?? OLDTITLE ??
?? NEWTITLE := 'P$DISPLAY_CHANGE_ENVIR_COMMAND', EJECT ??

  PROCEDURE p$display_change_envir_command
    (    parameter_list: clt$parameter_list;
     VAR status: ost$status);

{ PROCEDURE display_change_environment (
{   output, o: file = $optional
{   status)

?? PUSH (LISTEXT := ON) ??
?? FMT (FORMAT := OFF) ??

  VAR
    pdt: [STATIC, READ, cls$declaration_section] record
      header: clt$pdt_header,
      names: array [1 .. 3] of clt$pdt_parameter_name,
      parameters: array [1 .. 2] of clt$pdt_parameter,
      type1: record
        header: clt$type_specification_header,
      recend,
      type2: record
        header: clt$type_specification_header,
      recend,
    recend := [
    [1,
    [102, 3, 22, 11, 26, 30, 641],
    clc$command, 3, 2, 0, 0, 0, 0, 2, ''], [
    ['O                              ',clc$abbreviation_entry, 1],
    ['OUTPUT                         ',clc$nominal_entry, 1],
    ['STATUS                         ',clc$nominal_entry, 2]],
    [
{ PARAMETER 1
    [2, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name, clc$specify_positionally],
    clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 3, clc$optional_parameter, 0
  , 0],
{ PARAMETER 2
    [3, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name],
    clc$pass_by_reference, clc$immediate_evaluation, clc$standard_parameter_checking, 3,
  clc$optional_parameter, 0, 0]],
{ PARAMETER 1
    [[1, 0, clc$file_type]],
{ PARAMETER 2
    [[1, 0, clc$status_type]]];

?? FMT (FORMAT := ON) ??
?? POP ??

    CONST
      p$output = 1,
      p$status = 2;

    VAR
      pvt: array [1 .. 2] of clt$parameter_value;

    VAR
      display_control: clt$display_control,
      i: integer,
      ignore_status: ost$status,
      output_display_opened: boolean,
      ring_attributes: amt$ring_attributes,
      s: string (80);

    clp$evaluate_parameters (parameter_list, #SEQ (pdt), NIL, ^pvt, status);
    IF NOT status.normal THEN
      RETURN; {---->
    IFEND;

    IF pvt [p$output].specified THEN
      ring_attributes.r1 := #RING (^ring_attributes);
      ring_attributes.r2 := #RING (^ring_attributes);
      ring_attributes.r3 := #RING (^ring_attributes);
      clp$open_display_reference (pvt [p$output].value^.file_value^, ^dup$new_page_procedure, fsc$list,
            ring_attributes, display_control, status);
      IF NOT status.normal THEN
        RETURN; {----->
      IFEND;
      output_display_opened := TRUE;
    ELSE
      display_control := duv$execution_environment.output_file.display_control;
      display_control.line_number := display_control.page_length + 1;
    IFEND;

    STRINGREP (s, i, 'Environment changed              : ', v$control.changed_by_this_session);
    clp$put_display (display_control, s (1, i), clc$no_trim, ignore_status);
    STRINGREP (s, i, 'Restart_File changed             : ', v$control.restart_changed);
    clp$put_display (display_control, s (1, i), clc$no_trim, ignore_status);
    STRINGREP (s, i, 'Restart_File modification allowed: ',
          duv$execution_environment.restart_file_allows_modify);
    clp$put_display (display_control, s (1, i), clc$no_trim, ignore_status);

    IF output_display_opened THEN
      clp$close_display (display_control, ignore_status);
    IFEND;

  PROCEND p$display_change_envir_command;
?? OLDTITLE ??
?? NEWTITLE := 'P$RESET_CHANGES_COMMAND', EJECT ??

  PROCEDURE p$reset_changes_command
    (    parameter_list: clt$parameter_list;
     VAR status: ost$status);

{ PROCEDURE reset_changes (
{   reset_option, ro: key
{       (reset_to_last_used_version, rtluv)
{       (reset_to_original_version, rtov)
{       (reset_to_stored_version, rtsv)
{     keyend = $required
{   status)

?? PUSH (LISTEXT := ON) ??
?? FMT (FORMAT := OFF) ??

  VAR
    pdt: [STATIC, READ, cls$declaration_section] record
      header: clt$pdt_header,
      names: array [1 .. 3] of clt$pdt_parameter_name,
      parameters: array [1 .. 2] of clt$pdt_parameter,
      type1: record
        header: clt$type_specification_header,
        qualifier: clt$keyword_type_qualifier,
        keyword_specs: array [1 .. 6] of clt$keyword_specification,
      recend,
      type2: record
        header: clt$type_specification_header,
      recend,
    recend := [
    [1,
    [102, 3, 22, 11, 8, 46, 138],
    clc$command, 3, 2, 1, 0, 0, 0, 2, ''], [
    ['RESET_OPTION                   ',clc$nominal_entry, 1],
    ['RO                             ',clc$abbreviation_entry, 1],
    ['STATUS                         ',clc$nominal_entry, 2]],
    [
{ PARAMETER 1
    [1, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name, clc$specify_positionally],
    clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 229,
  clc$required_parameter, 0, 0],
{ PARAMETER 2
    [3, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name],
    clc$pass_by_reference, clc$immediate_evaluation, clc$standard_parameter_checking, 3,
  clc$optional_parameter, 0, 0]],
{ PARAMETER 1
    [[1, 0, clc$keyword_type], [6], [
    ['RESET_TO_LAST_USED_VERSION     ', clc$nominal_entry, clc$normal_usage_entry, 1],
    ['RESET_TO_ORIGINAL_VERSION      ', clc$nominal_entry, clc$normal_usage_entry, 2],
    ['RESET_TO_STORED_VERSION        ', clc$nominal_entry, clc$normal_usage_entry, 3],
    ['RTLUV                          ', clc$abbreviation_entry, clc$normal_usage_entry, 1],
    ['RTOV                           ', clc$abbreviation_entry, clc$normal_usage_entry, 2],
    ['RTSV                           ', clc$abbreviation_entry, clc$normal_usage_entry, 3]]
    ],
{ PARAMETER 2
    [[1, 0, clc$status_type]]];

?? FMT (FORMAT := ON) ??
?? POP ??

    CONST
      p$reset_option = 1,
      p$status = 2;

    VAR
      pvt: array [1 .. 2] of clt$parameter_value;

    clp$evaluate_parameters (parameter_list, #SEQ (pdt), NIL, ^pvt, status);
    IF NOT status.normal THEN
      RETURN; {---->
    IFEND;

    IF pvt [p$reset_option].value^.keyword_value = 'RESET_TO_LAST_USED_VERSION' THEN
      v$control.utility_dump_environment := v$control.modified_dump_environment;
      v$control.changed_by_this_session := FALSE;

    ELSEIF pvt [p$reset_option].value^.keyword_value = 'RESET_TO_ORIGINAL_VERSION' THEN
      v$control.utility_dump_environment := v$control.original_dump_environment;
      v$control.changed_by_this_session := TRUE;

    ELSEIF pvt [p$reset_option].value^.keyword_value = 'RESET_TO_STORED_VERSION' THEN
      v$control.utility_dump_environment := v$control.restart_dump_environment_p^;
      v$control.changed_by_this_session := TRUE;
    IFEND;

  PROCEND p$reset_changes_command;
?? OLDTITLE ??
?? NEWTITLE := 'P$RESTORE_CM_RECORD_COMMAND', EJECT ??

  PROCEDURE p$restore_environment_command
    (    parameter_list: clt$parameter_list;
     VAR status: ost$status);

{ PROCEDURE p$restore_environment_command (
{   restore_option, ro: key
{       (restore_to_original_version, rtov)
{     keyend = $required
{   status)

?? PUSH (LISTEXT := ON) ??
?? FMT (FORMAT := OFF) ??

  VAR
    pdt: [STATIC, READ, cls$declaration_section] record
      header: clt$pdt_header,
      names: array [1 .. 3] of clt$pdt_parameter_name,
      parameters: array [1 .. 2] of clt$pdt_parameter,
      type1: record
        header: clt$type_specification_header,
        qualifier: clt$keyword_type_qualifier,
        keyword_specs: array [1 .. 2] of clt$keyword_specification,
      recend,
      type2: record
        header: clt$type_specification_header,
      recend,
    recend := [
    [1,
    [102, 3, 22, 11, 20, 28, 702],
    clc$command, 3, 2, 1, 0, 0, 0, 2, ''], [
    ['RESTORE_OPTION                 ',clc$nominal_entry, 1],
    ['RO                             ',clc$abbreviation_entry, 1],
    ['STATUS                         ',clc$nominal_entry, 2]],
    [
{ PARAMETER 1
    [1, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name, clc$specify_positionally],
    clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 81, clc$required_parameter,
  0, 0],
{ PARAMETER 2
    [3, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name],
    clc$pass_by_reference, clc$immediate_evaluation, clc$standard_parameter_checking, 3,
  clc$optional_parameter, 0, 0]],
{ PARAMETER 1
    [[1, 0, clc$keyword_type], [2], [
    ['RESTORE_TO_ORIGINAL_VERSION    ', clc$nominal_entry, clc$normal_usage_entry, 1],
    ['RTOV                           ', clc$abbreviation_entry, clc$normal_usage_entry, 1]]
    ],
{ PARAMETER 2
    [[1, 0, clc$status_type]]];

?? FMT (FORMAT := ON) ??
?? POP ??

    CONST
      p$restore_option = 1,
      p$status = 2;

    VAR
      pvt: array [1 .. 2] of clt$parameter_value;

    clp$evaluate_parameters (parameter_list, #SEQ (pdt), NIL, ^pvt, status);
    IF NOT status.normal THEN
      RETURN; {---->
    IFEND;

{When we get here, RESTORE_TO_ORIGINAL_VERSION must have been selected, as there is no other keyword
    v$control.restart_changed := FALSE;
    v$control.restart_dump_environment_p^ := v$control.original_dump_environment;
    v$control.utility_dump_environment := v$control.original_dump_environment;

  PROCEND p$restore_environment_command;
?? OLDTITLE ??
?? NEWTITLE := 'P$QUIT_COMMAND', EJECT ??

  PROCEDURE p$quit_command
    (    parameter_list: clt$parameter_list;
     VAR status: ost$status);

?? NEWTITLE := 'P$QUIT_MOD', EJECT ??

    PROCEDURE p$quit_mod
      (    parameter_list: clt$parameter_list;
       VAR status: ost$status);

{ PROCEDURE quit (
{   quit_options, qo: key
{       (write_changes_to_restart_file, wctrf, write_changes, wc)
{       (use_changes, uc)
{       (discard_changes, dc)
{     keyend = $required
{   status)

?? PUSH (LISTEXT := ON) ??
?? FMT (FORMAT := OFF) ??

  VAR
    pdt: [STATIC, READ, cls$declaration_section] record
      header: clt$pdt_header,
      names: array [1 .. 3] of clt$pdt_parameter_name,
      parameters: array [1 .. 2] of clt$pdt_parameter,
      type1: record
        header: clt$type_specification_header,
        qualifier: clt$keyword_type_qualifier,
        keyword_specs: array [1 .. 8] of clt$keyword_specification,
      recend,
      type2: record
        header: clt$type_specification_header,
      recend,
    recend := [
    [1,
    [102, 3, 22, 9, 28, 21, 392],
    clc$command, 3, 2, 1, 0, 0, 0, 2, ''], [
    ['QO                             ',clc$abbreviation_entry, 1],
    ['QUIT_OPTIONS                   ',clc$nominal_entry, 1],
    ['STATUS                         ',clc$nominal_entry, 2]],
    [
{ PARAMETER 1
    [2, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name, clc$specify_positionally],
    clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 303,
  clc$required_parameter, 0, 0],
{ PARAMETER 2
    [3, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name],
    clc$pass_by_reference, clc$immediate_evaluation, clc$standard_parameter_checking, 3,
  clc$optional_parameter, 0, 0]],
{ PARAMETER 1
    [[1, 0, clc$keyword_type], [8], [
    ['DC                             ', clc$abbreviation_entry, clc$normal_usage_entry, 3],
    ['DISCARD_CHANGES                ', clc$nominal_entry, clc$normal_usage_entry, 3],
    ['UC                             ', clc$abbreviation_entry, clc$normal_usage_entry, 2],
    ['USE_CHANGES                    ', clc$nominal_entry, clc$normal_usage_entry, 2],
    ['WC                             ', clc$abbreviation_entry, clc$normal_usage_entry, 1],
    ['WCTRF                          ', clc$alias_entry, clc$normal_usage_entry, 1],
    ['WRITE_CHANGES                  ', clc$alias_entry, clc$normal_usage_entry, 1],
    ['WRITE_CHANGES_TO_RESTART_FILE  ', clc$nominal_entry, clc$normal_usage_entry, 1]]
    ],
{ PARAMETER 2
    [[1, 0, clc$status_type]]];

?? FMT (FORMAT := ON) ??
?? POP ??

      CONST
        p$quit_options = 1,
        p$status = 2;

      VAR
        pvt: array [1 .. 2] of clt$parameter_value;

      clp$evaluate_parameters (parameter_list, #SEQ (pdt), NIL, ^pvt, status);
      IF NOT status.normal THEN
        RETURN; {---->
      IFEND;

      IF pvt [p$quit_options].value^.keyword_value = 'WRITE_CHANGES_TO_RESTART_FILE' THEN
        v$control.utility_state := c$us_quit_write;
      ELSEIF pvt [p$quit_options].value^.keyword_value = 'USE_CHANGES' THEN
        v$control.utility_state := c$us_quit_use;
      ELSE
        v$control.utility_state := c$us_quit_no_write;
      IFEND;

    PROCEND p$quit_mod;
?? OLDTITLE ??
?? NEWTITLE := 'P$QUIT_NO_MOD', EJECT ??

    PROCEDURE p$quit_no_mod
      (    parameter_list: clt$parameter_list;
       VAR status: ost$status);

{ PROCEDURE quit (
{   quit_options, qo: key
{       (use_changes, uc)
{       (discard_changes, dc)
{     keyend = use_changes
{   status)

?? PUSH (LISTEXT := ON) ??
?? FMT (FORMAT := OFF) ??

  VAR
    pdt: [STATIC, READ, cls$declaration_section] record
      header: clt$pdt_header,
      names: array [1 .. 3] of clt$pdt_parameter_name,
      parameters: array [1 .. 2] of clt$pdt_parameter,
      type1: record
        header: clt$type_specification_header,
        qualifier: clt$keyword_type_qualifier,
        keyword_specs: array [1 .. 4] of clt$keyword_specification,
        default_value: string (11),
      recend,
      type2: record
        header: clt$type_specification_header,
      recend,
    recend := [
    [1,
    [102, 3, 22, 10, 8, 10, 769],
    clc$command, 3, 2, 0, 0, 0, 0, 2, ''], [
    ['QO                             ',clc$abbreviation_entry, 1],
    ['QUIT_OPTIONS                   ',clc$nominal_entry, 1],
    ['STATUS                         ',clc$nominal_entry, 2]],
    [
{ PARAMETER 1
    [2, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name, clc$specify_positionally],
    clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 155,
  clc$optional_default_parameter, 0, 11],
{ PARAMETER 2
    [3, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name],
    clc$pass_by_reference, clc$immediate_evaluation, clc$standard_parameter_checking, 3,
  clc$optional_parameter, 0, 0]],
{ PARAMETER 1
    [[1, 0, clc$keyword_type], [4], [
    ['DC                             ', clc$abbreviation_entry, clc$normal_usage_entry, 2],
    ['DISCARD_CHANGES                ', clc$nominal_entry, clc$normal_usage_entry, 2],
    ['UC                             ', clc$abbreviation_entry, clc$normal_usage_entry, 1],
    ['USE_CHANGES                    ', clc$nominal_entry, clc$normal_usage_entry, 1]]
    ,
    'use_changes'],
{ PARAMETER 2
    [[1, 0, clc$status_type]]];

?? FMT (FORMAT := ON) ??
?? POP ??

      CONST
        p$quit_options = 1,
        p$status = 2;

      VAR
        pvt: array [1 .. 2] of clt$parameter_value;

      clp$evaluate_parameters (parameter_list, #SEQ (pdt), NIL, ^pvt, status);
      IF NOT status.normal THEN
        RETURN; {---->
      IFEND;

      IF pvt [p$quit_options].value^.keyword_value = 'USE_CHANGES' THEN
        v$control.utility_state := c$us_quit_use;
      ELSE
        v$control.utility_state := c$us_quit_no_write;
      IFEND;

    PROCEND p$quit_no_mod;
?? OLDTITLE ??
?? NEWTITLE := 'P$QUIT_NO_CHANGES', EJECT ??

    PROCEDURE p$quit_no_changes
      (    parameter_list: clt$parameter_list;
       VAR status: ost$status);

{ PROCEDURE quit (
{   status)

?? PUSH (LISTEXT := ON) ??
?? FMT (FORMAT := OFF) ??

  VAR
    pdt: [STATIC, READ, cls$declaration_section] record
      header: clt$pdt_header,
      names: array [1 .. 1] of clt$pdt_parameter_name,
      parameters: array [1 .. 1] of clt$pdt_parameter,
      type1: record
        header: clt$type_specification_header,
      recend,
    recend := [
    [1,
    [102, 3, 22, 10, 8, 43, 75],
    clc$command, 1, 1, 0, 0, 0, 0, 1, ''], [
    ['STATUS                         ',clc$nominal_entry, 1]],
    [
{ PARAMETER 1
    [1, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name],
    clc$pass_by_reference, clc$immediate_evaluation, clc$standard_parameter_checking, 3,
  clc$optional_parameter, 0, 0]],
{ PARAMETER 1
    [[1, 0, clc$status_type]]];

?? FMT (FORMAT := ON) ??
?? POP ??

      CONST
        p$status = 1;

      VAR
        pvt: array [1 .. 1] of clt$parameter_value;

      clp$evaluate_parameters (parameter_list, #SEQ (pdt), NIL, ^pvt, status);
      IF NOT status.normal THEN
        RETURN; {---->
      IFEND;

      v$control.utility_state := c$us_quit_no_write;

    PROCEND p$quit_no_changes;
?? OLDTITLE ??
?? EJECT ??

    IF NOT v$control.changed_by_this_session THEN
      p$quit_no_changes (parameter_list, status);
    ELSEIF duv$execution_environment.restart_file_allows_modify THEN
      p$quit_mod (parameter_list, status);
    ELSE
      p$quit_no_mod (parameter_list, status);
    IFEND;
    IF NOT status.normal THEN
      RETURN; {---->
    IFEND;

    clp$end_include (c$utility_name, status);

  PROCEND p$quit_command;
?? OLDTITLE ??
?? NEWTITLE := '[xdcl] DUP$CHANGE_DUMP_ENVIRONMENT', EJECT ??

  PROCEDURE [XDCL] dup$change_dump_environment
    (    parameter_list: clt$parameter_list;
     VAR status: ost$status);

{ PROCEDURE change_dump_environment (
{   status)

?? PUSH (LISTEXT := ON) ??
?? FMT (FORMAT := OFF) ??

  VAR
    pdt: [STATIC, READ, cls$declaration_section] record
      header: clt$pdt_header,
      names: array [1 .. 1] of clt$pdt_parameter_name,
      parameters: array [1 .. 1] of clt$pdt_parameter,
      type1: record
        header: clt$type_specification_header,
      recend,
    recend := [
    [1,
    [102, 3, 21, 17, 1, 16, 309],
    clc$command, 1, 1, 0, 0, 0, 0, 1, ''], [
    ['STATUS                         ',clc$nominal_entry, 1]],
    [
{ PARAMETER 1
    [1, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name],
    clc$pass_by_reference, clc$immediate_evaluation, clc$standard_parameter_checking, 3,
  clc$optional_parameter, 0, 0]],
{ PARAMETER 1
    [[1, 0, clc$status_type]]];

?? FMT (FORMAT := ON) ??
?? POP ??

    CONST
      p$status = 1;

    VAR
      pvt: array [1 .. 1] of clt$parameter_value;

    VAR
      utility_attributes_p: ^clt$utility_attributes;

?? NEWTITLE := 'EXIT_CONDITION_HANDLER', EJECT ??

    PROCEDURE exit_condition_handler
      (    exit_condition: pmt$condition;
           exit_condition_descriptor_p: ^pmt$condition_information;
           save_area_p: ^ost$stack_frame_save_area;
       VAR condition_status: ost$status);

      duv$dump_environment_p := v$control.current_dump_environment_p;
      v$control.utility_state := c$us_init;

    PROCEND exit_condition_handler;
?? OLDTITLE ??
?? EJECT ??

    clp$evaluate_parameters (parameter_list, #SEQ (pdt), NIL, ^pvt, status);
    IF NOT status.normal THEN
      RETURN; {---->
    IFEND;

    IF duv$dump_environment_p = NIL THEN
      osp$set_status_abnormal (duc$dump_analyzer_id, due$no_restart_file, '', status);
      RETURN; {---->
    IFEND;

    PUSH utility_attributes_p: [1 .. 3];
    utility_attributes_p^ [1].key := clc$utility_command_search_mode;
    utility_attributes_p^ [1].command_search_mode := clc$global_command_search;
    utility_attributes_p^ [2].key := clc$utility_command_table;
    IF duv$execution_environment.restart_file_allows_modify THEN
      utility_attributes_p^ [2].command_table := duv$chade_commands_mod;
    ELSE
      utility_attributes_p^ [2].command_table := duv$chade_commands;
    IFEND;
    utility_attributes_p^ [3].key := clc$utility_prompt;
    utility_attributes_p^ [3].prompt.value := 'CHADE';
    utility_attributes_p^ [3].prompt.size := 5;

    clp$begin_utility (c$utility_name, utility_attributes_p^, status);
    IF NOT status.normal THEN
      RETURN; {---->
    IFEND;

    osp$establish_block_exit_hndlr (^exit_condition_handler);
    IF NOT status.normal THEN
      RETURN; {---->
    IFEND;

    v$control.changed_by_this_session := FALSE;
    IF v$control.utility_state = c$us_not_init THEN
      v$control.current_dump_environment_p := duv$dump_environment_p;
      v$control.restart_dump_environment_p := duv$dump_environment_p;
      v$control.original_dump_environment := duv$dump_environment_p^;
      v$control.modified_dump_environment := duv$dump_environment_p^;
      v$control.utility_dump_environment := duv$dump_environment_p^;
      v$control.utility_state := c$us_init;
    ELSE
      v$control.current_dump_environment_p := duv$dump_environment_p;
      v$control.utility_dump_environment := duv$dump_environment_p^;
    IFEND;
    duv$dump_environment_p := ^v$control.utility_dump_environment;

    clp$include_file (clc$current_command_input, '', c$utility_name, status);
    IF NOT status.normal THEN
      RETURN; {---->
    IFEND;

    clp$end_utility (c$utility_name, status);

    CASE v$control.utility_state OF
    = c$us_init, c$us_quit_no_write =
      duv$dump_environment_p := v$control.current_dump_environment_p;

    = c$us_quit_use =
      v$control.modified_dump_environment := v$control.utility_dump_environment;
      duv$dump_environment_p := ^v$control.modified_dump_environment;

    = c$us_quit_write =
      v$control.restart_changed := TRUE;
      v$control.restart_dump_environment_p^ := v$control.utility_dump_environment;
      duv$dump_environment_p := v$control.restart_dump_environment_p;

    CASEND;
    v$control.utility_state := c$us_init;

    osp$disestablish_cond_handler;

  PROCEND dup$change_dump_environment;
?? OLDTITLE ??
MODEND dum$change_dump_environment;
