*copyc OSD$DEFAULT_PRAGMATS
?? LEFT := 1, RIGHT := 110 ??
*copy OSD$DEFAULT_PRAGMATS
?? NEWTITLE := 'NOS/VE : OBJECT MODULE CONVERTER SIMULATED IO', EJECT ??
MODULE ocm$omc_simulated_io_routines;


?? SET (CHKALL := OFF) ??


{ *callc amxgfat }
{ *callc amxfile }
{ *callc amxopen }
{ *callc amxgetp }
{ *callc inxmove }
?? PUSH (LISTEXT := ON) ??
*copyc AMP$GET_FILE_ATTRIBUTES
*copyc AMP$FILE
*copyc AMP$OPEN
*copyc AMP$GET_PARTIAL
*copyc I#MOVE
?? POP ??


  VAR
    status_state: [XREF] (eoi_warning_status, error_status);


  VAR
    ci_file_identifier: [STATIC] amt$file_identifier,
    status: ost$status;

  TYPE
    cc_ost_status = record
      case normal: boolean of
      = FALSE =
        identifier: string (2),
        condition: 0 .. 999999,
        text: cc_ost_string,
      casend,
    recend,

    cc_ost_string = record
      size: 0 .. 256,
      value: string (256),
    recend;

?? NEWTITLE := '                         WARNING & ERROR ' ??
?? FMT (FORMAT := OFF) ??

?? eject ??
?? SET (LIST := OFF) ??
*copyc PME$PROGRAM_SERVICES_EXCEPTIONS
*copyc OCE$OBJECT_CONVERTER_EXCEPTIONS
?? SET (LIST := ON) ??



?? fmt (format := on) ??

  PROCEDURE eoi_warning (eoi_warning_condition: integer;
    VAR status: ost$status);

    status.normal := FALSE;
    status_state := eoi_warning_status;
    status.condition := eoi_warning_condition;

  PROCEND eoi_warning;



  PROCEDURE error (error_condition: integer;
        error_string: string ( * );
    VAR status: ost$status);

    status.normal := FALSE;
    status_state := error_status;
    status.condition := error_condition;
    status.text.value (1, * ) :=
      '                                                                            ';
    status.text.size := STRLENGTH (error_string);
    status.text.value (1, status.text.size) := error_string;
    status.identifier (1, 2) := 'OC';

  PROCEND error;
?? OLDTITLE ??
?? NEWTITLE := '                         OBTAIN CI FILE' ??
?? EJECT ??

  PROCEDURE [XDCL] obtain_ci_file (ci_file_name: amt$local_file_name;
    VAR stat: cc_ost_status);



    VAR
      local_file: boolean,
      existing_file: boolean,
      contains_data: boolean;

    VAR
      file_attributes: array [1 .. 4] of amt$file_attribute;


    file_attributes [1].key := amc$access_mode;
    file_attributes [2].key := amc$block_type;
    file_attributes [3].key := amc$record_type;
    file_attributes [4].key := amc$file_organization;

    amp#get_file_attributes (ci_file_name, file_attributes, local_file, existing_file, contains_data, status);
    IF NOT status.normal THEN
      stat := status;
      RETURN;
    IFEND;

    IF local_file THEN
      file_attributes [1].access_mode := $pft$usage_selections [pfc$read];
      file_attributes [2].block_type := amc$user_specified;
      file_attributes [3].record_type := amc$undefined;
      file_attributes [4].file_organization := amc$sequential;

      amp#file (ci_file_name, file_attributes, status);
      IF NOT status.normal THEN
        stat := status;
        RETURN;
      IFEND;

      amp#open (ci_file_name, amc$record, ci_file_identifier, status);
      stat := status;
    ELSE
      error (oce$missing_or_empty_file, ci_file_name, status);
      stat := status;
    IFEND;


  PROCEND obtain_ci_file;
?? OLDTITLE ??
  ?? NEWTITLE := '                         GET NEXT' ??
  ?? EJECT ??

  PROCEDURE [XDCL] get_next (working_storage_area: ^cell;
        working_storage_length: integer;
    VAR stat: cc_ost_status);




{       PURPOSE:                        }
{         To input the next object      }
{         module item even if it spans  }
{         physical records.             }


    VAR
      record_length: amt$max_record_length,
      transfer_count: amt$transfer_count,
      byte_address: amt$file_byte_address,
      file_position: amt$file_position,

      ws_area: ^cell,
      ws_length: amt$working_storage_length,
      pva: ^ost$pva;


    ws_area := working_storage_area;
    ws_length := working_storage_length;
    status.normal := TRUE;

{kluge1} i#move (ws_area, ws_area, ws_length);

    REPEAT
      amp#get_partial (ci_file_identifier, ws_area, ws_length, record_length, transfer_count, byte_address,
            file_position, amc$no_skip, status);

      IF (status.normal) AND (file_position <> amc$eoi) THEN
        IF transfer_count < ws_length THEN
          pva := #LOC (ws_area);
          pva^.offset := pva^.offset + transfer_count;

          ws_length := ws_length - transfer_count;
          transfer_count := 0;
        IFEND;
      ELSE
        IF (status.normal) AND (file_position = amc$eoi) THEN
          IF ws_length < working_storage_length THEN
            eoi_warning (oce$short_record_or_descriptor, status);
            stat := status;
          ELSE
            eoi_warning (oce$missing_rec_or_descriptor, status);
            stat := status;
          IFEND;
        ELSE
          stat := status;
        IFEND;
      IFEND;
    UNTIL (transfer_count >= ws_length) OR (NOT status.normal);

  PROCEND get_next;
?? OLDTITLE ??
MODEND omc$simulated_io_routines;
