Article 2681 of comp.sources.unix:
Path: nntpd.lkg.dec.com!crl.dec.com!crl.dec.com!caen!usenet.cis.ufl.edu!usenet.eel.ufl.edu!news.mathworks.com!uunet!in2.uu.net!news1.digital.com!vixie!vixie!not-for-mail
From: nmm1@cus.cam.ac.uk (Nick Maclaren)
Newsgroups: comp.sources.unix
Subject: v29i022: mvstape - suite of utilities for handling IBM MVS tapes, Part03/09
Date: 4 Aug 1995 15:04:09 -0700
Organization: Vixie Enterprises
Lines: 1490
Sender: vixie@vix.com
Approved: vixie@gw.home.vix.com
Message-ID: <3vu5gp$gk3@gw.home.vix.com>
References: <1.807573809.16947@gw.home.vix.com>
NNTP-Posting-Host: gw.home.vix.com

Submitted-By: nmm1@cus.cam.ac.uk (Nick Maclaren)
Posting-Number: Volume 29, Issue 22
Archive-Name: mvstape/part03

#! /bin/sh
# This is a shell archive.  Remove anything before this line, then unpack
# it by saving it into a file and typing "sh file".  To overwrite existing
# files, type "sh file -c".  You can also feed this as standard input via
# unshar, or by typing "sh <file", e.g..  If this archive is complete, you
# will see the following message at the end:
#		"End of archive 3 (of 9)."
# Contents:  READ_ME ebcdic.c ibmconv.c tapeio.c wibble.c
# Wrapped by nmm1@ursa.cus.cam.ac.uk on Fri Aug  4 15:43:57 1995
PATH=/bin:/usr/bin:/usr/ucb ; export PATH
if test -f 'READ_ME' -a "${1}" != "-c" ; then 
  echo shar: Will not clobber existing file \"'READ_ME'\"
else
echo shar: Extracting \"'READ_ME'\" \(11476 characters\)
sed "s/^X//" >'READ_ME' <<'END_OF_FILE'
XThe MVSTAPE Suite of Programs
X-----------------------------
X
XThis suite of programs will read IBM MVS tapes and others with related formats,
Xwith a variety of options for scanning their contents and extracting their
Xfiles.  It will handle both IBM Standard Label and unlabelled tapes (including
Xleading tape mark format), but not ANSI Labelled tapes, CMS dump tapes etc.
X
XThere is also a library of auxiliary functions for unpicking 370 architecture
Xdata formats, which can be used separately from the tape utilities.
X
XIt will handle sequential files in almost all MVS formats (i.e. not RECFM=D!),
XPDSs in TLS and IEBCOPY formats and simple direct access files in TLS format,
Xbut not IEHMOVE unloaded files, VSAM unloaded files etc.  [TLS is the
XUniversity of Cambridge Computing Service Tape Library System format that is
Xbased on IBM Standard Label tapes.]
X
XIt has some fairly fancy error recovery, plus abilities to override label
Xinformation and so on, but was not designed for recovering badly corrupted
Xtapes.  For example, it will not read PDSs at all if it cannot read the PDS
Xdirectory.  It has an optional kludge to carry on after format errors, mainly
Xso that it can read some MTS tapes, but this may cause confusion if used.
X
XSome of the documentation is slightly dependent on the Phoenix system, which is
Xa user-friendly MVS front end developed by the University of Cambridge
XComputing Service, but the programs are not.  All references to Phoenix
Xdependencies can be ignored without harm.
X
XIf anyone wants to extend it to support CMS, MTS, VMS or even VME formats, they
Xare welcome to do so and the author would be interested.  However, the project
Xfor which it was written covered solely MVS.  It should be fairly easy to add
XANSI label support, new sequential file formats, extra code pages and even new
Xtape dictionary or unloaded formats, but much harder to add support for
Xstructured files or error recovery from badly mangled tapes.
X
X
X
XPortability
X-----------
X
XThe code should be extremely portable, but does assume an ANSI C compiler.  It
Xwould be easy to convert it to K&R C, because the main incompatibility is the
Xuse of proformas, but there seems little point.  The program does not have
Xswitches to disable the TLS or debugging code, but they may be ignored when
Xirrelevant.
X
XIt assumes that CHAR_BIT = 8, and WILL NOT WORK if this is false.  There is
Xcode to support machines that are not big-endian, those where short and int are
Xnot 2 and 4 bytes and even segmented architectures, but only the first has been
Xtested.  The system calls have been localised and use a subset of POSIX; the
Xprogram has been converted to OS/2, though only partly tested on it, and should
Xbe easy to convert to other UNIX-like systems, such as VMS or Windows NT.
X
XSome people may want to extend the code pages, but the ones provided should
Xcover most tapes.  Only ebcdic.c needs modifying to add new pages, provided
Xthere are less than a few thousand (i.e. it uses linear lookup).
X
XIt has system-dependent code in three headers (system.h, which includes one of
Xuniextra.h and unifudge.h); this currently distinguishes all UNIX-like systems
Xfrom MS-DOS derivatives (tested on OS/2 2.0) and Macintoshes (untested).  It
Xdoes have some minor bug-bypassing in two other headers (mainly SunOS again!)
Xand three slightly system-dependent files (described below), but the main body
Xof the code is otherwise free of all system-dependent #ifdefs and #ifs.
X
XThe main exception to the above is the short tape- and signal-handling module
Xtapeio.c, which may need modification for each combination of system, tape deck
Xand device driver.  This is, unfortunately, a UNIX limitation and hence cannot
Xbe resolved.  Other systems are liable to be worse.  The version shipped is for
Xa more-or-less generic SCSI tape driver and works under both SunOS and DEC
XUltrix.  It has some #ifdefs for debugging code that may be useful when things
Xgo badly wrong, and some kludges to bypass Sun problems.
X
XNaturally, the POSIX emulation is system-dependent, and the only current one is
Xos2.c.  This should need very little change for any other MS-DOS derivative,
Xand should provide a good basis for other systems.  It has a large amount of
Xcode to check MS-DOS file names, to prevent operating system bugs from trashing
Xthe filing system (which used to happen, and may still do); this can simply be
Xstruck out if irrelevant.  Note that the actual tape support has not been
Ximplemented, and it is assumed that the tapes have been 'diskized' on a UNIX
Xsystem.
X
XAnother exception is the conversion library code in ibmconv.c; while this
Xshould be portable to any genuine ANSI C system, it does use long double and
Xhave Fortran support.  The former may well be broken on some systems, or run
Xlike a drain.  The latter is disabled by default, except for SunOS and HP-UX,
Xwhere the relevant incantations are in the source.  There is no way to provide
XFortran support portably.
X
XThe auxiliary code in weeble.c, wibble.c, convtest.c and convtest.f may be
Xuseful to installers and people porting the code, but does not seem worth
Xconverting from UNIX.  Some of it is system-dependent (especially the
Xconversion testing).  It is included in the distribution in case it is useful
Xto people extending porting the code.
X
X
X
XHorrible Warning
X----------------
X
XThis has been tested by the author and very few other people.  It is not the
Xquality of his code that is most likely to cause trouble - it is the things
Xthat he thought were true and aren't!  While IBM tape and file formats are
Xdocumented, it is what programs actually generate that matters.  The program
Xallows several common breaches of format and, for the benefit of MTS tapes, has
Xan option to ignore really quite drastic errors.  However, the effects of
Xignoring errors may be bizarre.
X
XThere is 5-6,000 lines of code (excluding checking programs and headers), with
Xover 1,000 basic blocks.  Given the fact that many tests are compound and the
Xbasic blocks interact in complex ways, there is just no chance that it will
Xever be fully debugged.  Common code has been used where practicable, but code
Xbeen replicated where this adds clarity.  The lack of structure in many places
Xreflects the lack of structure in the formats it has to decode!  The precise
Xconstraints on global variables are not commented, because that would have
Xadded weeks to the project.
X
XIn an attempt to increase reliability, there is a fair amount of checking (i.e.
Xa huge amount by normal UNIX standards), which itself may bring problems.  If a
Xtape breaks the format conventions unexpectedly, or the system behaves
Xunexpectedly (e.g. random return codes from close()), the program may stop dead
Xor reject the file.  While some of the checks on tape and file formats can be
Xremoved without harm, it is advisable to investigate the cause before doing so.
XInternal consistency checking should never be removed, as later parts of the
Xcode may rely upon it.
X
XBug reports are welcomed, though there is no promise to do anything about them.
X
XKnown half-tested areas include real (i.e. hardware) I/O error handling, some
Xaspects of signal handling (e.g. when signals are ignored on deviant versions
Xof UNIX and other systems) and the OS/2 interface (especially which errors
Xcause OS/2 to fall over).  It is also not clear how much tuning is worthwhile,
Xeven for the basic deck that it was tested on.
X
X
X
XCopyright
X---------
X
XSee file Copyright for the distribution and copyright conditions.  It is
Xcurrently unclear whether the author or the university owns the rights, and so
Xit is marked as joint copyright.  The conditions are the same, so it does not
Xreally matter anyway.
X
X
X
XContents
X--------
X
XThe make file builds four programs: check, loadtape and mvstape (which last has
Xsymbolic links readtape and scantape) and the conversion library (ibmconv.a).
XThere are man pages for check, loadtape, mvstape, readtape and scantape; check
Xis a debugging aid only, and should not normally be installed for end-users.
Xweeble.c, wibble.c, convtest.c, convtest.f and convdata are debugging tools,
Xand should be ignored by most people.  The files in the archive are:
X
XCopyright          -  the copyright conditions
XREAD_ME            -  this file
XMakefile           -  a very simple make file
X
Xcommand.h          -  mvstape's command decoding (reading mode only)
Xcontrol.h          -  mvstape's control of tape reading and scanning
Xebcdic.h           -  loadtape's and mvstape's EBCDIC operations etc.
Xexterns.h          -  mvstape's external functions
Xglobals.h          -  mvstape's external declarations (used everywhere)
Xibmconv.h          -  conversion library functions (user visible header)
Xiebcopy.h          -  mvstape's IEBCOPY unloaded PDS information
Xioerrs.h           -  mvstape's error recovery, entirely comments
Xlabels.h           -  loadtape's and mvstape's tape label definitions
Xloadtape.h         -  loadtape's main header
Xmvstape.h          -  mvstape's main header (kept to a minimum)
Xsystem.h           -  the controlling header for system dependencies
Xtarpit.h           -  mvstape's tar header format description
Xtlsdict.h          -  loadtape's and mvstape's TLS dictionary information
Xtlspds.h           -  mvstape's TLS unloaded PDS information
Xuniextra.h         -  various definitions for UNIX-like systems only
Xunifudge.h         -  various definitions for non UNIX-like systems only
Xversion.h          -  the version number information
X
Xcheck.c            -  the only module for the check program
Xcommand.c          -  mvstape's command-decoding (reading mode only)
Xcontrol.c          -  mvstape's reading mode overall control
Xebcdic.c           -  the translation tables (code pages) etc.
Xibmconv.c          -  the only module for the conversion library functions
Xiebcopy.c          -  mvstape's IEBCOPY unloaded PDS unpicking
Xlabels.c           -  mvstape's tape and TLS label unpicking
Xloadtape.c         -  the only module for the loadtape program
Xmisc.c             -  mvstape's functions that don't fit elsewhere
Xmvstape.c          -  mvstape's argument decoding, initialisation etc.
Xos2.c              -  POSIX emulation and other junk for MS-DOS, OS/2 etc.
Xrecover.c          -  mvstape's specialist I/O error recovery
Xscanning.c         -  mvstape's scanning mode overall control
Xtapeio.c           -  all the actual tape I/O, signal handling etc.
Xtlspds.c           -  mvstape's TLS unloaded PDS unpicking
Xunpick.c           -  mvstape's file decoding and reformatting
X
Xcheck.1            -  for debugging 'diskized' tape files
Xibmconv.3C         -  library of format conversion functions for C
Xibmconv.3F         -  library of format conversion functions for Fortran
Xloadtape.1         -  for creating 'diskized' tape files
Xmvstape.1          -  a pointer to readtape or scantape
Xreadtape.1         -  mvstape's tape reading mode
Xscantape.1         -  mvstape's tape scanning mode
X
Xweeble.c           -  a command for comparing skipping and reading times
Xwibble.c           -  a command for testing tape deck functionality
Xconvtest.c         -  a command for testing the conversion library
Xconvtest.f         -  a command for testing the conversion library
Xconvdata           -  the data for testing the conversion library
X
X
X
XAuthor
X------
X
XN.M. Maclaren,
XUniversity of Cambridge Computer Laboratory,
XNew Museums Site,
XPembroke Street,
XCambridge, CB2 3QG,
XEngland.
XEmail:  NMM1@UCS.CAM.AC.UK
XTel.    +44 223 334761
XFax.    +44 223 334679
X
XJuly 1995
END_OF_FILE
if test 11476 -ne `wc -c <'READ_ME'`; then
    echo shar: \"'READ_ME'\" unpacked with wrong size!
