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


{ PURPOSE:
{   To alter the order of modules on the
{   current output library.

?? NEWTITLE := 'Global Declarations Referenced by This Module', EJECT ??
?? PUSH (LISTEXT := ON) ??
*copyc oce$library_generator_errors
*copyc oct$display_toggles
*copyc oct$new_library_module_list
*copyc oct$nlm_modification_list
*copyc ost$status
?? POP ??
*copyc clp$evaluate_parameters
*copyc ocp$close_all_open_files
*copyc ocp$generate_message
*copyc ocp$initialize_olg_working_heap
*copyc ocp$reorder_nlm_list
*copyc ocp$search_modification_list
*copyc ocp$search_nlm_tree
*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
?? OLDTITLE ??
?? NEWTITLE := 'Global Declarations Declared by This Module', EJECT ??

  VAR
    command_status: ost$status;

?? OLDTITLE ??
?? NEWTITLE := 'reorder_module_subrange' ??
?? EJECT ??

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


    VAR
      new_reorders: ^oct$nlm_modification_list,
      last_reorder: ^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, reorder_list, new_reorders, 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, 'reordered', 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, 'reordered', command_status);
        new_reorders^.link := NIL;
        RETURN;
      IFEND;

      ocp$search_modification_list (current_module, reorder_list, last_reorder, 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, 'reordered', command_status);

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

        last_reorder^.nlm := nlm;

        last_reorder^.link := NIL;
      IFEND;

      nlm := nlm^.f_link;

    UNTIL current_module = last_module;


  PROCEND reorder_module_subrange;
?? OLDTITLE ??
?? NEWTITLE := '[XDCL] ocp$_reorder_module' ??
?? EJECT ??

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

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

{ PROCEDURE (ocm$creol_reom) reorder_module, reorder_modules, reom (
{   module, modules, m: list of any of
{       program_name
{       range of program_name
{     anyend = $required
{   placement, p: key
{       (after, a)
{       (before, b)
{     keyend = after
{   destination, d: program_name = $optional
{   status)

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

  VAR
    pdt: [STATIC, READ, cls$declaration_section] record
      header: clt$pdt_header,
      names: array [1 .. 8] of clt$pdt_parameter_name,
      parameters: array [1 .. 4] 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,
          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,
      type2: 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,
      type3: record
        header: clt$type_specification_header,
      recend,
      type4: record
        header: clt$type_specification_header,
      recend,
    recend := [
    [1,
    [93, 10, 11, 1, 36, 1, 512],
    clc$command, 8, 4, 1, 0, 0, 0, 4, 'OCM$CREOL_REOM'], [
    ['D                              ',clc$abbreviation_entry, 3],
    ['DESTINATION                    ',clc$nominal_entry, 3],
    ['M                              ',clc$abbreviation_entry, 1],
    ['MODULE                         ',clc$nominal_entry, 1],
    ['MODULES                        ',clc$alias_entry, 1],
    ['P                              ',clc$abbreviation_entry, 2],
    ['PLACEMENT                      ',clc$nominal_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, 49, 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, 155, clc$optional_default_parameter, 0, 5],
{ 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, 3, clc$optional_parameter, 0, 0],
{ PARAMETER 4
    [8, 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], [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$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 3
    [[1, 0, clc$program_name_type]],
{ PARAMETER 4
    [[1, 0, clc$status_type]]];

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

    CONST
      p$module = 1,
      p$placement = 2,
      p$destination = 3,
      p$status = 4;

    VAR
      pvt: array [1 .. 4] 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 ??

    VAR
      after: ^oct$new_library_module_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,
      reorder_list: oct$nlm_modification_list;

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

?? EJECT ??

    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
      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;

      reorder_list.link := NIL;
      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;
        reorder_module_subrange (first_module, last_module, ^reorder_list, status);
        IF NOT status.normal THEN
          EXIT /protect/;
        IFEND;
        node := node^.link;
      WHILEND;

      IF (reorder_list.link <> NIL) AND (reorder_list.link^.nlm^.name = after^.name) THEN
        reorder_list.link := reorder_list.link^.link;
      IFEND;

      ocp$reorder_nlm_list (after, ^reorder_list);

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


  PROCEND ocp$_reorder_module;
?? OLDTITLE ??
MODEND ocm$reorder;
