/*
 * This version of my FLX
 * runs on VAX/VMS. I converted it
 * because I think there is an illegal
 * character in one of the names on the
 * 68000 compiler source tape. This program
 * is based on the old one, but has a lot of
 * the stupid stuff having to do with the
 * way names were handled fixed.
 */
#include	<stdio.h>
#include	<time.h>
#include	<ssdef.h>
#include	<stsdef.h>
#include	<descrip.h>
#include	<iodef.h>

#define	NBLOCK	512			/* Size of a tape block		*/
#define	NNAME	20			/* # of names to extract	*/
#define	MINREC	14			/* Smallest tape record		*/
#define	TRUE	1			/* Truth			*/
#define	FALSE	0			/* Falsehood			*/
#define	NUL	0x00			/* Null byte			*/
#define	CR	0x0D			/* Carriage return		*/

#define	GOOD	(SS$_NORMAL)			/* Exit status		*/
#define	NASTY	(STS$M_INHIB_MSG|SS$_ABORT)	/* Exit status		*/

typedef	struct	label {			/* FLX tape file label		*/
	short	l_name0[2];		/* Two radix 50 name words	*/
	short	l_type[1];		/* Radix 50 type		*/
	char	l_prog;			/* Programmer number		*/
	char	l_proj;			/* Project number		*/
	short	l_prot;			/* Protection code		*/
	short	l_date;			/* Date (in some format)	*/
	short	l_name1[1];		/* One radix 50 name word	*/
}	LABEL;

typedef	struct	name {			/* Decoded name block		*/
	short	n_flag;			/* Some wildcard flags		*/
	char	n_proj;			/* Project number		*/
	char	n_prog;			/* Programmer number		*/
	short	n_name[3];		/* 3 radix 50 name words	*/
	short	n_type[1];		/* 1 radix 50 file type		*/
}	NAME;

#define	NWPROJ	0x0001			/* Project number is wild	*/
#define	NWPROG	0x0002			/* Programmer number is wild	*/
#define	NWNAME	0x0004			/* Name is wild			*/
#define	NWTYPE	0x0008			/* Type is wild			*/

char	bbuf[NBLOCK];			/* Block buffer for tape I/O	*/
char	*bbufpt;			/* Pointer into above buffer	*/
NAME	name[NNAME];			/* Array of names to extract	*/
short	mtchan;				/* Tape I/O channel		*/

int	func	= 0;			/* Function, initialze to none	*/
int	aflag	= FALSE;		/* ASCII mode flag		*/
int	vflag	= FALSE;		/* Verify flag			*/
char	*tape	= "MFA0:";		/* Tape drive name		*/
int	estat	= GOOD;			/* Exit status			*/
int	nname	= 0;			/* # of entries in NAME table	*/
int	proj	= 1;			/* Project code			*/
int	prog	= 1;			/* Programmer code		*/

main(argc, argv)
char *argv[];
{
	register char	*p;
	register int	c;
	register int	i;

	if (argc < 2)
		fatal(NULL, "no key");
	i = 2;
	p = argv[1];
	while ((c = *p++) != 0) {
		switch (c) {
		case 'c':
		case 't':
		case 'x':
			if (func != 0)
				fatal(NULL, "two things at once");
			func = c;
			break;

		case 'm':
			if (i >= argc)
				fatal(NULL, "missing tape name");
			tape = argv[i++];
			break;

		case 'u':
			if (i >= argc)
				fatal(NULL, "missing ppn");
			projprog(argv[i++]);
			break;

		case 'v':
			vflag = TRUE;
			break;

		case 'a':
			aflag = TRUE;
			break;

		default:
			fatal(NULL, "bad key");
		}
	}
	switch (func) {
	case 'c':
		addfile(i, argc, argv);
		break;

	case 't':
		table();
		break;

	case 'x':
		getfile(i, argc, argv);
		break;

	default:
		fatal(NULL, "no key");
	}
	exit(estat);
}

/*
 * The argument `cp' is a pointer
 * to a string of the form `[nnn,nnn]';
 * i.e. a project-programmer number.
 * Reset the external variables `proj'
 * and `prog' to agree with the arg.
 * Quit if the format is bad. Project
 * and programmer numbers are in octal.
 */