fi
# end of 'READ_ME'
fi
if test -f 'ebcdic.c' -a "${1}" != "-c" ; then 
  echo shar: Will not clobber existing file \"'ebcdic.c'\"
else
echo shar: Extracting \"'ebcdic.c'\" \(11251 characters\)
sed "s/^X//" >'ebcdic.c' <<'END_OF_FILE'
X/* (C) Copyright N.M. Maclaren 1993, 1994, 1995
X   (C) Copyright the University of Cambridge 1993, 1994, 1995
X   ALL RIGHTS RESERVED
X
Xebcdic.c - the translation tables etc. for EBCDIC to ASCII conversion.
XWarning: this is used by check, loadtape and mvstape, as well as the IBM
Xconversion library. */
X
X
X
X#include <ctype.h>
X#include <stdio.h>
X#include <stdlib.h>
X
X#include "ebcdic.h"                      /* This includes <limits.h> */
X
X
X
X/* Define the real code page lookup table and translation table.  The method of
Xinitialization is repulsive, but is all we can do in strict ANSI C. */
X
XINTERN CODE_PAGE code_pages[10];         /* See later for the exact size */
XINTERN const short *ebcdic_to_ascii = NULL;
X
X
X
X/* The following code pages can be modified or replaced, as appropriate, but
Xnote that -1 (not SUB) is used as the bad character indicator; it is replaced
Xby SUB in unpick.c.  Also note that spaces (for stripping) and ANSI control
Xcharacters are not extracted from the tables; as they are all fixed in EBCDIC
Xand only '+' varies with BCD, this should not cause problems! */
X
X
X
X/* The code page currently used in Phoenix - i.e. 7-bit ASCII plus the pound
Xsterling symbol with the NL = LF kludge. */
X
Xstatic const short phx_page[UCHAR_MAX+1] = {
X  -1,0x01,0x02,0x03,  -1,0x09,  -1,0x7f,  -1,  -1,  -1,0x0b,0x0c,0x0d,0x0e,0x0f,
X0x10,0x11,0x12,0x13,  -1,0x0a,0x08,  -1,0x18,0x19,  -1,  -1,0x1c,0x1d,0x1e,0x1f,
X  -1,  -1,  -1,  -1,  -1,0x0a,0x17,0x1b,  -1,  -1,  -1,  -1,  -1,0x05,0x06,0x07,
X  -1,  -1,0x16,  -1,  -1,  -1,  -1,0x04,  -1,  -1,  -1,  -1,0x14,0x15,  -1,0x1a,
X0x20,  -1,  -1,  -1,  -1,  -1,  -1,  -1,  -1,  -1,  -1,0x2e,0x3c,0x28,0x2b,0x7c,
X0x26,  -1,  -1,  -1,  -1,  -1,  -1,  -1,  -1,  -1,0x21,0x24,0x2a,0x29,0x3b,0x7e,
X0x2d,0x2f,  -1,  -1,  -1,  -1,  -1,  -1,  -1,  -1,  -1,0x2c,0x25,0x5f,0x3e,0x3f,
X  -1,0x5e,0xa3,  -1,  -1,  -1,  -1,  -1,  -1,0x60,0x3a,0x23,0x40,0x27,0x3d,0x22,
X  -1,0x61,0x62,0x63,0x64,0x65,0x66,0x67,0x68,0x69,  -1,  -1,  -1,  -1,  -1,  -1,
X  -1,0x6a,0x6b,0x6c,0x6d,0x6e,0x6f,0x70,0x71,0x72,  -1,  -1,  -1,  -1,  -1,  -1,
X  -1,  -1,0x73,0x74,0x75,0x76,0x77,0x78,0x79,0x7a,  -1,  -1,  -1,0x5b,  -1,  -1,
X  -1,  -1,  -1,  -1,  -1,  -1,  -1,  -1,  -1,  -1,  -1,  -1,  -1,0x5d,  -1,  -1,
X0x7b,0x41,0x42,0x43,0x44,0x45,0x46,0x47,0x48,0x49,  -1,  -1,  -1,  -1,  -1,  -1,
X0x7d,0x4a,0x4b,0x4c,0x4d,0x4e,0x4f,0x50,0x51,0x52,  -1,  -1,  -1,  -1,  -1,  -1,
X0x5c,  -1,0x53,0x54,0x55,0x56,0x57,0x58,0x59,0x5a,  -1,  -1,  -1,  -1,  -1,  -1,
X0x30,0x31,0x32,0x33,0x34,0x35,0x36,0x37,0x38,0x39,  -1,  -1,  -1,  -1,  -1,  -1
X};
X
X
X
X/* The 8-bit code page currently used in Phoenix - i.e. code page 37 modified to
Xbe compatible with the Phoenix 7-bit one. */
X
Xstatic const short phx8_page[UCHAR_MAX+1] = {
X0x00,0x01,0x02,0x03,0x9C,0x09,0x86,0x7F,0x97,0x8D,0x8E,0x0B,0x0C,0x0D,0x0E,0x0F,
X0x10,0x11,0x12,0x13,0x9D,0x85,0x08,0x87,0x18,0x19,0x92,0x8F,0x1C,0x1D,0x1E,0x1F,
X0x80,0x81,0x82,0x83,0x84,0x0A,0x17,0x1B,0x88,0x89,0x8A,0x8B,0x8C,0x05,0x06,0x07,
X0x90,0x91,0x16,0x93,0x94,0x95,0x96,0x04,0x98,0x99,0x9A,0x9B,0x14,0x15,0x9E,0x1A,
X0x20,0xA0,0xE2,0xE4,0xE0,0xE1,0xE3,0xE5,0xE7,0xF1,0xA2,0x2E,0x3C,0x28,0x2B,0x7C,
X0x26,0xE9,0xEA,0xEB,0xE8,0xED,0xEE,0xEF,0xEC,0xDF,0x21,0x24,0x2A,0x29,0x3B,0x7E,
X0x2D,0x2F,0xC2,0xC4,0xC0,0xC1,0xC3,0xC5,0xC7,0xD1,0xA6,0x2C,0x25,0x5F,0x3E,0x3F,
X0xF8,0x5E,0xA3,0xCB,0xC8,0xCD,0xCE,0xCF,0xCC,0x60,0x3A,0x23,0x40,0x27,0x3D,0x22,
X0xD8,0x61,0x62,0x63,0x64,0x65,0x66,0x67,0x68,0x69,0xAB,0xBB,0xF0,0xFD,0xFE,0xB1,
X0xB0,0x6A,0x6B,0x6C,0x6D,0x6E,0x6F,0x70,0x71,0x72,0xAA,0xBA,0xE6,0xB8,0xC6,0xA4,
X0xB5,0xAC,0x73,0x74,0x75,0x76,0x77,0x78,0x79,0x7A,0xA1,0xBF,0xD0,0x5B,0xDE,0xAE,
X0xC9,0xCA,0xA5,0xB7,0xA9,0xA7,0xB6,0xBC,0xBD,0xBE,0xDD,0xA8,0xAF,0x5D,0xB4,0xD7,
X0x7B,0x41,0x42,0x43,0x44,0x45,0x46,0x47,0x48,0x49,0xAD,0xF4,0xF6,0xF2,0xF3,0xF5,
X0x7D,0x4A,0x4B,0x4C,0x4D,0x4E,0x4F,0x50,0x51,0x52,0xB9,0xFB,0xFC,0xF9,0xFA,0xFF,
X0x5C,0xF7,0x53,0x54,0x55,0x56,0x57,0x58,0x59,0x5A,0xB2,0xD4,0xD6,0xD2,0xD3,0xD5,
X0x30,0x31,0x32,0x33,0x34,0x35,0x36,0x37,0x38,0x39,0xB3,0xDB,0xDC,0xD9,0xDA,0x9F
X};
X
X
X
X/* The code page used in Phoenix under MVT - the same characters as under MVS,
Xbut before any useful de-facto standards.  There is a kludge for the even older
Xup-arrow and back-arrow. */
X
Xstatic const short phx_mvt_page[UCHAR_MAX+1] = {
X  -1,0x01,0x02,0x03,  -1,0x09,  -1,0x7f,  -1,  -1,  -1,0x0b,0x0c,0x0d,0x0e,0x0f,
X0x10,0x11,0x12,0x13,  -1,0x0a,0x08,  -1,0x18,0x19,  -1,  -1,0x1c,0x1d,0x1e,0x1f,
X  -1,  -1,  -1,  -1,  -1,0x0a,0x17,0x1b,  -1,  -1,  -1,  -1,  -1,0x05,0x06,0x07,
X  -1,  -1,0x16,  -1,  -1,  -1,  -1,0x04,  -1,  -1,  -1,  -1,0x14,0x15,  -1,0x1a,
X0x20,  -1,0x5b,0x5d,0x7b,0x7d,  -1,  -1,  -1,  -1,0xa3,0x2e,0x3c,0x28,0x2b,0x7c,
X0x26,  -1,  -1,  -1,  -1,  -1,  -1,  -1,  -1,  -1,0x21,0x24,0x2a,0x29,0x3b,0x7e,
X0x2d,0x2f,0x5c,  -1,  -1,0x5e,0x5f,  -1,  -1,  -1,0x5e,0x2c,0x25,0x5f,0x3e,0x3f,
X  -1,  -1,  -1,  -1,  -1,  -1,  -1,  -1,  -1,0x60,0x3a,0x23,0x40,0x27,0x3d,0x22,
X  -1,0x61,0x62,0x63,0x64,0x65,0x66,0x67,0x68,0x69,  -1,  -1,  -1,  -1,  -1,  -1,
X  -1,0x6a,0x6b,0x6c,0x6d,0x6e,0x6f,0x70,0x71,0x72,  -1,  -1,  -1,  -1,  -1,  -1,
X  -1,  -1,0x73,0x74,0x75,0x76,0x77,0x78,0x79,0x7a,  -1,  -1,  -1,  -1,  -1,  -1,
X  -1,  -1,  -1,  -1,  -1,  -1,  -1,  -1,  -1,  -1,  -1,  -1,  -1,  -1,  -1,  -1,
X  -1,0x41,0x42,0x43,0x44,0x45,0x46,0x47,0x48,0x49,  -1,  -1,  -1,  -1,  -1,  -1,
X  -1,0x4a,0x4b,0x4c,0x4d,0x4e,0x4f,0x50,0x51,0x52,  -1,  -1,  -1,  -1,  -1,  -1,
X  -1,  -1,0x53,0x54,0x55,0x56,0x57,0x58,0x59,0x5a,  -1,  -1,  -1,  -1,  -1,  -1,
X0x30,0x31,0x32,0x33,0x34,0x35,0x36,0x37,0x38,0x39,  -1,  -1,  -1,  -1,  -1,  -1
X};
X
X
X
X/* IBM code page 37 mapping to 7-bit ASCII with the NL = LF kludge. */
X
Xstatic const short ibm_mvs_page[UCHAR_MAX+1] = {
X  -1,0x01,0x02,0x03,  -1,0x09,  -1,0x7f,  -1,  -1,  -1,0x0b,0x0c,0x0d,0x0e,0x0f,
X0x10,0x11,0x12,0x13,  -1,0x0a,0x08,  -1,0x18,0x19,  -1,  -1,0x1c,0x1d,0x1e,0x1f,
X  -1,  -1,  -1,  -1,  -1,0x0a,0x17,0x1b,  -1,  -1,  -1,  -1,  -1,0x05,0x06,0x07,
X  -1,  -1,0x16,  -1,  -1,  -1,  -1,0x04,  -1,  -1,  -1,  -1,0x14,0x15,  -1,0x1a,
X0x20,  -1,  -1,  -1,  -1,  -1,  -1,  -1,  -1,  -1,  -1,0x2e,0x3c,0x28,0x2b,0x7c,
X0x26,  -1,  -1,  -1,  -1,  -1,  -1,  -1,  -1,  -1,0x21,0x24,0x2a,0x29,0x3b,  -1,
X0x2d,0x2f,  -1,  -1,  -1,  -1,  -1,  -1,  -1,  -1,  -1,0x2c,0x25,0x5f,0x3e,0x3f,
X  -1,  -1,  -1,  -1,  -1,  -1,  -1,  -1,  -1,0x60,0x3a,0x23,0x40,0x27,0x3d,0x22,
X  -1,0x61,0x62,0x63,0x64,0x65,0x66,0x67,0x68,0x69,  -1,  -1,  -1,  -1,  -1,  -1,
X  -1,0x6a,0x6b,0x6c,0x6d,0x6e,0x6f,0x70,0x71,0x72,  -1,  -1,  -1,  -1,  -1,  -1,
X  -1,0x7e,0x73,0x74,0x75,0x76,0x77,0x78,0x79,0x7a,  -1,  -1,  -1,  -1,  -1,  -1,
X0x5e,  -1,  -1,  -1,  -1,  -1,  -1,  -1,  -1,  -1,0x5b,0x5d,  -1,  -1,  -1,  -1,
X0x7b,0x41,0x42,0x43,0x44,0x45,0x46,0x47,0x48,0x49,  -1,  -1,  -1,  -1,  -1,  -1,
X0x7d,0x4a,0x4b,0x4c,0x4d,0x4e,0x4f,0x50,0x51,0x52,  -1,  -1,  -1,  -1,  -1,  -1,
X0x5c,  -1,0x53,0x54,0x55,0x56,0x57,0x58,0x59,0x5a,  -1,  -1,  -1,  -1,  -1,  -1,
X0x30,0x31,0x32,0x33,0x34,0x35,0x36,0x37,0x38,0x39,  -1,  -1,  -1,  -1,  -1,  -1
X};
X
X
X
X/* IBM code page 37 mapping to ISO Latin 1. */
X
Xstatic const short code_37_page[UCHAR_MAX+1] = {
X0x00,0x01,0x02,0x03,0x9c,0x09,0x86,0x7f,0x97,0x8d,0x8e,0x0b,0x0c,0x0d,0x0e,0x0f,
X0x10,0x11,0x12,0x13,0x9d,0x85,0x08,0x87,0x18,0x19,0x92,0x8f,0x1c,0x1d,0x1e,0x1f,
X0x80,0x81,0x82,0x83,0x84,0x0a,0x17,0x1b,0x88,0x89,0x8a,0x8b,0x8c,0x05,0x06,0x07,
X0x90,0x91,0x16,0x93,0x94,0x95,0x96,0x04,0x98,0x99,0x9a,0x9b,0x14,0x15,0x9e,0x1a,
X0x20,0xa0,0xe2,0xe4,0xe0,0xe1,0xe3,0xe5,0xe7,0xf1,0xa2,0x2e,0x3c,0x28,0x2b,0x7c,
X0x26,0xe9,0xea,0xeb,0xe8,0xed,0xee,0xef,0xec,0xdf,0x21,0x24,0x2a,0x29,0x3b,0xac,
X0x2d,0x2f,0xc2,0xc4,0xc0,0xc1,0xc3,0xc5,0xc7,0xd1,0xa6,0x2c,0x25,0x5f,0x3e,0x3f,
X0xf8,0xc9,0xca,0xcb,0xc8,0xcd,0xce,0xcf,0xcc,0x60,0x3a,0x23,0x40,0x27,0x3d,0x22,
X0xd8,0x61,0x62,0x63,0x64,0x65,0x66,0x67,0x68,0x69,0xab,0xbb,0xf0,0xfd,0xfe,0xb1,
X0xb0,0x6a,0x6b,0x6c,0x6d,0x6e,0x6f,0x70,0x71,0x72,0xaa,0xba,0xe6,0xb8,0xc6,0xa4,
X0xb5,0x7e,0x73,0x74,0x75,0x76,0x77,0x78,0x79,0x7a,0xa1,0xbf,0xd0,0xdd,0xde,0xae,
X0x5e,0xa3,0xa5,0xb7,0xa9,0xa7,0xb6,0xbc,0xbd,0xbe,0x5b,0x5d,0xaf,0xa8,0xb4,0xd7,
X0x7b,0x41,0x42,0x43,0x44,0x45,0x46,0x47,0x48,0x49,0xad,0xf4,0xf6,0xf2,0xf3,0xf5,
X0x7d,0x4a,0x4b,0x4c,0x4d,0x4e,0x4f,0x50,0x51,0x52,0xb9,0xfb,0xfc,0xf9,0xfa,0xff,
X0x5c,0xf7,0x53,0x54,0x55,0x56,0x57,0x58,0x59,0x5a,0xb2,0xd4,0xd6,0xd2,0xd3,0xd5,
X0x30,0x31,0x32,0x33,0x34,0x35,0x36,0x37,0x38,0x39,0xb3,0xdb,0xdc,0xd9,0xda,0x9f,
X};
X
X
X
X/* IBM code page 500 mapping to ISO Latin 1. */
X
Xstatic const short code_500_page[UCHAR_MAX+1] = {
X0x00,0x01,0x02,0x03,0x9c,0x09,0x86,0x7f,0x97,0x8d,0x8e,0x0b,0x0c,0x0d,0x0e,0x0f,
X0x10,0x11,0x12,0x13,0x9d,0x85,0x08,0x87,0x18,0x19,0x92,0x8f,0x1c,0x1d,0x1e,0x1f,
X0x80,0x81,0x82,0x83,0x84,0x0a,0x17,0x1b,0x88,0x89,0x8a,0x8b,0x8c,0x05,0x06,0x07,
X0x90,0x91,0x16,0x93,0x94,0x95,0x96,0x04,0x98,0x99,0x9a,0x9b,0x14,0x15,0x9e,0x1a,
X0x20,0xa0,0xe2,0xe4,0xe0,0xe1,0xe3,0xe5,0xe7,0xf1,0x5b,0x2e,0x3c,0x28,0x2b,0x21,
X0x26,0xe9,0xea,0xeb,0xe8,0xed,0xee,0xef,0xec,0xdf,0x5d,0x24,0x2a,0x29,0x3b,0x5e,
X0x2d,0x2f,0xc2,0xc4,0xc0,0xc1,0xc3,0xc5,0xc7,0xd1,0xa6,0x2c,0x25,0x5f,0x3e,0x3f,
X0xf8,0xc9,0xca,0xcb,0xc8,0xcd,0xce,0xcf,0xcc,0x60,0x3a,0x23,0x40,0x27,0x3d,0x22,
X0xd8,0x61,0x62,0x63,0x64,0x65,0x66,0x67,0x68,0x69,0xab,0xbb,0xf0,0xfd,0xfe,0xb1,
X0xb0,0x6a,0x6b,0x6c,0x6d,0x6e,0x6f,0x70,0x71,0x72,0xaa,0xba,0xe6,0xb8,0xc6,0xa4,
X0xb5,0x7e,0x73,0x74,0x75,0x76,0x77,0x78,0x79,0x7a,0xa1,0xbf,0xd0,0xdd,0xde,0xae,
X0xa2,0xa3,0xa5,0xb7,0xa9,0xa7,0xb6,0xbc,0xbd,0xbe,0xac,0x7c,0xaf,0xa8,0xb4,0xd7,
X0x7b,0x41,0x42,0x43,0x44,0x45,0x46,0x47,0x48,0x49,0xad,0xf4,0xf6,0xf2,0xf3,0xf5,
X0x7d,0x4a,0x4b,0x4c,0x4d,0x4e,0x4f,0x50,0x51,0x52,0xb9,0xfb,0xfc,0xf9,0xfa,0xff,
X0x5c,0xf7,0x53,0x54,0x55,0x56,0x57,0x58,0x59,0x5a,0xb2,0xd4,0xd6,0xd2,0xd3,0xd5,
X0x30,0x31,0x32,0x33,0x34,0x35,0x36,0x37,0x38,0x39,0xb3,0xdb,0xdc,0xd9,0xda,0x9f,
X};
X
X
X
Xvoid initialize_code_pages (void) {
X
X/* This horrid little routine checks that there are 8-bit bytes and initializes
Xthe code pages. */
X
X    if (ebcdic_to_ascii != NULL) return;
X    if (CHAR_BIT != 8 || UCHAR_MAX != 255) {
X        fprintf(stderr,"The MVS suit of programs must have 8-bit bytes\n");
X        abort();
X    }
X    code_pages[0].name = "phx";
X    code_pages[0].table = phx_page;
X    code_pages[1].name = "phx8";
X    code_pages[1].table = phx8_page;
X    code_pages[2].name = "phxmvt";
X    code_pages[2].table = phx_mvt_page;
X    code_pages[3].name = "ibmmvs";
X    code_pages[3].table = ibm_mvs_page;
X    code_pages[4].name = "ibm037";
X    code_pages[4].table = code_37_page;
X    code_pages[5].name = "ibm500";
X    code_pages[5].table = code_500_page;
X    code_pages[6].name = NULL;
X    code_pages[6].table = NULL;
X    ebcdic_to_ascii = code_pages[0].table;
X}
X
X
X
XCODE_PAGE *select_code_page (const char *name) {
X
X/* This selects a code page, and returns the first one if the name is NULL
Xor the empty string. */
X
X    CODE_PAGE *ptr;
X    int i;
X
X    initialize_code_pages();
X    ptr = &code_pages[0];
X    ebcdic_to_ascii = ptr->table;
X    if (name == NULL || name[0] == '\0') return ptr;
X    while (ptr->name != NULL) {
X        for (i = 0; toupper(name[i]) == toupper(ptr->name[i]); ++i)
X            if (name[i] == '\0') {
X                ebcdic_to_ascii = ptr->table;
X                return ptr;
X            }
X        ++ptr;
X    }
X    return NULL;
X}
END_OF_FILE
if test 11251 -ne `wc -c <'ebcdic.c'`; then
    echo shar: \"'ebcdic.c'\" unpacked with wrong size!
