?? LEFT := 1, RIGHT := 110 ??
MODULE nam$open_di_load_file;
?? PUSH (LISTEXT := ON) ??
*copyc nac$network_management_catalog
*copyc nae$file_access_me_conditions
*copyc amt$file_attributes
*copyc amt$file_identifier
*copyc amt$local_file_name
*copyc amt$segment_pointer
*copyc llt$load_module
*copyc llt$transfer_symbol
*copyc nat$object_code_version
*copyc pft$cycle_selector
*copyc pft$name
*copyc pft$password
*copyc pft$share_selections
*copyc pft$usage_selections
?? POP ??
*copyc amp$get_segment_pointer
*copyc amp$return
*copyc fsp$close_file
*copyc fsp$open_file
*copyc nap$condition_handler_trace
*copyc osp$set_status_abnormal
*copyc osp$set_status_from_condition
*copyc pfp$attach
*copyc pmp$close_object_library
*copyc pmp$continue_to_cause
*copyc pmp$disestablish_cond_handler
*copyc pmp$establish_condition_handler
*copyc pmp$find_module_in_library
*copyc pmp$get_unique_name
*copyc pmp$open_object_library

?? TITLE := 'condition_handler', EJECT ??

  PROCEDURE [XDCL] nap$open_di_load_file (object_code_version: nat$object_code_version_string;
        boot_card: nat$card_type;
    VAR load_file_id: amt$file_identifier;
    VAR load_data: ^SEQ ( * );
    VAR load_file_opened: boolean;
    VAR status: ost$status);


    PROCEDURE condition_handler (
          condition: pmt$condition;
          condition_descriptor: ^pmt$condition_information;
          stack_frame_save_area_pointer: ^ost$stack_frame_save_area;
      VAR handler_status: ost$status );

      VAR
        ignore_status: ost$status;

      nap$condition_handler_trace (condition, stack_frame_save_area_pointer);
      IF condition.selector = mmc$segment_access_condition THEN
        osp$set_status_from_condition ('NA', condition,
              stack_frame_save_area_pointer, status, ignore_status);
        pmp$close_object_library (library_file_id, ignore_status);
        amp$return (library_name, ignore_status);
        fsp$close_file (load_file_id, local_status);
        amp$return (name, local_status);
        EXIT nap$open_di_load_file;
      ELSE
        pmp$continue_to_cause (pmc$execute_standard_procedure, handler_status);
      IFEND;

  PROCEND condition_handler;


?? TITLE := '[XDCL] nap$open_di_load_file', EJECT ??

