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

{ PURPOSE:
{   To include modules in the output
{   library based on external
{   reference searching of the
{   specified libraries.

?? NEWTITLE := 'Global Declarations Referenced by This Module', EJECT ??
?? PUSH (LISTEXT := ON) ??
*copyc occ$retain
*copyc oce$library_generator_errors
*copyc oct$module_description
*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$add_an_nlm
*copyc ocp$close_all_open_files
*copyc ocp$create_an_nlm
*copyc ocp$delete_an_nlm
*copyc ocp$generate_message
*copyc ocp$initialize_olg_working_heap
*copyc ocp$obtain_object_file
*copyc ocp$obtain_xdcl_list
*copyc ocp$obtain_xref_list
*copyc ocp$search_modification_list
*copyc ocp$search_nlm_tree
*copyc osp$set_status_abnormal
*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 ??

  TYPE
    oct$external_tree = record
      name: pmt$program_name,
      module_description: ^oct$module_description,
      l_link: ^oct$external_tree,
      r_link: ^oct$external_tree
    recend,

    tree_function = (add, delete, search);

?? OLDTITLE ??
?? NEWTITLE := '[XDCL] ocp$_satisfy_external_reference' ??
?? EJECT ??

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

?? 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 ??
?? NEWTITLE := 'process_externals' ??
?? EJECT ??

    PROCEDURE process_externals
      (    process: tree_function;
           name: pmt$program_name;
       VAR module_description: ^oct$module_description;
       VAR tree: oct$external_tree;
       VAR external_found: boolean;
       VAR status: ost$status);

      VAR
        current_entry: ^oct$external_tree,
        previous_entry: ^oct$external_tree,
        external_tree_entry: ^oct$external_tree,
        next_entry: ^oct$external_tree;



      previous_entry := ^tree;
      current_entry := tree.r_link;

      WHILE (current_entry <> NIL) AND (current_entry^.name <> name) DO
        previous_entry := current_entry;

        IF name < current_entry^.name THEN
          current_entry := current_entry^.l_link;
        ELSE
          current_entry := current_entry^.r_link;
        IFEND;
      WHILEND;

      IF current_entry = NIL THEN
        external_found := FALSE;

        IF process = add THEN
          NEXT external_tree_entry IN ocv$olg_scratch_seq;
          IF external_tree_entry = NIL THEN
            osp$set_status_abnormal ('OC', oce$e_internal_olg_seg_overflow, '', status);
            RETURN;
          IFEND;

          external_tree_entry^.name := name;
          external_tree_entry^.module_description := module_description;
          external_tree_entry^.l_link := NIL;
          external_tree_entry^.r_link := NIL;

          IF name < previous_entry^.name THEN
            previous_entry^.l_link := external_tree_entry;
          ELSE
            previous_entry^.r_link := external_tree_entry;
          IFEND;
        IFEND;
?? EJECT ??
      ELSE
        external_found := TRUE;
        module_description := current_entry^.module_description;

        IF process = delete THEN
          IF current_entry^.name < previous_entry^.name THEN
            IF (current_entry^.l_link = NIL) OR (current_entry^.r_link = NIL) THEN
              IF (current_entry^.l_link = NIL) AND (current_entry^.r_link = NIL) THEN
                previous_entry^.l_link := NIL;
              ELSE
                IF current_entry^.l_link = NIL THEN
                  previous_entry^.l_link := current_entry^.r_link;
                ELSE
                  previous_entry^.l_link := current_entry^.l_link;
                IFEND;
              IFEND;
            ELSE
              next_entry := current_entry^.l_link;

              WHILE next_entry^.r_link <> NIL DO
                next_entry := next_entry^.r_link;
              WHILEND;

              next_entry^.r_link := current_entry^.r_link;
              previous_entry^.l_link := current_entry^.l_link;
            IFEND;
          ELSE
            IF (current_entry^.l_link = NIL) OR (current_entry^.r_link = NIL) THEN
              IF (current_entry^.l_link = NIL) AND (current_entry^.r_link = NIL) THEN
                previous_entry^.r_link := NIL;
              ELSE
                IF current_entry^.l_link = NIL THEN
                  previous_entry^.r_link := current_entry^.r_link;
                ELSE
                  previous_entry^.r_link := current_entry^.l_link;
                IFEND;
              IFEND;
            ELSE
              next_entry := current_entry^.l_link;

              WHILE next_entry^.r_link <> NIL DO
                next_entry := next_entry^.r_link;
              WHILEND;

              next_entry^.r_link := current_entry^.r_link;
              previous_entry^.r_link := current_entry^.l_link;
            IFEND;
          IFEND;
        IFEND;
      IFEND;

    PROCEND process_externals;
?? OLDTITLE ??
?? NEWTITLE := 'obtain_global_externals' ??
?? EJECT ??

    PROCEDURE obtain_global_externals
      (    parameter: clt$parameter_value;
       VAR global_externals: oct$external_tree;
       VAR status: ost$status);


      VAR
        external_found: boolean,
        file_descriptor: ^oct$open_file_list,
        entry_point: llt$entry_point_index,
        load_module_header: ^llt$load_module_header,
        module_description: ^oct$module_description,
        node: ^clt$data_value,
        file: ^SEQ ( * );


      global_externals.name := osc$null_name;
      global_externals.l_link := NIL;
      global_externals.r_link := NIL;

      node := parameter.value;
      WHILE node <> NIL DO
        ocp$obtain_object_file (node^.element_value^.file_value^, file_descriptor, status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;

        IF file_descriptor^.kind <> occ$library THEN
          osp$set_status_abnormal ('OC', oce$e_object_file_must_be_lib, node^.element_value^.file_value^,
                status);
          RETURN;
        IFEND;

        IF (file_descriptor^.directory <> NIL) AND (file_descriptor^.entry_point_dictionary <> NIL) THEN
          file := file_descriptor^.directory^ [1].file;

          FOR entry_point := 1 TO UPPERBOUND (file_descriptor^.entry_point_dictionary^) DO
            IF file_descriptor^.entry_point_dictionary^ [entry_point].module_kind = llc$load_module THEN
              load_module_header := #PTR (file_descriptor^.entry_point_dictionary^ [entry_point].
                    module_header, file^);
              IF load_module_header = NIL THEN
                osp$set_status_abnormal ('OC', oce$e_premature_eof_on_file, file_descriptor^.name, status);
                RETURN;
              IFEND;

              module_description := ^file_descriptor^.directory^ [load_module_header^.module_index];

              process_externals (add, file_descriptor^.entry_point_dictionary^ [entry_point].name,
                    module_description, global_externals, external_found, status);

            IFEND;
          FOREND;
        IFEND;
        node := node^.link;
      WHILEND;

    PROCEND obtain_global_externals;
?? OLDTITLE ??
?? NEWTITLE := 'collect_externals' ??
?? EJECT ??

    PROCEDURE collect_externals
      (VAR nlm: ^oct$new_library_module_list;
       VAR unsatisfied_externals: oct$external_tree;
       VAR defined_externals: oct$external_tree;
       VAR status: ost$status);


      VAR
        deferred_entry_point_list: oct$external_declaration_list,
        xdcl_list: oct$external_declaration_list,
        xref_list: oct$external_reference_list,
        starting_procedure: pmt$program_name,

        x_dcl: ^oct$external_declaration_list,
        x_ref: ^oct$external_reference_list,
        external_found: boolean;


      unsatisfied_externals.name := osc$null_name;
      unsatisfied_externals.l_link := NIL;
      unsatisfied_externals.r_link := NIL;

      REPEAT
        nlm := nlm^.f_link;

        ocp$obtain_xdcl_list (nlm^.changed_info, occ$no_retain, {obtain_deferred_entry_points} FALSE,
              nlm^.description^, xdcl_list, starting_procedure, deferred_entry_point_list, status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;

        x_dcl := xdcl_list.link;
        WHILE x_dcl <> NIL DO
          IF x_dcl^.name <> osc$null_name THEN
            process_externals (delete, x_dcl^.name, dummy, unsatisfied_externals, external_found, status);
            IF NOT status.normal THEN
              RETURN;
            IFEND;

            process_externals (add, x_dcl^.name, dummy, defined_externals, external_found, status);
            IF NOT status.normal THEN
              RETURN;
            IFEND;
          IFEND;

          x_dcl := x_dcl^.link;
        WHILEND;
?? EJECT ??

        ocp$obtain_xref_list (nlm^.description^, xref_list, occ$no_retain, status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;

        x_ref := xref_list.link;
        WHILE x_ref <> NIL DO
          process_externals (search, x_ref^.name, dummy, defined_externals, external_found, status);
          IF NOT status.normal THEN
            RETURN;
          IFEND;

          IF NOT external_found THEN
            process_externals (add, x_ref^.name, dummy, unsatisfied_externals, external_found, status);
            IF NOT status.normal THEN
              RETURN;
            IFEND;
          IFEND;

          x_ref := x_ref^.link;
        WHILEND;
      UNTIL nlm^.f_link^.name = osc$null_name;


    PROCEND collect_externals;
?? OLDTITLE ??
?? NEWTITLE := 'satisfy_externals' ??
?? EJECT ??

    PROCEDURE satisfy_externals
      (    unsatisfied_externals: ^oct$external_tree;
       VAR global_externals: oct$external_tree;
           addition_list: ^oct$nlm_modification_list;
       VAR status: ost$status);


      VAR
        local_status: ost$status,

        addition_before: ^oct$nlm_modification_list,

        global_xdcl_list: ^oct$external_tree,

        load_module_header: ^llt$load_module_header,

        nlm: ^oct$new_library_module_list,
        nlm_before: ^oct$new_library_module_list,
        module_description: ^oct$module_description,
        module_found: boolean,
        external_found: boolean;


      IF unsatisfied_externals <> NIL THEN
        satisfy_externals (unsatisfied_externals^.l_link, global_externals, last_addition, status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;

        process_externals (search, unsatisfied_externals^.name, module_description, global_externals,
              external_found, status);
        IF external_found THEN
          ocp$search_nlm_tree (module_description^.name, nlm_before, module_found);
          IF module_found THEN
            osp$set_status_abnormal ('OC', oce$e_module_already_on_library, module_description^.name, status);
            RETURN;
          IFEND;

          ocp$search_modification_list (module_description^.name, addition_list, addition_before,
                module_found);
          IF NOT module_found THEN
            NEXT addition_before^.link IN ocv$olg_scratch_seq;
            IF addition_before^.link = NIL THEN
              osp$set_status_abnormal ('OC', oce$e_internal_olg_seg_overflow, '', status);
              RETURN;
            IFEND;

            ocp$create_an_nlm (module_description, nlm, status);
            IF NOT status.normal THEN
              RETURN;
            IFEND;

            addition_before^.link^.nlm := nlm;
            addition_before^.link^.link := NIL;
          IFEND;
        IFEND;

        satisfy_externals (unsatisfied_externals^.r_link, global_externals, last_addition, status);
      IFEND;


    PROCEND satisfy_externals;
?? OLDTITLE ??

{ PROCEDURE (ocm$creol_sater) satisfy_external_reference, satisfy_external_re..
{ ferences, sater (
{   library, libraries, l: list of file = $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$list_type_qualifier,
        element_type_spec: record
          header: clt$type_specification_header,
        recend,
      recend,
      type2: record
        header: clt$type_specification_header,
      recend,
    recend := [
    [1,
    [89, 8, 15, 11, 17, 22, 611],
    clc$command, 4, 2, 1, 0, 0, 0, 2, 'OCM$CREOL_SATER'], [
    ['L                              ',clc$abbreviation_entry, 1],
    ['LIBRARIES                      ',clc$alias_entry, 1],
    ['LIBRARY                        ',clc$nominal_entry, 1],
    ['STATUS                         ',clc$nominal_entry, 2]],
    [
{ PARAMETER 1
    [3, 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
    [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$list_type], [3, 1, clc$max_list_size, FALSE],
      [[1, 0, clc$file_type]]
    ],
{ PARAMETER 2
    [[1, 0, clc$status_type]]];

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

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

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

    VAR
      last_addition: ^oct$nlm_modification_list,
      addition_list: oct$nlm_modification_list,
      ignore_status: ost$status,
      last_valid_nlm: ^oct$new_library_module_list,
      nlm: ^oct$new_library_module_list,
      dummy: [STATIC] ^oct$module_description := NIL,
      unsatisfied_externals: oct$external_tree,
      defined_externals: oct$external_tree,
      global_externals: oct$external_tree;



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




    status.normal := TRUE;

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

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

    pmp$establish_condition_handler (established_conditions, ^condition_handler, ^established_descriptor,
          status);

  /protect/
    BEGIN
      RESET ocv$olg_scratch_seq;

      obtain_global_externals (pvt [p$library], global_externals, status);
      IF NOT status.normal THEN
        EXIT /protect/;
      IFEND;

      defined_externals.name := osc$null_name;
      defined_externals.l_link := NIL;
      defined_externals.r_link := NIL;

      nlm := ocv$nlm_list;
      last_valid_nlm := ocv$nlm_list^.b_link;

      WHILE (nlm^.f_link^.name <> osc$null_name) AND (status.normal) DO
        collect_externals (nlm, unsatisfied_externals, defined_externals, status);
        IF status.normal THEN
          addition_list.link := NIL;
          last_addition := ^addition_list;

          satisfy_externals (unsatisfied_externals.r_link, global_externals, last_addition, status);
          IF status.normal THEN
            ocp$add_additions_to_nlm_list (ocv$nlm_list^.b_link, ^addition_list);
          IFEND;
        IFEND;
      WHILEND;

      IF NOT status.normal THEN
        WHILE last_valid_nlm^.f_link^.name <> osc$null_name DO
          nlm := last_valid_nlm^.f_link;
          ocp$delete_an_nlm (nlm);
        WHILEND;
      IFEND;
    END /protect/;
    pmp$disestablish_cond_handler (established_conditions, ignore_status);


  PROCEND ocp$_satisfy_external_reference;

MODEND ocm$satisfy;