projprog(cp)
register char *cp;
{
	register int	c;

	if (*cp++ != '[')
		fatal(NULL, "bad ppn");
	proj = 0;
	while ((c = *cp++)>='0' && c<='7')
		proj = 8*proj + c - '0';
	if (c != ',')
		fatal(NULL, "bad ppn");
	prog = 0;
	while ((c = *cp++)>='0' && c<='7')
		prog = 8*prog + c - '0';
	if (c != ']')
		fatal(NULL, "bad ppn");
}

/*
 * Process the table command.
 * Read through the FLX tape, printing out
 * the information in the headers. The data
 * blocks are counted as they are read, just
 * in case this is `tv'. Quit on the double
 * tapemark at the end.
 */
table()
{
	register int	n;
	register int	nblocks;
	LABEL		lb;

	opentape(FALSE, TRUE);
	while (readtape((char *)&lb, sizeof(lb)) != 0) {
		nblocks = 0;
		while (readtape(bbuf, sizeof(bbuf)) != 0)
			++nblocks;
		n = printname(&lb);
		if (vflag != FALSE) {
			while (n < 14) {
				putchar(' ');
				++n;
			}
			printf("%5d", nblocks);
			printf(" [%03o,%03o]", lb.l_proj&0xFF, lb.l_prog&0xFF);
			printdate(lb.l_date);
			printf(" <%03o>", lb.l_prot&0xFF);
		}
		putchar('\n');
	}
	closetape(FALSE);
}

/*
 * Given a pointer to a structure
 * containing the FLX file label record,
 * convert the name from RADIX 50 to
 * ASCII and write it to the standard output.
 * The number of characters written out is
 * returned, just in case this is `tv'.
 */
printname(lbp)
LABEL	*lbp;
{
	register char	*p;
	register int	c;
	register int	n;
	char		b[9];

	r50toa(&b[0], lbp->l_name0, 2);
	r50toa(&b[6], lbp->l_name1, 1);
	n = 0;
	p = &b[0];
	while (p<&b[9] && (c = *p++)!=' ') {
		putchar(c);
		++n;
	}
	if (lbp->l_type[0] != 0) {
		putchar('.');
		++n;
		r50toa(&b[0], lbp->l_type, 1);
		p = &b[0];
		while (p<&b[3] && (c = *p++)!=' ') {
			putchar(c);
			++n;
		}
	}
	return (n);
}

/*
 * Convert `nr50' words worth of
 * RADIX 50 data, pointed to by the argument
 * `r50p', into `3*nr50' bytes of Ascii and
 * store the characters into the buffer
 * pointed to by the `cp' argument. The output
 * string is in lower case. The illegal code
 * in RADIX 50 is converted to a `?'.
 */
r50toa(cp, r50p, nr50)
register char	*cp;
register short	*r50p;
{
	register long	r50;
	register int	acx;

	static char	ctable[] = {
		" abcdefghijklmnopqrstuvwxyz$.?0123456789"
	};

	while (nr50--) {
		r50 = *r50p++;
		r50 &= 0xFFFF;
		acx = 0;
		while (r50 >= 03100) {
			r50 -= 03100;
			++acx;
		}
		*cp++ = ctable[acx];
		acx = 0;
		while (r50 >= 050) {
			r50 -= 050;
			++acx;
		}
		*cp++ = ctable[acx];
		*cp++ = ctable[r50];
	}
}

/*
 * Take a date word, convert the
 * date to a human being format and print
 * it on the standard output. The date word
 * is encoded as `1000*(year-1970)+daynum',
 * where January 1 is day number 1.
 */
printdate(date)
{
	register int	month;
	register int	day;
	register int	year;

	static	char monlen[]	= {
		31,	0,	31,	30,	31,	30,
		31,	31,	30,	31,	30,	31
	};
	static	char *monname[]	= {
		"Jan",	"Feb",	"Mar",	"Apr",	"May",	"Jun",
		"Jul",	"Aug",	"Sep",	"Oct",	"Nov",	"Dec"
	};

	year = (date/1000) + 1970;
	day  =  date%1000;
	monlen[1] = ((year%4)==0 && (year%100)!=0) ? 29 : 28;
	month = 0;
	while (day > 31)
		day -= monlen[month++];
	printf(" %02d-%s-%02d", day, monname[month], year-1900);
}

