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



{ PURPOSE:
{   To create a single load module from the
{   specified component object or load modules.

?? NEWTITLE := 'Global Declarations Referenced by This Module', ??
?? PUSH (LISTEXT := ON) ??
*copyc cle$ecc_expression_result
*copyc llt$object_library_header
*copyc occ$retain
*copyc oce$library_generator_errors
*copyc oct$component_list
*copyc oct$display_toggles
*copyc oct$header
*copyc oct$open_file_list
*copyc ost$status
?? POP ??
*copyc avp$get_capability
*copyc clp$convert_string_to_file
*copyc clp$evaluate_parameters
*copyc ocp$add_an_nlm
*copyc ocp$close_all_open_files
*copyc ocp$generate_message
*copyc ocp$initialize_olg_working_heap
*copyc ocp$obtain_header
*copyc ocp$obtain_library_list
*copyc ocp$obtain_object_file
*copyc ocp$obtain_xdcl_list
*copyc ocp$obtain_xref_list
*copyc ocp$search_nlm_tree
*copyc ocp$search_object_file
*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 pmp$get_legible_date_time
*copyc ocv$nlm_list
*copyc ocv$olg_scratch_seq
*copyc ocv$olg_working_heap
*copyc ocv$open_file_list
?? OLDTITLE ??
?? NEWTITLE := 'Global Declarations Declared by This Module', EJECT ??

  VAR
    object_type_checking: [STATIC, READ] string (6) := 'OBJECT';

?? OLDTITLE ??
?? NEWTITLE := 'get_xdcl', EJECT ??

  PROCEDURE get_xdcl
    (    name: pmt$program_name;
         sorted_xdcl_list: oct$sorted_xdcl_list;
         number_of_xdcls: llt$entry_point_index;
     VAR xdcl_found: boolean;
     VAR external_declaration: ^oct$external_declaration_list);

    VAR
      temp: integer,
      hi: llt$entry_point_index,
      lo: llt$entry_point_index,
      mid: llt$entry_point_index;


    xdcl_found := FALSE;
    hi := number_of_xdcls;
    lo := 1;

    WHILE (lo <= hi) AND NOT xdcl_found DO
      temp := lo + hi;
      mid := temp DIV 2;
      IF name = sorted_xdcl_list^ [mid]^.name THEN
        xdcl_found := TRUE;
        external_declaration := sorted_xdcl_list^ [mid];
      ELSEIF name < sorted_xdcl_list^ [mid]^.name THEN
        hi := mid - 1;
      ELSE
        lo := mid + 1;
      IFEND;
    WHILEND;

  PROCEND get_xdcl;
?? OLDTITLE ??
?? NEWTITLE := 'add_to_sorted_xdcl_list' ??
?? EJECT ??

  PROCEDURE add_to_sorted_xdcl_list
    (    last_modules_xdcl: ^oct$external_declaration_list;
     VAR sorted_xdcl_list: oct$sorted_xdcl_list;
     VAR sorted_xdcl_list_size: llt$entry_point_index;
     VAR number_of_xdcls: llt$entry_point_index;
     VAR status: ost$status);


{ The size of the sorted_xdcl_list will start out at 3000 and increase in increments of
{ 3000 if necessary.  3000 was chosen because it should be enough most of the time.  It
{ seems more efficient to allocate extra space that isn't used in the smaller cases than
{ to choose a smaller number and reallocate the space over and over for the larger cases.

    CONST
      xdcl_list_increment = 3000;

    VAR
      temp: integer,
      found: boolean,
      hi: llt$entry_point_index,
      i: llt$entry_point_index,
      lo: llt$entry_point_index,
      mid: llt$entry_point_index,
      old_xdcl_list: oct$sorted_xdcl_list;

    status.normal := TRUE;

    IF number_of_xdcls = sorted_xdcl_list_size THEN
      old_xdcl_list := sorted_xdcl_list;

      NEXT sorted_xdcl_list: [1 .. (sorted_xdcl_list_size + xdcl_list_increment)] IN ocv$olg_scratch_seq;
      IF sorted_xdcl_list = NIL THEN
        osp$set_status_abnormal (oc, oce$e_internal_olg_seg_overflow, '', status);
        RETURN;
      IFEND;

      FOR i := 1 TO sorted_xdcl_list_size DO
        sorted_xdcl_list^ [i] := old_xdcl_list^ [i];
      FOREND;

      sorted_xdcl_list_size := sorted_xdcl_list_size + xdcl_list_increment;
    IFEND;

    found := FALSE;
    hi := number_of_xdcls;
    lo := 1;

    WHILE (lo <= hi) AND NOT found DO
      temp := lo + hi;
      mid := temp DIV 2;
      IF last_modules_xdcl^.name = sorted_xdcl_list^ [mid]^.name THEN
        found := TRUE;
      ELSEIF last_modules_xdcl^.name < sorted_xdcl_list^ [mid]^.name THEN
        hi := mid - 1;
      ELSE
        lo := mid + 1;
      IFEND;
    WHILEND;

    IF found THEN
      osp$set_status_abnormal (oc, oce$e_xdcl_already_exists, last_modules_xdcl^.name, status);
      RETURN;
    IFEND;

    number_of_xdcls := number_of_xdcls + 1;

    FOR i := (number_of_xdcls - 1) DOWNTO lo DO
      sorted_xdcl_list^ [i + 1] := sorted_xdcl_list^ [i];
    FOREND;

    sorted_xdcl_list^ [lo] := last_modules_xdcl;

  PROCEND add_to_sorted_xdcl_list;
?? OLDTITLE ??
?? NEWTITLE := 'add_to_sorted_xref_list' ??
?? EJECT ??

  PROCEDURE add_to_sorted_xref_list
    (    last_modules_xref: ^oct$external_reference_list;
     VAR sorted_xref_list: oct$sorted_xref_list;
     VAR sorted_xref_list_size: 0 .. llc$max_ext_items;
     VAR number_of_xrefs: 0 .. llc$max_ext_items;
     VAR xref_found: boolean;
     VAR status: ost$status);


{ The size of the sorted_xref_list will start out at 3000 and increase in increments of
{ 3000 if necessary.  3000 was chosen because it should be enough most of the time.  It
{ seems more efficient to allocate extra space that isn't used in the smaller cases than
{ to choose a smaller number and reallocate the space over and over for the larger cases.

    CONST
      xref_list_increment = 3000;

    VAR
      temp: integer,
      hi: 0 .. llc$max_ext_items,
      i: 0 .. llc$max_ext_items,
      lo: 0 .. llc$max_ext_items,
      mid: 0 .. llc$max_ext_items,
      old_xref_list: oct$sorted_xref_list;

    status.normal := TRUE;

    xref_found := FALSE;

    IF number_of_xrefs = sorted_xref_list_size THEN
      old_xref_list := sorted_xref_list;

      NEXT sorted_xref_list: [1 .. (sorted_xref_list_size + xref_list_increment)] IN ocv$olg_scratch_seq;
      IF sorted_xref_list = NIL THEN
        osp$set_status_abnormal (oc, oce$e_internal_olg_seg_overflow, '', status);
        RETURN;
      IFEND;

      FOR i := 1 TO sorted_xref_list_size DO
        sorted_xref_list^ [i] := old_xref_list^ [i];
      FOREND;

      sorted_xref_list_size := sorted_xref_list_size + xref_list_increment;
    IFEND;

    hi := number_of_xrefs;
    lo := 1;

    WHILE (lo <= hi) AND NOT xref_found DO
      temp := lo + hi;
      mid := temp DIV 2;
      IF last_modules_xref^.name = sorted_xref_list^ [mid]^.name THEN
        xref_found := TRUE;
      ELSEIF last_modules_xref^.name < sorted_xref_list^ [mid]^.name THEN
        hi := mid - 1;
      ELSE
        lo := mid + 1;
      IFEND;
    WHILEND;

    IF NOT xref_found THEN
      number_of_xrefs := number_of_xrefs + 1;

      FOR i := (number_of_xrefs - 1) DOWNTO lo DO
        sorted_xref_list^ [i + 1] := sorted_xref_list^ [i];
      FOREND;

      sorted_xref_list^ [lo] := last_modules_xref;
    IFEND;

  PROCEND add_to_sorted_xref_list;
?? OLDTITLE ??
?? NEWTITLE := 'add_to_component_list' ??
?? EJECT ??

  PROCEDURE add_to_component_list
    (    first_module: pmt$program_name;
         last_module: pmt$program_name;
         xdcl_list: ^oct$external_declaration_list;
     VAR file_descriptor: ^oct$open_file_list;
     VAR last_xdcl: ^oct$external_declaration_list;
     VAR sorted_xdcl_list: oct$sorted_xdcl_list;
     VAR sorted_xdcl_list_size: llt$entry_point_index;
     VAR number_of_xdcls: llt$entry_point_index;
     VAR sorted_xref_list: oct$sorted_xref_list;
     VAR sorted_xref_list_size: 0 .. llc$max_ext_items;
     VAR number_of_xrefs: 0 .. llc$max_ext_items;
     VAR identification: llt$identification;
     VAR starting_procedure: pmt$program_name;
     VAR xref_list: oct$external_reference_list;
     VAR library_list: oct$name_list;
     VAR last_component: ^oct$component_list;
     VAR number_of_components: integer;
     VAR object_type_checking_found: boolean;
     VAR status: ost$status);




    VAR
      current_module: pmt$program_name,
      deferred_entry_point_list: oct$external_declaration_list,
      header: oct$header,
      last_library: ^oct$name_list,
      last_modules_xdcl: ^oct$external_declaration_list,
      last_xref: ^oct$external_reference_list,
      module_found: boolean,
      modules_last_library: ^oct$name_list,
      modules_last_xref: ^oct$external_reference_list,
      modules_library_list: oct$name_list,
      modules_xdcl_list: oct$external_declaration_list,
      modules_xref_list: oct$external_reference_list,
      start_proc: pmt$program_name,
      xdcl_found: boolean,
      xref_found: boolean;


    status.normal := TRUE;

    file_descriptor^.current_module := 1;

    ocp$search_object_file (first_module, module_found, file_descriptor);
    IF NOT module_found THEN
      osp$set_status_abnormal (oc, oce$e_module_not_found, first_module, status);
      RETURN;
    IFEND;

    REPEAT
      IF file_descriptor^.current_module > UPPERBOUND (file_descriptor^.directory^) THEN
        osp$set_status_abnormal (oc, oce$e_module_not_found, last_module, status);
        RETURN;
      IFEND;

      current_module := file_descriptor^.directory^ [file_descriptor^.current_module].name;
      number_of_components := number_of_components + 1;

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

      last_component^.link := NIL;
      last_component^.module_description := ^file_descriptor^.directory^ [file_descriptor^.current_module];

      IF (last_component^.module_description^.kind <> occ$cpu_object_module) AND
            (last_component^.module_description^.kind <> occ$load_module) THEN
        osp$set_status_abnormal (oc, oce$e_invalid_module_kind, last_component^.module_description^.name,
              status);
        RETURN;
      IFEND;

      ocp$obtain_header (last_component^.module_description^, NIL, header, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;

      IF llc$nonbindable IN header.identification.attributes THEN
        osp$set_status_abnormal (oc, oce$e_module_not_bindable, last_component^.module_description^.name,
              status);
        RETURN;
      IFEND;

      IF llc$object_cybil_checking IN header.identification.attributes THEN
        object_type_checking_found := TRUE;
      IFEND;

      IF header.identification.kind = llc$vector_virtual_state THEN
        identification.kind := llc$vector_virtual_state;
      ELSEIF header.identification.kind = llc$vector_extended_state THEN
        identification.kind := llc$vector_extended_state;
      IFEND;

      ocp$obtain_library_list (last_component^.module_description^, NIL, modules_library_list, occ$retain,
            status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;

      ocp$obtain_xdcl_list ({changed_info} NIL, occ$retain, {obtain_deferred_entry_points} FALSE,
            last_component^.module_description^, modules_xdcl_list, start_proc, deferred_entry_point_list,
            status);
      IF start_proc <> osc$null_name THEN
        starting_procedure := start_proc;
      IFEND;
      IF NOT status.normal THEN
        RETURN;
      IFEND;

      ocp$obtain_xref_list (last_component^.module_description^, modules_xref_list, occ$retain, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;

      last_modules_xdcl := modules_xdcl_list.link;

      WHILE last_modules_xdcl <> NIL DO
        add_to_sorted_xdcl_list (last_modules_xdcl, sorted_xdcl_list, sorted_xdcl_list_size, number_of_xdcls,
              status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;

        last_xdcl^.link := last_modules_xdcl;
        last_modules_xdcl := last_modules_xdcl^.link;
        last_xdcl^.link^.link := NIL;
        last_xdcl := last_xdcl^.link;
      WHILEND;

      last_xref := ^xref_list;
      WHILE (last_xref^.link <> NIL) DO
        last_xref := last_xref^.link;
      WHILEND;

      modules_last_xref := modules_xref_list.link;
      WHILE modules_last_xref <> NIL DO
        add_to_sorted_xref_list (modules_last_xref, sorted_xref_list, sorted_xref_list_size, number_of_xrefs,
              xref_found, status);
        IF NOT status.normal THEN
          RETURN;
        IFEND;

        IF NOT xref_found THEN
          last_xref^.link := modules_last_xref;
          modules_last_xref := modules_last_xref^.link;
          last_xref := last_xref^.link;
          last_xref^.link := NIL;
        ELSE
          modules_last_xref := modules_last_xref^.link;
        IFEND;
      WHILEND;


      modules_last_library := modules_library_list.link;
      WHILE modules_last_library <> NIL DO
        last_library := ^library_list;
        WHILE (last_library^.link <> NIL) AND (last_library^.link^.name <> modules_last_library^.name) DO
          last_library := last_library^.link;
        WHILEND;

        IF last_library^.link = NIL THEN
          last_library^.link := modules_last_library;
          modules_last_library := modules_last_library^.link;
          last_library^.link^.link := NIL;
        ELSE
          modules_last_library := modules_last_library^.link;
        IFEND;
      WHILEND;

      file_descriptor^.current_module := file_descriptor^.current_module + 1;

    UNTIL current_module = last_module;

  PROCEND add_to_component_list;
?? OLDTITLE ??
?? NEWTITLE := '[XDCL] ocp$_create_module' ??
?? EJECT ??

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

{ PROCEDURE (ocm$creol_crem) create_module, crem (
{   name, n: program_name = $required
{   component, components, c: list of record
{       library: file
{       modules: list rest of any of
{         program_name
{         range of program_name
{       anyend = $optional
{     recend = $required
{   gate, gates, g: (BY_NAME) any of
{       key
{         all
{       keyend
{       list of program_name
{     anyend = $optional
{   retain, r: (BY_NAME) any of
{       key
{         all
{       keyend
{       list of program_name
{     anyend = $optional
{   starting_procedure, sp: (BY_NAME) program_name = $optional
{   preset_value, pv: (BY_NAME) key
{       (zero, z)
{       (floating_point_indefinite, fpi)
{       (infinity, i)
{       (alternate_ones, ao)
{     keyend = $optional
{   include_binary_section_maps, ibsm: (BY_NAME) boolean = $optional
{   output, o: (BY_NAME) file = $optional
{   application_identifier, ai: (BY_NAME, ADVANCED) name = $optional
{   status)

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

  VAR
    pdt: [STATIC, READ, cls$declaration_section] record
      header: clt$pdt_header,
      names: array [1 .. 21] of clt$pdt_parameter_name,
      parameters: array [1 .. 10] of clt$pdt_parameter,
      type1: record
        header: clt$type_specification_header,
      recend,
      type2: record
        header: clt$type_specification_header,
        qualifier: clt$list_type_qualifier,
        element_type_spec: record
          header: clt$type_specification_header,
          qualifier: clt$record_type_qualifier,
          field_spec_1: clt$field_specification,
          element_type_spec_1: record
            header: clt$type_specification_header,
          recend,
          field_spec_2: clt$field_specification,
          element_type_spec_2: record
            header: clt$type_specification_header,
            qualifier: clt$list_type_qualifier,
            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,
      recend,
      type3: 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,
          element_type_spec: record
            header: clt$type_specification_header,
          recend,
        recend,
      recend,
      type4: 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,
          element_type_spec: record
            header: clt$type_specification_header,
          recend,
        recend,
      recend,
      type5: record
        header: clt$type_specification_header,
      recend,
      type6: record
        header: clt$type_specification_header,
        qualifier: clt$keyword_type_qualifier,
        keyword_specs: array [1 .. 8] of clt$keyword_specification,
      recend,
      type7: record
        header: clt$type_specification_header,
      recend,
      type8: record
        header: clt$type_specification_header,
      recend,
      type9: record
        header: clt$type_specification_header,
        qualifier: clt$name_type_qualifier,
      recend,
      type10: record
        header: clt$type_specification_header,
      recend,
    recend := [
    [1,
    [89, 11, 20, 11, 41, 40, 588],
    clc$command, 21, 10, 2, 1, 0, 0, 10, 'OCM$CREOL_CREM'], [
    ['AI                             ',clc$abbreviation_entry, 9],
    ['APPLICATION_IDENTIFIER         ',clc$nominal_entry, 9],
    ['C                              ',clc$abbreviation_entry, 2],
    ['COMPONENT                      ',clc$nominal_entry, 2],
    ['COMPONENTS                     ',clc$alias_entry, 2],
    ['G                              ',clc$abbreviation_entry, 3],
    ['GATE                           ',clc$nominal_entry, 3],
    ['GATES                          ',clc$alias_entry, 3],
    ['IBSM                           ',clc$abbreviation_entry, 7],
    ['INCLUDE_BINARY_SECTION_MAPS    ',clc$nominal_entry, 7],
    ['N                              ',clc$abbreviation_entry, 1],
    ['NAME                           ',clc$nominal_entry, 1],
    ['O                              ',clc$abbreviation_entry, 8],
    ['OUTPUT                         ',clc$nominal_entry, 8],
    ['PRESET_VALUE                   ',clc$nominal_entry, 6],
    ['PV                             ',clc$abbreviation_entry, 6],
    ['R                              ',clc$abbreviation_entry, 4],
    ['RETAIN                         ',clc$nominal_entry, 4],
    ['SP                             ',clc$abbreviation_entry, 5],
    ['STARTING_PROCEDURE             ',clc$nominal_entry, 5],
    ['STATUS                         ',clc$nominal_entry, 10]],
    [
{ PARAMETER 1
    [12, 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$required_parameter, 0
  , 0],
{ PARAMETER 2
    [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, 147,
  clc$required_parameter, 0, 0],
{ PARAMETER 3
    [7, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name],
    clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 83, clc$optional_parameter,
  0, 0],
{ PARAMETER 4
    [18, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name],
    clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 83, clc$optional_parameter,
  0, 0],
{ PARAMETER 5
    [20, clc$normal_usage_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_parameter, 0
  , 0],
{ PARAMETER 6
    [15, clc$normal_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name],
    clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 303,
  clc$optional_parameter, 0, 0],
{ PARAMETER 7
    [10, clc$normal_usage_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_parameter, 0
  , 0],
{ PARAMETER 8
    [14, clc$normal_usage_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_parameter, 0
  , 0],
{ PARAMETER 9
    [2, clc$advanced_usage_entry, clc$non_secure_parameter,
    $clt$parameter_spec_methods[clc$specify_by_name],
    clc$pass_by_value, clc$immediate_evaluation, clc$standard_parameter_checking, 5, clc$optional_parameter, 0
  , 0],
{ PARAMETER 10
    [21, 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$program_name_type]],
{ PARAMETER 2
    [[1, 0, clc$list_type], [131, 1, clc$max_list_size, FALSE],
      [[1, 0, clc$record_type], [2],
      ['LIBRARY                        ', clc$required_field, 3], [[1, 0, clc$file_type]],
      ['MODULES                        ', clc$optional_field, 49], [[1, 0, clc$list_type], [33, 0,
  clc$max_list_size, TRUE],
          [[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$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]]
      ],
    19, [[1, 0, clc$list_type], [3, 1, clc$max_list_size, FALSE],
        [[1, 0, clc$program_name_type]]
      ]
    ],
{ PARAMETER 4
    [[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]]
      ],
    19, [[1, 0, clc$list_type], [3, 1, clc$max_list_size, FALSE],
        [[1, 0, clc$program_name_type]]
      ]
    ],
{ PARAMETER 5
    [[1, 0, clc$program_name_type]],
{ PARAMETER 6
    [[1, 0, clc$keyword_type], [8], [
    ['ALTERNATE_ONES                 ', clc$nominal_entry, clc$normal_usage_entry, 4],
    ['AO                             ', clc$abbreviation_entry, clc$normal_usage_entry, 4],
    ['FLOATING_POINT_INDEFINITE      ', clc$nominal_entry, clc$normal_usage_entry, 2],
    ['FPI                            ', clc$abbreviation_entry, clc$normal_usage_entry, 2],
    ['I                              ', clc$abbreviation_entry, clc$normal_usage_entry, 3],
    ['INFINITY                       ', clc$nominal_entry, clc$normal_usage_entry, 3],
    ['Z                              ', clc$abbreviation_entry, clc$normal_usage_entry, 1],
    ['ZERO                           ', clc$nominal_entry, clc$normal_usage_entry, 1]]
    ],
{ PARAMETER 7
    [[1, 0, clc$boolean_type]],
{ PARAMETER 8
    [[1, 0, clc$file_type]],
{ PARAMETER 9
    [[1, 0, clc$name_type], [1, osc$max_name_size]],
{ PARAMETER 10
    [[1, 0, clc$status_type]]];

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

    CONST
      p$name = 1,
      p$component = 2,
      p$gate = 3,
      p$retain = 4,
      p$starting_procedure = 5,
      p$preset_value = 6,
      p$include_binary_section_maps = 7,
      p$output = 8,
      p$application_identifier = 9,
      p$status = 10;

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

{ These constants define the field numbers in the component record.

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

?? 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
      date: ost$date,

?? FMT (FORMAT := OFF) ??

      module_header_template: [STATIC] llt$identification :=
            [*,                                                          {name}
             llc$object_text_version,                                    {object_text_version}
             llc$mi_virtual_state,                                       {kind}
             [osc$hms_time, *],                                          {time_created}
             [osc$mdy_date, *],                                          {date_created}
             *,                                                          {attributes}
             0,                                                          {greatest_section_ordinal}
             llc$object_library_generator,                               {generator_id}
             'OBJECT LIBRARY GENERATOR ' CAT llc$object_library_version, {generator_name_vers}
             osc$null_name],                                             {commentary}

?? FMT (FORMAT := ON) ??
      time: ost$time;

    VAR
      application_administrator: boolean,
      component_list: oct$component_list,
      component_number: 0 .. llc$max_components,
      external_declaration: ^oct$external_declaration_list,
      file_descriptor: ^oct$open_file_list,
      first_module: pmt$program_name,
      ignore_status: ost$status,
      last_component: ^oct$component_list,
      last_module: pmt$program_name,
      last_xdcl: ^oct$external_declaration_list,
      library_list: oct$name_list,
      module_already_exists: boolean,
      module_node: ^clt$data_value,
      nlm: ^oct$new_library_module_list,
      node: ^clt$data_value,
      number_of_components: integer,
      number_of_xdcls: llt$entry_point_index,
      number_of_xrefs: 0 .. llc$max_ext_items,
      object_type_checking_found: boolean,
      program_name: pmt$program_name,
      section_map_file: clt$file,
      sorted_xdcl_list: oct$sorted_xdcl_list,
      sorted_xdcl_list_size: llt$entry_point_index,
      sorted_xref_list: oct$sorted_xref_list,
      sorted_xref_list_size: 0 .. llc$max_ext_items,
      xdcl_found: boolean,
      xdcl_list: oct$external_declaration_list;

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

    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$get_legible_date_time (osc$mdy_date, date, osc$hms_time, time, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    module_header_template.time_created.hms := time.hms;
    module_header_template.date_created.mdy := date.mdy;

    program_name := pvt [p$name].value^.program_name_value;

    ocp$search_nlm_tree (program_name, nlm, module_already_exists);
    IF module_already_exists THEN
      osp$set_status_abnormal (oc, oce$e_module_already_on_library, program_name, status);
      RETURN;
    IFEND;

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

  /protect/
    BEGIN
      ALLOCATE nlm IN ocv$olg_working_heap^;
      IF nlm = NIL THEN
        osp$set_status_condition (oce$e_internal_olg_seg_overflow, status);
        RETURN;
      IFEND;

      nlm^.name := program_name;
      module_header_template.name := nlm^.name;


      ALLOCATE nlm^.changed_info IN ocv$olg_working_heap^;
      IF nlm^.changed_info = NIL THEN
        osp$set_status_condition (oce$e_internal_olg_seg_overflow, status);
        FREE nlm IN ocv$olg_working_heap^;
        RETURN;
      IFEND;

      nlm^.changed_info^.name := NIL;
      nlm^.changed_info^.commentary := NIL;
      nlm^.changed_info^.entry_points := NIL;
      nlm^.changed_info^.starting_procedure := osc$null_name;
      nlm^.changed_info^.new_libraries := TRUE;
      nlm^.changed_info^.library_list := NIL;
      nlm^.changed_info^.debug_tables_to_omit := $oct$debug_tables [];
      nlm^.changed_info^.application_identifier := NIL;
      nlm^.changed_info^.cybil_parameter_checking := '      ';

      object_type_checking_found := FALSE;

      ALLOCATE nlm^.description IN ocv$olg_working_heap^;
      IF nlm^.description = NIL THEN
        osp$set_status_condition (oce$e_internal_olg_seg_overflow, status);
        FREE nlm^.changed_info IN ocv$olg_working_heap^;
        FREE nlm IN ocv$olg_working_heap^;
        RETURN;
      IFEND;

      nlm^.description^.name := program_name;
      nlm^.description^.source := occ$current;
      nlm^.description^.file := NIL;
      nlm^.description^.kind := occ$bound_module;

      ALLOCATE nlm^.description^.bound_module_header IN ocv$olg_working_heap^;
      IF nlm^.description^.bound_module_header = NIL THEN
        osp$set_status_condition (oce$e_internal_olg_seg_overflow, status);
        FREE nlm^.changed_info IN ocv$olg_working_heap^;
        FREE nlm^.description IN ocv$olg_working_heap^;
        FREE nlm IN ocv$olg_working_heap^;
        RETURN;
      IFEND;

      nlm^.description^.bound_module_header^.identification := module_header_template;
      nlm^.description^.bound_module_header^.xref_list.link := NIL;
      nlm^.description^.bound_module_header^.components := NIL;
      nlm^.description^.bound_module_header^.code_section_ids.link := NIL;
      nlm^.description^.bound_module_header^.preset_specified := FALSE;
      nlm^.description^.bound_module_header^.preset_value := pmc$initialize_to_zero;
      nlm^.description^.bound_module_header^.include_binary_section_maps := FALSE;

      nlm^.f_link := NIL;
      nlm^.b_link := NIL;
      nlm^.r_link := NIL;
      nlm^.l_link := NIL;
      nlm^.t_link := NIL;

      component_list.link := NIL;
      number_of_components := 0;

      xdcl_list.link := NIL;
      last_xdcl := ^xdcl_list;

      sorted_xdcl_list := NIL;
      sorted_xdcl_list_size := 0;
      number_of_xdcls := 0;

      sorted_xref_list := NIL;
      sorted_xref_list_size := 0;
      number_of_xrefs := 0;

      last_component := ^component_list;
      library_list.link := NIL;

    /valid_data_processing/
      BEGIN
        node := pvt [p$component].value;
        WHILE node <> NIL DO
          ocp$obtain_object_file (node^.element_value^.field_values^ [p$library].value^.file_value^,
                file_descriptor, status);
          IF NOT status.normal THEN
            EXIT /valid_data_processing/;
          IFEND;
          IF node^.element_value^.field_values^ [p$modules].value = NIL THEN

{ The modules field of the record was omitted. Use all the modules on the file.

            first_module := file_descriptor^.directory^ [1].name;
            last_module := file_descriptor^.directory^ [UPPERBOUND (file_descriptor^.directory^)].name;
            add_to_component_list (first_module, last_module, ^xdcl_list, file_descriptor, last_xdcl,
                  sorted_xdcl_list, sorted_xdcl_list_size, number_of_xdcls, sorted_xref_list,
                  sorted_xref_list_size, number_of_xrefs, nlm^.description^.bound_module_header^.
                  identification, nlm^.changed_info^.starting_procedure,
                  nlm^.description^.bound_module_header^.xref_list, library_list, last_component,
                  number_of_components, object_type_checking_found, status);
            IF NOT status.normal THEN
              EXIT /valid_data_processing/;
            IFEND;
          ELSE
            module_node := node^.element_value^.field_values^ [p$modules].value;
            WHILE (module_node <> NIL) AND (module_node^.element_value <> NIL) DO

{ Check whether a program_name or range of program_name was specified.

              IF module_node^.element_value^.kind = clc$program_name THEN
                first_module := module_node^.element_value^.program_name_value;
                last_module := first_module;
              ELSE
                first_module := module_node^.element_value^.low_value^.program_name_value;
                last_module := module_node^.element_value^.high_value^.program_name_value;
              IFEND;
              add_to_component_list (first_module, last_module, ^xdcl_list, file_descriptor, last_xdcl,
                    sorted_xdcl_list, sorted_xdcl_list_size, number_of_xdcls, sorted_xref_list,
                    sorted_xref_list_size, number_of_xrefs, nlm^.description^.bound_module_header^.
                    identification, nlm^.changed_info^.starting_procedure,
                    nlm^.description^.bound_module_header^.xref_list, library_list, last_component,
                    number_of_components, object_type_checking_found, status);
              IF NOT status.normal THEN
                EXIT /valid_data_processing/;
              IFEND;
              module_node := module_node^.link;
            WHILEND;
          IFEND;
          IF object_type_checking_found THEN
            nlm^.changed_info^.cybil_parameter_checking := object_type_checking;
          IFEND;
          node := node^.link;
        WHILEND;

        IF pvt [p$gate].specified THEN
          IF pvt [p$gate].value^.kind = clc$keyword THEN

{ Gate all externals.

            last_xdcl := xdcl_list.link;
            WHILE last_xdcl <> NIL DO
              last_xdcl^.attributes := last_xdcl^.attributes +
                    $llt$entry_point_attributes [llc$gated_entry_point];
              last_xdcl := last_xdcl^.link;
            WHILEND;
          ELSE
            node := pvt [p$gate].value;
            WHILE (node <> NIL) AND (node^.element_value <> NIL) DO
              get_xdcl (node^.element_value^.program_name_value, sorted_xdcl_list, number_of_xdcls,
                    xdcl_found, external_declaration);
              IF NOT xdcl_found THEN
                osp$set_status_abnormal (oc, oce$e_xdcl_doesnt_exist, node^.element_value^.program_name_value,
                      status);
                EXIT /valid_data_processing/;
              IFEND;

              external_declaration^.attributes := external_declaration^.attributes +
                    $llt$entry_point_attributes [llc$gated_entry_point];
              node := node^.link;
            WHILEND;
          IFEND;
        IFEND;
        IF pvt [p$retain].specified THEN
          IF pvt [p$retain].value^.kind = clc$keyword THEN

{ Retain all externals.

            last_xdcl := xdcl_list.link;
            WHILE last_xdcl <> NIL DO
              last_xdcl^.attributes := last_xdcl^.attributes +
                    $llt$entry_point_attributes [llc$retain_entry_point];
              last_xdcl := last_xdcl^.link;
            WHILEND;
          ELSE
            node := pvt [p$retain].value;
            WHILE (node <> NIL) AND (node^.element_value <> NIL) DO
              get_xdcl (node^.element_value^.program_name_value, sorted_xdcl_list, number_of_xdcls,
                    xdcl_found, external_declaration);
              IF NOT xdcl_found THEN
                osp$set_status_abnormal (oc, oce$e_xdcl_doesnt_exist, node^.element_value^.program_name_value,
                      status);
                EXIT /valid_data_processing/;
              IFEND;

              external_declaration^.attributes := external_declaration^.attributes +
                    $llt$entry_point_attributes [llc$retain_entry_point];
              node := node^.link;
            WHILEND;
          IFEND;
        IFEND;

        IF pvt [p$starting_procedure].specified THEN
          get_xdcl (pvt [p$starting_procedure].value^.program_name_value, sorted_xdcl_list, number_of_xdcls,
                xdcl_found, external_declaration);
          IF NOT xdcl_found THEN
            osp$set_status_abnormal (oc, oce$e_xdcl_doesnt_exist,
                  pvt [p$starting_procedure].value^.program_name_value, status);
            EXIT /valid_data_processing/;
          IFEND;
          nlm^.changed_info^.starting_procedure := pvt [p$starting_procedure].value^.program_name_value;
        IFEND;


        nlm^.description^.bound_module_header^.preset_specified := pvt [p$preset_value].specified;
        IF pvt [p$preset_value].specified THEN
          IF pvt [p$preset_value].value^.keyword_value = 'ZERO' THEN
            nlm^.description^.bound_module_header^.preset_value := pmc$initialize_to_zero;
          ELSEIF pvt [p$preset_value].value^.keyword_value = 'FLOATING_POINT_INDEFINITE' THEN
            nlm^.description^.bound_module_header^.preset_value := pmc$initialize_to_indefinite;
          ELSEIF pvt [p$preset_value].value^.keyword_value = 'INFINITY' THEN
            nlm^.description^.bound_module_header^.preset_value := pmc$initialize_to_infinity;
          ELSE {IF pvt [p$preset_value].value^.keyword_value = 'ALTERNATE_ONES' THEN
            nlm^.description^.bound_module_header^.preset_value := pmc$initialize_to_alt_ones;
          IFEND;
        ELSE
          nlm^.description^.bound_module_header^.preset_value := pmc$initialize_to_zero;
        IFEND;

        IF pvt [p$include_binary_section_maps].specified THEN
          nlm^.description^.bound_module_header^.include_binary_section_maps :=
                pvt [p$include_binary_section_maps].value^.boolean_value.value;
        IFEND;

        IF pvt [p$output].specified THEN
          clp$convert_string_to_file (pvt [p$output].value^.file_value^, section_map_file, status);
          IF NOT status.normal THEN
            EXIT /valid_data_processing/;
          IFEND;
          nlm^.description^.bound_module_header^.section_map.local_file_name :=
                section_map_file.local_file_name;
        ELSE
          nlm^.description^.bound_module_header^.section_map.local_file_name := osc$null_name;
        IFEND;

        IF pvt [p$application_identifier].specified THEN

          avp$get_capability (avc$application_administration, avc$user, application_administrator, status);
          IF NOT status.normal THEN
            EXIT /valid_data_processing/;
          IFEND;
          IF NOT application_administrator THEN
            osp$set_status_condition (oce$not_application_administrtr, status);
            EXIT /valid_data_processing/;
          IFEND;

          ALLOCATE nlm^.changed_info^.application_identifier IN ocv$olg_working_heap^;
          nlm^.changed_info^.application_identifier^.name := pvt [p$application_identifier].value^.name_value;
        IFEND;


        nlm^.changed_info^.entry_points := xdcl_list.link;
        nlm^.changed_info^.library_list := library_list.link;

        IF number_of_components >= llc$max_components THEN
          osp$set_status_condition (oce$e_too_many_components, status);
          EXIT /valid_data_processing/;
        IFEND;

        last_component := component_list.link;

        ALLOCATE nlm^.description^.bound_module_header^.components: [1 .. number_of_components] IN
              ocv$olg_working_heap^;
        IF nlm^.description^.bound_module_header^.components = NIL THEN
          osp$set_status_condition (oce$e_internal_olg_seg_overflow, status);
          RETURN;
        IFEND;
        FOR component_number := 1 TO number_of_components DO
          nlm^.description^.bound_module_header^.components^ [component_number] :=
                last_component^.module_description;
          last_component := last_component^.link;
          component_list.link := last_component;
        FOREND;



        ocp$add_an_nlm (ocv$nlm_list^.b_link, nlm);

        EXIT /protect/; { Normal return is from here.

      END /valid_data_processing/;



      FREE nlm IN ocv$olg_working_heap^;
    END /protect/;
    pmp$disestablish_cond_handler (established_conditions, ignore_status);

  PROCEND ocp$_create_module;

MODEND ocm$create_module;

