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

{ PURPOSE:
{   To add all or selected modules from
{   the named file or library to the
{   current library.

?? NEWTITLE := 'Global Declarations Referenced by This Module', EJECT ??
?? PUSH (LISTEXT := ON) ??
*copyc clt$data_value
*copyc oce$library_generator_errors
*copyc oct$display_toggles
*copyc oct$new_library_module_list
*copyc oct$nlm_modification_list
*copyc oct$open_file_list
*copyc ost$status
?? POP ??
*copyc clp$evaluate_parameters
*copyc ocp$add_additions_to_nlm_list
*copyc ocp$close_all_open_files
*copyc ocp$create_an_nlm
*copyc ocp$free_nlm_modification_list
*copyc ocp$generate_message
*copyc ocp$get_module_from_wfl
*copyc ocp$initialize_olg_working_heap
*copyc ocp$obtain_object_file
*copyc ocp$rewind_working_file_list
*copyc ocp$search_modification_list
*copyc ocp$search_nlm_tree
*copyc ocp$search_working_file_list
*copyc ocp$skip_module_on_wfl
*copyc osp$append_status_parameter
*copyc osp$set_status_abnormal
*copyc osp$set_status_condition
*copyc pmp$continue_to_cause
*copyc pmp$disestablish_cond_handler
*copyc pmp$establish_condition_handler
*copyc ocv$nlm_list
*copyc ocv$olg_scratch_seq
*copyc ocv$open_file_list
*copyc ocv$return_file_list
?? OLDTITLE ??
?? NEWTITLE := 'Global Declarations Declared by This Module', EJECT ??

  VAR
    command_status: ost$status;

?? OLDTITLE ??
?? NEWTITLE := 'add_module_subrange' ??
?? EJECT ??

  PROCEDURE add_module_subrange
    (    first_module: pmt$program_name;
         last_module: pmt$program_name;
     VAR working_file_list: oct$working_file_list;
         addition_list: {output} ^oct$nlm_modification_list;
     VAR status: ost$status);


    VAR
      new_additions: ^oct$nlm_modification_list,
      last_addition: ^oct$nlm_modification_list,

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


    ocp$search_modification_list (osc$null_name, addition_list, new_additions, module_found);

    ocp$rewind_working_file_list (working_file_list);

    ocp$search_working_file_list (first_module, working_file_list, module_found);
    IF NOT module_found THEN
      IF first_module = last_module THEN
        osp$set_status_abnormal (oc, oce$w_module_not_found, first_module, status);
      ELSE
        osp$set_status_abnormal (oc, oce$w_subrange_module_not_found, 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, 'added', command_status);
      RETURN;
    IFEND;

    REPEAT
      ocp$get_module_from_wfl (working_file_list, current_module, file_descriptor);
      IF current_module = osc$null_name THEN
        IF last_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, 'added', command_status);
          ocp$free_nlm_modification_list (new_additions);
        IFEND;
        RETURN;
      IFEND;

      ocp$search_modification_list (current_module, addition_list, last_addition, 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, 'added', command_status);

      ELSE
        ocp$search_nlm_tree (current_module, nlm, module_found);
        IF module_found THEN
          osp$set_status_abnormal (oc, oce$w_module_already_on_library, current_module, status);
          ocp$generate_message (status);
          osp$set_status_abnormal (oc, oce$e_some_modules_not, 'added', command_status);
        ELSE
          NEXT last_addition^.link IN ocv$olg_scratch_seq;
          last_addition := last_addition^.link;
          IF last_addition = NIL THEN
            osp$set_status_condition (oce$e_internal_olg_seg_overflow, status);
            RETURN;
          IFEND;

          ocp$create_an_nlm (^file_descriptor^.directory^ [file_descriptor^.current_module],
                last_addition^.nlm, status);
          IF NOT status.normal THEN
            RETURN;
          IFEND;

          last_addition^.link := NIL;
        IFEND;
      IFEND;

      ocp$skip_module_on_wfl (working_file_list);

    UNTIL current_module = last_module;


  PROCEND add_module_subrange;
?? OLDTITLE ??
?? NEWTITLE := '[XDCL] ocp$_add_module' ??
?? EJECT ??

{ This procedure is the command processor for the CREATE_OBJECT_LIBRARY
{ subcommand ADD_MODULE.

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

{ PROCEDURE (ocm$creol_addm) add_module, add_modules, addm (
{   library, libraries, l: list of file = $required
{   module, modules, m: list of any of
{       program_name
{       range of program_name
{     anyend = $optional
{   placement, p: key
{       (after, a)
{       (before, b)
{     keyend = after
{   destination, d: program_name = $optional
{   return_file_when_complete: (BY_NAME, HIDDEN) boolean = false
{   status)

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

  VAR
    pdt: [STATIC, READ, cls$declaration_section] record
      header: clt$pdt_header,
      names: array [1 .. 12] of clt$pdt_parameter_name,
      parameters: array [1 .. 6] of clt$pdt_parameter,
      type1: record
        header: clt$type_specification_header,
        qualifier: clt$list_type_qualifier_v2,
        element_type_spec: record
          header: clt$type_specification_header,
        recend,
      recend,
      type2: 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,
      type3: record
        header: clt$type_specification_header,
        qualifier: clt$keyword_type_qualifier,
        keyword_specs: array [1 .. 4] of clt$keyword_specification,
        default_value: string (5),
      recend,
      type4: record
        header: clt$type_specification_header,
      recend,
      type5: record
        header: clt$type_specification_header,
        default_value: string (5),
      recend,
      type6: record
        header: clt$type_specification_header,
      recend,
    recend := [
    [1,
    [93, 10, 11, 1, 15, 48, 228],
    clc$command, 12, 6, 1, 0, 1, 0, 6, 'OCM$CREOL_ADDM'], [
    ['D                              ',clc$abbreviation_entry, 4],
    ['DESTINATION                    ',clc$nominal_entry, 4],
    ['L                              ',clc$abbreviation_entry, 1],
    ['LIBRARIES                      ',clc$alias_entry, 1],
    ['LIBRARY                        ',clc$nominal_entry, 1],
    ['M                              ',clc$abbreviation_entry, 2],
    ['MODULE                         ',clc$nominal_entry, 2],
    ['MODULES                        ',clc$alias_entry, 2],
    ['P                              ',clc$abbreviation_entry, 3],
    ['PLACEMENT                      ',clc$nominal_entry, 3],
    ['RETURN_FILE_WHEN_COMPLETE      ',clc$nominal_entry, 5],
    ['STATUS                         ',clc$nominal_entry, 6]],
    [
{ PARAMETER 1
    [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, 19, clc$required_parameter, 0, 0],
{ PARAMETER 2
    [7, 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, 49, clc$optional_parameter, 0, 0],
{ PARAMETER 3
    [10, 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, 5],
{ PARAMETER 4
    [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 5
    [11, clc$hidden_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name],
    clc$pass_by_value, clc$immediate_evaluation,
  clc$standard_parameter_checking, 3, clc$optional_default_parameter, 0, 5],
{ PARAMETER 6
    [12, 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$list_type], [3, 1, clc$max_list_size, 0, FALSE, FALSE],
      [[1, 0, clc$file_type]]
    ],
{ PARAMETER 2
    [[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 3
    [[1, 0, clc$keyword_type], [4], [
    ['A                              ', clc$abbreviation_entry,
  clc$normal_usage_entry, 1],
    ['AFTER                          ', clc$nominal_entry,
  clc$normal_usage_entry, 1],
    ['B                              ', clc$abbreviation_entry,
  clc$normal_usage_entry, 2],
    ['BEFORE                         ', clc$nominal_entry,
  clc$normal_usage_entry, 2]]
    ,
    'after'],
{ PARAMETER 4
    [[1, 0, clc$program_name_type]],
{ PARAMETER 5
    [[1, 0, clc$boolean_type],
    'false'],
{ PARAMETER 6
    [[1, 0, clc$status_type]]];

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

    CONST
      p$library = 1,
      p$module = 2,
      p$placement = 3,
      p$destination = 4,
      p$return_file_when_complete = 5,
      p$status = 6;

    VAR
      pvt: array [1 .. 6] 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
      addition_list: oct$nlm_modification_list,
      after: ^oct$new_library_module_list,
      return_file_entry: ^oct$return_file_list,
      file_descriptor: ^oct$open_file_list,
      first_module: pmt$program_name,
      ignore_status: ost$status,
      last_module: pmt$program_name,
      module_found: boolean,
      nlm: ^oct$new_library_module_list,
      node: ^clt$data_value,
      working_file_list: oct$working_file_list;

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


    status.normal := TRUE;
    command_status.normal := TRUE;

    RESET ocv$olg_scratch_seq;

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

    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
      working_file_list.current_file := ^working_file_list.first_working_file;
      node := pvt [p$library].value;
      WHILE node <> NIL DO
        NEXT working_file_list.current_file^.link IN ocv$olg_scratch_seq;
        working_file_list.current_file := working_file_list.current_file^.link;
        IF working_file_list.current_file = NIL THEN
          osp$set_status_condition (oce$e_internal_olg_seg_overflow, status);
          RETURN;
        IFEND;
        ocp$obtain_object_file (node^.element_value^.file_value^, working_file_list.current_file^.descriptor,
              status);
        IF NOT status.normal THEN
          EXIT /protect/;
        IFEND;
        IF pvt [p$return_file_when_complete].value^.boolean_value.value THEN
          ALLOCATE return_file_entry;
          ALLOCATE return_file_entry^.file_name: [STRLENGTH(node^.element_value^.file_value^)];
          return_file_entry^.file_name^ := node^.element_value^.file_value^;
          return_file_entry^.link := ocv$return_file_list;
          ocv$return_file_list := return_file_entry;
        IFEND;

        node := node^.link;
      WHILEND;

      working_file_list.current_file^.link := NIL;

      IF pvt [p$destination].specified THEN
        ocp$search_nlm_tree (pvt [p$destination].value^.program_name_value, nlm, module_found);
        IF NOT module_found THEN
          osp$set_status_abnormal (oc, oce$e_module_not_found, pvt [p$destination].value^.program_name_value,
                status);
          EXIT /protect/;
        IFEND;
        IF pvt [p$placement].value^.keyword_value = 'AFTER' THEN
          after := nlm;
        ELSE { BEFORE
          after := nlm^.b_link;
        IFEND;
      ELSE
        IF pvt [p$placement].value^.keyword_value = 'AFTER' THEN
          after := ocv$nlm_list^.b_link;
        ELSE { BEFORE
          after := ocv$nlm_list;
        IFEND;
      IFEND;

      addition_list.link := NIL;

      IF pvt [p$module].specified THEN
        node := pvt [p$module].value;

      /obtain_addition_list/
        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;
          add_module_subrange (first_module, last_module, working_file_list, ^addition_list, status);
          IF NOT status.normal THEN
            EXIT /obtain_addition_list/;
          IFEND;
          node := node^.link;
        WHILEND /obtain_addition_list/;
      ELSE
        ocp$rewind_working_file_list (working_file_list);
        ocp$get_module_from_wfl (working_file_list, first_module, file_descriptor);
        last_module := osc$null_name;
        add_module_subrange (first_module, last_module, working_file_list, ^addition_list, status);
      IFEND;

      IF NOT status.normal THEN
        ocp$free_nlm_modification_list (^addition_list);
        EXIT /protect/;
      IFEND;

      ocp$add_additions_to_nlm_list (after, ^addition_list);
      status := command_status;
    END /protect/;
    pmp$disestablish_cond_handler (established_conditions, ignore_status);


  PROCEND ocp$_add_module;
?? OLDTITLE ??
MODEND ocm$add;
