?? RIGHT := 110 ??
?? NEWTITLE := 'NOS/VE Deadstart : Process Deadstart Files' ??
MODULE dsm$process_deadstart_files;

{ PURPOSE:
{   This module contains the procedure which copies the deadstart files from the deadstart
{   device to local files.

?? NEWTITLE := 'Global Declarations Referenced by This Module', EJECT ??
?? PUSH (LISTEXT := ON) ??
*copyc bat$record_header_type
?? POP ??
*copyc amp$get_segment_pointer
*copyc amp$put_next
*copyc amp$return
*copyc amp$set_segment_eoi
*copyc clp$include_file
*copyc cmp$convert_iou_number
*copyc cmp$get_channel_definition
*copyc cmp$get_element_name
*copyc dsp$cleanup_deadstart_io
*copyc dsp$initialize_io
*copyc dsp$read_deadstart_device
*copyc dsp$read_header_labels
*copyc dsp$retrieve_header_information
*copyc fsp$close_file
*copyc fsp$open_file
*copyc osp$system_error
?? EJECT ??
*copyc cmv$system_device_data
?? TITLE := 'process_ssv_file', EJECT ??

{ PURPOSE:
{   This procedure processes files that have a block type of SYSTEM_SPECIFIED and a record
{   type of VARIABLE.  These files must be processed in a special way because of the
{   possibility of partial "bam" records from the tape file.  Typically a "bam record"
{   contains a "bam header" followed by the record data.  If the record data plus "bam header"
{   cross a tape block boundary the record data is broken up so that a tape block starts
{   with a "bam header".  There is a flag in the "bam header" denoting the starting record
{   and the ending record.  This procedure puts the starting records and the ending records
{   back into full records.

  PROCEDURE process_ssv_file
    (    deadstart_file_identifier: dst$deadstart_file_identifier;
         file_name: ost$name;
         fa_p: ^fst$attachment_options;
         mca_p: ^fst$file_cycle_attributes;
         av_p: ^fst$file_cycle_attributes;
     VAR status: ost$status);

    VAR
      ba: amt$file_byte_address,
      bam_header_p: ^bat$record_header,
      data_line_p: ^SEQ ( * ),
      file_identifier: amt$file_identifier,
      save_length: integer,
      save_line_p: ^SEQ ( * ),
      scratch_file_id: amt$file_identifier,
      scratch_file_name: ost$name,
      scratch_segment_pointer: amt$segment_pointer,
      scratch_seq_p: ^SEQ ( * ),
      temp_file_id: amt$file_identifier,
      temp_file_name: ost$name,
      temp_file_size: integer,
      temp_seq_p: ^SEQ ( * );

    status.normal := TRUE;

   /open_files/
    BEGIN

      { Open the file that will temporarily hold the deadstart file retrieved from the deadstart device.

      temp_file_name := '$LOCAL.TEMP_';
      temp_file_name (13, *) := deadstart_file_identifier;
      read_tape_to_file (temp_file_name, fa_p, mca_p, av_p, temp_seq_p, temp_file_id, temp_file_size, status);
      IF NOT status.normal THEN
        EXIT /open_files/;
      IFEND;

      { Open the file that will be used as a scratch working area.

      scratch_file_name := '$LOCAL.SCRATCH_';
      scratch_file_name (13, *) := deadstart_file_identifier;
      fsp$open_file (scratch_file_name, amc$segment, fa_p, NIL, mca_p, av_p, NIL, scratch_file_id, status);
      IF NOT status.normal THEN
        EXIT /open_files/;
      IFEND;
      amp$get_segment_pointer (scratch_file_id, amc$sequence_pointer, scratch_segment_pointer, status);
      IF NOT status.normal THEN
        EXIT /open_files/;
      IFEND;
      scratch_seq_p := scratch_segment_pointer.sequence_pointer;
      RESET scratch_seq_p;

      { Open the file that will contain the actual deadstart file.

      fsp$open_file (file_name, amc$record, fa_p, NIL, mca_p, av_p, NIL, file_identifier, status);
      IF NOT status.normal THEN
        EXIT /open_files/;
      IFEND;

      { Move the file from the temp file to the actual file.  Concatenating any broken "bam records".

     /move_the_file/
      WHILE temp_file_size >= #SIZE (bat$record_header) DO

        { Read the "bam header".

        NEXT bam_header_p IN temp_seq_p;
        temp_file_size := temp_file_size - #SIZE (bam_header_p^);
        IF temp_file_size < bam_header_p^.length THEN
          EXIT /move_the_file/;
        IFEND;
        IF bam_header_p^.length <= 0 THEN
          CYCLE /move_the_file/;
        IFEND;

        { Concatenate the broken records if necessary.

        IF bam_header_p^.header_type = bac$start_record THEN
          RESET scratch_seq_p;
          save_length := 0;

         /concatenate_the_line/
          WHILE TRUE DO
            IF bam_header_p^.length > 0 THEN
              NEXT save_line_p: [[REP bam_header_p^.length OF cell]] IN scratch_seq_p;
              RESET save_line_p;
              NEXT data_line_p: [[REP bam_header_p^.length OF cell]] IN temp_seq_p;
              temp_file_size := temp_file_size - #SIZE (data_line_p^);
              RESET data_line_p;
              save_length := save_length + bam_header_p^.length;
              save_line_p^ := data_line_p^;
            IFEND;
            IF bam_header_p^.header_type = bac$end_record THEN
              EXIT /concatenate_the_line/;
            IFEND;
            IF temp_file_size < #SIZE (bam_header_p^) THEN
              EXIT /move_the_file/;
            IFEND;
            NEXT bam_header_p IN temp_seq_p;
            temp_file_size := temp_file_size - #SIZE (bam_header_p^);
          WHILEND /concatenate_the_line/;
          RESET scratch_seq_p;
          NEXT data_line_p: [[REP save_length OF cell]] IN scratch_seq_p;

        ELSE
          NEXT data_line_p: [[REP bam_header_p^.length OF cell]] IN temp_seq_p;
          temp_file_size := temp_file_size - #SIZE (data_line_p^);
        IFEND;

        { Write the record to the actual file.

        RESET data_line_p;
        amp$put_next (file_identifier, data_line_p, #SIZE (data_line_p^), ba, status);
        IF NOT status.normal THEN
          EXIT /move_the_file/;
        IFEND;
      WHILEND /move_the_file/;
    END /open_files/;

    fsp$close_file (temp_file_id, status);
    amp$return (temp_file_name, status);

    fsp$close_file (scratch_file_id, status);
    amp$return (scratch_file_name, status);

    fsp$close_file (file_identifier, status);

  PROCEND process_ssv_file;
?? TITLE := 'read_tape_to_file', EJECT ??

{ PURPOSE:
{   This procedure reads the file from the deadstart device.

  PROCEDURE read_tape_to_file
    (    file_name: ost$name;
         fa_p: ^fst$attachment_options;
         mca_p: ^fst$file_cycle_attributes;
         av_p: ^fst$file_cycle_attributes;
     VAR file_seq_p: ^SEQ ( * );
     VAR file_identifier: amt$file_identifier;
     VAR file_size: integer;
     VAR status: ost$status);

    CONST
      large_amount = 1000000(16);

    VAR
      data_size_read: integer,
      file_data_p: ^SEQ ( * ),
      file_segment_pointer: amt$segment_pointer;

    status.normal := TRUE;

    fsp$open_file (file_name, amc$segment, fa_p, NIL, mca_p, av_p, NIL, file_identifier, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;
    amp$get_segment_pointer (file_identifier, amc$sequence_pointer, file_segment_pointer, status);
    IF NOT status.normal THEN
      RETURN;
    IFEND;

    RESET file_segment_pointer.sequence_pointer;
    file_seq_p := file_segment_pointer.sequence_pointer;
    file_size := 0;

   /read_file_from_device/
    WHILE TRUE DO
      NEXT file_data_p: [[REP large_amount OF cell]] IN file_segment_pointer.sequence_pointer;
      dsp$read_deadstart_device (large_amount, file_data_p, data_size_read);
      file_size := file_size + data_size_read;
      IF data_size_read < large_amount THEN
        EXIT /read_file_from_device/;
      IFEND;
    WHILEND /read_file_from_device/;

    IF file_size = 0 THEN
      RETURN;
    IFEND;

    RESET file_segment_pointer.sequence_pointer;
    NEXT file_data_p: [[REP file_size OF cell]] IN file_segment_pointer.sequence_pointer;
    amp$set_segment_eoi (file_identifier, file_segment_pointer, status);
    RESET file_seq_p;

  PROCEND read_tape_to_file;
?? TITLE := 'reinitialize_io', EJECT ??

{ PURPOSE:
{   This procedure initializes the io.

  PROCEDURE reinitialize_io;

    VAR
      channel_definition: cmt$data_channel_definition,
      channel_descriptor: cmt$channel_descriptor,
      device: cmt$system_device_types,
      element_descriptor: cmt$element_descriptor,
      physical_identification: cmt$physical_identification,
      status: ost$status;

    IF cmv$system_device_data [cmc$sdt_tape_device].specified THEN
      device := cmc$sdt_tape_device;
    ELSE
      device := cmc$sdt_disk_device;
    IFEND;

    physical_identification.product_identification.product_number := ' ';
    physical_identification.serial_number := ' ';
    cmp$convert_iou_number (cmv$system_device_data [device].iou_number,
          physical_identification.hardware_address.iou, status);
    IF NOT status.normal THEN
      osp$system_error ('Unable to initialize IO.', ^status);
    IFEND;

    channel_descriptor.use_logical_identification := TRUE;
    channel_descriptor.iou := physical_identification.hardware_address.iou;
    channel_descriptor.name := cmv$system_device_data [device].channel_name;
    cmp$get_channel_definition (channel_descriptor, channel_definition, status);
    IF NOT status.normal THEN
      osp$system_error ('Unable to initialize IO.', ^status);
    IFEND;

    physical_identification.hardware_address.channel.ordinal := channel_definition.ordinal;
    physical_identification.hardware_address.channel_address :=
          cmv$system_device_data [device].equipment_number;
    physical_identification.hardware_address.unit_address :=
          cmv$system_device_data [device].unit_number;
    physical_identification.hardware_address.physical_address_specifier :=
          $cmt$physical_address_specifier [cmc$iou, cmc$channel, cmc$channel_address, cmc$unit_address];
    cmp$get_element_name (physical_identification, element_descriptor, status);
    IF NOT status.normal THEN
      osp$system_error ('Unable to initialize IO.', ^status);
    IFEND;

    IF element_descriptor.element_type <> cmc$storage_device_element THEN
      osp$system_error ('Unable to initialize IO.', NIL);
    IFEND;

    dsp$initialize_io (element_descriptor.peripheral_descriptor.element_name, status);
    IF NOT status.normal THEN
      osp$system_error ('Unable to initialize IO.', ^status);
    IFEND;

  PROCEND reinitialize_io;
?? TITLE := 'dsp$process_deadstart_files', EJECT ??

{ PURPOSE:
{   This procedure moves the deadstart files from the deadstart device to local files.

  PROCEDURE [XDCL] dsp$process_deadstart_files
    (    ending_file_identifier: dst$deadstart_file_identifier;
         last_files_processed: boolean);

    VAR
      av_p: ^fst$file_cycle_attributes,
      deadstart_file_identifier: dst$deadstart_file_identifier,
      fa_p: ^fst$attachment_options,
      file_identifier: amt$file_identifier,
      file_name: ost$name,
      file_seq_p: ^SEQ ( * ),
      file_size: integer,
      header_information: dst$header_information,
      mca_p: ^fst$file_cycle_attributes,
      status: ost$status;

    reinitialize_io;

    PUSH fa_p: [1 .. 1];
    fa_p^ [1].selector := fsc$access_and_share_modes;
    fa_p^ [1].access_modes.selector := fsc$specific_access_modes;
    fa_p^ [1].access_modes.value := $fst$file_access_options [fsc$shorten, fsc$append, fsc$modify, fsc$read];
    fa_p^ [1].share_modes.selector := fsc$specific_share_modes;
    fa_p^ [1].share_modes.value := $fst$file_access_options [];
    PUSH mca_p: [1 .. 4];
    mca_p^ [1].selector := fsc$block_type;
    mca_p^ [2].selector := fsc$record_type;
    mca_p^ [3].selector := fsc$ring_attributes;
    mca_p^ [4].selector := fsc$file_contents_and_processor;
    PUSH av_p: [1 .. 4];
    av_p^ [1].selector := fsc$block_type;
    av_p^ [2].selector := fsc$record_type;
    av_p^ [3].selector := fsc$ring_attributes;
    av_p^ [4].selector := fsc$file_contents_and_processor;

   /process_all_files/
    WHILE TRUE DO
      dsp$read_header_labels (deadstart_file_identifier);
      dsp$retrieve_header_information (header_information);
      mca_p^ [1].block_type := header_information.block_type;
      mca_p^ [2].record_type := header_information.record_type;

      IF (header_information.block_type = amc$system_specified) AND
            (header_information.record_type = amc$undefined) THEN
        mca_p^ [4].file_contents := 'OBJECT_LIBRARY';
        mca_p^ [4].file_processor := amc$unknown_processor;
      ELSE
        mca_p^ [4].file_contents := amc$unknown_contents;
        mca_p^ [4].file_processor := amc$unknown_processor;
      IFEND;

      file_name := '$LOCAL.';
      file_name (8, *) := deadstart_file_identifier;

      mca_p^ [3].ring_attributes.r1 := osc$tsrv_ring;
      mca_p^ [3].ring_attributes.r2 := osc$user_ring_2;
      mca_p^ [3].ring_attributes.r3 := osc$user_ring_2;
      av_p^ := mca_p^;

      IF (header_information.block_type = amc$system_specified) AND
            (header_information.record_type = amc$variable) THEN
        process_ssv_file (deadstart_file_identifier, file_name, fa_p, mca_p, av_p, status);
      ELSE
        read_tape_to_file (file_name, fa_p, mca_p, av_p, file_seq_p, file_identifier, file_size, status);
        fsp$close_file (file_identifier, status);
      IFEND;

      IF deadstart_file_identifier = ending_file_identifier THEN
        clp$include_file (file_name, ' ', osc$null_name, status);
        amp$return (file_name, status);
        EXIT /process_all_files/;
      IFEND;
    WHILEND /process_all_files/;

    IF last_files_processed THEN
      dsp$cleanup_deadstart_io (status);
    IFEND;

  PROCEND dsp$process_deadstart_files;
MODEND dsm$process_deadstart_files;
