?? RIGHT := 110 ??
?? NEWTITLE := 'NOS/VE : Loader : Load file preparation' ??
MODULE lom$load_file_preparation;

{  PURPOSE:
{    This module is responsible for preparing object text files for use in the load process.  This
{    consists of determining file attributes, verifying basic load file criteria, and opening
{    the file for segment access.

?? NEWTITLE := 'Global Declarations Referenced by This Module', EJECT ??
?? PUSH (LISTEXT := ON) ??
*copyc llt$load_module
*copyc lot$loader_type_definitions
*copyc lot$load_file_number
*copyc osd$integer_limits
*copyc oss$task_private
?? POP ??
*copyc amp$fetch
*copyc amp$get_segment_pointer
*copyc fsp$open_file
*copyc lop$report_error
*copyc lop$report_secondary_error
*copyc mmp$store_segment_attributes
*copyc osp$system_error
*copyc pmp$task_debug_ring

*copyc lov$secondary_status
?? OLDTITLE ??
?? NEWTITLE := 'Global Declarations Declared by This Module', EJECT ??
  VAR
    load_file_number: [STATIC, oss$task_private] lot$load_file_number := 0;

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

  PROCEDURE [XDCL] lop$build_file_descriptor
    (    file_name: amt$local_file_name;
     VAR file_loadable: {control} boolean;
     VAR file_descriptor: lot$file_descriptor);

    VAR
      current_attributes: array [1 .. 6] of amt$fetch_item,
      local_file: boolean,
      existing_file: boolean,
      contains_data: boolean,
      debug_ring: ost$ring,
      usage_attributes: array [1 .. 3] of fst$attachment_option,
      change_attributes: array [1 .. 1] of mmt$attribute_descriptor,
      segment_pointer: amt$segment_pointer,
      object_library_header: ^llt$object_library_header;

  /normal_sequence/
    BEGIN
      usage_attributes [1].selector := fsc$access_and_share_modes;
      usage_attributes [1].access_modes.selector := fsc$specific_access_modes;
      usage_attributes [1].access_modes.value := $fst$file_access_options [fsc$read, fsc$execute];
      usage_attributes [1].share_modes.selector := fsc$determine_from_access_modes;
      usage_attributes [2].selector := fsc$access_and_share_modes;
      usage_attributes [2].access_modes.selector := fsc$specific_access_modes;
      usage_attributes [2].access_modes.value := $fst$file_access_options [fsc$execute];
      usage_attributes [2].share_modes.selector := fsc$determine_from_access_modes;
      usage_attributes [3].selector := fsc$create_file;
      usage_attributes [3].create_file := FALSE;
      fsp$open_file (file_name, amc$segment, ^usage_attributes, NIL, NIL, NIL, NIL,
            file_descriptor.file_identifier, lov$secondary_status);
      IF NOT lov$secondary_status.normal THEN
        IF (lov$secondary_status.condition = ame$file_not_known) THEN
          lov$secondary_status.normal := TRUE;
          lop$report_error (lle$empty_load_file, file_name, '', 0);
          file_loadable := FALSE;
          file_descriptor.file_open := FALSE;
          RETURN;
        IFEND;
        IF (lov$secondary_status.condition = fse$redundant_attach_conflict) OR
              (lov$secondary_status.condition = pfe$cycle_busy) THEN
          lov$secondary_status.normal := TRUE;
          lop$report_error (lle$access_share_modes_conflict, file_name, '', 0);
          file_loadable := FALSE;
          file_descriptor.file_open := FALSE;
          RETURN;
        IFEND;
        lop$report_secondary_error (lov$secondary_status);
        EXIT /normal_sequence/
      IFEND;
      file_descriptor.file_open := TRUE;

      current_attributes [1].key := amc$ring_attributes;
      current_attributes [2].key := amc$file_contents;
      current_attributes [3].key := amc$file_structure;
      current_attributes [4].key := amc$file_access_procedure;
      current_attributes [5].key := amc$file_processor;
      current_attributes [6].key := amc$global_access_mode;

      amp$fetch (file_descriptor.file_identifier, current_attributes, lov$secondary_status);
      IF NOT (lov$secondary_status.normal AND (pfc$execute IN current_attributes [6].global_access_mode)) THEN
        IF NOT lov$secondary_status.normal THEN
          lop$report_secondary_error (lov$secondary_status);
        IFEND;
        EXIT /normal_sequence/
      IFEND;

      IF (current_attributes [2].file_contents <> amc$object) OR
            ((current_attributes [3].file_structure <> amc$data) AND
            (current_attributes [3].file_structure <> amc$library)) THEN
        lop$report_error (lle$file_not_load_file, file_name, '', 0);
        file_loadable := FALSE;
        file_descriptor.file_open := FALSE;
      ELSEIF (current_attributes [4].file_access_procedure <> osc$null_name) THEN
        lop$report_error (lle$file_contains_fap, file_name, '', 0);
        file_loadable := FALSE;
        file_descriptor.file_open := FALSE;
      ELSE
        file_descriptor.ring_brackets.r1 := current_attributes [1].ring_attributes.r1;
        file_descriptor.ring_brackets.r2 := current_attributes [1].ring_attributes.r2;
        file_descriptor.ring_brackets.r3 := current_attributes [1].ring_attributes.r3;
        file_descriptor.attributes.name := file_name;
        file_descriptor.attributes.library_file := (current_attributes [3].file_structure = amc$library);
        file_descriptor.attributes.key_lock.global := FALSE;
        file_descriptor.attributes.key_lock.local := FALSE;
        file_descriptor.attributes.key_lock.value := 0;
        file_descriptor.attributes.execute_privilege := osc$non_privileged;
        file_descriptor.attributes.debug_file := (current_attributes [5].file_processor = amc$debugger);
        load_file_number := load_file_number + 1;
        file_descriptor.attributes.load_file_number := load_file_number;

        amp$get_segment_pointer (file_descriptor.file_identifier, amc$sequence_pointer, segment_pointer,
              lov$secondary_status);
        IF NOT lov$secondary_status.normal THEN
          lop$report_secondary_error (lov$secondary_status);
          EXIT /normal_sequence/
        IFEND;

        IF file_descriptor.attributes.debug_file THEN
          debug_ring := pmp$task_debug_ring ();
          IF (file_descriptor.ring_brackets.r1 <= debug_ring) AND
                (debug_ring <= file_descriptor.ring_brackets.r2) THEN
            file_descriptor.ring_brackets.r1 := debug_ring;
            file_descriptor.ring_brackets.r2 := debug_ring;

{ change ring attributes in the segment_table_descriptor such that the debugger can access
{ it's own data;

            change_attributes [1].keyword := mmc$kw_ring_numbers;
            change_attributes [1].r1 := debug_ring;
            change_attributes [1].r2 := debug_ring;
            mmp$store_segment_attributes (segment_pointer.sequence_pointer, loc$loader_ring,
                  change_attributes, lov$secondary_status);
            IF NOT lov$secondary_status.normal THEN
              lop$report_secondary_error (lov$secondary_status);
              EXIT /normal_sequence/
            IFEND;
          IFEND;
        IFEND;

        file_descriptor.segment := segment_pointer.sequence_pointer;
        RESET file_descriptor.segment;

        IF file_descriptor.attributes.library_file THEN
          NEXT object_library_header IN file_descriptor.segment;
          IF object_library_header = NIL THEN
            lop$report_error (lle$library_header_missing, file_name, '', 0);
            file_loadable := FALSE;
            file_descriptor.file_open := FALSE;
            RETURN;
          IFEND;

          IF (object_library_header^.version <> llc$object_library_version) AND
                (object_library_header^.version <> 'V1.0') THEN
            lop$report_error (lle$wrong_library_version, llc$object_library_version, file_name, 0);
            file_loadable := FALSE;
            file_descriptor.file_open := FALSE;
            RETURN;
          IFEND;

          RESET file_descriptor.segment;
        IFEND;

        file_loadable := TRUE;
      IFEND;
      RETURN
    END /normal_sequence/;
    file_loadable := FALSE;
    file_descriptor.file_open := FALSE;
    lop$report_error (lle$unable_to_access_load_file, file_name, '', 0);
  PROCEND lop$build_file_descriptor;
MODEND lom$load_file_preparation;