/*
 * Extract files from the
 * tape. Read through the tape, looking
 * for files mentioned in the list of
 * names. Copy the bytes to the output file
 * on the VAX. If ASCII mode, delete any
 * NUL bytes and any CR bytes (the ASCII file
 * will have LF characters in it, which look
 * like newlines to the C I/O package!).
 */
getfile(i, argc, argv)
char	*argv[];
{
	register char	*p;
	register int	c;
	register int	n;
	register int	fd;
	register FILE	*ofp;
	LABEL		lb;
	char		ofn[40];

	while (i < argc)
		savename(argv[i++]);
	if (nname == 0)
		savename("[*,*]*.*");
	opentape(FALSE, TRUE);
	while (readtape((char *)&lb, sizeof(lb)) != 0) {
		ofp = NULL;
		if (named(&lb) != FALSE) {
			if (vflag != FALSE) {
				makename(ofn, &lb, TRUE);
				printf("Extract: %s\n", ofn);
			}
			makename(ofn, &lb, FALSE);
			if ((fd=creat(ofn, 0666, "rat=cr", "rfm=var")) < 0
			|| (ofp=fdopen(fd, "w")) == NULL)
				fatal(ofn, "cannot create output file");
		} else if (vflag != FALSE) {
			makename(ofn, &lb, TRUE);
			printf("Skipped: %s\n", ofn);
		}
		while ((n=readtape(bbuf, sizeof(bbuf))) != 0) {
			if (ofp != NULL) {
				for (p = &bbuf[0]; n--; ) {
					c = (*p++) & 0xFF;
					if (aflag==FALSE || (c!=NUL && c!=CR))
						putc(c, ofp);
				}
			}
		}
		if (ofp != NULL)
			fclose(ofp);
	}
	closetape(FALSE);
}

/*
 * Parse a file name. Save
 * the parsed name, with the appropriate
 * wildcard flags, into the external array of
 * names. If the name array isn't latge enough,
 * or if the name is bad, abort.
 */
savename(ifn)
char	*ifn;
{
	register char	*cp1;
	register char	*cp2;
	register NAME	*np;
	register int	c;
	char		b[9];

	if (nname >= NNAME)
		fatal(NULL, "too many names");
	np = &name[nname++];
	np->n_flag = 0;
	np->n_proj = proj;
	np->n_prog = prog;
	np->n_type[0] = 0;
	cp1 = ifn;
	if (*cp1 == '[') {
		++cp1;
		if ((c = *cp1++) == '*') {
			np->n_flag |= NWPROJ;
			c = *cp1++;
		} else {
			np->n_proj = 0;
			while (c>='0' && c<='7') {
				np->n_proj = 8*np->n_proj + c - '0';
				c = *cp1++;
			}
		}
		if (c != ',')
			fatal(ifn, "bad ppn");
		if ((c = *cp1++) == '*') {
			np->n_flag |= NWPROG;
			c = *cp1++;
		} else {
			np->n_prog = 0;
			while (c>='0' && c<='7') {
				np->n_prog = 8*np->n_prog + c - '0';
				c = *cp1++;
			}
		}
		if (c != ']')
			fatal(ifn, "bad ppn");
	}		
	cp2 = &b[0];
	while ((c = *cp1++)!='\0' && c!='.') {
		if (cp2 < &b[9])
			*cp2++ = c;
	}
	if (b[0]=='*' && cp2==&b[1])
		np->n_flag |= NWNAME;
	else {
		while (cp2 < &b[9])
			*cp2++ = ' ';
		ator50(&np->n_name[0], 3, &b[0]);
	}
	if (c == '.') {
		cp2 = &b[0];
		while ((c = *cp1++) != '\0') {
			if (cp2 < &b[3])
				*cp2++ = c;
		}
		if (b[0]=='*' && cp2==&b[1])
			np->n_flag |= NWTYPE;
		else {
			while (cp2 < &b[3])
				*cp2++ = ' ';
			ator50(&np->n_type[0], 1, &b[0]);
		}
	}
}

