?? RIGHT := 110 ??
?? NEWTITLE := 'NOS/VE : Loader : Executive' ??
MODULE lom$loader_executive;

{  PURPOSE:
{    This module contains executive components which exercise high level control and coordination for
{    loader processes.

?? NEWTITLE := 'Global Declarations Referenced by This Module', EJECT ??
?? PUSH (LISTEXT := ON) ??
*copyc amt$file_access_selections
*copyc amt$file_byte_address
*copyc amt$file_identifier
*copyc amt$local_file_name
*copyc amt$segment_pointer
*copyc amt$term_option
*copyc cyd$cybil_structure_definitions
*copyc cyd$run_time_error_condition
*copyc fst$file_reference
*copyc lle$load_map_diagnostics
*copyc lle$loader_status_conditions
*copyc loc$deferred_entry_pt_library
*copyc loc$task_services_library_name
*copyc loe$abort_load
*copyc loe$map_malfunction
*copyc lot$deferred_library_list
*copyc lot$loader_options
*copyc lot$loader_type_definitions
*copyc osd$code_base_pointer
*copyc oss$job_paged_literal
*copyc ost$caller_identifier
*copyc ost$status
*copyc pmc$default_user_stack_size
*copyc pme$execution_exceptions
*copyc pme$insufficient_privilege
*copyc pme$program_services_exceptions
*copyc pmt$loaded_address
*copyc pmt$loader_seq_descriptor
*copyc sft$audit_information
?? POP ??
*copyc amp$get_file_attributes
*copyc amp$put_next
*copyc avp$ring_nominal
*copyc avp$security_option_active
*copyc clp$convert_integer_to_string
*copyc clp$convert_str_to_path_handle
*copyc fsp$change_segment_number
*copyc fsp$close_file
*copyc fsp$open_file
*copyc lop$activate_library
*copyc lop$add_deferred_common_blocks
*copyc lop$add_program_load_libraries
*copyc lop$add_unsatisfied_ref_to_list
*copyc lop$augment_dynamic_loaded_eps
*copyc lop$deactivate_library
*copyc lop$defix_program_segment_attr
*copyc lop$determine_initial_ring
*copyc lop$establish_transfer_symbol
*copyc lop$find_entry_point_residence
*copyc lop$find_linkage_name_lists
*copyc lop$find_matching_entry_point
*copyc lop$finish_load_map
*copyc lop$fix_program_segment_attr
*copyc lop$gen_init_intercept_linkage
*copyc lop$generate_cross_refernce_map
*copyc lop$generate_load_map_text
*copyc lop$generate_segment_map
*copyc lop$initialize_apd_processing
*copyc lop$initialize_load_map
*copyc lop$load_module
*copyc lop$load_module_list
*copyc lop$load_object_files
*copyc lop$reinitialize_module
*copyc lop$release_transient_segments
*copyc lop$reserve_storage
*copyc lop$satisfy_externals
*copyc lop$search_entry_pt_dictionary
*copyc lop$store_intercept_linkage
*copyc lop$store_linkage
*copyc mmp$fetch_segment_attributes
*copyc osp$append_status_integer
*copyc osp$append_status_parameter
*copyc osp$format_message
*copyc osp$generate_message
*copyc osp$get_status_severity
*copyc osp$set_status_abnormal
*copyc osp$set_status_from_condition
*copyc pmp$continue_to_cause
*copyc pmp$disestablish_cond_handler
*copyc pmp$establish_condition_handler
*copyc pmp$exit
*copyc pmp$find_prog_options_and_libs
*copyc pmp$get_entry_point_dictionary
*copyc pmp$intercept_call_procedure
*copyc pmp$log
*copyc sfp$emit_audit_statistic
*copyc lov$apd_load
*copyc lov$common_blocks
*copyc lov$deferred_common_blocks
*copyc lov$deferred_entry_points
*copyc lov$dynamic_loaded_entry_points
*copyc lov$head_of_unsat_ref_list
*copyc osv$task_private_heap
?? OLDTITLE ??
?? NEWTITLE := 'Global Declarations Declared by This Module', EJECT ??

  VAR

{!  Use the following when CYBIL supports UPPERVALUE in initialization expressions:
{!    lov$diagnostic_count: [XDCL] array [ost$status_severity] of 0 .. 0ffff(16) := [REP (ORD
{(UPPERVALUE
{!      (ost$status_severity)) + 1) of 0];

    lov$diagnostic_count: [XDCL] array [ost$status_severity] of 0 .. 0ffff(16) := [REP 5 of 0];

  VAR
    lov$secondary_status: [XDCL] ost$status := [TRUE];

  VAR
    lov$file_descriptors: [XDCL] ^array [1 .. * ] of lot$file_descriptor := NIL,
    lov$loader_options: [XDCL] lot$loader_options := ['loadmap', $pmt$load_map_options [pmc$no_load_map],
          pmc$warning_load_errors, 0, pmc$default_user_stack_size, * ];

  VAR
    map_malfunction: [STATIC, READ, oss$job_paged_literal] pmt$condition :=
          [pmc$user_defined_condition, loe$map_malfunction],
    termination_conditions: [STATIC, READ, oss$job_paged_literal] pmt$condition :=
          [pmc$condition_combination, $pmt$condition_combination
          [pmc$system_conditions, mmc$segment_access_condition, pmc$user_defined_condition]];

  VAR
    access_selections: [STATIC, READ, oss$job_paged_literal] array
          [1 .. 2] of fst$attachment_option := [[fsc$access_and_share_modes,
          [fsc$specific_access_modes, [fsc$shorten, fsc$append]], [fsc$required_share_modes]],
          [fsc$access_and_share_modes, [fsc$specific_access_modes, [fsc$append]],
          [fsc$required_share_modes]]],
    error_file_id: [STATIC] amt$file_identifier,
    error_file_name: [STATIC, READ, oss$job_paged_literal] amt$local_file_name := '$ERRORS',
    error_file_opened: [STATIC] boolean := FALSE,
    list_modules: [STATIC] boolean := FALSE,
    first_severity_to_check: [STATIC] ost$status_severity,
    lop$load_program_can_be_called: [STATIC] boolean := TRUE,
    loader_running: [STATIC] boolean := TRUE;

  CONST
    loc$referenced_by_dynamic_load = '***** DYNAMIC LOAD *****       ';

  VAR

{   The following variable controls the fixing and defixing of program segment
{   attributes during dynamic load (pmp$load and lop$load_entry_point):
{     TRUE: program load is active - do not fix or defix program segment attributes
{           during dynamic load;
{     FALSE: program load is not active - fix and defix program segment attributes
{            during dynamic load.

    lov$program_load: [STATIC] boolean := FALSE;

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

{ PURPOSE:
{   The purpose of this request is to find the address of a previously
{   dynamically loaded entry point.

  PROCEDURE find_dynamic_loaded_ep
    (    name: pmt$program_name;
         reference_ring: ost$valid_ring;
     VAR entry_point_found: boolean;
     VAR address: pmt$loaded_address);

    VAR
      temp: integer,
      hi: ost$non_negative_integers,
      lo: ost$non_negative_integers,
      mid: ost$non_negative_integers;


    entry_point_found := FALSE;

    IF lov$dynamic_loaded_entry_points = NIL THEN
      RETURN;
    IFEND;

    hi := lov$dynamic_loaded_entry_points^.number_of_entry_points;
    lo := 1;

    WHILE (lo <= hi) AND NOT entry_point_found DO
      temp := lo + hi;
      mid := temp DIV 2;
      IF name = lov$dynamic_loaded_entry_points^.container^ [mid].program_name THEN
        IF reference_ring = lov$dynamic_loaded_entry_points^.container^ [mid].reference_ring THEN
          entry_point_found := TRUE;
        ELSEIF reference_ring < lov$dynamic_loaded_entry_points^.container^ [mid].reference_ring THEN
          hi := mid - 1;
        ELSE
          lo := mid + 1;
        IFEND;

      ELSEIF name < lov$dynamic_loaded_entry_points^.container^ [mid].program_name THEN
        hi := mid - 1;
      ELSE
        lo := mid + 1;
      IFEND;
    WHILEND;

    IF entry_point_found THEN
      address := lov$dynamic_loaded_entry_points^.container^ [mid].loaded_address;
    IFEND;

  PROCEND find_dynamic_loaded_ep;
?? OLDTITLE ??
?? NEWTITLE := 'record_dynamic_loaded_ep', EJECT ??

{ PURPOSE:
{   The purpose of this request is to save the address of a dynamically loaded
{   entry point.  The saved reference may then be used again later if needed.

  PROCEDURE record_dynamic_loaded_ep
    (    name: pmt$program_name;
         reference_ring: ost$valid_ring;
         address: pmt$loaded_address);

    VAR
      temp: integer,
      entry_point: ost$non_negative_integers,
      hi: ost$non_negative_integers,
      lo: ost$non_negative_integers,
      mid: ost$non_negative_integers;


    IF lov$dynamic_loaded_entry_points = NIL THEN
      lop$augment_dynamic_loaded_eps;
    ELSE
      IF lov$dynamic_loaded_entry_points^.number_of_entry_points =
            UPPERBOUND (lov$dynamic_loaded_entry_points^.container^) THEN
        lop$augment_dynamic_loaded_eps;
      IFEND;
    IFEND;

    hi := lov$dynamic_loaded_entry_points^.number_of_entry_points;
    lo := 1;

    WHILE (lo <= hi) DO
      temp := lo + hi;
      mid := temp DIV 2;
      IF name = lov$dynamic_loaded_entry_points^.container^ [mid].program_name THEN
        IF reference_ring = lov$dynamic_loaded_entry_points^.container^ [mid].reference_ring THEN

{ Should never get here.

        ELSEIF reference_ring < lov$dynamic_loaded_entry_points^.container^ [mid].reference_ring THEN
          hi := mid - 1;
        ELSE
          lo := mid + 1;
        IFEND;

      ELSEIF name < lov$dynamic_loaded_entry_points^.container^ [mid].program_name THEN
        hi := mid - 1;
      ELSE
        lo := mid + 1;
      IFEND;
    WHILEND;

    FOR entry_point := lov$dynamic_loaded_entry_points^.number_of_entry_points DOWNTO lo DO
      lov$dynamic_loaded_entry_points^.container^ [entry_point + 1] := lov$dynamic_loaded_entry_points^.
            container^ [entry_point];
    FOREND;
    lov$dynamic_loaded_entry_points^.number_of_entry_points :=
          lov$dynamic_loaded_entry_points^.number_of_entry_points + 1;

    lov$dynamic_loaded_entry_points^.container^ [lo].program_name := name;
    lov$dynamic_loaded_entry_points^.container^ [lo].reference_ring := reference_ring;
    lov$dynamic_loaded_entry_points^.container^ [lo].loaded_address := address;

  PROCEND record_dynamic_loaded_ep;
?? OLDTITLE ??
?? NEWTITLE := 'remove_dynamic_loaded_ep', EJECT ??

{ PURPOSE:
{   The purpose of this request is to find the specified entry in the dynamically
{   loaded entry point list, and remove it.

  PROCEDURE remove_dynamic_loaded_ep
    (    name: pmt$program_name;
         loaded_ring: ost$valid_ring;
         call_bracket: ost$valid_ring);

    VAR
      temp: integer,
      entry_point: ost$non_negative_integers,
      entry_point_found: boolean,
      hi: ost$non_negative_integers,
      lo: ost$non_negative_integers,
      mid: ost$non_negative_integers;


    entry_point_found := FALSE;

    IF lov$dynamic_loaded_entry_points = NIL THEN
      RETURN;
    IFEND;

    hi := lov$dynamic_loaded_entry_points^.number_of_entry_points;
    lo := 1;

    WHILE (lo <= hi) AND NOT entry_point_found DO
      temp := lo + hi;
      mid := temp DIV 2;
      IF name = lov$dynamic_loaded_entry_points^.container^ [mid].program_name THEN
        entry_point_found := TRUE;
      ELSEIF name < lov$dynamic_loaded_entry_points^.container^ [mid].program_name THEN
        hi := mid - 1;
      ELSE
        lo := mid + 1;
      IFEND;
    WHILEND;

    IF entry_point_found THEN

{ Find the entry point whose reference ring fits the call bracket.

      WHILE (mid >= 1) AND (mid <= lov$dynamic_loaded_entry_points^.number_of_entry_points) AND
            (lov$dynamic_loaded_entry_points^.container^ [mid].program_name = name) DO
        IF (lov$dynamic_loaded_entry_points^.container^ [mid].reference_ring >= loaded_ring) THEN
          IF (lov$dynamic_loaded_entry_points^.container^ [mid].reference_ring <= call_bracket) THEN

            FOR entry_point := (mid + 1) TO lov$dynamic_loaded_entry_points^.number_of_entry_points DO
              lov$dynamic_loaded_entry_points^.container^ [entry_point - 1] :=
                    lov$dynamic_loaded_entry_points^.container^ [entry_point];
            FOREND;
            lov$dynamic_loaded_entry_points^.number_of_entry_points :=
                  lov$dynamic_loaded_entry_points^.number_of_entry_points - 1;
            RETURN;
          ELSE
            mid := mid - 1;
          IFEND;
        ELSE
          mid := mid + 1;
        IFEND;
      WHILEND;
    IFEND;

  PROCEND remove_dynamic_loaded_ep;
?? OLDTITLE ??


?? NEWTITLE := '[XDCL] lop$reset_loader_for_2nd_load', EJECT ??

  PROCEDURE [XDCL] lop$reset_loader_for_2nd_load
    (VAR status: ost$status);

    VAR
      i: ost$status_severity;

    status.normal := TRUE;

    IF NOT loader_running THEN
      osp$set_status_abnormal ('LL', lle$loader_stopped, '', status);
      RETURN;
    IFEND;

    FOR i := LOWERVALUE (ost$status_severity) TO UPPERVALUE (ost$status_severity) DO
      lov$diagnostic_count [i] := 0;
    FOREND;

    lop$load_program_can_be_called := TRUE;

  PROCEND lop$reset_loader_for_2nd_load;
?? OLDTITLE ??
?? NEWTITLE := '[XDCL] lop$load_program' ??

{  PURPOSE:
{    This procedure is the executive component of the program load process.  It is responsible for
{    controlling and coordinating the loading of a program in response to an execute request.

  PROCEDURE [XDCL] lop$load_program
    (    object_file_list: ^pmt$object_file_list;
         module_list: ^pmt$module_list;
         execute_library_list: ^pmt$object_library_list;
         job_library_list: ^pmt$object_library_list;
         starting_procedure: pmt$program_name;
         target_ring: ost$ring;
         loader_options_value: lot$loader_options;
         mpe_description: ^pmt$loader_description;
     VAR loaded_program_cbp: ^ost$external_code_base_pointer;
     VAR status {control} : ost$status);

    VAR
      finish_load_map: boolean;

    CONST
      normal_termination = TRUE,
      premature_termination = FALSE;

?? NEWTITLE := 'load_map_malfunction', EJECT ??

{  PURPOSE:
{     The purpose of this condition handler is to terminate the task if
{     initialize or generate load map detects an unexpected abnormal status
{     from a NOS/VE request - the task exits with the unexpected status.

    PROCEDURE load_map_malfunction
      (    condition: pmt$condition;
           system_status: ^pmt$condition_information;
           save_area: ^ost$stack_frame_save_area;
       VAR status: ost$status);

      VAR
        malfunction: ^ost$status;

      malfunction := system_status;
      pmp$exit (malfunction^);

    PROCEND load_map_malfunction;
?? OLDTITLE ??
?? NEWTITLE := 'terminate_prematurely', EJECT ??

{   PURPOSE:
{      Circumstances may arise within the loader which cause premature termination
{      of the load process.  These circumstances are reported within the loader via
{      conditions.  This condition handler is responsible for fielding the condition;
{      reporting the abnormality; and prematurely terminating the load process.
{
{      The conditions and their meanings are:
{      1.  system conditions: the hardware detected a condition which is probably
{          caused by a loader coding error.  The specific condition is reported to
{          the output file and the task is terminated with the loader malfunctioned
{          exception code.  SEE: code for pmc$detected_uncorrected_err processing.
{      2.  segment access conditions:
{          a. mmc$sac_read_beyond_eoi, mmc$sac_segment_access_error,
{             mmc$sac_key_lock_violation, mmc$sac_ring_violation:
{             segment management detected an inconsistency which was probably
{             caused by a loader coding error.  The specific condition is reported
{             to the output file and the task is terminated with the loader
{             malfunctioned exception code.
{          b. mmc$sac_read_write_beyond_msl: user limits prevented the loader from
{             completing the load process.  The task is terminated with the
{             insufficient memory to load exception code.
{          c. mmc$sac_io_read_error: a hardware error was detected attempting to
{             read a page from a device.  The specific condition is reported to
{             the output file and the task is terminated with the premature load
{             termination exception code.
{      3.  user defined conditions:
{          a. cye$run_time_condition: the CYBIL run time checking detected an
{             error which was probably cause by a loader coding error.  The
{             specific condition is reported to the output file and the task is
{             terminated with loader malfunctioned exception code.
{          b. loe$abort_load: several constituent procedures of the loader detect
{             circumstances which prohibit continuation of the load process.  The
{             detecting procedure reports the circumstance to load map and causes
{             the loe$abort_load condition.  This condition handler terminates the
{             task with the premature load termination exception code.
{          c. loe$loader_malfunction: a constituent procedure of the loader
{             detected an inconsistency which probably was caused by a loader
{             coding error.  The detecting procedure causes the condition
{             pointing to a status variable which identifies the inconsistency.
{             This condition handler reports the identified inconsistency to
{             the output file and terminates the task with the loader malfunctioned
{             exception code.
{          d. loe$insufficient_memory: several constituent procedures of the
{             loader detect circumstances where there is not enough virtual memory
{             to complete the load process - this is generally a case of user
{             limit being exceeded.  The detecting procedure reports the shortage
{             to the load map and causes the condition.  This condition handler
{             terminates the task with insufficient memory to load exception code.
{          e. other: other user defined conditions will be continued and
{             otherwise ignored.
{

    PROCEDURE terminate_prematurely
      (    condition: pmt$condition;
           malfunction_status: ^pmt$condition_information;
           save_area: ^ost$stack_frame_save_area;
       VAR condition_status: ost$status);

      VAR
        termination_descriptor: pmt$established_handler,
        cybil_error: ^ost$status,
        malfunction: ^ost$status,
        message: ost$status;

      CASE condition.selector OF
      = pmc$system_conditions =
        osp$set_status_from_condition ('LL', condition, save_area, message, condition_status);
        IF NOT (pmc$detected_uncorrected_err IN condition.system_conditions) THEN
          osp$generate_message (message, condition_status);
          osp$set_status_abnormal ('LL', lle$loader_malfunctioned, 'PROGRAM', status);
        ELSE
          status := message;
        IFEND;
      = mmc$segment_access_condition =
        CASE condition.segment_access_condition.identifier OF
        = mmc$sac_read_beyond_eoi, mmc$sac_segment_access_error, mmc$sac_key_lock_violation,
              mmc$sac_ring_violation =
          osp$set_status_from_condition ('LL', condition, save_area, message, condition_status);
          osp$generate_message (message, condition_status);
          osp$set_status_abnormal ('LL', lle$loader_malfunctioned, 'PROGRAM', status);
        = mmc$sac_read_write_beyond_msl =
          osp$set_status_abnormal ('LL', lle$insufficient_memory_to_load, '', status);
        = mmc$sac_io_read_error =
          osp$set_status_from_condition ('LL', condition, save_area, message, condition_status);
          osp$generate_message (message, condition_status);
          osp$set_status_abnormal ('LL', lle$premature_load_termination, 'Program', status);
        ELSE
          osp$set_status_from_condition ('LL', condition, save_area, message, condition_status);
          osp$generate_message (message, condition_status);
          osp$set_status_abnormal ('LL', lle$premature_load_termination, 'Program', status);
        CASEND;
      = pmc$user_defined_condition =
        IF (condition.user_condition_name = cye$run_time_condition) THEN
          cybil_error := malfunction_status;
          osp$generate_message (cybil_error^, condition_status);
          osp$set_status_abnormal ('LL', lle$loader_malfunctioned, 'PROGRAM', status);
        ELSEIF (condition.user_condition_name = loe$abort_load) THEN
          osp$set_status_abnormal ('LL', lle$premature_load_termination, 'Program', status);
        ELSEIF (condition.user_condition_name = loe$loader_malfunction) THEN
          malfunction := malfunction_status;
          osp$generate_message (malfunction^, condition_status);
          osp$set_status_abnormal ('LL', lle$loader_malfunctioned, 'PROGRAM', status);
        ELSEIF (condition.user_condition_name = loe$insufficient_memory) THEN
          osp$set_status_abnormal ('LL', lle$insufficient_memory_to_load, '', status);
        ELSE
          pmp$continue_to_cause (pmc$execute_standard_procedure, condition_status);
          RETURN;
        IFEND;
      ELSE
        pmp$continue_to_cause (pmc$execute_standard_procedure, condition_status);
        RETURN;
      CASEND;
      IF finish_load_map THEN
        finish_load_map := FALSE;
        pmp$establish_condition_handler (termination_conditions, ^terminate_prematurely,
              ^termination_descriptor, condition_status);
        lop$finish_load_map (control_options.map, transfer_descriptor, premature_termination);
      IFEND;
      EXIT lop$load_program;

    PROCEND terminate_prematurely;
?? OLDTITLE, EJECT ??

    VAR
      control_options: lot$control_options,
      execute_libraries: ^pmt$object_library_list,
      existing_file: boolean,
      file_reference_p: ^fst$file_reference,
      i: integer,
      ignore_attributes: array [1 .. 1] of amt$get_item,
      ignore_contains_data: boolean,
      ignore_local_file: boolean,
      initial_ring: ost$valid_ring,
      malfunction_descriptor: pmt$established_handler,
      map_ring_attributes: amt$ring_attributes,
      module_name: pmt$program_name,
      nominal_ring: ost$ring,
      num_of_execute_libraries: pmt$number_of_libraries,
      operation_information_p: ^sft$audit_information,
      operation_status_p: ^ost$status,
      reference_descriptor: lot$reference_descriptor,
      starting_procedure_ring: ost$valid_ring,
      termination_descriptor: pmt$established_handler,
      transfer_descriptor: lot$external_descriptor,
      transfer_symbol_defined: boolean;

    CONST
      loc$run_time_library_name = 'cyf$run_time_library';

    IF NOT lop$load_program_can_be_called THEN
      osp$set_status_abnormal ('LL', lle$cant_call_lop$load_program, '', status);
      RETURN;
    IFEND;
    lop$load_program_can_be_called := FALSE;

    CASE loader_options_value.termination_error_level OF
    = pmc$warning_load_errors =
      first_severity_to_check := osc$warning_status;
    = pmc$error_load_errors =
      first_severity_to_check := osc$error_status;
    = pmc$fatal_load_errors =
      first_severity_to_check := osc$fatal_status;
    CASEND;



    lov$secondary_status.normal := TRUE;
    finish_load_map := FALSE;

    pmp$establish_condition_handler (termination_conditions, ^terminate_prematurely, ^termination_descriptor,
          status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    IF ((loader_options_value.map <> $pmt$load_map_options [pmc$no_load_map]) AND
          (loader_options_value.map <> $pmt$load_map_options [])) THEN
      pmp$establish_condition_handler (map_malfunction, ^load_map_malfunction, ^malfunction_descriptor,
            status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
      ignore_attributes [1].key := amc$null_attribute;
      amp$get_file_attributes (loader_options_value.map_file, ignore_attributes, ignore_local_file,
            existing_file, ignore_contains_data, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
      nominal_ring := avp$ring_nominal ();
      IF (existing_file OR (nominal_ring > target_ring)) THEN
        map_ring_attributes.r1 := nominal_ring;
        map_ring_attributes.r2 := nominal_ring;
        map_ring_attributes.r3 := nominal_ring;
      ELSE
        map_ring_attributes.r1 := target_ring;
        map_ring_attributes.r2 := target_ring;
        map_ring_attributes.r3 := target_ring;
      IFEND;
      lop$initialize_load_map (loader_options_value.map_file, map_ring_attributes, status);
      lov$loader_options := loader_options_value;
      IF status.normal THEN
        finish_load_map := TRUE;
      ELSE

{turn off load map generation - the load map is inaccessible.

        lov$loader_options.map := $pmt$load_map_options [pmc$no_load_map];
        status.normal := TRUE;
      IFEND;
    ELSE
      lov$loader_options := loader_options_value;
    IFEND;
    control_options.map := lov$loader_options.map;
    control_options.debug_ring := lov$loader_options.debug_ring;
    transfer_descriptor.name := osc$null_name;
    transfer_descriptor.global_key := loc$master_key;
    transfer_descriptor.reference_ring := osc$max_ring;
    IF object_file_list <> NIL THEN
      ALLOCATE lov$file_descriptors: [1 .. UPPERBOUND (object_file_list^)] IN osv$task_private_heap^;
    IFEND;
    IF execute_library_list = NIL THEN
      num_of_execute_libraries := 1;
    ELSE
      num_of_execute_libraries := UPPERBOUND (execute_library_list^) + 1;
    IFEND;
    PUSH execute_libraries: [1 .. num_of_execute_libraries];
    execute_libraries^ [num_of_execute_libraries] := loc$task_services_library_name;
    IF execute_library_list <> NIL THEN
      FOR i := 1 TO UPPERBOUND (execute_library_list^) DO
        execute_libraries^ [i] := execute_library_list^ [i];
      FOREND;
    IFEND;
    lop$add_program_load_libraries (execute_libraries, job_library_list, {deferred_libraries} NIL);
    lop$determine_initial_ring (object_file_list, execute_library_list, target_ring, initial_ring,
          starting_procedure_ring, lov$file_descriptors);
    lop$defix_program_segment_attr;
    IF (mpe_description <> NIL) AND (mpe_description^.apd_load) THEN
      lop$initialize_apd_processing (mpe_description);
    IFEND;
    lov$program_load := TRUE;
    IF object_file_list <> NIL THEN
      lop$load_object_files (lov$file_descriptors, initial_ring, control_options, transfer_descriptor);
    IFEND;
    IF module_list <> NIL THEN
      lop$load_module_list (module_list, initial_ring, control_options, transfer_descriptor);
    IFEND;
    loaded_program_cbp := NIL;
    lop$establish_transfer_symbol (starting_procedure, starting_procedure_ring, transfer_descriptor,
          reference_descriptor, loaded_program_cbp);
    lop$satisfy_externals (control_options);
    IF (mpe_description <> NIL) AND (mpe_description^.apd_load) THEN
      lop$gen_init_intercept_linkage (transfer_descriptor, reference_descriptor.details);
    IFEND;
    lop$release_transient_segments (control_options);
    lop$fix_program_segment_attr;
    lov$program_load := FALSE;
    finish_load_map := FALSE;
    lop$finish_load_map (control_options.map, transfer_descriptor, normal_termination);
    IF avp$security_option_active (avc$vso_security_audit) THEN
      PUSH file_reference_p: [fsc$max_path_size];
      lop$find_entry_point_residence (transfer_descriptor.name, starting_procedure_ring, module_name,
            file_reference_p^, status);
      PUSH operation_information_p;
      operation_information_p^.audited_operation := sfc$ao_job_execute_program;
      operation_information_p^.execute_program.program_name_p := ^transfer_descriptor.name;
      PUSH operation_status_p;
      IF status.normal THEN
        operation_status_p^.normal := TRUE;
        operation_information_p^.execute_program.module_name_p := ^module_name;
        operation_information_p^.execute_program.library_name_p := file_reference_p;
        operation_information_p^.execute_program.loaded_ring := starting_procedure_ring;
      ELSE

{ Lop$find_entry_point_residence returned an abnormal status; most likely this was caused
{ by a load error involving the starting procedure.  Try to be as specific about the
{ error condition as possible.

        operation_status_p^.normal := FALSE;
        IF transfer_descriptor.name = osc$null_name THEN
          operation_status_p^.condition := lle$transfer_symbol_missing;
        ELSE
          operation_status_p^.condition := lle$transfer_symbol_undefined;
        IFEND;
        operation_information_p^.execute_program.module_name_p := NIL;
        operation_information_p^.execute_program.library_name_p := NIL;
        operation_information_p^.execute_program.loaded_ring := osc$invalid_ring;
      IFEND;
      check_diagnostic_severity (status);
      IF (NOT status.normal) AND operation_status_p^.normal THEN

{ There was a load error but the starting procedure was found.

        operation_status_p^.normal := FALSE;
        operation_status_p^.condition := status.condition;
      IFEND;
      sfp$emit_audit_statistic (operation_information_p^, operation_status_p^);
    ELSE
      check_diagnostic_severity (status);
    IFEND;

  PROCEND lop$load_program;
?? OLDTITLE ??
?? NEWTITLE := '[XDCL, #GATE] pmp$establish_segment_access', EJECT ??
*copy pmh$establish_segment_access

  PROCEDURE [XDCL, #GATE] pmp$establish_segment_access
    (    file_identifier: amt$file_identifier,
         common_block: pmt$program_name;
     VAR segment_pointer: amt$segment_pointer;
     VAR status: ost$status);

    VAR
      index: lot$common_blocks_index,
      kind: amt$pointer_kind,
      caller_id: ost$caller_identifier,
      found: boolean;

    status.normal := TRUE;
    #CALLER_ID (caller_id);
    found := FALSE;

    IF lov$common_blocks <> NIL THEN

    /find_common_block/
      FOR index := 1 TO UPPERBOUND (lov$common_blocks^) DO
        IF lov$common_blocks^ [index].name = common_block THEN
          found := TRUE;
          EXIT /find_common_block/;
        IFEND;
      FOREND /find_common_block/;
    IFEND;

    IF (NOT found) OR (NOT lov$common_blocks^ [index].unallocated_common) THEN
      osp$set_status_abnormal ('PM', pme$common_not_unallocated, common_block, status);
      RETURN;
    IFEND;

    IF lov$common_blocks^ [index].unallocated_common_open THEN
      osp$set_status_abnormal ('PM', pme$common_file_open, common_block, status);
      RETURN;
    IFEND;

    kind := amc$cell_pointer;
    fsp$change_segment_number (file_identifier, lov$common_blocks^ [index].unallocated_common_segment,
          caller_id.ring, kind, segment_pointer, status);

    IF status.normal THEN
      lov$common_blocks^ [index].unallocated_common_open := TRUE;
      lov$common_blocks^ [index].unallocated_common_file_id := file_identifier;
    IFEND;

  PROCEND pmp$establish_segment_access;
?? OLDTITLE ??
?? NEWTITLE := '[XDCL, #GATE] pmp$disestablish_segment_access', EJECT ??
*copy pmh$disestablish_segment_access

  PROCEDURE [XDCL, #GATE] pmp$disestablish_segment_access
    (    common_block: pmt$program_name;
     VAR status: ost$status);

    VAR
      found: boolean,
      index: lot$common_blocks_index;

    status.normal := TRUE;
    found := FALSE;
    IF lov$common_blocks <> NIL THEN

    /find_common_block/
      FOR index := 1 TO UPPERBOUND (lov$common_blocks^) DO
        IF lov$common_blocks^ [index].name = common_block THEN
          found := TRUE;
          EXIT /find_common_block/;
        IFEND;
      FOREND /find_common_block/;
    IFEND;

    IF (NOT found) OR (NOT lov$common_blocks^ [index].unallocated_common) THEN
      osp$set_status_abnormal ('PM', pme$common_not_unallocated, common_block, status);
      RETURN;
    IFEND;

    IF NOT lov$common_blocks^ [index].unallocated_common_open THEN
      osp$set_status_abnormal ('PM', pme$common_file_not_open, common_block, status);
      RETURN;
    IFEND;

    lov$common_blocks^ [index].unallocated_common_open := FALSE;

  PROCEND pmp$disestablish_segment_access;
?? OLDTITLE ??
?? NEWTITLE := '[XDCL, #GATE] pmp$close_common_block_file', EJECT ??
*copy pmh$close_common_block_file

  PROCEDURE [XDCL, #GATE] pmp$close_common_block_file
    (    common_block: pmt$program_name;
     VAR status: ost$status);

    VAR
      found: boolean,
      ignore_status: ost$status,
      index: lot$common_blocks_index;

    status.normal := TRUE;
    found := FALSE;
    IF lov$common_blocks <> NIL THEN

    /find_common_block/
      FOR index := 1 TO UPPERBOUND (lov$common_blocks^) DO
        IF lov$common_blocks^ [index].name = common_block THEN
          found := TRUE;
          EXIT /find_common_block/;
        IFEND;
      FOREND /find_common_block/;
    IFEND;

    IF (NOT found) OR (NOT lov$common_blocks^ [index].unallocated_common) THEN
      osp$set_status_abnormal ('PM', pme$common_not_unallocated, common_block, status);
      RETURN;
    IFEND;

    IF NOT lov$common_blocks^ [index].unallocated_common_open THEN
      osp$set_status_abnormal ('PM', pme$common_file_not_open, common_block, status);
      RETURN;
    IFEND;

    fsp$close_file (lov$common_blocks^ [index].unallocated_common_file_id, status);

    pmp$disestablish_segment_access (common_block, ignore_status);

  PROCEND pmp$close_common_block_file;
?? OLDTITLE ??
?? NEWTITLE := '[XDCL, #GATE] pmp$remove_entry_point', EJECT ??
*copy pmh$remove_entry_point

  PROCEDURE [XDCL, #GATE] pmp$remove_entry_point
    (    name: pmt$program_name;
     VAR status {control} : ost$status);

    VAR
      entry_point_defined: boolean,
      definition: ^lot$entry_definition,
      prior_definition: ^lot$entry_definition,
      linkage: ^lot$linkage_name_lists,
      caller_id: ost$caller_identifier;


    #CALLER_ID (caller_id);
    status.normal := TRUE;
    entry_point_defined := FALSE;

    lop$find_linkage_name_lists (name, linkage);

    prior_definition := NIL;
    definition := linkage^.definitions_list;

  /find_entry_point/
    WHILE definition <> NIL DO
      IF ((caller_id.global_key = definition^.attributes.global_lock) OR
            (definition^.attributes.gated AND ((definition^.attributes.global_lock = loc$no_lock) OR
            (caller_id.global_key = loc$master_key)))) AND ((caller_id.ring >=
            definition^.attributes.loaded_ring) AND (caller_id.ring <= definition^.attributes.call_bracket))
            THEN
        entry_point_defined := TRUE;
        EXIT /find_entry_point/;
      IFEND;
      prior_definition := definition;
      definition := definition^.nnext;
    WHILEND /find_entry_point/;

    IF entry_point_defined THEN
      remove_dynamic_loaded_ep (name, definition^.attributes.loaded_ring,
            definition^.attributes.call_bracket);
      IF prior_definition <> NIL THEN
        prior_definition^.nnext := definition^.nnext;
      ELSE
        linkage^.definitions_list := NIL;
      IFEND;
    ELSE
      osp$set_status_abnormal ('PM', pme$unknown_entry_point, name, status);
    IFEND;

  PROCEND pmp$remove_entry_point;
?? OLDTITLE ??
?? NEWTITLE := '[XDCL, #GATE] pmp$load', EJECT ??
*copy pmh$load

  PROCEDURE [XDCL, #GATE] pmp$load
    (    name: pmt$program_name;
         kind: pmt$loaded_address_kind;
     VAR address: pmt$loaded_address;
     VAR status {control} : ost$status);

    VAR
      caller_id: ost$caller_identifier;


    #CALLER_ID (caller_id);

    status.normal := TRUE;
    address.kind := kind; { do minimal parameter access checking }

    lop$load_entry_point (name, caller_id.ring, 0, kind, address, status);

  PROCEND pmp$load;
?? OLDTITLE ??
?? NEWTITLE := '[XDCL, #GATE] pmp$load_entry_point', EJECT ??
*copy pmh$load_entry_point

  PROCEDURE [XDCL, #GATE] pmp$load_entry_point
    (    name: pmt$program_name;
         reference_ring: ost$valid_ring;
         reference_global_key: ost$key_lock_value;
         kind: pmt$loaded_address_kind;
     VAR address: pmt$loaded_address;
     VAR status {control} : ost$status);

    status.normal := TRUE;
    address.kind := kind; { do minimal parameter access checking }

    lop$load_entry_point (name, reference_ring, reference_global_key, kind, address, status);

  PROCEND pmp$load_entry_point;
?? OLDTITLE ??
?? NEWTITLE := '[XDCL] lop$load_entry_point', EJECT ??
*copy loh$load_entry_point

  PROCEDURE [XDCL] lop$load_entry_point
    (    name: pmt$program_name;
         reference_ring: ost$valid_ring;
         reference_global_key: ost$key_lock_value;
         kind: pmt$loaded_address_kind;
     VAR address: pmt$loaded_address;
     VAR status {control} : ost$status);

    VAR
      fix_segment_attributes: boolean;

?? NEWTITLE := 'load_map_malfunction', EJECT ??

{  PURPOSE:
{     The purpose of this condition handler is to terminate the task if
{     generate load map detects an unexpected abnormal status from a
{     NOS/VE request - the task exits with the unexpected status.

    PROCEDURE load_map_malfunction
      (    condition: pmt$condition;
           system_status: ^pmt$condition_information;
           save_area: ^ost$stack_frame_save_area;
       VAR status: ost$status);

      VAR
        malfunction: ^ost$status;

      malfunction := system_status;
      pmp$exit (malfunction^);
    PROCEND load_map_malfunction;
?? OLDTITLE ??
?? NEWTITLE := 'terminate_prematurely', EJECT ??

{   PURPOSE:
{      Circumstances may arise within the loader which cause premature termination
{      of the load process.  These circumstances are reported within the loader via
{      conditions.  This condition handler is responsible for fielding the condition;
{      reporting the abnormality; and prematurely terminating the load process.
{
{      The conditions and their meanings are:
{      1.  system conditions: the hardware detected a condition which is probably
{          caused by a loader coding error.  The specific condition is reported to
{          the output file and the task is terminated with the loader malfunctioned
{          exception code.  SEE: code for pmc$detected_uncorrected_err processing.
{      2.  segment access conditions:
{          a. mmc$sac_read_beyond_eoi, mmc$sac_segment_access_error,
{             mmc$sac_key_lock_violation, mmc$sac_ring_violation:
{             segment management detected an inconsistency which was probably
{             caused by a loader coding error.  The specific condition is reported
{             to the output file and the task is terminated with the loader
{             malfunctioned exception code.
{          b. mmc$sac_read_write_beyond_msl: user limits prevented the loader from
{             completing the load process.  The task is terminated with the
{             insufficient memory to load exception code.
{          c. mmc$sac_io_read_error: a hardware error was detected attempting to
{             read a page from a device.  The specific condition is reported to
{             the output file and the task is terminated with the premature load
{             termination exception code.
{      3.  user defined conditions:
{          a. cye$run_time_condition: the CYBIL run time checking detected an
{             error which was probably cause by a loader coding error.  The
{             specific condition is reported to the output file and the task is
{             terminated with loader malfunctioned exception code.
{          b. loe$abort_load: several constituent procedures of the loader detect
{             circumstances which prohibit continuation of the load process.  The
{             detecting procedure reports the circumstance to load map and causes
{             the loe$abort_load condition.  This condition handler terminates the
{             task with the premature load termination exception code.
{          c. loe$loader_malfunction: a constituent procedure of the loader
{             detected an inconsistency which probably was caused by a loader
{             coding error.  The detecting procedure causes the condition
{             pointing to a status variable which identifies the inconsistency.
{             This condition handler reports the identified inconsistency to
{             the output file and terminates the task with the loader malfunctioned
{             exception code.
{          d. loe$insufficient_memory: several constituent procedures of the
{             loader detect circumstances where there is not enough virtual memory
{             to complete the load process - this is generally a case of user
{             limit being exceeded.  The detecting procedure reports the shortage
{             to the load map and causes the condition.  This condition handler
{             terminates the task with insufficient memory to load exception code.
{          e. other: other user defined conditions will be continued and
{             otherwise ignored.
{

    PROCEDURE terminate_prematurely
      (    condition: pmt$condition;
           malfunction_status: ^pmt$condition_information;
           save_area: ^ost$stack_frame_save_area;
       VAR condition_status: ost$status);

      VAR
        termination_descriptor: pmt$established_handler,
        cybil_error: ^ost$status,
        malfunction: ^ost$status,
        message: ost$status;

      CASE condition.selector OF
      = pmc$system_conditions =
        osp$set_status_from_condition ('LL', condition, save_area, message, condition_status);
        IF NOT (pmc$detected_uncorrected_err IN condition.system_conditions) THEN
          osp$generate_message (message, condition_status);
          osp$set_status_abnormal ('LL', lle$loader_malfunctioned, 'ENTRY POINT', local_status);
        ELSE
          local_status := message;
        IFEND;
      = mmc$segment_access_condition =
        CASE condition.segment_access_condition.identifier OF
        = mmc$sac_read_beyond_eoi, mmc$sac_segment_access_error, mmc$sac_key_lock_violation,
              mmc$sac_ring_violation =
          osp$set_status_from_condition ('LL', condition, save_area, message, condition_status);
          osp$generate_message (message, condition_status);
          osp$set_status_abnormal ('LL', lle$loader_malfunctioned, 'ENTRY POINT', local_status);
        = mmc$sac_read_write_beyond_msl =
          osp$set_status_abnormal ('LL', lle$insufficient_memory_to_load, '', local_status);
        = mmc$sac_io_read_error =
          osp$set_status_from_condition ('LL', condition, save_area, message, condition_status);
          osp$generate_message (message, condition_status);
          osp$set_status_abnormal ('LL', lle$premature_load_termination, 'Entry Point', local_status);
        ELSE
          osp$set_status_from_condition ('LL', condition, save_area, message, condition_status);
          osp$generate_message (message, condition_status);
          osp$set_status_abnormal ('LL', lle$premature_load_termination, 'Entry Point', local_status);
        CASEND;
      = pmc$user_defined_condition =
        IF (condition.user_condition_name = cye$run_time_condition) THEN
          cybil_error := malfunction_status;
          osp$generate_message (cybil_error^, condition_status);
          osp$set_status_abnormal ('LL', lle$loader_malfunctioned, 'ENTRY POINT', local_status);
        ELSEIF (condition.user_condition_name = loe$abort_load) THEN
          osp$set_status_abnormal ('LL', lle$premature_load_termination, 'Entry Point', local_status);
        ELSEIF (condition.user_condition_name = loe$loader_malfunction) THEN
          malfunction := malfunction_status;
          osp$generate_message (malfunction^, condition_status);
          osp$set_status_abnormal ('LL', lle$loader_malfunctioned, 'ENTRY POINT', local_status);
        ELSEIF (condition.user_condition_name = loe$insufficient_memory) THEN
          osp$set_status_abnormal ('LL', lle$insufficient_memory_to_load, '', local_status);
        ELSE
          pmp$continue_to_cause (pmc$execute_standard_procedure, condition_status);
          RETURN;
        IFEND;
      ELSE
        pmp$continue_to_cause (pmc$execute_standard_procedure, condition_status);
        RETURN;
      CASEND;
      IF fix_segment_attributes THEN
        pmp$establish_condition_handler (termination_conditions, ^terminate_prematurely,
              ^termination_descriptor, condition_status);
        fix_segment_attributes := FALSE;
        lop$fix_program_segment_attr;

{disestablish terminate_prematurely's condition handler

        pmp$disestablish_cond_handler (termination_conditions, condition_status);
      IFEND;

{disestablish lop$load_entry_point's condition handler

      pmp$disestablish_cond_handler (termination_conditions, condition_status);
      pmp$exit (local_status);

    PROCEND terminate_prematurely;
?? OLDTITLE ??

*copy lov$binding_segment_attributes

    VAR
      cbp_size: ost$segment_length,
      common_blocks: ^lot$deferred_common_blocks,
      control_options: lot$control_options,
      converter: record
        case 0 .. 1 of
        = 0 =
          local_ptr_to_proc: ^procedure,
        = 1 =
          ptr_to_proc: cyt$pointer_to_procedure,
        casend,
      recend,
      deferred_entry_point_index: 0 .. 0ff(16),
      deferred_libraries: ^lot$deferred_library_list,
      entry_point_definition: ^lot$entry_definition,
      entry_point_found: boolean,
      entry_point_unaligned: boolean,
      entry_points: ^lot$deferred_entry_points,
      external_descriptor: lot$external_descriptor,
      i: ost$status_severity,
      ignored: boolean,
      j: integer,
      linkage_info: ^lot$linkage_name_lists,
      local_address: pmt$loaded_address,
      local_status: ost$status, { use local variables to protect against storing values to defixed segments }
      job_libraries: ^pmt$object_library_list,
      job_library_list: ^pmt$object_library_list,
      malfunction_descriptor: pmt$established_handler,
      match_found: boolean,
      num_of_deferred_ep_libraries: pmt$number_of_libraries,
      num_of_job_libraries: pmt$number_of_libraries,
      proc_pointer: cyt$pointer_to_procedure,
      prog_options_and_libraries: ^pmt$prog_options_and_libraries,
      reference_descriptor: lot$reference_descriptor,
      str: ost$string,
      termination_descriptor: pmt$established_handler;


     status.normal := TRUE;

    IF NOT loader_running THEN
      osp$set_status_abnormal ('LL', lle$loader_stopped, '', status);
      RETURN;
    IFEND;

    find_dynamic_loaded_ep (name, reference_ring, entry_point_found, address);
    IF entry_point_found THEN
      RETURN;
    IFEND;

    local_status.normal := TRUE;
    fix_segment_attributes := FALSE;
    pmp$establish_condition_handler (termination_conditions, ^terminate_prematurely, ^termination_descriptor,
          local_status);
    IF NOT local_status.normal THEN
      status := local_status;
      RETURN;
    IFEND;
    IF (lov$loader_options.map <> $pmt$load_map_options [pmc$no_load_map]) THEN
      pmp$establish_condition_handler (map_malfunction, ^load_map_malfunction, ^malfunction_descriptor,
            local_status);
      IF NOT local_status.normal THEN
        status := local_status;
        RETURN;
      IFEND;
    IFEND;
    local_address.kind := kind;
    FOR i := LOWERVALUE (ost$status_severity) TO UPPERVALUE (ost$status_severity) DO
      lov$diagnostic_count [i] := 0;
    FOREND;
    control_options.map := lov$loader_options.map;
    control_options.debug_ring := lov$loader_options.debug_ring;
    IF NOT lov$program_load THEN
      lop$defix_program_segment_attr;
      fix_segment_attributes := TRUE;
    IFEND;

    reference_descriptor.mmodule := loc$referenced_by_dynamic_load;

    IF kind = pmc$data_address THEN
      reference_descriptor.details.address.ring := #RING (^local_address.pointer_to_data);
      reference_descriptor.details.address.segment := #SEGMENT (^local_address.pointer_to_data);
      reference_descriptor.details.address.offset := #OFFSET (^local_address.pointer_to_data);
      reference_descriptor.details.kind := llc$address;
      reference_descriptor.details.binding_section_destination := FALSE;
      reference_descriptor.details.declaration_matching_required := FALSE;
    ELSE
      cbp_size := #SIZE (ost$external_code_base_pointer);
      lop$reserve_storage (binding_segment_attributes, 8, 0, FALSE, 0, loc$no_shadow_file, 0, cbp_size,
            reference_descriptor.details.address);
      reference_descriptor.details.kind := llc$external_proc;
      reference_descriptor.details.binding_section_destination := TRUE;
      reference_descriptor.details.declaration_matching_required := FALSE;
      reference_descriptor.details.in_target_text := FALSE;
      proc_pointer.code_base_pointer_p := #ADDRESS (reference_descriptor.details.address.ring,
            reference_descriptor.details.address.segment, reference_descriptor.details.address.offset);
      proc_pointer.static_link := NIL;
      converter.ptr_to_proc := proc_pointer;
      local_address.pointer_to_procedure := converter.local_ptr_to_proc;
    IFEND;
    external_descriptor.name := name;
    external_descriptor.reference_ring := reference_ring;
    external_descriptor.global_key := 0;
    IF lov$deferred_common_blocks <> NIL THEN

{ All deferred common blocks will be added to the common block table whether the entry point
{ has already been loaded or not since the entry point may reference a deferred common block.

      common_blocks := lov$deferred_common_blocks;
      WHILE common_blocks <> NIL DO
        lop$add_deferred_common_blocks (common_blocks^.deferred_common_blocks);
        common_blocks := common_blocks^.link;
      WHILEND;
      lov$deferred_common_blocks := NIL;
    IFEND;
    lop$find_matching_entry_point (external_descriptor, match_found, linkage_info, entry_point_definition);
    IF match_found THEN
      IF lov$apd_flags.apd_load AND entry_point_definition^.attributes.in_target_text AND
            (kind = pmc$procedure_address) AND (linkage_info^.name <> 'CYP$NIL') THEN
        lop$store_intercept_linkage (reference_descriptor.details, linkage_info^.name,
              entry_point_definition^, ignored, ignored, entry_point_unaligned);
      ELSE
        lop$store_linkage (^reference_descriptor.details, entry_point_definition, ignored, ignored,
              entry_point_unaligned);
      IFEND;
      IF entry_point_unaligned THEN
        lop$report_error (lle$entry_point_unaligned, name, entry_point_definition^.defining_module, 0);
        check_diagnostic_severity (local_status);
        IF NOT local_status.normal THEN
          pmp$exit (local_status);
        IFEND;
      IFEND;
    ELSE
      pmp$find_prog_options_and_libs (prog_options_and_libraries);
      job_library_list := prog_options_and_libraries^.job_library_list;
      num_of_job_libraries := 1;
      deferred_libraries := NIL;
      num_of_deferred_ep_libraries := 0;
      IF lov$deferred_entry_points <> NIL THEN

{ Each record in the list of deferred entry points represents all of the deferred
{ entry points from one prelinked module.  There must be a separate deferred
{ entry point "library" set up for each one.  Since the "library" names must be
{ unique, an index is concatenated to a constant to define the deferred entry
{ point library name.

        entry_points := lov$deferred_entry_points;
        WHILE entry_points <> NIL DO
          num_of_deferred_ep_libraries := num_of_deferred_ep_libraries + 1;
          entry_points := entry_points^.link;
        WHILEND;

        deferred_entry_point_index := 0;
        PUSH deferred_libraries: [1 .. num_of_deferred_ep_libraries];
        entry_points := lov$deferred_entry_points;
        FOR j := 1 TO num_of_deferred_ep_libraries DO
          deferred_entry_point_index := deferred_entry_point_index + 1;
          clp$convert_integer_to_string (deferred_entry_point_index, 10, FALSE, str, {ignore} local_status);
          deferred_libraries^ [j].name := loc$deferred_entry_pt_library;
          deferred_libraries^ [j].name (loc$deferred_entry_pt_lib_size + 1, str.size) :=
                str.value (1, str.size);
          deferred_libraries^ [j].segment := #SEGMENT (entry_points^.deferred_entry_points);
          entry_points := entry_points^.link;
        FOREND;

      IFEND;
      IF job_library_list <> NIL THEN
        num_of_job_libraries := num_of_job_libraries + UPPERBOUND (job_library_list^);
      IFEND;
      PUSH job_libraries: [1 .. num_of_job_libraries];
      job_libraries^ [1] := loc$task_services_library_name;
      IF job_library_list <> NIL THEN
        FOR j := 1 TO UPPERBOUND (job_library_list^) DO
          job_libraries^ [j + 1] := job_library_list^ [j];
        FOREND;
      IFEND;
      lop$add_program_load_libraries ({execute_libraries} NIL, job_libraries, deferred_libraries);
      reference_descriptor.ring := reference_ring;
      reference_descriptor.global_key := 0;
      lop$add_unsatisfied_ref_to_list (reference_descriptor, linkage_info);
      lop$satisfy_externals (control_options);
      lop$release_transient_segments (control_options);
      lop$find_matching_entry_point (external_descriptor, match_found, linkage_info, entry_point_definition);
      IF match_found THEN
        check_diagnostic_severity (local_status);
      ELSE
        osp$set_status_abnormal ('LL', lle$entry_point_not_found, external_descriptor.name, local_status);
      IFEND;
    IFEND;
    IF NOT lov$program_load THEN
      fix_segment_attributes := FALSE;
      lop$fix_program_segment_attr;
    IFEND;
    IF local_status.normal AND match_found THEN
      address := local_address;
      record_dynamic_loaded_ep (name, reference_ring, address);
      IF pmc$entry_point_xref IN lov$loader_options.map THEN
        lop$generate_cross_refernce_map;
      IFEND;
      IF pmc$segment_map IN lov$loader_options.map THEN
        lop$generate_segment_map;
      IFEND;
    IFEND;
    status := local_status;

  PROCEND lop$load_entry_point;
?? OLDTITLE ??
?? NEWTITLE := '[XDCL, #GATE] pmp$load_from_library', EJECT ??
*copy pmh$load_from_library

  PROCEDURE [XDCL, #GATE] pmp$load_from_library
    (    name: pmt$program_name;
         ring: ost$ring;
         global_key: ost$key_lock_value;
         kind: pmt$loaded_address_kind;
         library: ^SEQ ( * );
         library_name: amt$local_file_name;
     VAR address: pmt$loaded_address;
     VAR status {control} : ost$status);


    status.normal := TRUE;
    address.kind := kind; { do minimal parameter access checking }

    lop$load_module_from_library (name, ring, 0, library, library_name, kind, address, status);

  PROCEND pmp$load_from_library;
?? OLDTITLE ??
?? NEWTITLE := '[XDCL, #GATE] pmp$load_module_from_library', EJECT ??
*copy pmh$load_module_from_library

  PROCEDURE [XDCL, #GATE] pmp$load_module_from_library
    (    name: pmt$program_name;
         reference_ring: ost$valid_ring;
         kind: pmt$loaded_address_kind;
         library: fst$file_reference;
     VAR loaded_ring: ost$valid_ring;
     VAR call_bracket_ring: ost$valid_ring;
     VAR address: pmt$loaded_address;
     VAR status {control} : ost$status);

?? EJECT ??

    VAR
      evaluated_file_reference: fst$evaluated_file_reference,
      intercept_pointer: record
        case boolean of
        = TRUE =
          procedure_pointer: ^procedure,
        = FALSE =
          code_base_pointer: ^ost$external_code_base_pointer,
        casend,
      recend,

      first_conversion: record
        case boolean of
        = TRUE =
          procedure_pointer: ^procedure,
        = FALSE =
          code_base_pointer: ^ost$external_code_base_pointer,
        casend,
      recend,

      second_conversion: record
        case boolean of
        = TRUE =
          code_base_pva: ^cell,
        = FALSE =
          pva_record: ^ost$pva,
        casend,
      recend,
      path_handle_name: fst$path_handle_name;

    status.normal := TRUE;
    address.kind := kind;
    intercept_pointer.procedure_pointer := ^pmp$intercept_call_procedure;

    clp$convert_str_to_path_handle (library, {delete_allowed} TRUE, {resolve_path} FALSE,
          {include_open_pos_in_handle} FALSE, path_handle_name, evaluated_file_reference, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    lop$activate_library (path_handle_name);
    lop$load_entry_point (name, reference_ring, 0, kind, address, status);
    lop$deactivate_library (path_handle_name);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    first_conversion.procedure_pointer := address.pointer_to_procedure;
    call_bracket_ring := first_conversion.code_base_pointer^.r3;

{ This is to get the loaded ring of the procedure, not the apd intercept
{ procedure.

    IF (#SEGMENT (first_conversion.code_base_pointer^.code_pva) =
          #SEGMENT (intercept_pointer.code_base_pointer^.code_pva)) AND
          (#OFFSET (first_conversion.code_base_pointer^.code_pva) =
          #OFFSET (intercept_pointer.code_base_pointer^.code_pva)) THEN
      first_conversion.code_base_pointer := first_conversion.code_base_pointer^.binding_pva;
    IFEND;

    second_conversion.code_base_pva := ^first_conversion.code_base_pointer^.code_pva;
    loaded_ring := second_conversion.pva_record^.ring;

  PROCEND pmp$load_module_from_library;
?? OLDTITLE ??
?? NEWTITLE := '[XDCL] lop$load_module_from_library', EJECT ??

  PROCEDURE [XDCL] lop$load_module_from_library
    (    name: pmt$program_name;
         ring: ost$valid_ring;
         global_key: ost$key_lock_value;
         library: ^SEQ ( * );
         library_name: amt$local_file_name;
         kind: pmt$loaded_address_kind;
     VAR address: pmt$loaded_address;
     VAR status {control} : ost$status);


    VAR
      fix_segment_attributes: boolean;

?? NEWTITLE := 'load_map_malfunction', EJECT ??

{  PURPOSE:
{     The purpose of this condition handler is to terminate the task if
{     generate load map detects an unexpected abnormal status from a
{     NOS/VE request - the task exits with the unexpected status.

    PROCEDURE load_map_malfunction
      (    condition: pmt$condition;
           system_status: ^pmt$condition_information;
           save_area: ^ost$stack_frame_save_area;
       VAR status: ost$status);

      VAR
        malfunction: ^ost$status;

      malfunction := system_status;
      pmp$exit (malfunction^);

    PROCEND load_map_malfunction;
?? OLDTITLE ??
?? NEWTITLE := 'terminate_prematurely', EJECT ??

{   PURPOSE:
{      Circumstances may arise within the loader which cause premature termination
{      of the load process.  These circumstances are reported within the loader via
{      conditions.  This condition handler is responsible for fielding the condition;
{      reporting the abnormality; and prematurely terminating the load process.
{
{      The conditions and their meanings are:
{      1.  system conditions: the hardware detected a condition which is probably
{          caused by a loader coding error.  The specific condition is reported to
{          the output file and the task is terminated with the loader malfunctioned
{          exception code.  SEE: code for pmc$detected_uncorrected_err processing.
{      2.  segment access conditions:
{          a. mmc$sac_read_beyond_eoi, mmc$sac_segment_access_error,
{             mmc$sac_key_lock_violation, mmc$sac_ring_violation:
{             segment management detected an inconsistency which was probably
{             caused by a loader coding error.  The specific condition is reported
{             to the output file and the task is terminated with the loader
{             malfunctioned exception code.
{          b. mmc$sac_read_write_beyond_msl: user limits prevented the loader from
{             completing the load process.  The task is terminated with the
{             insufficient memory to load exception code.
{          c. mmc$sac_io_read_error: a hardware error was detected attempting to
{             read a page from a device.  The specific condition is reported to
{             the output file and the task is terminated with the premature load
{             termination exception code.
{      3.  user defined conditions:
{          a. cye$run_time_condition: the CYBIL run time checking detected an
{             error which was probably cause by a loader coding error.  The
{             specific condition is reported to the output file and the task is
{             terminated with loader malfunctioned exception code.
{          b. loe$abort_load: several constituent procedures of the loader detect
{             circumstances which prohibit continuation of the load process.  The
{             detecting procedure reports the circumstance to load map and causes
{             the loe$abort_load condition.  This condition handler terminates the
{             task with the premature load termination exception code.
{          c. loe$loader_malfunction: a constituent procedure of the loader
{             detected an inconsistency which probably was caused by a loader
{             coding error.  The detecting procedure causes the condition
{             pointing to a status variable which identifies the inconsistency.
{             This condition handler reports the identified inconsistency to
{             the output file and terminates the task with the loader malfunctioned
{             exception code.
{          d. loe$insufficient_memory: several constituent procedures of the
{             loader detect circumstances where there is not enough virtual memory
{             to complete the load process - this is generally a case of user
{             limit being exceeded.  The detecting procedure reports the shortage
{             to the load map and causes the condition.  This condition handler
{             terminates the task with insufficient memory to load exception code.
{          e. other: other user defined conditions will be continued and
{             otherwise ignored.
{

    PROCEDURE terminate_prematurely
      (    condition: pmt$condition;
           malfunction_status: ^pmt$condition_information;
           save_area: ^ost$stack_frame_save_area;
       VAR condition_status: ost$status);

      VAR
        termination_descriptor: pmt$established_handler,
        cybil_error: ^ost$status,
        malfunction: ^ost$status,
        message: ost$status;

      CASE condition.selector OF
      = pmc$system_conditions =
        osp$set_status_from_condition ('LL', condition, save_area, message, condition_status);
        IF NOT (pmc$detected_uncorrected_err IN condition.system_conditions) THEN
          osp$generate_message (message, condition_status);
          osp$set_status_abnormal ('LL', lle$loader_malfunctioned, 'ENTRY POINT', local_status);
        ELSE
          local_status := message;
        IFEND;
      = mmc$segment_access_condition =
        CASE condition.segment_access_condition.identifier OF
        = mmc$sac_read_beyond_eoi, mmc$sac_segment_access_error, mmc$sac_key_lock_violation,
              mmc$sac_ring_violation =
          osp$set_status_from_condition ('LL', condition, save_area, message, condition_status);
          osp$generate_message (message, condition_status);
          osp$set_status_abnormal ('LL', lle$loader_malfunctioned, 'ENTRY POINT', local_status);
        = mmc$sac_read_write_beyond_msl =
          osp$set_status_abnormal ('LL', lle$insufficient_memory_to_load, '', local_status);
        = mmc$sac_io_read_error =
          osp$set_status_from_condition ('LL', condition, save_area, message, condition_status);
          osp$generate_message (message, condition_status);
          osp$set_status_abnormal ('LL', lle$premature_load_termination, 'Entry Point', local_status);
        ELSE
          osp$set_status_from_condition ('LL', condition, save_area, message, condition_status);
          osp$generate_message (message, condition_status);
          osp$set_status_abnormal ('LL', lle$premature_load_termination, 'Entry Point', local_status);
        CASEND;
      = pmc$user_defined_condition =
        IF (condition.user_condition_name = cye$run_time_condition) THEN
          cybil_error := malfunction_status;
          osp$generate_message (cybil_error^, condition_status);
          osp$set_status_abnormal ('LL', lle$loader_malfunctioned, 'ENTRY POINT', local_status);
        ELSEIF (condition.user_condition_name = loe$abort_load) THEN
          osp$set_status_abnormal ('LL', lle$premature_load_termination, 'Entry Point', local_status);
        ELSEIF (condition.user_condition_name = loe$loader_malfunction) THEN
          malfunction := malfunction_status;
          osp$generate_message (malfunction^, condition_status);
          osp$set_status_abnormal ('LL', lle$loader_malfunctioned, 'ENTRY POINT', local_status);
        ELSEIF (condition.user_condition_name = loe$insufficient_memory) THEN
          osp$set_status_abnormal ('LL', lle$insufficient_memory_to_load, '', local_status);
        ELSE
          pmp$continue_to_cause (pmc$execute_standard_procedure, condition_status);
          RETURN;
        IFEND;
      ELSE
        pmp$continue_to_cause (pmc$execute_standard_procedure, condition_status);
        RETURN;
      CASEND;
      IF fix_segment_attributes THEN
        pmp$establish_condition_handler (termination_conditions, ^terminate_prematurely,
              ^termination_descriptor, condition_status);
        fix_segment_attributes := FALSE;
        lop$fix_program_segment_attr;

{disestablish terminate_prematurely's condition handler

        pmp$disestablish_cond_handler (termination_conditions, condition_status);
      IFEND;

{disestablish lop$load_module_from_library's condition handler

      pmp$disestablish_cond_handler (termination_conditions, condition_status);
      pmp$exit (local_status);

    PROCEND terminate_prematurely;
?? OLDTITLE, EJECT ??

*copy lov$binding_segment_attributes

    VAR
      cbp_size: ost$segment_length,
      cell_pointer: ^cell,
      control_options: lot$control_options,
      converter: record
        case 0 .. 1 of
        = 0 =
          local_ptr_to_proc: ^procedure,
        = 1 =
          ptr_to_proc: cyt$pointer_to_procedure,
        casend,
      recend,
      entry_point_definition: ^lot$entry_definition,
      entry_point_dictionary: ^llt$entry_point_dictionary,
      entry_point_found: boolean,
      entry_point_gated: boolean,
      entry_point_unaligned: boolean,
      entry_pt_dictionary_index: 1 .. llc$max_entry_points_in_library,
      external_descriptor: lot$external_descriptor,
      i: ost$status_severity,
      ignored: boolean,
      ignore_symbol_table_present: boolean,
      job_library_list_p: ^pmt$object_library_list,
      job_libraries_p: ^pmt$object_library_list,
      library_file: ^SEQ ( * ),
      library_file_attributes: lot$load_file_attributes,
      library_index: pmt$number_of_libraries,
      linkage_info: ^lot$linkage_name_lists,
      local_address: pmt$loaded_address,
      local_status: ost$status, { use local variables to protect against storing values to defixed segments }
      malfunction_descriptor: pmt$established_handler,
      match_found: boolean,
      module_header: ^llt$load_module_header,
      module_ring_attributes: lot$module_ring_attributes,
      module_structure_error: boolean,
      number_of_job_libraries: pmt$number_of_libraries,
      object_text_descriptor: ^llt$object_text_descriptor,
      proc_pointer: cyt$pointer_to_procedure,
      prog_options_and_libraries_p: ^pmt$prog_options_and_libraries,
      pseudo_transfer_descriptor: lot$external_descriptor,
      reference_descriptor: lot$reference_descriptor,
      segment_attributes: array [1 .. 1] of mmt$attribute_descriptor,
      termination_descriptor: pmt$established_handler;

?? EJECT ??

    status.normal := TRUE;

    IF NOT loader_running THEN
      osp$set_status_abnormal ('LL', lle$loader_stopped, '', status);
      RETURN;
    IFEND;

    segment_attributes [1].keyword := mmc$kw_segment_access_control;
    cell_pointer := library;
    mmp$fetch_segment_attributes (cell_pointer, segment_attributes, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    IF segment_attributes [1].access_control.execute_privilege = osc$non_executable THEN
      osp$set_status_abnormal ('LL', lle$library_not_executable, '', status);
      RETURN;
    IFEND;

    find_dynamic_loaded_ep (name, ring, entry_point_found, address);
    IF entry_point_found THEN
      RETURN;
    IFEND;

    local_status.normal := TRUE;
    fix_segment_attributes := FALSE;
    pmp$establish_condition_handler (termination_conditions, ^terminate_prematurely, ^termination_descriptor,
          local_status);
    IF NOT local_status.normal THEN
      status := local_status;
      RETURN;
    IFEND;
    IF (lov$loader_options.map <> $pmt$load_map_options [pmc$no_load_map]) THEN
      pmp$establish_condition_handler (map_malfunction, ^load_map_malfunction, ^malfunction_descriptor,
            local_status);
      IF NOT local_status.normal THEN
        status := local_status;
        RETURN;
      IFEND;
    IFEND;
    local_address.kind := kind;
    FOR i := LOWERVALUE (ost$status_severity) TO UPPERVALUE (ost$status_severity) DO
      lov$diagnostic_count [i] := 0;
    FOREND;
    control_options.map := lov$loader_options.map;
    control_options.debug_ring := lov$loader_options.debug_ring;
    IF NOT lov$program_load THEN
      lop$defix_program_segment_attr;
      fix_segment_attributes := TRUE;
    IFEND;

    reference_descriptor.mmodule := loc$referenced_by_dynamic_load;

    IF kind = pmc$data_address THEN
      reference_descriptor.details.address.ring := #RING (^local_address.pointer_to_data);
      reference_descriptor.details.address.segment := #SEGMENT (^local_address.pointer_to_data);
      reference_descriptor.details.address.offset := #OFFSET (^local_address.pointer_to_data);
      reference_descriptor.details.kind := llc$address;
      reference_descriptor.details.binding_section_destination := FALSE;
      reference_descriptor.details.declaration_matching_required := FALSE;
    ELSE
      cbp_size := #SIZE (ost$external_code_base_pointer);
      lop$reserve_storage (binding_segment_attributes, 8, 0, FALSE, 0, loc$no_shadow_file, 0, cbp_size,
            reference_descriptor.details.address);
      reference_descriptor.details.kind := llc$external_proc;
      reference_descriptor.details.binding_section_destination := TRUE;
      reference_descriptor.details.declaration_matching_required := FALSE;
      reference_descriptor.details.in_target_text := FALSE;
      proc_pointer.code_base_pointer_p := #ADDRESS (reference_descriptor.details.address.ring,
            reference_descriptor.details.address.segment, reference_descriptor.details.address.offset);
      proc_pointer.static_link := NIL;
      converter.ptr_to_proc := proc_pointer;
      local_address.pointer_to_procedure := converter.local_ptr_to_proc;
    IFEND;
    external_descriptor.name := name;
    external_descriptor.reference_ring := ring;
    external_descriptor.global_key := 0;
    lop$find_matching_entry_point (external_descriptor, match_found, linkage_info, entry_point_definition);
    IF match_found THEN
      IF lov$apd_flags.apd_load AND entry_point_definition^.attributes.in_target_text AND
            (kind = pmc$procedure_address) AND (linkage_info^.name <> 'CYP$NIL') THEN
        lop$store_intercept_linkage (reference_descriptor.details, linkage_info^.name,
              entry_point_definition^, ignored, ignored, entry_point_unaligned);
      ELSE
        lop$store_linkage (^reference_descriptor.details, entry_point_definition, ignored, ignored,
              entry_point_unaligned);
      IFEND;
      IF entry_point_unaligned THEN
        lop$report_error (lle$entry_point_unaligned, name, entry_point_definition^.defining_module, 0);
        check_diagnostic_severity (local_status);
        IF NOT local_status.normal THEN
          pmp$exit (local_status);
        IFEND;
      IFEND;
    ELSE
      reference_descriptor.ring := ring;
      reference_descriptor.global_key := 0;

    /satisfy_entry_pt_from_library/
      BEGIN
        library_file := library;
        pmp$get_entry_point_dictionary (library_file, entry_point_dictionary, local_status);
        IF NOT local_status.normal THEN
          EXIT /satisfy_entry_pt_from_library/
        IFEND;
        IF entry_point_dictionary = NIL THEN
          osp$set_status_abnormal ('LL', lle$entry_point_not_found, name, local_status);
          EXIT /satisfy_entry_pt_from_library/
        IFEND;
        lop$search_entry_pt_dictionary (^name, entry_point_dictionary, entry_point_found, entry_point_gated,
              entry_pt_dictionary_index);
        IF NOT entry_point_found THEN
          osp$set_status_abnormal ('LL', lle$entry_point_not_found, name, local_status);
          EXIT /satisfy_entry_pt_from_library/
        IFEND;
        module_header := #PTR (entry_point_dictionary^ [entry_pt_dictionary_index].module_header,
              library_file^);
        IF module_header = NIL THEN
          lop$report_error (lle$bad_module_header_ptr, name, 'module', entry_pt_dictionary_index);
          check_diagnostic_severity (local_status);
          EXIT /satisfy_entry_pt_from_library/
        IFEND;
        object_text_descriptor := #PTR (module_header^.interpretive_element, library_file^);
        IF object_text_descriptor = NIL THEN
          lop$report_error (lle$bad_interpretive_elem_ptr, name, '', #OFFSET (module_header));
          check_diagnostic_severity (local_status);
          EXIT /satisfy_entry_pt_from_library/
        IFEND;

        RESET library_file TO object_text_descriptor;

        module_ring_attributes.loaded_ring := ring;
        module_ring_attributes.call_bracket := ring;

        library_file_attributes.name := library_name;
        library_file_attributes.library_file := TRUE;
        library_file_attributes.debug_file := FALSE;
        library_file_attributes.key_lock.global := FALSE;
        library_file_attributes.key_lock.local := FALSE;
        library_file_attributes.key_lock.value := 0;
        library_file_attributes.execute_privilege := osc$non_privileged;

        lop$add_unsatisfied_ref_to_list (reference_descriptor, linkage_info);

        lop$load_module (module_ring_attributes, library_file_attributes, control_options, library_file,
              pseudo_transfer_descriptor, ignore_symbol_table_present, module_structure_error);

        pmp$find_prog_options_and_libs (prog_options_and_libraries_p);
        job_library_list_p := prog_options_and_libraries_p^.job_library_list;
        IF job_library_list_p = NIL THEN
          number_of_job_libraries := 1;
        ELSE
          number_of_job_libraries := UPPERBOUND (job_library_list_p^) + 1;
        IFEND;
        PUSH job_libraries_p: [1 .. number_of_job_libraries];
        job_libraries_p^ [1] := loc$task_services_library_name;
        IF job_library_list_p <> NIL THEN
          FOR library_index := 1 TO UPPERBOUND (job_library_list_p^) DO
            job_libraries_p^ [library_index + 1] := job_library_list_p^ [library_index];
          FOREND;
        IFEND;
        lop$add_program_load_libraries ({execute_libraries} NIL, job_libraries_p, {deferred_libraries} NIL);
        lop$satisfy_externals (control_options);
        lop$release_transient_segments (control_options);
        lop$find_matching_entry_point (external_descriptor, match_found, linkage_info,
              entry_point_definition);
        IF match_found THEN
          check_diagnostic_severity (local_status);
        ELSE
          osp$set_status_abnormal ('LL', lle$entry_point_not_found, external_descriptor.name, local_status);
        IFEND;
      END /satisfy_entry_pt_from_library/;
    IFEND;
    IF NOT lov$program_load THEN
      fix_segment_attributes := FALSE;
      lop$fix_program_segment_attr;
    IFEND;
    IF local_status.normal AND match_found THEN
      address := local_address;
      record_dynamic_loaded_ep (name, ring, address);
      IF pmc$entry_point_xref IN lov$loader_options.map THEN
        lop$generate_cross_refernce_map;
      IFEND;
      IF pmc$segment_map IN lov$loader_options.map THEN
        lop$generate_segment_map;
      IFEND;
    IFEND;
    status := local_status;

  PROCEND lop$load_module_from_library;
?? OLDTITLE ??
?? NEWTITLE := '[XDCL] lop$terminate_loader', EJECT ??

  PROCEDURE [XDCL] lop$terminate_loader;


    loader_running := FALSE;


  PROCEND lop$terminate_loader;
?? OLDTITLE ??
?? NEWTITLE := 'check_diagnostic_severity', EJECT ??

  PROCEDURE check_diagnostic_severity
    (VAR status {control} : ost$status);

    VAR
      severity: ost$status_severity;

  /check_diagnostic_counts/
    FOR severity := first_severity_to_check TO osc$catastrophic_status DO
      IF lov$diagnostic_count [severity] <> 0 THEN
        osp$set_status_abnormal ('LL', lle$term_error_level_exceeded, '', status);
        EXIT /check_diagnostic_counts/
      IFEND;
    FOREND /check_diagnostic_counts/;
  PROCEND check_diagnostic_severity;
  ?VAR
    messages_to_job_log: boolean := FALSE?;

?? OLDTITLE ??
?? NEWTITLE := '[XDCL] lop$report_error', EJECT ??

  PROCEDURE [XDCL] lop$report_error
    (    error_condition: ost$status_condition;
         text_1: string ( * );
         text_2: string ( * );
         number: integer);

{!  Should radix for number be passed as an argument??

    VAR
      ignore_status: ost$status,
      lov$ignore_param_verification: [XREF] integer,
      local_condition: ost$status_condition,
      load_map_data: lot$load_map_data,
      severity: ost$status_severity;

    list_modules := FALSE;
    IF error_condition = lle$declaration_mismatch THEN
      CASE lov$ignore_param_verification OF
      = 0 =
        local_condition := error_condition;
      = 1 =
        local_condition := lle$informative_dec_mismatch;
      ELSE
        RETURN;
      CASEND;
    ELSE
      local_condition := error_condition;
    IFEND;
    osp$set_status_abnormal ('LL', local_condition, text_1, load_map_data.diagnostic_status);
    IF text_2 <> '' THEN
      osp$append_status_parameter (osc$status_parameter_delimiter, text_2, load_map_data.diagnostic_status);
    IFEND;
    osp$append_status_integer (osc$status_parameter_delimiter, number, 10, FALSE,
          load_map_data.diagnostic_status);
    load_map_data.code := loc$lm_issue_diagnostic;
    ?IF messages_to_job_log = TRUE THEN
      log_loader_error (load_map_data.diagnostic_status);
    ?IFEND
    IF lov$loader_options.map <> $pmt$load_map_options [pmc$no_load_map] THEN
      lop$generate_load_map_text (load_map_data);
      IF error_condition = lle$unsatisfied_external THEN
        list_modules := TRUE;
      IFEND;
    IFEND;

    osp$get_status_severity (local_condition, severity, ignore_status);
    lov$diagnostic_count [severity] := lov$diagnostic_count [severity] + 1;
    IF severity >= first_severity_to_check THEN
      generate_message (load_map_data.diagnostic_status, ignore_status);
    IFEND;
  PROCEND lop$report_error;
?? OLDTITLE ??
?? NEWTITLE := '[XDCL] lop$report_secondary_error', EJECT ??

  PROCEDURE [XDCL] lop$report_secondary_error
    (    status: ost$status);

    VAR
      load_map_data: lot$load_map_data,
      local_status: ost$status,
      ignore_status: ost$status,
      severity: ost$status_severity;

    local_status.condition := status.condition;
    local_status.text := status.text;
    load_map_data.code := loc$lm_issue_diagnostic;
    load_map_data.diagnostic_status := local_status;
    ?IF messages_to_job_log = TRUE THEN
      log_loader_error (local_status);
    ?IFEND
    IF lov$loader_options.map <> $pmt$load_map_options [pmc$no_load_map] THEN
      lop$generate_load_map_text (load_map_data);
    IFEND;
    osp$get_status_severity (local_status.condition, severity, ignore_status);
    lov$diagnostic_count [severity] := lov$diagnostic_count [severity] + 1;
    IF severity >= first_severity_to_check THEN
      generate_message (load_map_data.diagnostic_status, ignore_status);
    IFEND;
  PROCEND lop$report_secondary_error;
?? OLDTITLE ??
?? NEWTITLE := '[XDCL] lop$list_referencing_module', EJECT ??

  PROCEDURE [XDCL] lop$list_referencing_module
    (    module_name: pmt$program_name);

    VAR
      byte_address: amt$file_byte_address,
      status: ost$status,
      message: string (32),
      message1: [STATIC, READ, oss$job_paged_literal] string (32) := '                                ';

    IF NOT error_file_opened THEN
      RETURN;
    IFEND;

    IF NOT list_modules THEN
      RETURN;
    IFEND;

    message := message1;
    message (2, * ) := module_name (1, * );
    amp$put_next (error_file_id, ^message, 32, byte_address, status);

  PROCEND lop$list_referencing_module;
?? OLDTITLE ??
?? NEWTITLE := 'generate_message', EJECT ??

  PROCEDURE generate_message
    (    message_status: ost$status;
     VAR status: ost$status);

    VAR
      byte_address: amt$file_byte_address,
      ignore_status: ost$status,
      length_pointer: ^ost$status_message_line_size,
      line_count_pointer: ^ost$status_message_line_count,
      line_index: ost$status_message_line_count,
      message: ost$status_message,
      message_sequence: ^ost$status_message,
      text_pointer: ^ost$status_message_line;

    osp$format_message (message_status, osc$full_message_level, osc$max_status_message_line, message, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    message_sequence := ^message;
    RESET message_sequence;
    NEXT line_count_pointer IN message_sequence;

    IF NOT error_file_opened THEN
      fsp$open_file (error_file_name, amc$record, ^access_selections, {Default_creation=} NIL,
            {Mandated_creation=} NIL, {Attribute_validation=} NIL, {Attribute_override=} NIL, error_file_id,
            status);
      IF NOT status.normal THEN
        FOR line_index := 1 TO line_count_pointer^ DO
          NEXT length_pointer IN message_sequence;
          NEXT text_pointer: [length_pointer^] IN message_sequence;
          pmp$log (text_pointer^, ignore_status);
        FOREND;
        RETURN;
      IFEND;
      error_file_opened := TRUE;
    IFEND;

    FOR line_index := 1 TO line_count_pointer^ DO
      NEXT length_pointer IN message_sequence;
      NEXT text_pointer: [length_pointer^] IN message_sequence;
      amp$put_next (error_file_id, text_pointer, length_pointer^, byte_address, status);
      IF NOT status.normal THEN
        RETURN;
      IFEND;
    FOREND;

  PROCEND generate_message;
  ?IF messages_to_job_log = TRUE THEN

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

    PROCEDURE log_loader_error
      (    status: ost$status);

      VAR
        message_content: ost$status_message,
        message: ^ost$status_message,
        message_line_count: ^ost$status_message_line_count,
        message_line_size: ^ost$status_message_line_size,
        message_line_text: ^string ( * ),
        i: 1 .. osc$max_status_message_lines,
        local_status: ost$status;

      osp$format_message (status, osc$full_message_level, 100, message_content, local_status);
      message := ^message_content;
      RESET message;
      NEXT message_line_count IN message;
      FOR i := 1 TO message_line_count^ DO
        NEXT message_line_size IN message;
        NEXT message_line_text: [message_line_size^] IN message;
        pmp$log (message_line_text^, local_status);
      FOREND;
    PROCEND log_loader_error;
  ?IFEND

?? OLDTITLE ??
?? NEWTITLE := '[XDCL, #GATE] pmp$reinitialize_module', EJECT ??
*copy pmh$reinitialize_module

  PROCEDURE [XDCL, #GATE] pmp$reinitialize_module
    (    module_name: pmt$program_name;
     VAR status: ost$status);

    status.normal := TRUE;
    lop$reinitialize_module (module_name, status);

  PROCEND pmp$reinitialize_module;
?? OLDTITLE ??
?? NEWTITLE := '[XDCL, #GATE] pmp$change_term_error_level', EJECT ??
*copyc pmh$change_term_error_level

  PROCEDURE [XDCL, #GATE] pmp$change_term_error_level
    (    new_termination_error_level: ost$status_severity;
     VAR old_termination_error_level: ost$status_severity;
     VAR status: ost$status);


    status.normal := TRUE;
    old_termination_error_level := first_severity_to_check;
    first_severity_to_check := new_termination_error_level;

  PROCEND pmp$change_term_error_level;
?? OLDTITLE ??
MODEND lom$loader_executive;
