?? RIGHT := 79, LEFT := 1 ??
?? FMT (FORMAT := ON, keyw := upper, ident := lower) ??
MODULE ptread;

*copyc pxiotyp
*copyc bizclos
*copyc bizget
*copyc bizopen
*copyc bizput
*copyc bizweof
*copyc bizweor
*copyc fzmark
*copyc fzwords
*copyc zutps2d
*copyc zn7pmsg
*copyc zutpcsa
?? NEWTITLE := '~~~~~   put message in dayfile', EJECT ??

{}
{write string into dayfile}
{}

  PROCEDURE [XDCL] dyfstring (s: string ( * );
        dayfile: 0 .. 7);

    VAR
      dcm: array [1 .. 8] of packed array [0 .. 9] of 0 .. 3f(16),
      dcwi: integer,
      dcci: 0 .. 9,
      si: ost$string_index,
      eol: boolean;

    si := 1;
    dcwi := 1;
    dcci := 0;
    eol := TRUE;
    utp$convert_string_to_dc_string (utc$ascii64, dcm, dcwi, dcci, s, si, eol);
    n7p$issue_dayfile_message (#LOC (dcm), dayfile);
  PROCEND dyfstring;
{}
{send message and number to dayfile}
{}

  PROCEDURE [XDCL] dyfstrnum (s: string ( * );
        value: integer;
        dayfile: 0 .. 7);

    VAR
      new_s: ^string ( * ),
      n,
      i: integer;

    i := STRLENGTH (s);
    PUSH new_s: [i + 10];
    new_s^ (1, i) := s (1, i);
    new_s^ (i + 1, 10) := '          ';
    STRINGREP (new_s^ (i + 1, 10), n, value);
    dyfstring (new_s^, 3);
  PROCEND dyfstrnum;
?? OLDTITLE ??
?? NEWTITLE := '~~~~~   Read tape test', EJECT ??

  PROCEDURE [XREF] NROPEN;
  PROCEDURE [XREF] NWOPEN;
  PROCEDURE [XREF] NREADN;
  PROCEDURE [XREF] NWRITE;
  PROCEDURE [XREF] NCLOSE;


  PROGRAM  read_tape_test ALIAS 'RT2000' (plength: string(7);
    pmultifile: string(7);
    pmultivol: string(7);
    puserrec: string(7));

    TYPE
      schar = string(7),
      ftab = packed record
        lfn: 0 .. 3ffffffffff(16),
        ln: 0 .. 0f(16),             { level number
        at: 0 .. 0f(16),             { abnormal termination
        eoi: boolean,                { end of information
        code: 0 .. 7f(16),           { request return code
        bo: boolean,                 { binary operation
        ocb: boolean,                { operation complete bit
      recend,
      wrec = packed record
        u8b1: 0 .. 0ff(16),
        rn1: 0 .. 0ffffff(16),
        wnlen: 0 .. 0fffffff(16),
        wnlenl: 0 .. 15,         { 2
        u8b2: 0 .. 0ff(16),
        rn2: 0 .. 0ffffff(16),
        wnu2: 0 .. 0ffffff(16),
        wnl2: 0 .. 0ff(16),      { 3
        u8b3: 0 .. 0ff(16),
        rn3: 0 .. 0ffffff(16),
        wnu3: 0 .. 0fffff(16),
        wnl3: 0 .. 0fff(16),     { 4
        u8b4: 0 .. 0ff(16),
        rn4: 0 .. 0ffffff(16),
        wnu4: 0 .. 0ffff(16),
        wnl4: 0 .. 0ffff(16),    { 5
        u8b5: 0 .. 0ff(16),
        rn5: 0 .. 0ffffff(16),
        wnu5: 0 .. 0fff(16),
        wnl5: 0 .. 0fffff(16),   { 6
        u8b6: 0 .. 0ff(16),
        rn6: 0 .. 0ffffff(16),
        wnu6: 0 .. 0ff(16),
        wnl6: 0 .. 0ffffff(16),  { 7
        u8b7: 0 .. 0ff(16),
        rn7: 0 .. 0ffffff(16),
        wnu7: 0 .. 015,
        wnl7: 0 .. 0fffffff(16), { 8
        u8b8: 0 .. 0ff(16),
        rn8: 0 .. 0ffffff(16),
        wn8: 0 .. 0ffffffff(16), { 9
        u8b9: 0 .. 0ff(16),
        rnu9: 0 .. 0fffff(16),
        rnl9: 0 .. 15,           { 10
        wn9: 0 .. 0ffffffff(16),
        u8b10: 0 .. 0ff(16),
        rnu10: 0 .. 0ffff(16),
        rnl10: 0 .. 0ff(16),     { 11
        wn10: 0 .. 0ffffffff(16),
        u8b11: 0 .. 0ff(16),
        rnu11: 0 .. 0fff(16),
        rnl11: 0 .. 0fff(16),    { 12
        wn11: 0 .. 0ffffffff(16),
        u8b12: 0 .. 0ff(16),
        rnu12: 0 .. 0ff(16),
        rnl12: 0 .. 0ffff(16),   { 13
        wn12: 0 .. 0ffffffff(16),
        u8b13: 0 .. 0ff(16),
        rnu13: 0 .. 15,
        rnl13: 0 .. 0fffff(16),  { 14
        wn13: 0 .. 0ffffffff(16),
        u8b14: 0 .. 0ff(16),
        rn14: 0 .. 0ffffff(16),  { 15
        wn14: 0 .. 0ffffffff(16),
        u8bu15: 0 .. 15,
        u8bl15: 0 .. 15,         { 16
        rn15: 0 .. 0ffffff(16),
        wn15: 0 .. 0ffffffff(16),
      recend;

    CONST
      max_multiple = 34,
      max_ve_data_record = 33024,  { bits per record 4128*8 }
      min_words = 16;

    VAR
      length: [STATIC] integer := 32,
      test_flag: [STATIC] boolean := FALSE,
      BDATA: [XREF] array[1 .. 36] OF wrec,
      FET: [XREF] packed array[0 .. 12] OF integer,
      FET2: [XREF] packed array[0 .. 12] OF integer,
      FILE2: [XREF] integer,
      PARST3: [XREF] integer,
      pfet: ^ftab,
      multi_file: [STATIC] boolean := FALSE,
      multi_vol: [STATIC] boolean := FALSE,
      status: [STATIC] boolean := FALSE,
      arg: array[1..4] OF schar,
      integ1: integer,
      integ2: integer,
      record_number: integer,
      word_no: integer,
      record_count: integer,
      test_size: [STATIC] integer := 10,  {records per file}
      second_vol: [STATIC] boolean := FALSE,
      intchr1: char,
      intvar: integer,
      min_block: record
        err_msg: string (24),
        record_length: integer,   { ve 64 bits
        record_number: integer,   { ve 24 bits
        word_number: integer,     { ve 32 bits
      recend,
      err_file: ^cell,
      err_file_name: string(7),
      file_w: ^cell,
      file_w_name: string(7),
      nos180_file: ^cell,
      nos180_file_name: string (7),
      file_mark_position: file_mark;

  PROCEDURE set_fet;
    IF (multi_vol) AND (FILE2 <> 0) THEN
      pfet := #LOC(FET2);
    ELSE
      pfet := #LOC(FET);
    IFEND;
  PROCEND set_fet;

  PROCEDURE check_for_end_of_reel;
    set_fet;
    IF (pfet^.at = 1) THEN
      dyfstring ('END OF REEL', 3);
      NCLOSE;
      IF multi_vol THEN
        second_vol := TRUE;
      IFEND;
      IF (multi_vol) AND (FILE2 = 0) THEN
        FILE2 := 7;
        NROPEN;
        set_fet;
        integ2 := pfet^.at;
        IF integ2 <> 0 THEN
          dyfstrnum ('ABNORMAL STATUS OPEN2', integ2, 3);
        IFEND;
        NREADN;
        set_fet;
      IFEND;
    IFEND;
  PROCEND check_for_end_of_reel;

  PROCEDURE read_file_mark;
     NREADN;
     check_for_end_of_reel;
     IF (pfet^.ln <> 15) THEN
        integ1 := pfet^.ln;
        dyfstrnum ('EOF FILE POSITION ERROR', integ1, 3);
        min_block.err_msg := 'EOF FILE POSITION ERROR ';
        put_out_errorfile;
     IFEND;
  PROCEND read_file_mark;

  PROCEDURE put_out_errorfile;
    IF status = FALSE THEN
      err_file_name := 'FT2000';
      bi#open (err_file, err_file_name, new#, output#, first#);
      status := TRUE;
    IFEND;
    dyfstrnum ('ERROR ON RECORD', record_number, 3);
    min_block.record_number := record_number;
    min_block.record_length := ((BDATA[1].wnlen * 16) + BDATA[1].wnlenl);
    bi#put (err_file, #LOC(min_block), #SIZE(min_block));
  PROCEND put_out_errorfile;

  PROCEDURE record_number_error;
     dyfstrnum ('DATA RECORD NUMBER ERROR', record_count, 3);
     min_block.err_msg := 'DATA RECORD NUMBER ERROR';
     put_out_errorfile;
  PROCEND record_number_error;

  PROCEDURE word_error;
     dyfstrnum ('DATA WORD NUMBER ERROR', word_no, 3);
     min_block.err_msg := ' DATA WORD NUMBER ERROR';
     min_block.word_number := word_no;
     put_out_errorfile;
  PROCEND word_error;

  PROCEDURE verify_data_record;

    word_no := BDATA[1].wnl2;
    IF (word_no <> 2) THEN
      word_error;
    IFEND;
    word_no := BDATA[1].wnl3;
    IF (word_no <> 3) THEN
      word_error;
    IFEND;
    word_no := BDATA[1].wnl4;
    IF (word_no <> 4) THEN
      word_error;
    IFEND;
    word_no := BDATA[1].wnl5;
    IF (word_no <> 5) THEN
      word_error;
    IFEND;
    word_no := BDATA[1].wnl6;
    IF (word_no <> 6) THEN
      word_error;
    IFEND;
    word_no := BDATA[1].wnl7;
    IF (word_no <> 7) THEN
      word_error;
    IFEND;
    word_no := BDATA[1].wn8;
    IF (word_no <> 8) THEN
      word_error;
    IFEND;
    word_no := BDATA[1].wn9;
    IF (word_no <> 9) THEN
      word_error;
    IFEND;
    word_no := BDATA[1].wn10;
    IF (word_no <> 10) THEN
      word_error;
    IFEND;
    word_no := BDATA[1].wn11;
    IF (word_no <> 11) THEN
      word_error;
    IFEND;
    word_no := BDATA[1].wn12;
    IF (word_no <> 12) THEN
      word_error;
    IFEND;
    word_no := BDATA[1].wn13;
    IF (word_no <> 13) THEN
      word_error;
    IFEND;
    word_no := BDATA[1].wn14;
    IF (word_no <> 14) THEN
      word_error;
    IFEND;
    word_no := BDATA[1].wn15;
    IF (word_no <> 15) THEN
      word_error;
    IFEND;
    record_count := BDATA[1].rn3;
    IF (record_count <> record_number) THEN
      record_number_error;
    IFEND;
    record_count := BDATA[1].rn4;
    IF (record_count <> record_number) THEN
      record_number_error;
    IFEND;
    record_count := BDATA[1].rn5;
    IF (record_count <> record_number) THEN
      record_number_error;
    IFEND;
    record_count := BDATA[1].rn6;
    IF (record_count <> record_number) THEN
      record_number_error;
    IFEND;
    record_count := BDATA[1].rn7;
    IF (record_count <> record_number) THEN
      record_number_error;
    IFEND;
    record_count := BDATA[1].rn8;
    IF (record_count <> record_number) THEN
      record_number_error;
    IFEND;
  PROCEND verify_data_record;

  PROCEDURE read_tape;

    VAR
      rec_length: integer,
      words_per_get: integer,
      inl: integer,
      i: integer;

    FOR i := 1 TO test_size DO
      NREADN;
      IF test_flag THEN
       bi#put (file_w, #LOC(BDATA), 551);
       bi#weor (file_w);
      IFEND;
      check_for_end_of_reel;
      integ2 := pfet^.at;
      IF (integ2 <> 0) THEN
        dyfstrnum ('ABNORMAL STATUS', integ2, 3);
      IFEND;
      IF test_flag THEN
        dyfstrnum ('WORDS READ', PARST3, 3);
      IFEND;
      IF (pfet^.ln <> 15) THEN
        IF i=1 THEN
          verify_data_record;
        IFEND;
      ELSE  { pfet^.ln = 15
        dyfstring ('INCORRECT END OF FILE', 3);
        min_block.err_msg := ' INCORRECT END OF FILE ';
        put_out_errorfile;
      IFEND;
      record_number := record_number + 1;
    FOREND;
  PROCEND read_tape;


{BEGIN MAIN PT2000 PROGRAM}


   utp$get_control_statement_args ( arg);

      intchr1 := arg[2](1);
      IF (intchr1 = 'T') THEN
        dyfstring ('MULTI FILE', 3);
        multi_file := TRUE;
      IFEND;
      intchr1 := arg[3](1);
      IF (intchr1 = 'T') THEN
        dyfstring ('CYBIL NO MULTI VOL', 3);
        multi_vol := FALSE;
      IFEND;
      intchr1 := arg[1](1);
      CASE  intchr1 OF
      = '0' =
        integ1 := 0;
      = '1' =
        integ1 := 10;
      = '2' =
        integ1 := 20;
      = '3' =
        integ1 := 30;
      ELSE
        integ1 := 100;
      CASEND;
      intchr1 := arg[1](2);
      CASE intchr1 OF
      = '0' =
        integ2 := 0;
      = '1' =
        integ2 := 1;
      = '2' =
        integ2 := 2;
      = '3' =
        integ2 := 3;
      = '4' =
        integ2 := 4;
      = '5' =
        integ2 := 5;
      = '6' =
        integ2 := 6;
      = '7' =
        integ2 := 7;
      = '8' =
        integ2 := 8;
      = '9' =
        integ2 := 9;
      ELSE
        integ2 := 40;
      CASEND;
      length := integ1 + integ2;

    dyfstrnum ('LENGTH', length, 3);
    IF length > max_multiple THEN
      dyfstrnum ('LENGTH OF RECORD IS TOO LARGE', length, 3);
      min_block.err_msg := 'LENGTH RECORD TOO LARGE ';
      put_out_errorfile;
      length := max_multiple;
    IFEND;
    intchr1 := arg[4](1);
    IF (intchr1 = 'U') THEN
      dyfstring ('USER BLOCK TYPE', 3);
      test_size := 10;
    ELSE
      test_size := 9600 * length;
      test_size := (test_size DIV max_ve_data_record) + 1;
    IFEND;
    IF (intchr1 = 'W') THEN
      test_flag := TRUE;
    IFEND;
    dyfstrnum ('RECORDS PER FILE', test_size, 3);
    IF test_flag THEN
      file_w_name := 'TESTV';
      bi#open (file_w, file_w_name, new#, output#, first#);
    IFEND;
{Open test file}
    NROPEN;
    pfet := #LOC(FET);
    IF ((pfet^.at = 1) OR (pfet^.ln = 15)) THEN
      dyfstring ('FILE POSITION ERROR', 3);
      min_block.err_msg := ' FILE POSITION ERROR    ';
      put_out_errorfile;
    IFEND;
    integ2 := pfet^.at;
    IF integ2 <> 0 THEN
      dyfstrnum ('ABNORMAL STATUS AT OPEN', integ2, 3);
      min_block.err_msg := 'ABNORMAL STATUS AT OPEN';
      put_out_errorfile;
    IFEND;
    record_number := 1;
    read_tape;
    IF multi_file THEN
      read_file_mark;
      read_tape;
      read_file_mark;
    IFEND;
    IF multi_vol THEN
      WHILE (second_vol = FALSE) DO
      read_tape;
      IF multi_file THEN
        read_file_mark;
        read_tape;
        read_file_mark;
      IFEND;
      WHILEND;
      NCLOSE;
    ELSE
      NCLOSE;
    IFEND;
    IF test_flag THEN
      bi#close (file_w, first#);
    IFEND;

    IF status THEN
      bi#close (err_file, first#);
    IFEND;
{}
  PROCEND read_tape_test;
MODEND ptread;