{ PURPOSE: This procedure returns a device interface boot file for a specified
{          software version and boot card. The load file is returned as a
{          pointer to sequence.
{
{ DESIGN:  The boot file is constructed from the module list associated with
{          the program description with a name of the form
{          'BOOT_cccc' where cccc is the boot card type of MPB, HDLC, ESCI, or MCI.
{          The program description is found in the network object catalog with
{          a catalog name of the form 'VERSION_vvvv' where vvvv is the hexadecimal
{          version number under file name of 'DI_OBJECT'.
{
{          It is the responsibility of the calling program to close and return
{          the load file.

    CONST
      load_and_transfer_addr_length = 8;

    VAR
      boot_file_selections: [STATIC, READ] array [1 .. 3] of fst$attachment_option :=
            [[fsc$access_and_share_modes, [fsc$specific_access_modes,
            [fsc$read, fsc$shorten, fsc$append]], * ], [fsc$sequential_access, TRUE],
            [fsc$free_behind, TRUE]],
      data_block: ^SEQ ( * ),
      established_conditions: pmt$condition,
      established_descriptor: pmt$established_handler,
      file_size: 0 .. 0ffffffff(16),
      highest_cycle: [STATIC, READ] pft$cycle_selector := [pfc$highest_cycle],
      index: pmt$number_of_modules,
      library: ^SEQ ( * ),
      library_file_id: amt$file_identifier,
      load_library: [STATIC] array [1 .. 5] of pft$name := [nac$management_family,
        nac$management_master_catalog, nac$cdcnet_subcatalog, *, nac$di_object_library ],
      library_name: ost$name,
      load_file_pointer: amt$segment_pointer,
      local_status: ost$status,
      module_address: pmt$object_library_address,
      module_data: ^SEQ ( * ),
      module_list: ^array [1 .. * ] of pmt$program_name,
      name: ost$name,
      object_file_list: ^llt$object_file_list,
      password: [STATIC, READ] pft$password := ' ',
      program_attributes: ^llt$program_attributes,
      program_description: ^SEQ ( * ),
      program_description_address: pmt$object_library_address,
      program_description_name: pmt$program_name,
      segment_file: ^SEQ ( * ),
      share_selections: [STATIC, READ] pft$share_selections := [pfc$read],
      usage_selections: [STATIC, READ] pft$usage_selections := [pfc$read],
      version_catalog_name: pft$name;

    established_conditions.selector := pmc$all_conditions;
    pmp$establish_condition_handler (established_conditions,
          ^condition_handler, ^established_descriptor, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    status.normal := TRUE;
    load_file_opened := FALSE;
    file_size := 0;
    version_catalog_name := nac$version_subcatalog;
    version_catalog_name (9,4) := object_code_version;
    program_description_name := 'BOOT';

    CASE boot_card OF
    = nac$ica2_boot_card =
      program_description_name (5, 4) := '_ICA';
    = nac$cim_boot_card =
      program_description_name (5, 5) := '_HDLC';
    = nac$esci_boot_card =
      program_description_name (5, 5) := '_ESCI';
    = nac$mci_boot_card =
      program_description_name (5, 4) := '_MCI';
    ELSE
    CASEND;
    load_library [UPPERBOUND (load_library) - 1] := version_catalog_name;
    pmp$get_unique_name (library_name, status);
    pfp$attach (library_name, load_library, highest_cycle, password, usage_selections, share_selections,
          pfc$no_wait, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    pmp$open_object_library (library_name, library_file_id, library, status);
    IF NOT status.normal THEN
      amp$return (library_name, local_status);
      RETURN;
    IFEND;

    pmp$find_module_in_library (program_description_name, library, program_description_address, status);
    IF NOT status.normal THEN
      pmp$close_object_library (library_file_id, local_status);
      amp$return (library_name, local_status);
      RETURN;
    IFEND;

    IF program_description_address.kind <> llc$program_description THEN
      pmp$close_object_library (library_file_id, local_status);
      amp$return (library_name, local_status);
      osp$set_status_abnormal (nac$status_id, nae$module_not_program_desc, program_description_name, status);
      RETURN;
    IFEND;

    pmp$get_unique_name (name, status);
    fsp$open_file (name, amc$segment, ^boot_file_selections, {default_creation_attributes =} NIL,
          {mandated_creation_attributes =} NIL, {attribute_validation =} NIL, {attribute_override =} NIL,
          load_file_id, status);
    IF NOT status.normal THEN
      pmp$close_object_library (library_file_id, local_status);
      amp$return (library_name, local_status);
      RETURN;
    IFEND;

    amp$get_segment_pointer (load_file_id, amc$sequence_pointer, load_file_pointer, status);
    IF NOT status.normal THEN
      pmp$close_object_library (library_file_id, local_status);
      amp$return (library_name, local_status);
      fsp$close_file (load_file_id, local_status);
      amp$return (name, local_status);
      RETURN;
    IFEND;
    segment_file := load_file_pointer.sequence_pointer;
    RESET segment_file;

    program_description := program_description_address.program_description;
    NEXT program_attributes IN program_description;
    IF pmc$object_file_list_specified IN program_attributes^.contents THEN
      NEXT object_file_list: [1 .. program_attributes^.number_of_object_files] IN program_description;
    IFEND;

    IF pmc$module_list_specified IN program_attributes^.contents THEN
      NEXT module_list: [1 .. program_attributes^.number_of_modules] IN program_description;

    /forloop/
      FOR index := 1 TO program_attributes^.number_of_modules DO
        pmp$find_module_in_library (module_list^ [index], library, module_address, status);
        IF NOT status.normal THEN
          EXIT /forloop/;
        IFEND;
        IF module_address.kind <> llc$load_module THEN
          osp$set_status_abnormal (nac$status_id, nae$module_not_a_load_module, module_list^ [index], status);
          EXIT /forloop/;
        IFEND;
          NEXT module_data: [[REP #SIZE (module_address.load_module^) OF cell]] IN module_address.load_module;
          NEXT data_block: [[REP #SIZE (module_address.load_module^) OF cell]] IN segment_file;
          file_size := file_size + #SIZE (module_address.load_module^);
          IF data_block = NIL THEN
            osp$set_status_abnormal (nac$status_id, nae$write_beyond_file_limit, '', status);
            EXIT /forloop/;
          IFEND;
        data_block^ := module_data^;
      FOREND /forloop/;

    IFEND;
    RESET segment_file;
    NEXT load_data: [[REP file_size OF cell]] IN segment_file;

    load_file_opened := status.normal;

    IF NOT load_file_opened THEN
      fsp$close_file (load_file_id, local_status);
      amp$return (name, local_status);
    IFEND;

    pmp$close_object_library (library_file_id, local_status);
    amp$return (library_name, local_status);

    pmp$disestablish_cond_handler (established_conditions, status);

  PROCEND nap$open_di_load_file;
MODEND nam$open_di_load_file;