fi
# end of 'ebcdic.c'
fi
if test -f 'ibmconv.c' -a "${1}" != "-c" ; then 
  echo shar: Will not clobber existing file \"'ibmconv.c'\"
else
echo shar: Extracting \"'ibmconv.c'\" \(9248 characters\)
sed "s/^X//" >'ibmconv.c' <<'END_OF_FILE'
X/* (C) Copyright N.M. Maclaren 1994, 1995
X   (C) Copyright the University of Cambridge 1994, 1995
X   ALL RIGHTS RESERVED
X
Xibmconv.c  -  some library functions to do data conversion from IBM 370 format
Xto local format.
X
XThis includes ebcdic.c, which uses <stdio.h>; this is portable but may be
Xinconvenient.  If so, only one diagnostic need be changed to avoid it.
X
XWhile the code is reasonably portable, it must have 8-bit characters and will
Xwork best on systems with at least 32-bit floats and 64-bit doubles.  A warning
Xto the vaxatious: the code has been tested only on systems with more-or-less
XIEEE arithmetic.
X
XThe code for Fortran support is revolting, but I do not know of any clean way 
Xto do it.
X
XUnlike the main code, it uses ASCII SUB to replace bad characters on all 
Xsystems.  Cleaning this up would be very messy, and it is simplest just to
Xchange it here for MS-DOS derivatives (if anyone wants to).  But there is a
Xmore serious reason for not doing this:
X
XThe handling of floating point exceptions is COMPLETELY knotted under CSet/2
Xand possibly in OS/2 generally.  As far as I can discover, both over- and
Xunder-flow are invariably fatal.  While they can be trapped, attempting to do
Xso brings the library down about my ears.  This means that the conversion of
XREAL*4 to FLOAT is a disaster area.  The preprocessor definition
XKNOTTED_SIGNALS is used to get the code vaguely working. */
X
X
X
X#include <ctype.h>
X#include <errno.h>
X#include <float.h>
X#include <math.h>
X#include <string.h>
X
X#include "ibmconv.h"
X
X#define CONVERSION_LIBRARY
X#include "ebcdic.c"               /* Note:  this includes ebcdic.h */
X
X#define SUB_CHAR    0x1a          /* Used for invalid characters */
X
X
X
X#ifdef __sun
X#define FortranName(a) a##_
X#define LongDouble 0
X#endif
X#ifdef __hpux
X#define FortranName(a) a
X#define LongDouble 1
X#endif
X
X#ifdef FortranName
X
Xextern int FortranName(ibmcodepage) (const char *code_page) {
X    return ibm_code_page(code_page);
X}
Xextern int FortranName(ibmchars) (const void *input, char *output, int *count) {
X    return ibm_chars(input,output,*count);
X}
Xextern int FortranName(ibmint2s) (const void *input, short *output,
X        int *count) {
X    return ibm_shorts(input,output,*count);
X}
Xextern int FortranName(ibmint4s) (const void *input, long *output, int *count) {
X    return ibm_longs(input,output,*count);
X}
Xextern int FortranName(ibmreal4s) (const void *input, float *output,
X        int *count) {
X    return ibm_floats(input,output,*count);
X}
Xextern int FortranName(ibmreal8s) (const void *input, double *output,
X        int *count) {
X    return ibm_doubles(input,output,*count);
X}
Xextern int FortranName(ibmreal16s) (const void *input, long double *output,
X        int *count) {
X#if LongDouble
X    return ibm_long_doubles(input,output,*count);
X#else
X    fprintf(stderr,"The IBMREAL16S Fortran function is not available.\n");
X    abort();
X#endif
X}
X
X#endif    /* FortranName */
X
X
X
Xint ibm_code_page (const char *code_page) {
X
X/* Set up the code page.  Return 0 for success and -1 for page not found. */
X
X    initialize_code_pages();
X    return (select_code_page(code_page) != NULL ? 0 : -1);
X}
X
X
X
Xextern int ibm_chars (const void *input, char *output, int count) {
X
X/* Translate characters from EBCDIC to ASCII.  Return 0 for success and -1 for
Xa negative count.  Set errno to EDOM and return 1 if any untranslatable
Xcharacters. */
X
X    const unsigned char *ptr = (const unsigned char *)input;
X    int code = 0, i, n;
X
X    initialize_code_pages();
X    if (count < 0) return -1;
X    for (i = 0; i < count; ++i) {
X        if ((n = EBCDIC_to_ASCII(*ptr++)) < 0) {
X            n = SUB_CHAR;
X            errno = EDOM;
X            code = 1;
X        }
X        *output++ = n;
X    }
X    return code;
X}
X
X
X
Xextern int ibm_shorts (const void *input, short *output, int count) {
X
X/* Translate signed halfword integers into native form.  Return 0 for
Xsuccess and -1 for a negative count.  Set errno to ERANGE and return 1 if
Xany overflow. */
X
X    const unsigned char *ptr = (const unsigned char *)input;
X    int code = 0, i;
X    short k;
X    long n;
X
X    if (count < 0) return -1;
X    for (i = 0; i < count; ++i) {
X        n = get_BE_short(ptr);
X        k = n = (n < 0x8000 ? n : n-0x10000);
X        if (k != n) {
X            errno = ERANGE;
X            code = 1;
X        }
X        *output++ = k;
X        ptr += 2;
X    }
X    return code;
X}
X
X
X
Xextern int ibm_ints (const void *input, int *output, int count) {
X
X/* Translate signed fullword integers into native form.  Return 0 for
Xsuccess and -1 for a negative count.  Set errno to ERANGE and return 1 if
Xany overflow. */
X
X    const unsigned char *ptr = (const unsigned char *)input;
X    int code = 0, i, k;
X    unsigned long n;
X
X    if (count < 0) return -1;
X    for (i = 0; i < count; ++i) {
X        n = get_BE_int(ptr);
X        k = (n < 0x80000000u ? n :
X            ((long)(n-0x80000000u)-0x40000000u)-0x40000000u);
X        if (k != n) {
X            errno = ERANGE;
X            code = 1;
X        }
X        *output++ = k;
X        ptr += 4;
X    }
X    return code;
X}
X
X
X
Xextern int ibm_longs (const void *input, long *output, int count) {
X
X/* Translate signed fullword integers into native form.  Return 0 for
Xsuccess and -1 for a negative count.  Set errno to ERANGE and return 1 if
Xany overflow. */
X
X    const unsigned char *ptr = (const unsigned char *)input;
X    int code = 0, i;
X    long k;
X    unsigned long n;
X
X    if (count < 0) return -1;
X    for (i = 0; i < count; ++i) {
X        n = get_BE_int(ptr);
X        k = (n < 0x80000000u ? n :
X            ((long)(n-0x80000000u)-0x40000000u)-0x40000000u);
X        if (k != n) {
X            errno = ERANGE;
X            code = 1;
X        }
X        *output++ = k;
X        ptr += 4;
X    }
X    return code;
X}
X
X
X
Xextern int ibm_floats (const void *input, float *output, int count) {
X
X/* Translate single precision floating point numbers into native form.  Return
X0 for success and -1 for a negative count.  Set errno to ERANGE and return 1 if
Xany overflow. */
X
X    const unsigned char *ptr = (const unsigned char *)input;
X    double d;
X    unsigned long k;
X    int code = 0, error = errno, i, j, n;
X
X    if (count < 0) return -1;
X    for (i = 0; i < count; ++i) {
X        n = *ptr++;
X        k = 0;
X        for (j = 0; j < 3; ++j) k = (k<<8)+*ptr++;
X        errno = 0;
X        d = ldexp((double)k,4*((n&0x7f)-64-6));
X        if (d > FLT_MAX || errno == ERANGE) {
X            d = FLT_MAX;
X            error = ERANGE;
X            code = 1;
X        }
X#ifdef KNOTTED_SIGNALS
X        if (d < FLT_MIN) d = FLT_MIN;
X#endif
X        *output++ = (n&0x80 ? -d : d);
X    }
X    errno = error;
X    return code;
X}
X
X
X
Xextern int ibm_doubles (const void *input, double *output, int count) {
X
X/* Translate double precision floating point numbers into native form.  Return
X0 for success and -1 for a negative count.  Set errno to ERANGE and return 1 if
Xany overflow. */
X
X    const unsigned char *ptr = (const unsigned char *)input;
X    double d;
X    unsigned long k;
X    int code = 0, error = errno, i, j, n;
X
X    if (count < 0) return -1;
X    for (i = 0; i < count; ++i) {
X        n = *ptr++;
X        k = 0;
X        for (j = 0; j < 3; ++j) k = (k<<8)+*ptr++;
X        d = (double)k;
X        d = 65536.0*d+((*ptr<<8)+*(ptr+1));
X        ptr += 2;
X        d = 65536.0*d+((*ptr<<8)+*(ptr+1));
X        ptr += 2;
X        errno = 0;
X        d = ldexp(d,4*((n&0x7f)-64-14));
X        if (d > DBL_MAX || errno == ERANGE) {
X            error = ERANGE;
X            code = 1;
X        }
X        *output++ = (n&0x80 ? -d : d);
X    }
X    errno = error;
X    return code;
X}
X
X
X
Xextern int ibm_long_doubles (const void *input, long double *output,
X    int count) {
X
X/* Translate extended precision floating point numbers into native form.
XReturn 0 for success and -1 for a negative count.  Set errno to ERANGE and
Xreturn 1 if any overflow. */
X
X    const unsigned char *ptr = (const unsigned char *)input;
X    long double d;
X    unsigned long k;
X    int code = 0, i, j, m, n;
X
X    if (count < 0) return -1;
X    for (i = 0; i < count; ++i) {
X        n = *ptr++;
X        k = 0;
X        for (j = 0; j < 3; ++j) k = (k<<8)+*ptr++;
X        d = (long double)k;
X        d = 65536.0L*d+((*ptr<<8)+*(ptr+1));
X        ptr += 2;
X        d = 65536.0L*d+((*ptr<<8)+*(ptr+1));
X        ptr += 2;
X        ++ptr;
X        k = 0;
X        for (j = 0; j < 3; ++j) k = (k<<8)+*ptr++;
X        d = 16777216.0L*d+(long double)k;
X        d = 65536.0L*d+((*ptr<<8)+*(ptr+1));
X        ptr += 2;
X        d = 65536.0L*d+((*ptr<<8)+*(ptr+1));
X        ptr += 2;
X        m = 4*((n&0x7f)-64-28);
X/* Checking this properly is a really foul job - as far as I know, the test
Xcannot fail on any current architecture! */
X        if (m+4*28 > 3.32*LDBL_MAX_10_EXP) {
X            d = LDBL_MAX;
X            errno = ERANGE;
X            code = 1;
X        } else {
X            while (m >= 16) {
X                m -= 16;
X                d *= 65536.0L;
X            }
X            while (m <= -16) {
X                m += 16;
X                d /= 65536.0L;
X            }
X            while (m > 0) {
X                --m;
X                d *= 2.0;
X            }
X            while (m < 0) {
X                ++m;
X                d /= 2.0;
X            }
X        }
X        *output++ = (n&0x80 ? -d : d);
X    }
X    return code;
X}
END_OF_FILE
if test 9248 -ne `wc -c <'ibmconv.c'`; then
    echo shar: \"'ibmconv.c'\" unpacked with wrong size!
