?? RIGHT := 110 ??
?? NEWTITLE := 'NOS/VE:  Object Library Generator' ??
MODULE ocm$delete;


{ PURPOSE:
{   To delete module(s) currently scheduled
{   to be part of the output library.

?? NEWTITLE := 'Global Declarations Referenced by This Module', EJECT ??
?? PUSH (LISTEXT := ON) ??
*copyc oce$library_generator_errors
*copyc oct$nlm_modification_list
*copyc ost$status
?? POP ??
*copyc clp$evaluate_parameters
*copyc ocp$close_all_open_files
*copyc ocp$delete_list_from_nlm_list
*copyc ocp$generate_message
*copyc ocp$initialize_olg_working_heap
*copyc ocp$search_modification_list
*copyc ocp$search_nlm_tree
*copyc ocv$nlm_list
*copyc ocv$olg_scratch_seq
*copyc ocv$open_file_list
*copyc osp$append_status_parameter
*copyc osp$set_status_abnormal
*copyc pmp$continue_to_cause
*copyc pmp$disestablish_cond_handler
*copyc pmp$establish_condition_handler
?? OLDTITLE ??
?? NEWTITLE := 'Global Declarations Declared by This Module', EJECT ??

  VAR
    command_status: ost$status;

?? OLDTITLE ??
?? NEWTITLE := 'delete_module_subrange' ??
?? EJECT ??

  PROCEDURE delete_module_subrange
    (    first_module: pmt$program_name;
         last_module: pmt$program_name;
         deletion_list: {output} ^oct$nlm_modification_list;
     VAR status: ost$status);


    VAR
      new_deletions: ^oct$nlm_modification_list,
      last_deletion: ^oct$nlm_modification_list,

      module_found: boolean,
      nlm: ^oct$new_library_module_list,
      current_module: pmt$program_name;


    ocp$search_modification_list (osc$null_name, deletion_list, new_deletions, module_found);

    ocp$search_nlm_tree (first_module, nlm, module_found);
    IF NOT module_found THEN
      IF first_module = last_module THEN
        osp$set_status_abnormal ('OC', oce$w_module_not_on_library, first_module, status);
      ELSE
        osp$set_status_abnormal ('OC', oce$w_subrange_not_found_on_lib, first_module, status);
        osp$append_status_parameter (osc$status_parameter_delimiter, first_module, status);
        osp$append_status_parameter (osc$status_parameter_delimiter, last_module, status);
      IFEND;
      ocp$generate_message (status);
      osp$set_status_abnormal ('OC', oce$e_some_modules_not, 'deleted', command_status);
      RETURN;
    IFEND;

    REPEAT
      current_module := nlm^.name;
      IF current_module = osc$null_name THEN
        osp$set_status_abnormal ('OC', oce$e_range_module_2_not_found, last_module, status);
        osp$append_status_parameter (osc$status_parameter_delimiter, first_module, status);
        ocp$generate_message (status);
        osp$set_status_abnormal ('OC', oce$e_some_modules_not, 'deleted', command_status);
        new_deletions^.link := NIL;
        RETURN;
      IFEND;

      ocp$search_modification_list (current_module, deletion_list, last_deletion, module_found);
      IF module_found THEN
        osp$set_status_abnormal ('OC', oce$w_same_module_quoted_twice, current_module, status);
        ocp$generate_message (status);
        osp$set_status_abnormal ('OC', oce$e_some_modules_not, 'deleted', command_status);

      ELSE
        NEXT last_deletion^.link IN ocv$olg_scratch_seq;
        last_deletion := last_deletion^.link;
        IF last_deletion = NIL THEN
          osp$set_status_abnormal ('OC', oce$e_internal_olg_seg_overflow, '', status);
          RETURN;
        IFEND;

        last_deletion^.nlm := nlm;

        last_deletion^.link := NIL;
      IFEND;

      nlm := nlm^.f_link;

    UNTIL current_module = last_module;


  PROCEND delete_module_subrange;
?? OLDTITLE ??
?? NEWTITLE := 'ocp$_delete_module' ??
?? EJECT ??

  PROCEDURE [XDCL] ocp$_delete_module
    (    parameter_list: clt$parameter_list;
     VAR status: ost$status);

{ PROCEDURE (ocm$creol_delm) delete_module, delete_modules, delm (
{   module, modules, m: any of
{       key
{         all
{       keyend
{       list of any of
{         program_name
{         range of program_name
{       anyend
{     anyend = $required
{   status)

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

  VAR
    pdt: [STATIC, READ, cls$declaration_section] record
      header: clt$pdt_header,
      names: array [1 .. 4] of clt$pdt_parameter_name,
      parameters: array [1 .. 2] of clt$pdt_parameter,
      type1: record
        header: clt$type_specification_header,
        qualifier: clt$union_type_qualifier,
        type_size_1: clt$type_specification_size,
        element_type_spec_1: record
          header: clt$type_specification_header,
          qualifier: clt$keyword_type_qualifier,
          keyword_specs: array [1 .. 1] of clt$keyword_specification,
        recend,
        type_size_2: clt$type_specification_size,
        element_type_spec_2: record
          header: clt$type_specification_header,
          qualifier: clt$list_type_qualifier_v2,
          element_type_spec: record
            header: clt$type_specification_header,
            qualifier: clt$union_type_qualifier,
            type_size_1: clt$type_specification_size,
            element_type_spec_1: record
              header: clt$type_specification_header,
            recend,
            type_size_2: clt$type_specification_size,
            element_type_spec_2: record
              header: clt$type_specification_header,
              qualifier: clt$range_type_qualifier,
              element_type_spec: record
                header: clt$type_specification_header,
              recend,
            recend,
          recend,
        recend,
      recend,
      type2: record
        header: clt$type_specification_header,
      recend,
    recend := [
    [1,
    [93, 10, 11, 0, 45, 25, 703],
    clc$command, 4, 2, 1, 0, 0, 0, 2, 'OCM$CREOL_DELM'], [
    ['M                              ',clc$abbreviation_entry, 1],
    ['MODULE                         ',clc$nominal_entry, 1],
    ['MODULES                        ',clc$alias_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, 113, clc$required_parameter, 0, 0],
{ PARAMETER 2
    [4, 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$union_type], [[clc$keyword_type,
    clc$list_type],
    FALSE, 2],
    44, [[1, 0, clc$keyword_type], [1], [
      ['ALL                            ', clc$nominal_entry,
  clc$normal_usage_entry, 1]]
      ],
    49, [[1, 0, clc$list_type], [33, 1, clc$max_list_size, 0, FALSE, FALSE],
        [[1, 0, clc$union_type], [[clc$program_name_type,
        clc$range_type],
        FALSE, 2],
        3, [[1, 0, clc$program_name_type]],
        10, [[1, 0, clc$range_type], [3],
            [[1, 0, clc$program_name_type]]
          ]
        ]
      ]
    ],
{ PARAMETER 2
    [[1, 0, clc$status_type]]];

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

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

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

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

{ PURPOSE:
{   The purpose of this procedure is to handle the terminate break and
{   block exit conditions.

    PROCEDURE condition_handler
      (    condition: pmt$condition;
           condition_descriptor: ^pmt$condition_information;
           stack_frame_save_area_p: ^ost$stack_frame_save_area;
       VAR handler_status: ost$status);

      IF (condition.selector = ifc$interactive_condition) AND
            (condition.interactive_condition = ifc$terminate_break) THEN

{ Ignore the condition.

        RETURN;
      ELSEIF condition.selector = pmc$block_exit_processing THEN
        ocp$close_all_open_files (ocv$open_file_list);
        ocp$initialize_olg_working_heap;
        RESET ocv$olg_scratch_seq;
      ELSE
        pmp$continue_to_cause (pmc$execute_standard_procedure, handler_status);
      IFEND;
    PROCEND condition_handler;
?? OLDTITLE, EJECT ??

    VAR
      after: ^oct$new_library_module_list,
      deletion_list: oct$nlm_modification_list,
      first_module: pmt$program_name,
      ignore_status: ost$status,
      last_module: pmt$program_name,
      node: ^clt$data_value;


    VAR
      established_conditions: pmt$condition,
      established_descriptor: pmt$established_handler;


    status.normal := TRUE;
    command_status.normal := TRUE;
    established_conditions.selector := pmc$condition_combination;
    established_conditions.combination := $pmt$condition_combination
          [ifc$interactive_condition, pmc$block_exit_processing];

    RESET ocv$olg_scratch_seq;

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

    pmp$establish_condition_handler (established_conditions, ^condition_handler, ^established_descriptor,
          status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

  /protect/
    BEGIN
      deletion_list.link := NIL;
      IF pvt [p$module].value^.kind = clc$keyword THEN

{ Delete all modules if there are any.

        IF ocv$nlm_list^.f_link^.name = osc$null_name THEN
          EXIT /protect/;
        ELSE
          first_module := ocv$nlm_list^.f_link^.name;
          last_module := ocv$nlm_list^.b_link^.name;
          delete_module_subrange (first_module, last_module, ^deletion_list, status);
          IF NOT status.normal THEN
            EXIT /protect/;
          IFEND;
        IFEND;
      ELSE
        node := pvt [p$module].value;
        WHILE (node <> NIL) AND (node^.element_value <> NIL) DO
          IF node^.element_value^.kind = clc$range THEN
            first_module := node^.element_value^.low_value^.program_name_value;
            last_module := node^.element_value^.high_value^.program_name_value;
          ELSE
            first_module := node^.element_value^.program_name_value;
            last_module := first_module;
          IFEND;
          delete_module_subrange (first_module, last_module, ^deletion_list, status);
          IF NOT status.normal THEN
            EXIT /protect/;
          IFEND;
          node := node^.link;
        WHILEND;
      IFEND;

      ocp$delete_list_from_nlm_list (^deletion_list);

      status := command_status;
    END /protect/;
    pmp$disestablish_cond_handler (established_conditions, ignore_status);


  PROCEND ocp$_delete_module;
?? OLDTITLE ??
MODEND ocm$delete;