/*
 * Look through the list of
 * saved names and return true if
 * the name in the LABEL structure
 * pointed to by "lp" is there.
 */
named(lp)
register LABEL	*lp;
{
	register NAME	*np;

	for (np = &name[0]; np < &name[nname]; ++np) {
		if ((np->n_flag&NWPROJ)==0 && np->n_proj!=lp->l_proj)
			continue;
		if ((np->n_flag&NWPROG)==0 && np->n_prog!=lp->l_prog)
			continue;
		if ((np->n_flag&NWNAME) == 0) {
			if (np->n_name[0] != lp->l_name0[0])
				continue;
			if (np->n_name[1] != lp->l_name0[1])
				continue;
			if (np->n_name[2] != lp->l_name1[0])
				continue;
		}
		if ((np->n_flag&NWTYPE)==0 && np->n_type[0]!=lp->l_type[0])
			continue;
		return (TRUE);
	}
	return (FALSE);
}

/*
 * Take a LABEL read from the
 * tape, and handcraft a file name
 * string. Store the name in the
 * supplied buffer. If the "ppnflag"
 * is TRUE, expand the ppn.
 */
makename(cp, lp, ppnflag)
register char	*cp;
register LABEL	*lp;
{
	register char	*bp;
	register int	c;
	char		b[9];

	if (ppnflag != FALSE) {
		sprintf(cp, "[%03o,%03o]", lp->l_proj&0xFF, lp->l_prog&0xFF);
		while (*cp != '\0')
			++cp;
	}
	r50toa(&b[0], lp->l_name0, 2);
	r50toa(&b[6], lp->l_name1, 1);
	bp = &b[0];
	while (bp<&b[9] && (c = *bp++)!=' ')
		*cp++ = c;
	if (lp->l_type[0] != 0) {
		*cp++ = '.';
		r50toa(&b[0], lp->l_type, 1);
		bp = &b[0];
		while (bp<&b[3] && (c = *bp++)!=' ')
			*cp++ = c;
	}
	*cp = '\0';
}

/*
 * Append files to the
 * tape. The tape is assumed to be
 * positioned correctly. This lets you
 * mount a tape, rewind it, and then
 * append files onto it.
 */
addfile(i, argc, argv)
char	*argv[];
{
	register FILE	*ifp;
	register int	c;
	register int	nbytes;
	register char	*ifn;
	LABEL		lb;

	if (i == argc)
		fatal(NULL, "no files");
	while (i < argc) {
		ifn = argv[i++];
		if ((ifp=fopen(ifn, "r")) == NULL)
			fatal(ifn, "cannot open file");
		if (vflag != FALSE)
			printf("Creating: %s\n", ifn);
		opentape(TRUE, FALSE);
		makelabel(&lb, ifn);
		writetape((char *)&lb, sizeof(lb));
		nbytes = 0;
		bbufpt = &bbuf[0];
		while ((c=getc(ifp)) != EOF) {
			if (aflag!=FALSE && c=='\n') {
				byte(CR);
				++nbytes;
			}
			byte(c);
			++nbytes;
		}
		if ((nbytes&0x01) != 0)
			byte(NUL);
		flushtape();
		closetape(TRUE);
		fclose(ifp);
	}
}

/*
 * Store a byte into the
 * tape buffer. If there is no
 * room in the buffer flush the data
 * out to the tape.
 */
byte(b)
register int	b;
{
	if (bbufpt >= &bbuf[NBLOCK]) {
		flushtape();
		bbufpt = &bbuf[0];
	}
	*bbufpt++ = b;
}

/*
 * Write any data still in the
 * block buffer to the tape. Avoid writing
 * out short records; the tape drive is allowed
 * to throw them away. Short records are padded
 * out with null bytes.
 */
flushtape()
{	
	register int	n;

	if ((n=bbufpt-&bbuf[0]) != 0) {
		while (n < MINREC) {
			*bbufpt++ = 0;
			++n;
		}
		writetape(bbuf, n);
	}
}

