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

{ PURPOSE:
{   Contains the routines for the
{   accessing of object and library
{   files.

?? NEWTITLE := 'Global Declarations Referenced by This Module', EJECT ??
?? PUSH (LISTEXT := ON) ??
*copyc fst$file_reference
*copyc oce$library_generator_errors
*copyc oct$new_library_module_list
*copyc oct$open_file_list
*copyc oct$working_file_list
*copyc ost$status
*copyc pmt$program_name
?? POP ??
*copyc amp$get_segment_pointer
*copyc amp$return
*copyc bap$get_phn_via_file_id
*copyc clp$count_list_elements
*copyc clp$validate_local_file_name
*copyc fsp$close_file
*copyc fsp$convert_to_new_contents
*copyc fsp$get_open_information
*copyc fsp$open_file
*copyc fsp$set_file_reference_abnormal
*copyc ocp$build_file_directory
*copyc ocp$build_library_directory
*copyc ocp$build_module_directory
*copyc ocp$build_panel_directory
*copyc ocp$build_scl_directory
*copyc ocp$generate_message
*copyc ocp$search_nlm_tree
*copyc osp$set_status_abnormal
*copyc ocv$olg_scratch_seq
*copyc ocv$olg_working_heap
*copyc ocv$open_file_list
*copyc ocv$return_file_list
?? OLDTITLE ??
?? NEWTITLE := '[XDCL] ocp$search_object_file' ??
?? EJECT ??

  PROCEDURE [XDCL] ocp$search_object_file
    (    module_name: pmt$program_name;
     VAR module_found: boolean;
     VAR file_descriptor: ^oct$open_file_list);



    FOR file_descriptor^.current_module := file_descriptor^.current_module TO
          UPPERBOUND (file_descriptor^.directory^) DO

      IF module_name = file_descriptor^.directory^ [file_descriptor^.current_module].name THEN
        module_found := TRUE;
        RETURN;
      IFEND;
    FOREND;

    module_found := FALSE;


  PROCEND ocp$search_object_file;
?? OLDTITLE ??
?? NEWTITLE := '[XDCL] ocp$search_open_file_list' ??
?? EJECT ??

  PROCEDURE [XDCL] ocp$search_open_file_list
    (    file_name: amt$local_file_name;
     VAR file_found: boolean;
     VAR file_descriptor: ^oct$open_file_list);


    file_descriptor := ocv$open_file_list.link;

    WHILE file_descriptor <> NIL DO
      IF file_descriptor^.name = file_name THEN
        file_found := TRUE;
        RETURN;
      ELSE
        file_descriptor := file_descriptor^.link;
      IFEND;
    WHILEND;


    file_found := FALSE;


  PROCEND ocp$search_open_file_list;
?? OLDTITLE ??
?? NEWTITLE := '[XDCL] ocp$obtain_object_file' ??
?? EJECT ??

  PROCEDURE [XDCL] ocp$obtain_object_file
    (    file_name: fst$file_reference;
     VAR file_descriptor: ^oct$open_file_list;
     VAR status: ost$status);

    VAR
      attachment_options: array [1 .. 5] of fst$attachment_option,
      cycle_attributes: fst$cycle_attribute_values,
      file_already_open: boolean,
      file_id: amt$file_identifier,
      ignore_name_is_valid: boolean,
      ignore_path_handle: fmt$path_handle,
      ignore_status: ost$status,
      ignore_user_attributes_size: fst$user_defined_attribute_size,
      local_file_name: amt$local_file_name,
      name_is_path_handle: boolean,
      segment: amt$segment_pointer,
      validation_attributes: array [1 .. 8] of fst$file_cycle_attribute;


    clp$validate_local_file_name (file_name, local_file_name, ignore_path_handle, name_is_path_handle,
          ignore_name_is_valid);
    IF name_is_path_handle THEN
      ocp$search_open_file_list (local_file_name, file_already_open, file_descriptor);
      IF file_already_open THEN
        RETURN;
      IFEND;
    IFEND;

    validation_attributes [1].selector := fsc$file_contents_and_processor;
    validation_attributes [1].file_contents := fsc$object_library;
    validation_attributes [1].file_processor := osc$null_name;
    validation_attributes [2].selector := fsc$file_contents_and_processor;
    validation_attributes [2].file_contents := fsc$object_data;
    validation_attributes [2].file_processor := osc$null_name;

    validation_attributes [3].selector := fsc$file_contents_and_processor;
    validation_attributes [3].file_contents := fsc$screen_form;
    validation_attributes [3].file_processor := osc$null_name;

    validation_attributes [4].selector := fsc$file_contents_and_processor;
    validation_attributes [4].file_contents := fsc$legible_scl_procedure;
    validation_attributes [4].file_processor := osc$null_name;
    validation_attributes [5].selector := fsc$file_contents_and_processor;
    validation_attributes [5].file_contents := fsc$legible_data;
    validation_attributes [5].file_processor := osc$null_name;
    validation_attributes [6].selector := fsc$file_contents_and_processor;
    validation_attributes [6].file_contents := amc$legible;
    validation_attributes [6].file_processor := osc$null_name;
    validation_attributes [7].selector := fsc$file_contents_and_processor;
    validation_attributes [7].file_contents := fsc$data;
    validation_attributes [7].file_processor := osc$null_name;
    validation_attributes [8].selector := fsc$file_contents_and_processor;
    validation_attributes [8].file_contents := fsc$unknown_contents;
    validation_attributes [8].file_processor := osc$null_name;

    attachment_options [1].selector := fsc$access_and_share_modes;
    attachment_options [1].access_modes.selector := fsc$specific_access_modes;
    attachment_options [1].access_modes.value := $fst$file_access_options [fsc$read];
    attachment_options [1].share_modes.selector := fsc$specific_share_modes;
    attachment_options [1].share_modes.value := $fst$file_access_options [fsc$read, fsc$execute];
    attachment_options [2].selector := fsc$open_share_modes;
    attachment_options [2].open_share_modes := $fst$file_access_options [fsc$read, fsc$execute];
    attachment_options [3].selector := fsc$sequential_access;
    attachment_options [3].sequential_access := TRUE;
    attachment_options [4].selector := fsc$free_behind;
    attachment_options [4].free_behind := TRUE;
    attachment_options [5].selector := fsc$create_file;
    attachment_options [5].create_file := FALSE;

    fsp$open_file (file_name, amc$segment, ^attachment_options, NIL, NIL, ^validation_attributes, NIL,
          file_id, status);
    IF NOT status.normal THEN
      IF status.condition = ame$new_file_requires_append THEN
        osp$set_status_abnormal ('OC', oce$e_missing_or_empty_file, file_name, status);
      IFEND;
      RETURN;
    IFEND;

    bap$get_phn_via_file_id (file_id, local_file_name, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    ocp$search_open_file_list (local_file_name, file_already_open, file_descriptor);
    IF file_already_open THEN
      fsp$close_file (file_id, ignore_status);
      RETURN;
    IFEND;

    fsp$get_open_information (file_id, NIL, NIL, NIL, ^cycle_attributes, NIL, NIL, NIL,
          ignore_user_attributes_size, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    ALLOCATE file_descriptor IN ocv$olg_working_heap^;
    IF file_descriptor = NIL THEN
      osp$set_status_abnormal ('OC', oce$e_internal_olg_seg_overflow, '', status);
      RETURN;
    IFEND;

  /obtain_object_file/
    BEGIN
      file_descriptor^.name := local_file_name;

      IF (cycle_attributes.file_contents = fsc$object_library) OR
            (cycle_attributes.file_contents = fsc$object_data) THEN
        amp$get_segment_pointer (file_id, amc$sequence_pointer, segment, status);
        IF NOT status.normal THEN
          EXIT /obtain_object_file/;
        IFEND;

        file_descriptor^.identifier := file_id;
        IF cycle_attributes.file_contents = fsc$object_data THEN
          file_descriptor^.kind := occ$file;
          ocp$build_file_directory (segment.sequence_pointer, file_descriptor, status);
        ELSE
          file_descriptor^.kind := occ$library;
          ocp$build_library_directory (segment.sequence_pointer, file_descriptor, status);
        IFEND;

      ELSEIF cycle_attributes.file_contents = fsc$screen_form THEN
        amp$get_segment_pointer (file_id, amc$sequence_pointer, segment, status);
        IF NOT status.normal THEN
          EXIT /obtain_object_file/;
        IFEND;

        file_descriptor^.identifier := file_id;
        file_descriptor^.kind := occ$file;
        ocp$build_panel_directory (segment.sequence_pointer, file_descriptor, status);

      ELSE {fsc$legible_scl_procedure or equivalent}

{ Re-open the file for record access.

        fsp$open_file (local_file_name, amc$record, ^attachment_options, NIL, NIL, NIL, NIL,
              file_descriptor^.identifier, status);
        IF NOT status.normal THEN
          EXIT /obtain_object_file/;
        IFEND;

        fsp$close_file (file_id, ignore_status);
        file_id := file_descriptor^.identifier;

        file_descriptor^.kind := occ$library;
        ocp$build_scl_directory (local_file_name, file_descriptor, status);

        file_descriptor^.name := osc$null_name;
        fsp$close_file (file_descriptor^.identifier, ignore_status);
      IFEND;
    END /obtain_object_file/;

    IF NOT status.normal THEN
      fsp$close_file (file_id, ignore_status);
      FREE file_descriptor IN ocv$olg_working_heap^;
      RETURN;
    IFEND;

    file_descriptor^.link := ocv$open_file_list.link;
    ocv$open_file_list.link := file_descriptor;

  PROCEND ocp$obtain_object_file;
?? OLDTITLE ??
?? NEWTITLE := '[XDCL] ocp$close_all_open_files' ??
?? EJECT ??

  PROCEDURE [XDCL] ocp$close_all_open_files
    (VAR open_file_list: oct$open_file_list);


    VAR
      status: ost$status,
      file: ^oct$open_file_list;


    status.normal := TRUE;
    file := open_file_list.link;

    WHILE file <> NIL DO
      IF file^.name <> osc$null_name THEN
        fsp$close_file (file^.identifier, status);
        IF NOT status.normal THEN
          ocp$generate_message (status);
          status.normal := TRUE;
        IFEND;
      IFEND;

      file := file^.link;
    WHILEND;

    open_file_list.link := NIL;


  PROCEND ocp$close_all_open_files;
?? OLDTITLE ??
?? NEWTITLE := '[XDCL] ocp$return_files' ??
?? EJECT ??
  PROCEDURE [XDCL] ocp$return_files;

    VAR
      entry: ^oct$return_file_list,
      ignore_status: ost$status,
      next_entry: ^oct$return_file_list;


    IF ocv$return_file_list <> NIL THEN
      entry := ocv$return_file_list;
      REPEAT
        amp$return (entry^.file_name^, ignore_status);
        next_entry := entry^.link;
        FREE entry^.file_name;
        FREE entry;
        entry := next_entry;
      UNTIL entry = NIL;

      ocv$return_file_list := NIL;
    IFEND;

  PROCEND ocp$return_files;
?? OLDTITLE ??
?? NEWTITLE := '[XDCL] ocp$rewind_working_file_list' ??
?? EJECT ??

  PROCEDURE [XDCL] ocp$rewind_working_file_list
    (VAR working_file_list: oct$working_file_list);


    working_file_list.current_file := working_file_list.first_working_file.link;
    working_file_list.current_file^.descriptor^.current_module := 1;


  PROCEND ocp$rewind_working_file_list;
?? OLDTITLE ??
?? NEWTITLE := '[XDCL] ocp$get_module_from_wfl' ??
?? EJECT ??

  PROCEDURE [XDCL] ocp$get_module_from_wfl
    (    working_file_list: oct$working_file_list;
     VAR module_name: pmt$program_name;
     VAR file_descriptor: ^oct$open_file_list);


    IF working_file_list.current_file = NIL THEN
      file_descriptor := NIL;
      module_name := osc$null_name;
    ELSE
      file_descriptor := working_file_list.current_file^.descriptor;
      module_name := file_descriptor^.directory^ [file_descriptor^.current_module].name;
    IFEND;


  PROCEND ocp$get_module_from_wfl;
?? OLDTITLE ??
?? NEWTITLE := '[XDCL] ocp$skip_module_on_wfl' ??
?? EJECT ??

  PROCEDURE [XDCL] ocp$skip_module_on_wfl
    (VAR working_file_list: oct$working_file_list);


    VAR
      module_name: pmt$program_name;


    IF working_file_list.current_file^.descriptor^.current_module >=
          UPPERBOUND (working_file_list.current_file^.descriptor^.directory^) THEN
      working_file_list.current_file := working_file_list.current_file^.link;
      IF working_file_list.current_file <> NIL THEN
        working_file_list.current_file^.descriptor^.current_module := 1;
      IFEND;
    ELSE
      working_file_list.current_file^.descriptor^.current_module :=
            working_file_list.current_file^.descriptor^.current_module + 1;
    IFEND;


  PROCEND ocp$skip_module_on_wfl;
?? OLDTITLE ??
?? NEWTITLE := '[XDCL] ocp$search_working_file_list' ??
?? EJECT ??

  PROCEDURE [XDCL] ocp$search_working_file_list
    (    module_name: pmt$program_name;
     VAR working_file_list: oct$working_file_list;
     VAR module_found: boolean);


    REPEAT
      ocp$search_object_file (module_name, module_found, working_file_list.current_file^.descriptor);
      IF module_found THEN
        RETURN;
      ELSE
        working_file_list.current_file := working_file_list.current_file^.link;
        IF working_file_list.current_file = NIL THEN
          RETURN;
        ELSE
          working_file_list.current_file^.descriptor^.current_module := 1;
        IFEND;
      IFEND;
    UNTIL FALSE;


  PROCEND ocp$search_working_file_list;
?? OLDTITLE ??

MODEND ocm$object_file_handlers;
