From:	CSBVAX::MRGATE!RELAY-INFO-VAX@CRVAX.SRI.COM@SMTP  2-SEP-1988 23:25
To:	ARISIA::EVERHART
Subj:	ATREAD.4_of_4


Received: From KL.SRI.COM by CRVAX.SRI.COM with TCP; Fri,  2 SEP 88 19:39:59 PDT
Received: from ucbvax.Berkeley.EDU by KL.SRI.COM with TCP; Fri, 2 Sep 88 19:14:58 PDT
Received: by ucbvax.Berkeley.EDU (5.59/1.31)
	id AA17212; Fri, 2 Sep 88 17:13:46 PDT
Received: from USENET by ucbvax.Berkeley.EDU with netnews
	for info-vax@kl.sri.com (info-vax@kl.sri.com)
	(contact usenet@ucbvax.Berkeley.EDU if you have questions)
Date: 29 Aug 88 03:25:04 GMT
From: naucse!jdc@arizona.edu  (John Campbell)
Organization: Northern Arizona University, Flagstaff, AZ
Subject: ATREAD.4_of_4
Message-Id: <851@naucse.UUCP>
Sender: info-vax-request@kl.sri.com
To: info-vax@kl.sri.com


+-+-+-+ Beginning of part 4 +-+-+-+
X   t_desc.dsc$w_length  = 256;
X#ifdef DEC_TABLE
X   t_desc.dsc$a_pointer = &LIB$AB_EBC_ASC_REV;
X#else
X   t_desc.dsc$a_pointer = EBC_ASC_TABLE;
X#endif
X   t_desc.dsc$b_class   = DSC$K_CLASS_S;
X   t_desc.dsc$b_dtype   = DSC$K_DTYPE_T;
X
X/* Read a block */
X   if (!no_tape) {
X      status = SYS$QIOW(0, channel, IO$_READLBLK, &iosb, 0, 0,
X                                            in_line, MAX_BUF, 0,0,0,0);
X      if (iosb.cond_value == SS$_ENDOFFILE) {
X         return T_TM;
X      }
X      else if (status == SS$_ENDOFFILE)
X         return EOF;
X      else if ((status & 1) != 1)
X         LIB$STOP(status);
X      if (((iosb.cond_value &1) != 1) && (iosb.cond_value != SS$_ENDOFFILE))
X         LIB$STOP(iosb.cond_value);
X
X   /* Record the size of the current block. */
X      byte_count = iosb.count;
X   }
X   else {
X      byte_count = read (channel, in_line, MAX_BUF) - 1;
X      if (byte_count <= 1 && in_line[0] == 26) {
X         return T_TM;
X      }
X   }
X/* Increment the global record count. */
X   rec_count++;
X
X/* Determine the character set. */
X   if (first) {
X      if (in_line[0] != 'V') {
X         ebcdic_flag = 1;
X         yy_data = out_line;
X      }
X      first = 0;
X   }
X
X   if (ebcdic_flag) {
X   /* Translate the record just read. */
X      src_desc.dsc$w_length = byte_count;
X      dst_desc.dsc$w_length = byte_count;
X      if (((status = LIB$MOVTC (&src_desc, &fill_desc, &t_desc, &dst_desc))
X               & 1) != 1)
X         LIB$STOP(status);
X   }
X   if (data_flag)
X      ret_val = T_DATA;
X   else {
X   /* Determine what token to return (identifying data in the buffer). */
X      switch (yy_data[0]) {
X      case 'V':
X         ret_val = yy_data[3] == '1' ? T_VOL1 : T_VOLn;
X      break;
X      case 'H':
X         ret_val = yy_data[3] == '1' ? T_HDR1 :
X                   yy_data[3] == '2' ? T_HDR2 :
X                   yy_data[3] == '3' ? T_HDR3 :
X                   yy_data[3] == '4' ? T_HDR4 : T_HDRn;
X      break;
X      case 'E':
X         if (yy_data[2] == 'F') {
X            ret_val = T_EOF;
X         }
X         else {
X            ret_val = T_EOV;
X         }
X      break;
X      default:
X         yyerror ("lexical expected control info (not data)");
X      }
X   }
X   /*
X      At this point we have to "know" where we are in the tape format
X      eventually this is going to be a grammar controlled state table.
X      for now, any record that is longer than 300 characters...
X   */
X   if (verbose_flag) {
X      printf ("Tape Record %d, Block Size %d, Ansi type %.4s\n",
X       rec_count, byte_count, ret_val != T_DATA ? yy_data : "DATA");
X   }
X
X   return ret_val;
X}
$ GOSUB UNPACK_FILE
$ FILE_IS = "TDUMP.C"
$ CHECKSUM_IS = 1594270554
$ COPY SYS$INPUT VMS_SHARE_DUMMY.DUMMY
X/*-
X   tdump.c                     Last Modified             24-May-88/JDC
X
X   This utility dumps a tape to disk.  It will mount the tape as foreign
X   and copy blocks of the tape to the disk until two tape marks in a row
X   are reached (EOT).  Each tape mark is written as a record containing
X   a single ^Z separator.
X
X   Modification History:
X
X   24-May-88/JDC - Initial version finished.
X
X-*/
X/*
X   Can't use VMS 'C' write!  There is a problem in the 'C' run-time library.
X   While it is possible to read arbitrary character data in variable length
X   records with the open(), read() library utilities, it is not possible
X   to write such records.  The problem is that write() will always search
X   for '\n' (even if "ctx=bin" is set) and break the output record into
X   multiple records.  This behavior is documented in the 'C' RTL manual, but
X   I hope they fix it someday.  In case they do, I am leaving in the "almost"
X   right code.
X*/
X#define NORTLWRITE
X
X#include <descrip>
X#include <stdio.h>
X#include <ssdef>
X#include <iodef>
X#include <file>
X#include <ctype.h>
X#include <climsgdef.h>
X#include <dvidef>
X#include <dcdef>
X#include <rmsdef>
X
X#ifdef NORTLWRITE
X#include <rms.h>
X#include <ssdef.h>
X
Xstruct FAB fab;
Xstruct RAB rab;
X#endif
X
X#define MNT$M_FOREIGN  1
X#define MNT$M_NOWRITE  1<<6
X#define MNT$_DEVNAM    1
X#define MNT$_BLOCKSIZE 8
X#define MNT$_COMMENT   0x14
X#define MNT$_RECORDSIZ 16
X#define MNT$_FLAGS     4
X
X#define DMT$M_NOUNLOAD 1
X
X#define T_TM   1
X#define T_DATA 2
X
Xtypedef struct
X          {
X          short cond_value;
X          short count;
X          int info;
X          }  status_block;
X
Xtypedef struct
X          {
X          short buffer_len;
X          short item_code;
X          int buffer_addr;
X          int ret_len_addr;
X          }  item_desc;
X
X/* Changed to read from USER$TAPE (instead of a hard-coded tape drive). */
Xglobalref LIB$AB_EBC_ASC;  /* RTL translation table. */
X
X#define MAX_BUF 65532
X#define MAX_NAME 132
X#define MAX_WILD_NAMES 80
Xstatic char tape[] = "USER$TAPE", buf1[MAX_BUF+2], buf2[MAX_BUF+2];
Xstatic char *yy_data=NULL, file_name[MAX_NAME];
Xstatic int byte_count, ebcdic_flag = 0, file_id, rec_count=0,
X           efn1, efn2, verbose_flag=0;
X
Xshort channel;
X
X
Xmain(argc, argv)
Xint argc;
Xchar *argv[];
X{
X   char *out_file;
X   static char *default_name="tape.dump";
X#ifdef NORTLWRITE
X   int status;
X#endif
X
X   if (argc <= 1)
X      out_file = default_name;
X   else
X      out_file = argv[1];
X
X/* Check the device and open a channel to the tape. */
X   open_tape (&channel);
X
X#ifdef NORTLWRITE
X   fab = cc$rms_fab;
X   fab.fab$l_fna = out_file;
X   fab.fab$b_fns = strlen(out_file);
X   fab.fab$w_mrs = MAX_BUF;
X   fab.fab$b_rat = FAB$M_CR;
X   fab.fab$b_rfm = FAB$C_VAR;
X   rab = cc$rms_rab;
X   rab.rab$l_fab = &fab;
X
X   status = sys$create (&fab);
X   if (status != RMS$_NORMAL && status != RMS$_CREATED)
X      lib$stop (status);
X   status = sys$connect (&rab);
X   if (status != RMS$_NORMAL)
X      lib$stop (status);
X#else
X/* mrs allows more than 512 bytes to be written, but ctx doesn't work yet. */
X   file_id = creat (out_file, 0, "rat=cr", "rfm=var", "mrs=65534", "ctx=bin");
X   if (file_id == -1) {
X      fprintf (stderr, "Can't open output file.\n");
X      exit(1);
X   }
X#endif
X   write_out ();
X#ifdef NORTLWRITE
X   status = sys$close (&fab);
X   if (status != RMS$_NORMAL)
X      lib$stop (status);
X#else
X   close (file_id);
X#endif
X   LIB$FREE_EF(&efn1);
X   LIB$FREE_EF(&efn2);
X}
X
X
Xwrite_out ()
X{
X   int token, tm_count=0;
X#ifdef NORTLWRITE
X   int status;
X#endif
X
X   while (tm_count < 2) {
X      token = read_in();
X      if (token == T_TM) {
X#ifdef NORTLWRITE
X      rab.rab$l_rbf = "\032";
X      rab.rab$w_rsz = 1;
X      status = sys$put (&rab);
X      if (status != RMS$_NORMAL)
X         lib$stop (status);
X#else
X         write (file_id, "\032", 1);
X#endif
X         tm_count++;
X      }
X      else {
X#ifdef NORTLWRITE
X      rab.rab$l_rbf = yy_data;
X      rab.rab$w_rsz = byte_count;
X      status = sys$put (&rab);
X      if (status != RMS$_NORMAL)
X         lib$stop (status);
X#else
X         write (file_id, yy_data, byte_count);
X#endif
X         tm_count = 0;
X      }
X   }
X}
X
X
Xopen_tape (channel)
Xint *channel;
X/*-
X   Routine to check that the device/disk name stored in "tape" is
X   really available.
X-*/
X{
X   struct {
X      item_desc dev_type;
X      int terminator;
X   }  dvi_list;
X
X   struct {
X      item_desc dev_name;
X      item_desc block_size;
X      item_desc flags_item;
X      item_desc comment;
X      int terminator;
X   }  mnt_list;
X
X   int flags = MNT$M_FOREIGN | MNT$M_NOWRITE,
X       blocks = MAX_BUF, comment=0, status;
X   char buf[100];
X   int dev_type, zero=0;
X   char buffer[255];
X   $DESCRIPTOR(tape_desc, tape);
X   $DESCRIPTOR(result_desc, buffer);
X
X/* set up dvi item list */
X   dvi_list.dev_type.buffer_len = 4;
X   dvi_list.dev_type.item_code = DVI$_DEVCLASS;
X   dvi_list.dev_type.buffer_addr = &dev_type;
X   dvi_list.dev_type.ret_len_addr = 0;
X
X   dvi_list.terminator = 0;
X
X/* See if the logical name stored in "tape" is a disk file. */
X   status = SYS$GETDVIW (0, 0, &tape_desc, &dvi_list, 0, 0, 0, 0);
X   if (!(status & 1) || dev_type != DC$_TAPE) {
X      fprintf (stderr, "Device <%s> is not known\n", tape);
X      exit (1);
X   }
X
X/* set up mnt_list */
X   mnt_list.dev_name.buffer_len = strlen(tape);
X   mnt_list.dev_name.item_code = MNT$_DEVNAM;
X   mnt_list.dev_name.buffer_addr = tape;
X   mnt_list.dev_name.ret_len_addr = 0;
X
X   mnt_list.block_size.buffer_len = 4;
X   mnt_list.block_size.item_code = MNT$_BLOCKSIZE;
X   mnt_list.block_size.buffer_addr = &blocks;
X   mnt_list.block_size.ret_len_addr = 0;
X
X   mnt_list.flags_item.buffer_len = 4;
X   mnt_list.flags_item.item_code = MNT$_FLAGS;
X   mnt_list.flags_item.buffer_addr = &flags;
X   mnt_list.flags_item.ret_len_addr = 0;
X
X#ifdef COMMENTS
X   /* Ask the user if they want a comment to the operator. */
X      printf("\n%s\n%s",
V"The first tape has reached the end.  Would you like a message to the operator"
X,
X"to be attached to the next mount request (Yes or No)? ");
X      gets (buf);
X      if (comment = str_match (buf, -1, "yes", -1, 3)) {
X         printf ("Message? ");
X         gets (buf);
X      }
X   }
X   if (comment) {
X      mnt_list.comment.buffer_len   = strlen(buf);
X      mnt_list.comment.item_code    = MNT$_COMMENT;
X      mnt_list.comment.buffer_addr  = buf;
X      mnt_list.comment.ret_len_addr = 0;
X   }
X   else {
X#endif
X      mnt_list.comment.buffer_len   = 0;   /* Terminate the terminator int. */
X      mnt_list.comment.item_code    = 0;
X      mnt_list.comment.buffer_addr  = 0;
X      mnt_list.comment.ret_len_addr = 0;
X
X   mnt_list.terminator = 0;
X
X/* mount the tape */
X/*
X   "Trick" dismount whatever the user did and remount the tape as
X   foreign with a large enough block size.
X*/
X   if (((status = SYS$DISMOU(&tape_desc, DMT$M_NOUNLOAD)) &1) != 1) {
X      if (status != SS$_DEVNOTMOUNT)
X         lib$stop(status);
X   }
X   if (((status = SYS$MOUNT(&mnt_list)) &1) != 1)
X      lib$stop(status);
X   if (((status = SYS$ASSIGN(&tape_desc,channel,0,0)) &1) !=1)
X      lib$stop(status);
X}
X
X
Xread_in()
X/*-
X   Read tokens off the "tape" so we can "see" tape marks.
X-*/
X{
X   static int state = -1, mark_count = 0;
X   int status, ret_val;
X   static status_block iosb1, iosb2;  /* MUST be static for asynch. */
X   status_block *iosb;
X
X/* Read a block */
X   if (state == -1) {
X   /* Initial read. */
X      if (!((status = LIB$GET_EF(&efn1)) & 1))
X         lib$stop (status);
X      if (!((status = LIB$GET_EF(&efn2)) & 1))
X         lib$stop (status);
X
X      status = SYS$QIOW(0, channel, IO$_READLBLK, &iosb1, 0, 0,
X                                            buf1, MAX_BUF, 0,0,0,0);
X      SYS$QIO (efn2, channel, IO$_READLBLK, &iosb2, 0, 0, buf2,
X                                                  MAX_BUF, 0,0,0,0);
X      state = 1;
X      yy_data = buf1;
X      iosb = &iosb1;
X   }
X   else if (state == 1) {
X   /* Wait for read on buffer 2, post read on buffer 1 */
X      SYS$QIO (efn1, channel, IO$_READLBLK, &iosb1, 0, 0, buf1,
X                                                  MAX_BUF, 0,0,0,0);
X      status = SYS$SYNCH (efn2, &iosb2);
X      yy_data = buf2;
X      iosb = &iosb2;
X      state = 2;
X   }
X   else if (state == 2) {
X   /* Wait for read on buffer 1, post read on buffer 2 */
X      SYS$QIO (efn2, channel, IO$_READLBLK, &iosb2, 0, 0, buf2,
X                                                  MAX_BUF, 0,0,0,0);
X      status = SYS$SYNCH (efn1, &iosb1);
X      yy_data = buf1;
X      iosb = &iosb1;
X      state = 1;
X   }
X
X   ret_val = T_DATA;
X   if (iosb->cond_value == SS$_ENDOFFILE)
X      ret_val = T_TM;
X   else if (status == SS$_ENDOFFILE)
X      ret_val = EOF;
X   else if ((status & 1) != 1)
X      lib$stop(status);
X   if (((iosb->cond_value &1) != 1) && (iosb->cond_value != SS$_ENDOFFILE))
X      lib$stop(iosb->cond_value);
X
X   if (ret_val == T_DATA) {
X   /* Record the size of the current block. */
X      byte_count = iosb->count;
X
X   /* Increment the global record count. */
X      rec_count++;
X   }
X
X   if (ret_val == T_TM)
X      ++mark_count;
X
X   printf ("Tape Record %6d, Block Size %6d\t\t\t\tTape Mark %d\r",
X            rec_count, byte_count, mark_count);
X
X   return ret_val;
X}
$ GOSUB UNPACK_FILE
$ EXIT
-+-+-+-+-+ End of part 4 +-+-+-+-+-
-- 
	John Campbell               ...!arizona!naucse!jdc

	unix?  Sure send me a dozen, all different colors.

