?? TITLE := 'COMPARE_ and DISPLAY_FILE Input Procedures', EJECT ??
?? RIGHT := 110 ??

{ PURPOSE: The purpose of this "module" is to provide common input
{          procedures for the processors of the commands COMPARE_FILE
{          and DISPLAY_FILE. These procedures attempt to minimize input
{          data transfers for the commands.
{
{ NOTES:
{          1. This "module" is to be COPYed into each command processor.
{          2. For a mass storage file, the file is opened for segment
{             access and input requests result in the return of a
{             pointer to the requested data.
{          3. For a non-mass storage file, a buffer (which must be
{             PUSHed by the calling command processor) is used. Except
{             for having to establish the buffer after OPEN time, the
{             calling processor is unaware of the type of input file.
{          4. Reading of data from a particular byte address (other than
{             the current) is a result of the user specifying a byte
{             address in the call to DISPLAY_FILE. In such a case, the
{             byte address ia always relative to BOI of the file.
{          5. Information concerning the input file is maintained in a
{             variable of type clt$get_control_record.
{

?? NEWTITLE := 'Global Declarations', EJECT ??
?? PUSH (LISTEXT := ON) ??
*copyc oss$job_paged_literal
*copyc ost$status
?? POP ??
*copyc amp$fetch_access_information
*copyc amp$get_next
*copyc amp$get_segment_pointer
*copyc amp$rewind
*copyc amp$set_segment_position
*copyc fsp$close_file
*copyc fsp$open_file
*copyc i#current_sequence_position
*copyc osp$append_status_file
*copyc rmp$get_device_class
?? EJECT ??

  CONST
    clc$input_buffer_size = 8192;

  TYPE
    clt$get_control_record = record
      access_level: amt$access_level,
      file_id: amt$file_identifier,
      sequence_pointer: ^SEQ ( * ),
      sequence_size: amt$file_byte_address,
      bytes_remaining: amt$file_byte_address,
      file_position: amt$file_position,
      buffer_first_byte_address: integer,
      buffer_last_byte_address: integer,
      get_next_returned_eoi: boolean,
    recend;

?? TITLE := 'clp$open_for_get', EJECT ??

  PROCEDURE clp$open_for_get
    (    file: fst$file_reference;
         command_name: string ( * <= osc$max_name_size);
         byte_address_specified: boolean;
     VAR file_position: amt$file_position;
     VAR get_control: clt$get_control_record;
     VAR buffer_required: boolean;
     VAR status: ost$status);

    VAR
      file_attachment: array [1 .. 3] of fst$attachment_option,
      device_assigned: boolean,
      device_class: rmt$device_class,
      fetch_access_selections: array [1 .. 1] of amt$access_info,
      attribute_override: array [1 .. 3] of fst$file_cycle_attribute,
      file_organization_selector: [STATIC, READ, oss$job_paged_literal] array [boolean] of
            amt$file_organization := [amc$sequential, amc$byte_addressable],
      ignore_status: ost$status,
      segment_pointer: amt$segment_pointer;

    status.normal := TRUE;
    file_attachment [1].selector := fsc$access_and_share_modes;
    file_attachment [1].access_modes.selector := fsc$specific_access_modes;
    file_attachment [1].access_modes.value := $fst$file_access_options [fsc$read];
    file_attachment [1].share_modes.selector := fsc$specific_share_modes;
    file_attachment [1].share_modes.value := $fst$file_access_options [fsc$read, fsc$execute];
    file_attachment [2].selector := fsc$open_share_modes;
    file_attachment [2].open_share_modes := $fst$file_access_options [fsc$read, fsc$execute];
    file_attachment [3].selector := fsc$create_file;
    file_attachment [3].create_file := FALSE;

    attribute_override [1].selector := fsc$block_type;
    attribute_override [1].block_type := amc$system_specified;
    attribute_override [2].selector := fsc$record_type;
    attribute_override [2].record_type := amc$undefined;
    attribute_override [3].selector := fsc$file_organization;

    rmp$get_device_class (file, device_assigned, device_class, status);
    IF NOT status.normal THEN
      RETURN; {----->
    IFEND;

    IF device_class = rmc$mass_storage_device THEN
      get_control.access_level := amc$segment;
      attribute_override [3].file_organization := file_organization_selector [byte_address_specified];
    ELSE
      get_control.access_level := amc$record;
      attribute_override [3].file_organization := amc$sequential;
    IFEND;

    fsp$open_file (file, get_control.access_level, ^file_attachment, NIL, NIL, NIL, ^attribute_override,
          get_control.file_id, status);
    IF NOT status.normal THEN
      IF status.condition = ame$new_file_requires_append THEN
        osp$set_status_abnormal ('CL', cle$file_never_opened, '', status);
        osp$append_status_file (osc$status_parameter_delimiter, file, status);
        osp$append_status_parameter (osc$status_parameter_delimiter, command_name, status);
      IFEND;
      RETURN; {----->
    IFEND;

    fetch_access_selections [1].key := amc$file_position;
    amp$fetch_access_information (get_control.file_id, fetch_access_selections, status);
    IF NOT status.normal THEN
      fsp$close_file (get_control.file_id, ignore_status);
      RETURN; {----->
    IFEND;
    IF fetch_access_selections [1].item_returned THEN
      file_position := fetch_access_selections [1].file_position;
    ELSE
      file_position := amc$boi;
    IFEND;

    IF get_control.access_level = amc$record THEN
      buffer_required := TRUE;
      get_control.sequence_size := clc$input_buffer_size;
      get_control.bytes_remaining := 0;
      IF byte_address_specified AND (file_position <> amc$boi) THEN
        amp$rewind (get_control.file_id, osc$wait, status);
        IF NOT status.normal THEN
          fsp$close_file (get_control.file_id, ignore_status);
          RETURN; {----->
        IFEND;
        file_position := amc$boi;
      IFEND;
      get_control.buffer_first_byte_address := -1;
      get_control.buffer_last_byte_address := -1;

    ELSE {access_level = amc$segment
      amp$get_segment_pointer (get_control.file_id, amc$sequence_pointer, segment_pointer, status);
      IF status.normal THEN
        get_control.sequence_pointer := segment_pointer.sequence_pointer;
        IF byte_address_specified THEN
          RESET get_control.sequence_pointer;
        IFEND;
        get_control.bytes_remaining := #SIZE (get_control.sequence_pointer^) -
              i#current_sequence_position (get_control.sequence_pointer);
      ELSEIF status.condition = ame$read_of_empty_segment THEN
        status.normal := TRUE;
        get_control.sequence_pointer := NIL;
        get_control.bytes_remaining := 0;
      ELSE
        fsp$close_file (get_control.file_id, ignore_status);
        RETURN; {----->
      IFEND;
      buffer_required := FALSE;
    IFEND;

    get_control.file_position := file_position;
    get_control.get_next_returned_eoi := FALSE;

  PROCEND clp$open_for_get;
?? TITLE := 'clp$get_next_bytes', EJECT ??

  PROCEDURE clp$get_next_bytes
    (    bytes_requested: amt$file_byte_address;
     VAR transfer_count: amt$transfer_count;
     VAR file_position: amt$file_position;
     VAR get_control: clt$get_control_record;
     VAR byte_pointer_returned: ^cell;
     VAR status: ost$status);

    VAR
      byte_pointer: ^array [1 .. * ] of cell,
      byte_address_ignored: amt$file_byte_address,
      index: amt$file_byte_address,
      temp_byte_pointer: ^array [1 .. * ] of cell;

{  Check first to see if data remain.  There are 2 cases:
{
{  1. segment_access - in this case get_control.bytes_remaining describes
{     the number of bytes left in the segment.
{
{  2. record_access - in this case get_control.bytes_remaining describes
{     the number of bytes left in the buffer from the last amp$get_next.

    status.normal := TRUE;
    IF (get_control.bytes_remaining <= 0) AND ((get_control.access_level = amc$segment) OR
          get_control.get_next_returned_eoi) THEN
      transfer_count := 0;
      file_position := amc$eoi;
      RETURN; {----->
    ELSE
      file_position := amc$eor;
    IFEND;

    IF get_control.access_level = amc$record THEN
      IF (get_control.bytes_remaining < bytes_requested) AND (NOT get_control.get_next_returned_eoi) THEN

        IF get_control.bytes_remaining > 0 THEN
          NEXT temp_byte_pointer: [1 .. get_control.bytes_remaining] IN get_control.sequence_pointer;
          RESET get_control.sequence_pointer;
          NEXT byte_pointer: [1 .. get_control.bytes_remaining] IN get_control.sequence_pointer;
          FOR index := 1 TO get_control.bytes_remaining DO
            byte_pointer^ [index] := temp_byte_pointer^ [index];
          FOREND;
        ELSE
          RESET get_control.sequence_pointer;
        IFEND;
        NEXT temp_byte_pointer: [1 .. 1] IN get_control.sequence_pointer;

        amp$get_next (get_control.file_id, temp_byte_pointer,
              get_control.sequence_size - get_control.bytes_remaining, transfer_count, byte_address_ignored,
              get_control.file_position, status);
        IF NOT status.normal THEN
          IF status.condition = ame$input_after_eoi THEN
            transfer_count := 0;
            file_position := amc$eoi;
            get_control.file_position := amc$eoi;
            get_control.get_next_returned_eoi := TRUE;
            status.normal := TRUE;
          IFEND;
          RETURN; {----->
        IFEND;
        get_control.get_next_returned_eoi := get_control.file_position = amc$eoi;

        get_control.bytes_remaining := get_control.bytes_remaining + transfer_count;
        RESET get_control.sequence_pointer;
        get_control.buffer_first_byte_address := get_control.buffer_last_byte_address + 1;
        get_control.buffer_last_byte_address := get_control.buffer_first_byte_address + transfer_count - 1;
      IFEND;

    ELSE {access_level = amc$segment
      IF get_control.bytes_remaining <= bytes_requested THEN
        get_control.file_position := amc$eoi;
      IFEND;
    IFEND;

    IF get_control.bytes_remaining > bytes_requested THEN
      transfer_count := bytes_requested;
    ELSE
      transfer_count := get_control.bytes_remaining;
    IFEND;

    IF transfer_count <= 0 THEN
      file_position := amc$eoi;
      RETURN; {----->
    IFEND;

    NEXT byte_pointer: [1 .. transfer_count] IN get_control.sequence_pointer;
    byte_pointer_returned := byte_pointer;

    get_control.bytes_remaining := get_control.bytes_remaining - transfer_count;

  PROCEND clp$get_next_bytes;
?? TITLE := 'clp$close_for_get', EJECT ??

  PROCEDURE clp$close_for_get
    (VAR get_control: clt$get_control_record;
     VAR status: ost$status);

    VAR
      segment_pointer: amt$segment_pointer;


    status.normal := TRUE;

    IF (get_control.access_level = amc$segment) AND (get_control.sequence_pointer <> NIL) THEN
      segment_pointer.kind := amc$sequence_pointer;
      segment_pointer.sequence_pointer := get_control.sequence_pointer;
      amp$set_segment_position (get_control.file_id, segment_pointer, status);
    IFEND;

    fsp$close_file (get_control.file_id, status);

  PROCEND clp$close_for_get;
?? TITLE := 'clp$seek_byte', EJECT ??

  PROCEDURE clp$seek_byte
    (    byte_address: amt$file_byte_address;
     VAR get_control: clt$get_control_record;
     VAR status: ost$status);

    VAR
      file_position: amt$file_position,
      ignore_byte_pointer: ^cell,
      number_to_skip: amt$file_byte_address,
      positioner: ^array [1 .. * ] of cell,
      transfer_count: amt$transfer_count;


    status.normal := TRUE;

    IF get_control.access_level = amc$segment THEN
      IF byte_address > #SIZE (get_control.sequence_pointer^) THEN
        osp$set_status_abnormal ('CL', cle$integer_too_large, 'BYTE_ADDRESS', status);
        RETURN; {----->
      IFEND;
      RESET get_control.sequence_pointer;
      IF byte_address > 0 THEN
        NEXT positioner: [1 .. byte_address] IN get_control.sequence_pointer;
      IFEND;
      get_control.bytes_remaining := #SIZE (get_control.sequence_pointer^) - byte_address;
      RETURN; {----->
    IFEND;

    IF (get_control.buffer_last_byte_address < 0) AND (get_control.bytes_remaining = 0) THEN
      clp$get_next_bytes (1, transfer_count, file_position, get_control, ignore_byte_pointer, status);
      IF NOT status.normal THEN
        RETURN; {----->
      IFEND;
    IFEND;

    IF byte_address < get_control.buffer_first_byte_address THEN
      amp$rewind (get_control.file_id, osc$wait, status);
      IF NOT status.normal THEN
        RETURN; {----->
      IFEND;
      get_control.file_position := amc$boi;
      number_to_skip := byte_address;
      get_control.buffer_first_byte_address := -1;
      get_control.buffer_last_byte_address := -1;
      get_control.bytes_remaining := 0;

    ELSEIF byte_address > get_control.buffer_last_byte_address THEN
      number_to_skip := byte_address - get_control.buffer_last_byte_address - 1;
      get_control.bytes_remaining := 0;

    ELSE {byte address within current buffer}
      number_to_skip := byte_address - get_control.buffer_first_byte_address;
      RESET get_control.sequence_pointer;
      IF number_to_skip > 0 THEN
        NEXT positioner: [1 .. number_to_skip] IN get_control.sequence_pointer;
      IFEND;
      get_control.bytes_remaining := get_control.buffer_last_byte_address - byte_address + 1;
      RETURN; {----->
    IFEND;

    WHILE number_to_skip >= clc$input_buffer_size DO
      clp$get_next_bytes (clc$input_buffer_size, transfer_count, file_position, get_control,
            ignore_byte_pointer, status);
      IF NOT status.normal OR (file_position = amc$eoi) THEN
        RETURN; {----->
      IFEND;
      number_to_skip := number_to_skip - transfer_count;
    WHILEND;

    IF number_to_skip > 0 THEN
      clp$get_next_bytes (number_to_skip, transfer_count, file_position, get_control, ignore_byte_pointer,
            status);
    IFEND;

  PROCEND clp$seek_byte;
?? OLDTITLE ??