/*
 * Format a FLX tape header
 * record, given the file name. The
 * date is set to todays date. The access
 * mode is always set to "233".
 */
makelabel(lp, ifn)
LABEL	*lp;
char	*ifn;
{
	register char	*cp2;
	register char	*cp3;
	register	c;
	long		tod;
	struct tm	*tmp;
	struct tm	*localtime();
	char		b[12];

	cp2 = ifn;
	while (*cp2 != 0)
		++cp2;
	while (cp2!=ifn && cp2[-1]!=':' && cp2[-1]!=']')
		--cp2;
	cp3 = &b[0];
	while ((c = *cp2++)!=0 && c!='.') {
		if (cp3 < &b[9])
			*cp3++ = c;
	}
	while (cp3 < &b[9])
		*cp3++ = ' ';
	if (c == '.') {
		while ((c = *cp2++) != 0) {
			if (cp3 < &b[12])
				*cp3++ = c;
		}
	}
	while (cp3 < &b[12])
		*cp3++ = ' ';
	ator50(lp->l_name0, 2, &b[0]);
	ator50(lp->l_name1, 1, &b[6]);
	ator50(lp->l_type,  1, &b[9]);
	time(&tod);
	tmp = localtime(&tod);
	lp->l_date = 1000*(tmp->tm_year-70) + tmp->tm_yday + 1;
	lp->l_proj = proj;
	lp->l_prog = prog;
	lp->l_prot = 0233;
}

/*
 * Convert ASCII to radix 50.
 * The "r50p" points to an array of
 * 16 bit words that get the radix 50
 * encoded name. The "cp" points to a
 * block of ASCII data. The ASCII data
 * must be 3*nr50 bytes long.
 */
ator50(r50p, nr50, cp)
register short	*r50p;
register char	*cp;
{
	register int	r50;

	while (nr50--) {
		r50  = 050*050*r50char(cp[0]);
		r50 += 050*r50char(cp[1]);
		r50 += r50char(cp[2]);
		cp  += 3;
		*r50p++ = r50;
	}
}

/*
 * Convert character "c" to
 * its radix 50 encoding. All illegal
 * characters get mapped to "x". Earlier
 * versions of this routine mapped all
 * illegal characters to 035, which
 * was unused in the normal radix 50
 * encoding. If you do this, then standard
 * FLX on the VAX won't read the tape.
 */
r50char(c)
register int	c;
{
	if (c == ' ')
		return (0);
	if (c>='A' && c<='Z')
		return (c - 'A' + 01);
	if (c>='a' && c<='z')
		return (c - 'a' + 01);
	if (c == '$')
		return (033);
	if (c == '.')
		return (034);
	if (c>='0' && c<='9')
		return (c - '0' + 036);
	return ('X' - 'A' + 01);
}

/*
 * Open up the tape.
 * Translate the logical name and
 * assign the channel. The two flags
 * indicate what type of operation is
 * going to be performed. The "wflag"
 * flag is true if you are going to try
 * and write on the tape. The "rflag" is
 * true if you want the tape rewound.
 */
opentape(wflag, rflag)
{
	struct	dsc$descriptor	idsc;
	struct	dsc$descriptor	odsc;
	char	oname[40];
	int	iosb[2];
	int	status;

	odsc.dsc$a_pointer = tape;
	odsc.dsc$w_length  = strlen(tape);
	odsc.dsc$b_dtype   = DSC$K_DTYPE_T;
	odsc.dsc$b_class   = DSC$K_CLASS_S;
	idsc.dsc$b_dtype   = DSC$K_DTYPE_T;
	idsc.dsc$b_class   = DSC$K_CLASS_S;
	do {
		idsc.dsc$a_pointer = odsc.dsc$a_pointer;
		idsc.dsc$w_length  = odsc.dsc$w_length;
		odsc.dsc$a_pointer = &oname[0];
		odsc.dsc$w_length  = sizeof(oname);
		status = LIB$SYS_TRNLOG(&idsc, &odsc.dsc$w_length, &odsc);
		if (status!=SS$_NORMAL && status!=SS$_NOTRAN)
			check(status, "translate name");
		if (oname[0] == 0x1B) {
			odsc.dsc$a_pointer += 4;	/* Skip over 	*/
			odsc.dsc$w_length  -= 4;	/* the kludge	*/
		}
	} while (status == SS$_NORMAL);
	status = SYS$ASSIGN(&odsc, &mtchan, 0, 0);
	check(status, "assign of tape drive");
	/* Check if tape? */
	/* Check write enable if wflag */
	if (rflag != FALSE)
		mtqiow("rewind", IO$_REWIND, iosb, 0, 0);
}

