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

*copyc pxiotyp
*copyc bizclos
*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 := '~~~~~   Write tape test', EJECT ??

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


  PROGRAM  write_tape_test ALIAS 'WT2300' (plength: string(7);
    pmultifile: string(7);
    pmultivol: 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 = 4128,
      min_words = 16,
      large_jobs =1001(16);  {cio buffer size faster data xfer}

    VAR
      length: [STATIC] integer := 32,
      test_flag: [STATIC] boolean := FALSE,
      BUFF: [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,
      test_size: [STATIC] integer := 512,  {60 bit words}
      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,
      buf1: [STATIC] wrec,
      cmdata: packed record
        rdata: packed array[1 .. 34] of wrec,
        lastdb: packed array[1 .. 6] OF 0 .. 15,
      recend,
      err_file: ^cell,
      err_file_name: string(7),
      vol2_file: ^cell,
      vol2_file_name: string(7),
      nos180_file: ^cell,
      nos180_file_name: string (7),
      file_mark_position: file_mark;

  PROCEDURE check_for_eoi;
    f#mark (nos180_file, file_mark_position);
    IF file_mark_position = eoi# THEN
      second_vol := TRUE;
      bi#weof (nos180_file);
      bi#weof (nos180_file);
      bi#close (nos180_file, first#);
      vol2_file_name := 'T22300';
      bi#open (vol2_file, vol2_file_name, new#, output#, first#);
    IFEND;
  PROCEND check_for_eoi;

  PROCEDURE initialize_data_record ;

    buf1.u8b1 := 0;
    buf1.rn1 := 0;
    buf1.wnlen := (length * 120) DIV 16;
    buf1.wnlenl := (length * 120) MOD 10(16);
    buf1.u8b2 := 29;
    buf1.rn2 := record_number;
    buf1.wnu2 := 0;
    buf1.wnl2 := 2;
    buf1.u8b3 := 29;
    buf1.rn3 := record_number;
    buf1.wnu2 := 0;
    buf1.wnl3 := 3;
    buf1.u8b4 := 29;
    buf1.rn4 := record_number;
    buf1.wnu4 := 0;
    buf1.wnl4 := 4;
    buf1.u8b5 := 29;
    buf1.rn5 := record_number;
    buf1.wnu5 := 0;
    buf1.wnl5 := 5;
    buf1.u8b6 := 29;
    buf1.rn6 := record_number;
    buf1.wnu6 := 0;
    buf1.wnl6 := 6;
    buf1.u8b7 := 29;
    buf1.rn7 := record_number;
    buf1.wnu7 := 0;
    buf1.wnl7 := 7;
    buf1.u8b8 := 29;
    buf1.rn8 := record_number;
    buf1.wn8 := 8;
    buf1.u8b9 := 29;
    buf1.rnu9 := record_number DIV 16;
    buf1.rnl9 := record_number MOD 10(16);
    buf1.wn9 := 9;
    buf1.u8b10 := 29;
    buf1.rnu10 := record_number DIV 100(16);
    buf1.rnl10 := record_number MOD 100(16);
    buf1.rnl10 := record_number;
    buf1.wn10 := 10;
    buf1.u8b11 := 29;
    buf1.rnu11 := record_number DIV 1000(16);
    buf1.rnl11 := record_number MOD 1000(16);
    buf1.rnl11 := record_number;
    buf1.wn11 := 11;
    buf1.u8b12 := 29;
    buf1.rnu12 := record_number DIV 10000(16);
    buf1.rnl12 := record_number MOD 10000(16);
    buf1.rnl12 := record_number;
    buf1.wn12 := 12;
    buf1.u8b13 := 29;
    buf1.rnu13 := record_number DIV 100000(16);
    buf1.rnl13 := record_number MOD 100000(16);
    buf1.rnl13 := record_number;
    buf1.wn13 := 13;
    buf1.u8b14 := 29;
    buf1.rn14 := record_number;
    buf1.wn14 := 14;
    buf1.u8bu15 := 1;
    buf1.u8bl15 := 13;
    buf1.rn15 := record_number;
    buf1.wn15 := 15;
  PROCEND initialize_data_record;

  PROCEDURE update_record;
    word_no := buf1.wn15 + 1;
    buf1.wnlen := word_no DIV 16;
    buf1.wnlenl := word_no MOD 10(16);
    word_no := word_no + 1;
    buf1.wnu2 := word_no DIV 100(16);
    buf1.wnl2 := word_no MOD 100(16);
    word_no := word_no + 1;
    buf1.wnu3 := word_no DIV 1000(16);
    buf1.wnl3 := word_no MOD 1000(16);
    buf1.wnl4 := buf1.wnl4 + 15;
    buf1.wnl5 := buf1.wnl5 + 15;
    buf1.wnl6 := buf1.wnl6 + 15;
    buf1.wnl7 := buf1.wnl7 + 15;
    buf1.wn8 := buf1.wn8 + 15;
    buf1.wn9 := buf1.wn9 + 15;
    buf1.wn10 := buf1.wn10 + 15;
    buf1.wn11 := buf1.wn11 + 15;
    buf1.wn12 := buf1.wn12 + 15;
    buf1.wn13 := buf1.wn13 + 15;
    buf1.wn14 := buf1.wn14 + 15;
    buf1.wn15 := buf1.wn15 + 15;
  PROCEND update_record;

  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);
      IF multi_vol THEN
        second_vol := TRUE;
      IFEND;
      NCLOSE;
      IF (multi_vol) AND (FILE2 = 0) THEN
        FILE2 := 7;
        NWOPEN;
        set_fet;
        integ2 := pfet^.at;
        IF integ2 <> 0 THEN
          dyfstrnum ('ABNORMAL STATUS OPEN2', integ2, 3);
        IFEND;
      IFEND;
    IFEND;
  PROCEND check_for_end_of_reel;

  PROCEDURE write_file_mark;
    IF test_flag THEN
      FWRITE;
      check_for_end_of_reel;
    ELSE
      IF second_vol THEN
        bi#weof (vol2_file);
      ELSE
        bi#weof (nos180_file);
      IFEND;
    IFEND;
  PROCEND write_file_mark;

  PROCEDURE put_out_errorfile;
    IF status = FALSE THEN
      err_file_name := 'FT2300';
      bi#open (err_file, err_file_name, new#, output#, first#);
      status := TRUE;
    IFEND;
    bi#put (err_file, #LOC(min_block), #SIZE(min_block));
  PROCEND put_out_errorfile;

  PROCEDURE write_tape;

    VAR
      rec_length: integer,
      record_count: integer,
      i: integer;

    FOR record_count := 1 TO 10 DO
      initialize_data_record;
      IF test_flag THEN
        BUFF[1] := buf1;
      ELSE
        cmdata.rdata[1] := buf1;
      IFEND;
      buf1.u8b1 := 29;
      buf1.rn1 := record_number;
      FOR i := 2 TO length DO
        update_record;
        IF test_flag THEN
          BUFF[i] := buf1;
        ELSE
          cmdata.rdata[i] := buf1;
        IFEND;
      FOREND;
      IF test_flag THEN
        FET[2] := test_size + PARST3;
        FET[3] := PARST3;
        NWRITE;
        set_fet;
        integ2 := pfet^.at;
        IF integ2 <> 0 THEN
          dyfstrnum ('ABNORMAL STATUS', integ2, 3);
        IFEND;
        check_for_end_of_reel;
      ELSE
        bi#put (nos180_file, #LOC (cmdata), test_size);
        bi#weor (nos180_file);
        IF multi_vol THEN
          check_for_eoi;
        IFEND;
      IFEND;
      record_number := record_number + 1;
    FOREND;
  PROCEND write_tape;


{BEGIN MAIN PT2300 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 ('MULTI VOL', 3);
        multi_vol := TRUE;
      IFEND;
      intchr1 := arg[1](1);
      CASE  intchr1 OF
      = '0' =
        integ1 := 0;
      = '1' =
        integ1 := 10;
      = '2' =
        integ1 := 20;
      = '3' =
        integ1 := 30;
      ELSE
        integ1 := 40;
      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;
    test_size := min_words * length;
    intchr1 := arg[4](1);
    IF (intchr1 = 'W') THEN
      test_flag := TRUE;
    IFEND;
    IF test_flag THEN
      NWOPEN;
      set_fet;
      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;
    ELSE
      nos180_file_name := 'CT2300'; {nosve tape}
{Open test file}
      bi#open (nos180_file, nos180_file_name, new#, output#, first#);
    IFEND;
    record_number := 1;
    write_tape;
    IF multi_file THEN
      write_file_mark;
      write_tape;
      write_file_mark;
    IFEND;
    IF multi_vol THEN
      WHILE (second_vol = FALSE) DO
        IF test_flag THEN
          check_for_end_of_reel;
        ELSE
          check_for_eoi;
        IFEND;
        write_tape;
        IF multi_file THEN
          write_file_mark;
          write_tape;
          write_file_mark;
        IFEND;
      WHILEND;
      IF test_flag THEN
        NCLOSE;
      ELSE
        bi#close (nos180_file, first#);
      IFEND;
    ELSE
      IF test_flag THEN
        NCLOSE;
      ELSE
        bi#close (nos180_file, first#);
      IFEND;
    IFEND;

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