fi
# end of 'ibmconv.c'
fi
if test -f 'tapeio.c' -a "${1}" != "-c" ; then 
  echo shar: Will not clobber existing file \"'tapeio.c'\"
else
echo shar: Extracting \"'tapeio.c'\" \(9840 characters\)
sed "s/^X//" >'tapeio.c' <<'END_OF_FILE'
X/* (C) Copyright N.M. Maclaren 1993, 1994, 1995
X   (C) Copyright the University of Cambridge 1993, 1994, 1995
X   ALL RIGHTS RESERVED
X
Xtapeio.c  -  the functions to access the tape and the signal handling (sic).
XWhile these can be written portably, efficiency considerations, broken
Xversions of UNIX and demented devices (and their drivers) mean that they will
Xneed attention on many systems.  Note that this includes no private headers,
Xand so may be used from any appropriate program.  Special code is triggered by
Xtwo pre-processor symbols, both of which should be undefined for most systems:
X
X#ifdef __sun
XThis provides extra diagnostics and bypasses for Solaris 2 problems.  Some of
Xthe code may be useful for other 'System V' systems.
X
X#ifdef TAPE_DEBUG
XThis is for debugging tape-related problems, and may be ignored unless it is
Xuseful.
X*/
X
X
X
X/* The following are all the external headers.  Note that system.h includes
Xseveral others, and must come first both for POSIX compliance and to bypass a
XSolaris 2 header bug. */
X
X#include "system.h"
X
X#include <signal.h>
X
X#include <sys/ioctl.h>
X#include <sys/mtio.h>
X
X
X
Xstatic unsigned char following_EOF = 0;    /* Kludge up a Solaris 2 insanity */
X
X
X
Xint basic_tape_open (const char *name) {
X
X/* Open the tape device for input, check that it seems to be a tape device, and
Xrewind to load point. */
X
X    int fileno;
X    struct mtget mt_status;
X    struct stat status;
X    struct mtop mt_command;
X
X#ifdef TAPE_DEBUG
X    fprintf(stderr,"Opening tape '%s'",name);
X#endif
X    errno = 0;
X    if ((fileno = open(name,O_RDONLY)) < 0)
X        fileno = -1;
X    else if (fstat(fileno,&status) != 0 || ! S_ISCHR(status.st_mode)) {
X        close(fileno);
X        fileno = -2;
X    } else if (ioctl(fileno,MTIOCGET,&mt_status) < 0 ||
X            mt_status.mt_erreg != 0) {
X        close(fileno);
X        fileno = -3;
X    } else {
X        mt_command.mt_op = MTREW;
X        mt_command.mt_count = 1;
X        if (ioctl(fileno,MTIOCTOP,&mt_command) < 0) {
X            close(fileno);
X            fileno = -4;
X        }
X    }
X    following_EOF = 0;
X#ifdef TAPE_DEBUG
X    fprintf(stderr," returns %d\n",fileno);
X#endif
X    return fileno;
X}
X
X
X
Xint basic_tape_close (int fileno) {
X
X/* Close the tape device. */
X
X    int result;
X
X#ifdef TAPE_DEBUG
X    fprintf(stderr,"Closing tape %d ",fileno);
X#endif
X    errno = 0;
X    result = close(fileno);
X    following_EOF = 0;
X#ifdef TAPE_DEBUG
X    fprintf(stderr," returns %d\n",result);
X#endif
X    return result;
X}
X
X
X
Xint basic_tape_rewind (int fileno) {
X
X/* Rewind a tape, leaving it at the load point. */
X
X    int result;
X    struct mtop mt_command;
X
X#ifdef TAPE_DEBUG
X    fprintf(stderr,"Rewinding tape %d ",fileno);
X#endif
X    errno = 0;
X    mt_command.mt_op = MTREW;
X    mt_command.mt_count = 1;
X    result = ioctl(fileno,MTIOCTOP,&mt_command);
X    following_EOF = 0;
X#ifdef TAPE_DEBUG
X    fprintf(stderr," returns %d\n",result);
X#endif
X    return result;
X}
X
X
X
X/* The SCSI sense key and the SCSI error code are printed on the console by the
Xdevice driver; the first appears to come back in mt_erreg, but the second is
Xthrown away.  As I can find no description of what it means (if anything), this
Xdoes not matter much.  Heaven alone knows what rubbish is returned in mt_status
Xand mt_dsreg! */
X
X#ifdef __sun
X#define error_code_limit 23    /* This must be kept in step */
X#define SUN_EOF          18
X#define SUN_EOT          19
X#else
X#define error_code_limit 16    /* This must be kept in step */
X#endif
X
Xstatic struct {const char *define, *meaning;} error_codes[] = {
X    {"NO_SENSE", "whatever that means after an error - please report this"},
X    {"RECOVERABLE_ERROR", "this shouldn't happen - please report it"},
X    {"NOT_READY", "load tape and make sure ONLINE button is lit"},
X    {"MEDIUM_ERROR", "probably a stretch of bad tape or bad block"},
X    {"HARDWARE_ERROR", "tape drive is broken - please report it"},
X    {"ILLEGAL_REQUEST", "this shouldn't happen - please report it"},
X    {"UNIT_ATTENTION", "tape needs attention - please report it"},
X    {"WRITE_PROTECT", "this shouldn't happen - please report it"},
X    {"BLANK_CHECK", "attempting to read beyond end of written tape"},
X    {"VENDOR_UNIQUE", "whatever that means - please report this"},
X    {"COPY_ABORTED", "whatever that means - please report this"},
X    {"ABORTED_COMMAND", "this shouldn't happen - please report it"},
X    {"EQUAL", "whatever that means - please report this"},
X    {"VOLUME_OVERFLOW", "this shouldn't happen - please report it"},
X    {"MISCOMPARE", "whatever that means - please report this"},
X    {"RESERVED", "whatever that means - please report this"},
X    {"SUN_FATAL", "scsi handshake failure - please report this"},
X    {"SUN_TIMEOUT", "command timeout - please report this"},
X    {"SUN_EOF", "this shouldn't happen - please report it"},    /* But .... */
X    {"SUN_EOT", "this shouldn't happen - please report it"},
X    {"SUN_LENGTH", "this shouldn't happen - please report it"},
X    {"SUN_BOT", "this shouldn't happen - please report it"},
X    {"SUN_WRONGMEDIA", "this shouldn't happen - please report it"}
X};
X
X
X
Xconst char * basic_tape_status (int fileno) {
X
X/* Create a string containing some diagnostics after an I/O error or unexpected
XEOF on tape.  When and if I discover more information, I shall be able to do
Xbetter! */
X
X    struct mtget mt_status;
X    static char text[100];
X    int n;
X
X#ifdef TAPE_DEBUG
X    fprintf(stderr,"Getting status on tape %d ",fileno);
X#endif
X    if (ioctl(fileno,MTIOCGET,&mt_status) < 0) {
X#ifdef TAPE_DEBUG
X        fprintf(stderr," returns NULL\n");
X#endif
X        return NULL;
X    }
X#if 0 == 1
X/* Leave the (SunOS) testing code here, #ifed out, for possible help with
Xporting.  Other systems are very similar, but some of the field names may vary.
XHP-UX does, at least. */
X    sprintf(text,"type=%x, dsreg=%x, erreg=%x, resid=%x, fileno=%x, blkno=%x,
X        flags=%x, bf=%x",(unsigned short)mt_status.mt_type,
X        (unsigned short)mt_status.mt_dsreg,(unsigned short)mt_status.mt_erreg,
X        (unsigned long)mt_status.mt_resid,(unsigned long)mt_status.mt_fileno,
X        (unsigned long)mt_status.mt_blkno,(unsigned short)mt_status.mt_flags,
X        (unsigned short)mt_status.mt_bf);
X#endif
X    n = mt_status.mt_erreg;
X    if (n >= 0 && n < error_code_limit)
X        sprintf(text,"sense key %d (%s) %s",n,error_codes[n].define,
X            error_codes[n].meaning);
X    else
X        sprintf(text,"unknown sense key value %d - please report this",n);
X#ifdef TAPE_DEBUG
X    fprintf(stderr," returns '%s'\n",text);
X#endif
X    return text;
X}
X
X
X
Xint basic_tape_skip (int fileno, int labels, int data) {
X
X/* This skips none or more label files and none or more data files.  It is not
Xobvious when it should use ioctl() and when it should read the data. */
X
X    int result;
X    struct mtop mt_command;
X
X#ifdef TAPE_DEBUG
X    fprintf(stderr,"Skipping tape %d labels %d other files %d ",
X        fileno,labels,data);
X#endif
X    errno = 0;
X    mt_command.mt_op = MTFSF;
X    if (labels+data > 0) {
X        mt_command.mt_count = (int)(labels+data);
X        result = ioctl(fileno,MTIOCTOP,&mt_command);
X        following_EOF = 0;
X    } else
X        result = 0;
X#ifdef TAPE_DEBUG
X    fprintf(stderr," returns %d\n",result);
X#endif
X    return result;
X}
X
X
X
Xint basic_tape_read (int fileno, char *buffer, int length) {
X
X/* Read an actual tape block.  The horrible Sun-dependent code is to bypass one
Xinsanity of 'System V' tapes under Solaris 2 - other 'System V' systems may have
Xthe same behaviour, though I am not convinced. */
X
X#ifdef __sun
X    struct mtget mt_status;
X    struct mtop mt_command;
X#endif
X    int result, n;
X
X#ifdef TAPE_DEBUG
X    fprintf(stderr,"Reading tape %d buffer %p length %d ",fileno,buffer,length);
X#endif
X    errno = 0;
X    result = read(fileno,buffer,length);
X#ifdef __sun
X/* This is truly horrible, but is needed to kludge up Sun's incompetence! */
X    while (following_EOF && result < 0 &&
X            ioctl(fileno,MTIOCGET,&mt_status) >= 0 &&
X            (mt_status.mt_erreg == SUN_EOF || mt_status.mt_erreg == SUN_EOT)) {
X        mt_command.mt_op = MTFSF;
X        mt_command.mt_count = 1;
X        if (ioctl(fileno,MTIOCTOP,&mt_command) < 0) break;
X        result = read(fileno,buffer,length);
X    }
X#endif
X    following_EOF = (result == 0);
X#ifdef TAPE_DEBUG
X    fprintf(stderr," returns %d\n",result);
X#endif
X    return result;
X}
X
X
X
Xstatic void (*receiver_address)(const char *);
X
X
X
Xstatic void handler (int sig) {
X
X/* Trap certain signals and unload the tape where possible.  Note that
Xresetting the signal handler could cause problems with stuck decks. */
X
X    const char *error;
X
X#ifdef TAPE_DEBUG
X    fprintf(stderr,"Trapping signal %d\n",sig);
X#endif
X    switch (sig) {
Xcase SIGHUP: error = "hangup (e.g. logoff)"; break;
Xcase SIGINT: error = "interrupt (e.g. control-C)"; break;
Xcase SIGQUIT: error = "quit (kill with dump)"; break;
Xcase SIGPIPE: error = "write on closed pipe"; break;
Xcase SIGALRM: error = "timer alarm"; break;
Xcase SIGTERM: error = "terminate (i.e. kill)"; break;
Xcase SIGTSTP: error = "terminal stop"; break;
Xcase SIGTTIN: error = "no tty for input"; break;
Xcase SIGTTOU: error = "no tty for output"; break;
Xdefault: error = "unknown reason"; break;
X    }
X    receiver_address(error);
X}
X
X
X
Xvoid basic_tape_signal (void (*receiver)(const char *)) {
X
X    receiver_address = receiver;
X
X/* Trap all of the signals that are at all likely to be caused by normal,
Xexternal events (including user action), to allow some cleaning up. */
X
X#ifdef TAPE_DEBUG
X    fprintf(stderr,"Setting signal handler to %p\n",receiver);
X#endif
X    signal(SIGHUP,handler);
X    signal(SIGINT,handler);
X    signal(SIGQUIT,handler);
X    signal(SIGPIPE,handler);
X    signal(SIGALRM,handler);
X    signal(SIGTERM,handler);
X    signal(SIGTSTP,handler);
X    signal(SIGTTIN,handler);
X    signal(SIGTTOU,handler);
X}
END_OF_FILE
if test 9840 -ne `wc -c <'tapeio.c'`; then
    echo shar: \"'tapeio.c'\" unpacked with wrong size!