/*
 * Close the tape.
 * If the "wflag" is true write a
 * double tapemark, and backspace to
 * between them.
 */
closetape(wflag)
{
	int	status;
	int	iosb[2];

	if (wflag != FALSE) {
		mtqiow("write EOF #1", IO$_WRITEOF, iosb, 0, 0);
		mtqiow("write EOF #2", IO$_WRITEOF, iosb, 0, 0);
		mtqiow("backspace", IO$_SKIPRECORD, iosb, 0x0000FFFF, 0);
	}
	status = SYS$DASSGN(mtchan);
	check(status, "deassign of tape drive");
}

/*
 * Read from the tape.
 * The address of the buffer, and
 * the size of the buffer is supplied.
 * Return the number of bytes read.
 * Return 0 if a tape mark is encountered.
 * Return -1 on any errors. The details
 * of the error are tossed away.
 */
readtape(bufp, nbuf)
char	*bufp;
{
	int	status;
	int	iosb[2];

	status = mtqiow(NULL, IO$_READVBLK, iosb, bufp, nbuf);
	if (status == SS$_NORMAL)
		return ((iosb[0]>>16) & 0xFFFF);
	if (status == SS$_ENDOFFILE)
		return (0);
	check(status, "read");
}

/*
 * Write a block to the tape.
 * All errors are fatal, as there is
 * not a lot you can do.
 */
writetape(bufp, nbuf)
char	*bufp;
{
	int	status;
	int	iosb[2];

	status = mtqiow(NULL, IO$_WRITEVBLK, iosb, bufp, nbuf);
	if (status == SS$_NORMAL)
		status = iosb[0]&0xFFFF;
	if (status!=SS$_NORMAL || ((iosb[0]>>16)&0xFFFF)!=nbuf)
		check(status, "write");
}

/*
 * This routine issues
 * general I/O commands to the
 * tape. It is just an interface layer
 * that defaults a number of the
 * parameters. If the "msg" is not null
 * it quits on errors.
 */
mtqiow(msg, fn, iosb, p1, p2)
char	*msg;
int	iosb[];
{
	int	status;

	status = SYS$QIOW(0, mtchan, fn, iosb, 0, 0, p1, p2, 0, 0, 0, 0);
	if (status == SS$_NORMAL)
		status = iosb[0]&0xFFFF;
	if (msg!=NULL && status!=SS$_NORMAL)
		check(status, msg);
	return (status);
}

/*
 * This routine puts out
 * fatal error message for just
 * about everyone. The first argument
 * may be NULL; it is an optional 
 * file name.
 */
fatal(p1, p2)
char	*p1;
char	*p2;
{
	fprintf(stderr, "flx: ");
	if (p1 != NULL)
		fprintf(stderr, "%s: ", p1);
	fprintf(stderr, "%s\n", p2);
	exit(NASTY);
}

/*
 * Check an I/O status.
 * If good, just return. Otherwise
 * ask the system for the error message
 * text, print it, and die.
 */
check(status, msg)
char	*msg;
{
	struct	dsc$descriptor	odsc;
	char	buf[256];

	if (status != SS$_NORMAL) {
		odsc.dsc$a_pointer = buf;
		odsc.dsc$w_length  = sizeof(buf);
		odsc.dsc$b_dtype   = DSC$K_DTYPE_T;
		odsc.dsc$b_class   = DSC$K_CLASS_S;
		status = SYS$GETMSG(status, &odsc.dsc$w_length, &odsc, 1, 0);
		if (status != SS$_NORMAL)
			exit(status);
		buf[odsc.dsc$w_length] = 0;
		fatal(msg, buf);
	}
}