fi
# end of 'tapeio.c'
fi
if test -f 'wibble.c' -a "${1}" != "-c" ; then 
  echo shar: Will not clobber existing file \"'wibble.c'\"
else
echo shar: Extracting \"'wibble.c'\" \(7689 characters\)
sed "s/^X//" >'wibble.c' <<'END_OF_FILE'
X/* (C) Copyright N.M. Maclaren 1993
X   (C) Copyright the University of Cambridge 1993
X   ALL RIGHTS RESERVED
X
Xweeble.c - an auxiliary that tests a couple of aspects of the performance and
Xfunctionality of tape drives.  Note that a non-rewinding raw device must be
Xused.  Note also that it assumes UNIX, because it is not intended for release
Xto users. */
X
X
X
X#include <stdio.h>
X#include <stdlib.h>
X#include <string.h>
X#include <time.h>
X#if ! __STDC__ || defined(sun)    /* Yes, it's Sun again! */
X#define difftime(x,y) ((double)((x)-(y)))
X#endif
X
X#include <unistd.h>
X#include <fcntl.h>
X#include <sys/stat.h>
X#include <sys/types.h>
X#ifdef USE_NBUF
X#include <sys/ioctl.h>
X#else
X#define OPEN open
X#define CLOSE close
X#define READ read
X#define WRITE write
X#endif
X
X
X
X#define records 2000          /* 2000 is just under 25 MB in all */
X
Xint blocksizes[12] = {1,2,3,4,5,32760,16,17,18,19,20,32759};
X
X
X
Xint main (argc, argv)
Xint argc;
Xchar *argv[];
X{
X    int filedes, i, j, k, l;
X    char random;
X    time_t time1, time2;
X    char *buffer;
X
X    if (argc != 2) {
X        fprintf(stderr,"Invalid number of arguments\n");
X        exit(1);
X    }
X    if ((buffer = malloc(33000)) == NULL) {
X        fprintf(stderr,"Unable to get buffer\n");
X        exit(1);
X    }
X
X    strcpy(buffer,"mt -f ");
X    strcat(buffer,argv[1]);
X    strcat(buffer," rew");
X    if (system(buffer) != 0) {
X        fprintf(stderr,"Unable to position initially\n");
X        exit(1);
X    }
X
X    random = 0;
X    for (k = 0; k < 2; ++k) {
X        time1 = time(NULL);
X        if ((filedes = OPEN(argv[1],O_WRONLY)) < 0) {
X            fprintf(stderr,"Unable to open device file\n");
X            perror("");
X            exit(1);
X        }
X        for (i = 0; i < records; ++i) {
X            l = (i < 12 ? blocksizes[i] : 6000);
X            for (j = 0; j < l; ++j) buffer[j] = (random = 13*random+1);
X            if (WRITE(filedes,buffer,l) != l) {
X                fprintf(stderr,"I/O error on writing record %d\n",i);
X                perror("");
X                exit(1);
X            }
X        }
X        CLOSE(filedes);
X        time2 = time(NULL);
X        printf("Time to write %d MB:  %.0f seconds\n",
X            (6*records+500)/1000,difftime(time2,time1));
X    }
X
X    if ((filedes = OPEN(argv[1],O_WRONLY)) < 0) {
X        fprintf(stderr,"Unable to open device file\n");
X        perror("");
X        exit(1);
X    }
X    if (WRITE(filedes,"Kilroy was here",15) != 15) {
X        fprintf(stderr,"I/O error on writing\n");
X        perror("");
X        exit(1);
X    }
X    CLOSE(filedes);
X
X    time1 = time(NULL);
X    strcpy(buffer,"mt -f ");
X    strcat(buffer,argv[1]);
X    strcat(buffer," rew");
X    if (system(buffer) != 0) {
X        fprintf(stderr,"Unable to rewind tape\n");
X        exit(1);
X    }
X    time2 = time(NULL);
X    printf("Time to rewind tape:  %.0f seconds\n",difftime(time2,time1));
X
X    random = 0;
X    for (k = 0; k < 2; ++k) {
X        time1 = time(NULL);
X        if ((filedes = OPEN(argv[1],O_RDONLY)) < 0) {
X            fprintf(stderr,"Unable to open device file\n");
X            perror("");
X            exit(1);
X        }
X        for (i = 0; i < records; ++i) {
X            l = (i < 12 ? blocksizes[i] : 6000);
X            if (READ(filedes,buffer,33000) != l) {
X                fprintf(stderr,"I/O error on reading record %d\n",i);
X                perror("");
X                exit(1);
X            }
X            for (j = 0; j < l; ++j)
X                if (buffer[j] != (random = 13*random+1)) {
X                fprintf(stderr,"Block contents mismatch\n");
X                exit(1);
X            }
X        }
X        if (READ(filedes,buffer,33000) != 0) {
X            fprintf(stderr,"Failed to detect filemark\n");
X            perror("");
X            exit(1);
X        }
X        CLOSE(filedes);
X        time2 = time(NULL);
X        printf("Time to read %d MB:  %.0f seconds\n",
X            (6*records+500)/1000,difftime(time2,time1));
X    }
X
X    time1 = time(NULL);
X    strcpy(buffer,"mt -f ");
X    strcat(buffer,argv[1]);
X    strcat(buffer," rew");
X    if (system(buffer) != 0) {
X        fprintf(stderr,"Unable to rewind tape\n");
X        exit(1);
X    }
X    time2 = time(NULL);
X    printf("Time to rewind tape:  %.0f seconds\n",difftime(time2,time1));
X
X    time1 = time(NULL);
X    strcpy(buffer,"mt -f ");
X    strcat(buffer,argv[1]);
X    strcat(buffer," fsf 2");
X    if (system(buffer) != 0) {
X        fprintf(stderr,"Unable to skip files\n");
X        exit(1);
X    }
X    if ((filedes = OPEN(argv[1],O_RDONLY)) < 0) {
X        fprintf(stderr,"Unable to open device file\n");
X        perror("");
X        exit(1);
X    }
X    if (READ(filedes,buffer,15) != 15 ||
X            memcmp(buffer,"Kilroy was here",15) != 0) {
X        fprintf(stderr,"Failed to skip correctly\n");
X        perror("");
X        exit(1);
X    }
X    CLOSE(filedes);
X    time2 = time(NULL);
X    printf("Time to skip files:  %.0f seconds\n",difftime(time2,time1));
X
X    strcpy(buffer,"mt -f ");
X    strcat(buffer,argv[1]);
X    strcat(buffer," offl");
X    system(buffer);
X    exit(0);
X}
X
X
X
X/* The following is for Ultrix only. */
X
X#ifdef USE_NBUF
X#define NBUFF 5
X
Xint writing, buffptr, buffcount;
Xchar *buffers[NBUFF];
X
Xint OPEN (name, mode)
Xchar *name;
Xint mode;
X{
X    int i, count = NBUFF, filedes;
X    if ((filedes = open(name,mode)) < 0) return filedes;
X    if (ioctl(filedes,FIONBUF,&count) < 0) {
X        fprintf(stderr,"Unable to set up buffering\n");
X        exit(1);
X    }
X    writing = (mode == O_WRONLY);
X    for (i = 0; i < NBUFF; ++i)
X        if ((buffers[i] = malloc(33000)) == NULL) {
X            fprintf(stderr,"Unable to get buffer\n");
X            exit(1);
X        }
X    buffptr = buffcount = 0;
X    if (! writing) {
X        for (i = 0 ; i < NBUFF; ++i)
X            if (read(filedes,buffers[i],33000) < 0) {
X                fprintf(stderr,"I/O error on reading 0\n");
X                perror("");
X                exit(1);
X            }
X    }
X    return filedes;
X}
X
XCLOSE (filedes)
Xint filedes;
X{
X    char *currbuff;
X    int i;
X    if (writing) {
X        if (buffcount < NBUFF) buffptr = 0;
X        for (i = 0 ; i < (buffcount < NBUFF ? buffcount : NBUFF); ++i) {
X            currbuff = buffers[buffptr];
X            if (++buffptr >= NBUFF) buffptr = 0;
X            if (ioctl(filedes,FIONBDONE,&currbuff) < 0) {
X                fprintf(stderr,"I/O error on writing 3\n");
X                perror("");
X                exit(1);
X            }
X        }
X    }
X    for (i = 0; i < NBUFF; ++i) free(buffers[i]);
X    ioctl(filedes,FIONBUF,0);
X    close(filedes);
X}
X
Xint READ (filedes, buffer, count)
Xint filedes;
Xchar *buffer;
Xint count;
X{
X    char *currbuff = buffers[buffptr];
X    int status;
X    if ((status = ioctl(filedes,FIONBDONE,&currbuff)) < 0) {
X        fprintf(stderr,"I/O error on reading record %d (1)\n",buffcount);
X        perror("");
X        exit(1);
X    }
X    memcpy(buffer,currbuff,status);
X    ++buffcount;
X    if (read(filedes,currbuff,count) < 0) {
X        fprintf(stderr,"I/O error on reading record %d (2)\n",buffcount);
X        perror("");
X        exit(1);
X    }
X    if (++buffptr >= NBUFF) buffptr = 0;
X    return status;
X}
X
Xint WRITE (filedes, buffer, count)
Xint filedes;
Xchar *buffer;
Xint count;
X{
X    char *currbuff = buffers[buffptr];
X    int status;
X    if (buffcount >= 5 && ioctl(filedes,FIONBDONE,&currbuff) < 0) {
X        fprintf(stderr,"I/O error on writing record %d (1)\n",buffcount);
X        perror("");
X        exit(1);
X    }
X    memcpy(currbuff,buffer,count);
X    ++buffcount;
X    if ((status = write(filedes,currbuff,count)) < 0) {
X        fprintf(stderr,"I/O error on writing record %d (2)\n",buffcount);
X        perror("");
X        exit(1);
X    }
X    if (++buffptr >= NBUFF) buffptr = 0;
X    return status;
X}
X#endif
END_OF_FILE
if test 7689 -ne `wc -c <'wibble.c'`; then
    echo shar: \"'wibble.c'\" unpacked with wrong size!
fi
# end of 'wibble.c'
fi
echo shar: End of archive 3 \(of 9\).
cp /dev/null ark3isdone
MISSING=""
for I in 1 2 3 4 5 6 7 8 9 ; do
    if test ! -f ark${I}isdone ; then
	MISSING="${MISSING} ${I}"
    fi
done
if test "${MISSING}" = "" ; then
    echo You have unpacked all 9 archives.
    rm -f ark[1-9]isdone ark[1-9][0-9]isdone
else
    echo You still need to unpack the following archives:
    echo "        " ${MISSING}
fi
##  End of shell archive.
exit 0


