v02i037: UNIFY(r) Selection Preprocessor

Brandon S. Allbery allbery at ncoast.UUCP
Sun Jan 31 14:19:33 AEST 1988


Comp.sources.misc: Volume 2, Issue 37

Submitted-By: The Moderator <allbery at ncoast.UUCP>

Archive-Name: usp


Comp.sources.misc: Volume 2, Issue 37
Submitted-By: The Moderator <allbery at ncoast.UUCP>
Archive-Name: usp

I decided that as long as I was posting some of my UNIFY(r) stuff, I'd throw
this in.  This is a preprocessor for C programs which allows certain things
to be done much more easily than usual:  in particular, coding queries now
uses a single unified syntax rather than having to choose between ten or so
functions.  It also allows you to specify literal dates and times and get the
current date and time in a much more natural way.  It also replaces the "upp"
C preprocessor, although you must use USP syntax instead of upp.  There is a
man page in here describing the commands accepted by USP.

Oh -- just in case anyone's interested, I wrote one of these (watered down a
bit) for Informix 3.3.  While it's watered down as far as selection ability,
it at least builds all those blasted "struct dbview"s and such for you.  It
reduced a 14-page program to 4 pages (I kid you not!).

#--------------------------------CUT HERE-------------------------------------
#! /bin/sh
#
# This is a shell archive.  Save this into a file, edit it
# and delete all lines above this comment.  Then give this
# file to sh by executing the command "sh file".  The files
# will be extracted into the current directory owned by
# you with default permissions.
#
# The files contained herein are:
#
# -rw-r--r--  1 allbery users       378 Jan 30 20:59 Makefile
# -rw-r--r--  1 allbery users      7392 Jan 30 20:59 genpgm.c
# -rw-r--r--  1 allbery users      6043 Jan 30 20:59 usp.man
# -rw-r--r--  1 allbery users     11761 Jan 30 20:59 usp.y
# -rw-r--r--  1 allbery users      3438 Jan 30 20:59 usptok.l
#
echo 'x - Makefile'
if test -f Makefile; then echo 'shar: not overwriting Makefile'; else
sed 's/^X//' << '________This_Is_The_END________' > Makefile
XSHELL = /bin/sh
XCFLAGS = -O -I/appl/u32/include -DUNIFY32
XYFLAGS = -d
X
XOBJ = usp.o usptok.o genpgm.o
X
Xusp: $(OBJ)
X	UNIFY=/appl/u32/lib PATH=/appl/u32/bin:$$PATH uld usp $(OBJ) -ll
X
Xusptok.o: y.tab.h
Xy.tab.h usp.o: usp.y
X
Xtester: usp TESTER
X	DBPATH=/coesys/bin usp < TESTER > t1.c
X	cc -O -c t1.c
X	UNIFY=/appl/u32/lib PATH=/appl/u32/bin:$$PATH uld t1 t1.o
X#	DBPATH=/coesys/bin t1
________This_Is_The_END________
if test `wc -l < Makefile` -ne 17; then
	echo 'shar: Makefile was damaged during transit (should have been 17 bytes)'
fi
fi		; : end of overwriting check
echo 'x - genpgm.c'
if test -f genpgm.c; then echo 'shar: not overwriting genpgm.c'; else
sed 's/^X//' << '________This_Is_The_END________' > genpgm.c
X#include <stdio.h>
X#include <varargs.h>
X#include <dbtypes.h>
X
Xextern FILE *yyin, *yyout;
Xextern FILE *tmpfile();
Xextern char *recname();
Xextern char *fldsyn();
Xextern char *fldname();
Xextern char *strchr();
X
Xstatic FILE *htf = (FILE *) 0;
Xstatic FILE *stf = (FILE *) 0;
Xstatic char vname[] = "_ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789";
Xint nlflag = 1;
Xstatic int diddate, dosync;
Xchar *srcfile = "-";
Xextern int indent, _ign_, yylineno;
Xstatic int *typetab = (int *) 0;
X
X/*VARARGS PRINTFLIKE1*/
Xputhead(va_alist)
Xva_dcl {
X	char *fmt;
X	va_list args;
X
X	va_start(args);
X	fmt = va_arg(args, char *);
X	vfprintf(htf, fmt, args);
X	va_end(args);
X	if (fmt[strlen(fmt) - 1] == '\n')
X		syncf(htf);
X}
X
X/*VARARGS PRINTFLIKE1*/
Xputsel(va_alist)
Xva_dcl {
X	char *fmt;
X	va_list args;
X	static char buf[5120];
X
X	va_start(args);
X	fmt = va_arg(args, char *);
X	vsprintf(buf, fmt, args);
X	va_end(args);
X	__emit(buf);
X}
X
Xstatic __emit(buf)
Xchar *buf; {
X	for (; *buf != '\0'; buf++) {
X		if (*buf == '\1') {
X			syncf(stf);
X			lead(indent);
X			continue;
X		}
X		putc(*buf, stf);
X	}
X}
X
Xsyncf(fp)
XFILE *fp; {
X	fprintf(fp, "#line %d", yylineno);
X	if (yyin != stdin)
X		fprintf(fp, " \"%s\"", srcfile);
X	putc('\n', fp);
X}
X
Xstatic lead(cnt) {
X	while (cnt > 8) {
X		putc('\t', stf);
X		cnt -= 8;
X	}
X	while (cnt-- > 0)
X		putc(' ', stf);
X}
X
Xdumpf(fp, dest)
XFILE *fp, *dest; {
X	int ch;
X
X	yyin = fp;
X	nlflag = 1;
X	diddate = 0;
X	dosync = 1;
X	if (typetab != (int *) 0) {
X		free((char *) typetab);
X		typetab = 0;
X	}
X	if (htf == (FILE *) 0 && (htf = tmpfile()) == (FILE *) 0) {
X		yyerror("can't open temp file for header");
X		exit(2);
X	}
X	fprintf(htf, "static int __i__er_ = 0;\n");
X	if (stf == (FILE *) 0 && (stf = tmpfile()) == (FILE *) 0) {
X		yyerror("can't open temp file for code");
X		exit(2);
X	}
X	while ((ch = input()) != 0) {
X		if (ch == '$') {
X 			if (nlflag && indent == 0) {
X				indent = 1;	/* '$' == space for output */
X				if ((ch = input()) != '\t')
X					putc(' ', stf);
X				while (ch == ' ' || ch == '\t') {
X					putc(ch, stf);
X					ch = input();
X				}
X				unput(ch);
X				_ign_ = 1;
X				yyparse();
X				_ign_ = 0;
X				nlflag = 0;
X				dosync = 1;
X			}
X			else {	/* embedded record/field ref */
X				char vbuf[256];
X				int cnt;
X				char *cp;
X
X				cnt = 0;
X				nlflag = 0;
X				while ((ch = input()) != 0 && strchr(vname, ch) != (char *) 0)
X					vbuf[cnt++] = ch;
X				if (cnt == 0 && ch == '(') {
X					parsedate();
X					continue;
X				}
X				unput(ch);
X				if (cnt == 0) {
X					putc('$', stf);
X					continue;
X				}
X				vbuf[cnt] = '\0';
X				for (cnt = numrecs(); cnt > 0; cnt--) {
X					if ((cp = recname(cnt)) == (char *) 0)
X						continue;
X					else if (strcmp(cp, vbuf) == 0)
X						break;
X				}
X				if (cnt != 0) {
X					fprintf(stf, "%d", cnt);
X					continue;
X				}
X				for (cnt = numflds(); cnt > 0; cnt--) {
X					if ((cp = fldname(cnt)) == (char *) 0)
X						continue;
X					else if (strcmp(cp, vbuf) == 0)
X						break;
X				}
X				if (cnt != 0)
X					fprintf(stf, "%d", cnt);
X				else {
X					yyerror("unrecognized record/field name `%s'", vbuf);
X					fputs(vbuf, stf);
X				}
X			}
X		}
X		else {
X			if (ch != '\n' && ch != ' ' && ch != '\t')
X				nlflag = 0;
X			else if (ch == '\n') {
X				indent = 0;
X				nlflag = 1;
X			}
X			putc(ch, stf);
X			if (dosync && ch == '\n') {
X				syncf(stf);
X				dosync = 0;
X			}
X		}
X	}
X	rewind(htf);
X	rewind(stf);
X	while ((ch = getc(htf)) != EOF)
X		putc(ch, dest);
X	putc('\n', dest);
X	while ((ch = getc(stf)) != EOF)
X		putc(ch, dest);
X	fclose(htf);
X	fclose(stf);
X	htf = (FILE *) 0;
X	stf = (FILE *) 0;
X}
X
Xmain(argc, argv)
Xchar **argv; {
X	char fname[1024];
X	FILE *inf, *outf;
X	int arg, len;
X
X	srcfile = "-";
X	if (argc < 2)
X		dumpf(stdin, stdout);
X	else
X		for (arg = 1; argv[arg] != (char *) 0; arg++) {
X			strcpy(fname, argv[arg]);
X			len = strlen(fname);
X			if (fname[len - 2] == '.' && fname[len - 1] == 'c')
X				strcpy(fname + len - 1, "usp.c");
X			else
X				strcat(fname, ".c");
X			if ((inf = fopen(argv[arg], "r")) == (FILE *) 0) {
X				perror(argv[arg]);
X				continue;
X			}
X			if ((outf = fopen(fname, "w")) == (FILE *) 0) {
X				perror(fname);
X				fclose(inf);
X				continue;
X			}
X			srcfile = argv[arg];
X			dumpf(inf, outf);
X			fclose(inf);
X			fclose(outf);
X		}
X	exit(0);
X}
X
Xchar *utype(type, len) {
X	static char buf[256];
X
X	switch (type) {
X	case INT:
X	case DATE:
X	case HR:
X		strcpy(buf, "short %s");
X		break;
X	case LONG:
X	case AMT:
X		strcpy(buf, "long %s");
X		break;
X	case HAMT:
X	case FLT:
X		strcpy(buf, "double %s");
X		break;
X	case STRNG:
X		len++;
X	case COMB:
X		typeset(len);
X		sprintf(buf, "_str_%d %%s", len);
X		break;
X	}
X	return buf;
X}
X
X/*
X * Make an entry in the typeset table.  Do nothing if it's in there already.
X */
X
Xtypeset(len) {
X	int cnt;
X
X	for (cnt = 0; typetab != (int *) 0 && typetab[cnt] != 0; cnt++)
X		if (typetab[cnt] == len)
X			return;
X	cnt += 2;
X	if ((typetab = (int *) (typetab == (int *) 0? malloc(cnt * sizeof (int)): realloc(typetab, cnt * sizeof (int)))) == (int *) 0) {
X		yyerror("out of memory for defined type table");
X		exit(1);
X	}
X	typetab[cnt - 2] = len;
X	typetab[cnt - 1] = 0;
X	puthead("typedef char _str_%d[%d];\n", len, len);
X}
X
X/*
X * input() next call will start a date, to a ')'.  Parse the date, eat the
X * ')', and output the internal (short) value of the date.  `/' only.
X * Actually, times are handled as well; the deciding factor is whether
X * a '/' or a ':' is used.
X *
X * Three special cases: (nulldate), "hour", and "today".  (I can't specify
X * nulldate's form in a comment for obvious reasons; the string is the standard
X * UNIFY one.)
X */
X
Xparsedate() {
X	char dbuf[256], term[2];
X	int ch, cnt;
X	int date[3], ck[3];
X	short d;
X
X	for (cnt = 0; (ch = input()) != 0 && ch != '\n' && ch != ')'; cnt++)
X		dbuf[cnt] = ch;
X	dbuf[cnt] = '\0';
X	if (ch != ')' || cnt == 0) {
X		yyerror("unterminated or empty date/time constant");
X		fprintf(stf, "$(%s", dbuf);
X		return;
X	}
X	if (strcmp(dbuf, "**/**/**") == 0) {
X		fprintf(stf, "%d", NULLDATE);
X		return;
X	}
X	if (strcmp(dbuf, "today") == 0) {
X		fprintf(stf, "(_u__now = time((long *) 0), _u__date = localtime(&_u__now), _u__today[0] = _u__date->tm_mon + 1, _u__today[1] = _u__date->tm_mday, _u__today[2] = _u__date->tm_year, kday(_u__today))");
X		if (!diddate)
X			puthead("#include <time.h>\nstatic int _u__today[3];\nstatic long _u__now;\nstatic struct tm *_u__date;\n");
X		diddate = 1;
X		return;
X	}
X	if (strcmp(dbuf, "hour") == 0) {
X		fprintf(stf, "(_u__now = time((long *) 0), _u__date = localtime(&_u__now), _u__date->tm_hour * 100 + _u__date->tm_min)");
X		if (!diddate)
X			puthead("#include <time.h>\nstatic int _u__today[3];\nstatic long _u__now;\nstatic struct tm *_u__date;\n");
X		diddate = 1;
X		return;
X	}
X	dbuf[cnt++] = ')';	/* hack for sscanf checking */
X	dbuf[cnt] = '\0';
X	if ((cnt = sscanf(dbuf, "%d:%d%[)]", &date[0], &date[1], term)) == 3) {
X		if (date[0] < 0 || date[0] > 23) {
X			yyerror("syntax error in time/hour");
X			fprintf(stf, "$(%s", dbuf);
X			return;
X		}
X		if (date[1] < 0 || date[1] > 59) {
X			yyerror("syntax error in time/minute");
X			fprintf(stf, "$(%s", dbuf);
X			return;
X		}
X		fprintf(stf, "%d", date[0] * 100 + date[1]);
X		return;
X	}
X	if ((cnt = sscanf(dbuf, "%d/%d/%d%[)]", &date[0], &date[1], &date[2], term)) != 4) {
X		yyerror("syntax error in date (section %d)", cnt);
X		fprintf(stf, "$(%s", dbuf);
X		return;
X	}
X	d = kday(date);
X	kdate(d, ck);
X	if (!ivcmp(ck, date, sizeof date)) {
X		yyerror("invalid date spec");
X		d = NULLDATE;
X	}
X	fprintf(stf, "%d", d);
X}
________This_Is_The_END________
if test `wc -l < genpgm.c` -ne 338; then
	echo 'shar: genpgm.c was damaged during transit (should have been 338 bytes)'
fi
fi		; : end of overwriting check
echo 'x - usp.man'
if test -f usp.man; then echo 'shar: not overwriting usp.man'; else
sed 's/^X//' << '________This_Is_The_END________' > usp.man
X'''
X''' USP (UNIFY(r) Selection Preprocessor)
X'''
X.TH USP 1L
X.SH NAME
Xusp \- unify(R) selection preprocessor
X.SH SYNOPSIS
X.B usp <
X.I file.c
X.B >
X.I outfile.c
X.SH DESCRIPTION
X.I Usp
Xis a preprocessor for C programs which use the Unify\*R C HLI.  It obviates
Xthe need for the Unify preprocessor,
X.BR upp ,
Xand the include file
X.IR file.h ,
Xwhile providing more features including automatic date translation and a
Xsimple selection language.
X.SH USAGE
X.SS Invocation
XAt present, the
X.B usp
Xcommand reads a C program from standard input and writes a modified copy of
Xthe program to standard output.  The modifications are triggered by a dollar
Xsign character
X.BR ($) .
XThe output file is preceded by definitions used by the succeeding code.
X.SS Syntax
X.BR Usp 's
Xtranslation capabilities are triggered by a dollar sign character.  If the
Xcharacter appears in column 1 of a line, it triggers a command translation.
XIf the character is in any other column, it triggers a record, field or date
Xtranslation.
X.SS Command syntax
XThe 
X.B usp
Xcommand processor recognizes a limited subset of commands associated with
Xdata selection and retrieval.  The command syntax is described by the
Xfollowing BNF syntax:
X.de Bs
X.in +15
X.ll -5
X.sp 2
X.ns
X..
X.de Bn
X.ti -10
X.sp
X\\$1 ::= \\$2
X.if \w\\$3 | \\$3
X.if \w\\$4 | \\$4
X.if \w\\$5 | \\$5
X.if \w\\$6 | \\$6
X.if \w\\$7 | \\$7
X.if \w\\$8 | \\$8
X.if \w\\$9 | \\$9
X..
X.de Be
X.in -15
X.ll +5
X.sp 2
X.ns
X..
X.Bs
X.Bn <command> <define> <get> <put> <foreach> <select> <sort>
X.Bn <define> "define <variable> { like <field> | <type> } ;"
X.Bn <get> "get <variable> = <field> ;"
X.Bn <put> "put <field> = <variable> ;"
X.Bn <foreach> "foreach <selection> {"
X.Bn <select> "select { <selection> | interrupt <switch> }"
X.Bn <sort> "sort messages <switch>"
X.Bn <selection> "<record> [[of <record>] [where <condition>] [by <keys>] | key <const>]"
X.Bn <switch> on off
X.Bn <condition> <basic> "<condition> and <basic>"
X.Bn <basic> "<field> <op> <variable>"
X.Bn <op> = ^= > >= < <=
X.Bn <type> "numeric <integer>" "amount <integer>" "float <integer>" "string <integer>" date time
X.Bn <field> "[<record>.]<fsyn>"
X.Bn <variable> "[&]<identifier>" <string>
X.Bn <keys> <key> "<keys> , <key>"
X.Bn <key> <field> "<key> -> <field>"
X.Be
XNote that
X.BR <integer> , " <string>" ", and " <identifier>
Xare standard C constructs; refer to a C programming manual for more information.
X.SS Commands
XThe following commands are accepted by 
X.BR usp :
X.RS 5
X.IP "define <variable>" 5
XDefine a variable, either "like" a database field or as a Unify\*R type.  This
Xis basically a convenience.
X.IP "get <variable> = <field>" 5
XAssign the contents of a database field to a variable.  This is essentially a
X.IR gfield ,
Xwith the exception that a string field will automatically be null-terminated
Xat the end of its defined length.  This requires that a string variable be
Xdefined one character longer than the corresponding Unify\*R field; the
X.B define
Xcommand already does this.
X.IP "put <field> = <variable>" 5
XThe inverse of
X.BR get ;
Xit does a
X.I pfield
Xoperation.  It will call
X.I error
Xif the operation fails.
X.IP "foreach <selection>" 5
XThe first of the selection commands; it is capable of dealing with multiple
Xreturned records.  It begins a loop which, in the generated program, is a
X.I for
Xloop.  See
X.I Selections
Xfor more information.
X.IP "select <selection>" 5
XThe other selection command; it returns exactly one record.
X.IP "select interrupt <switch>" 5
Xcontrols whether queries may be interrupted; if a 
X.B foreach
Xquery is interupted, the enclosed loop is not executed.
X.IP "sort messages <switch>" 5
XThe
X.B sort messages
Xcommand controls whether the sorting versions of the
X.B foreach
Xcommand will display the messages
X.IR Selecting , " Sorting" ", and " Formatting" .
X.RE
X.SS Selections
XA
X.B selection
Xis a specification of which rows of which table will be returned by a query.
XIt is not as complex as is possible with
X.BR SQL ,
Xbut is complex enough to simplify many programming projects.
X.P
XThe basic form of a selection is shown by the BNF syntax above.  The only
Xsemantic conditions are as follows:
X.RS 5
X.IP -
XThe syntax
X.B foreach ... key
Xis illegal;
X.IP -
XThe syntax
X.B select ... by
Xis illegal; and
X.IP -
XThe `&' character is required on non-string variables.
X.RE
X.P
XThe `of' keyword exploits explicit relationships.  It also determines
Xautomatically whether the relationship is being followed in a one-to-many or a
Xmany-to-one direction.
X.P
XSorting is always in ascending order; the "->" syntax is used to follow
Xexplicit relationship chains.  See the descrition of the
X.I unisort
Xfunction in the Unify\*R Programmer's manual, but note that the "->" chain is
Xreversed in order from the sort array.
X.SS Non-command syntax
XThe 
X.B usp
Xprocessor also translates bjects when it sees a `$' character in the middle of
Xa line.  In this case, the character following the $ is inspected.  If it is a
Xleft parenthesis `(', then the object is a date.  Dates have the following syntax:
X.RS 20
X.sp
X$(mm/dd/yy)
X.br
X$(**/**/**)
X.br
X$(today)
X.sp
X.RE
XThe `$(today)' syntax expands to a static function call.
X.P
XIf the character following the `$' is not a left parenthesis, then the following
Xidentifier is interpreted as a record or short field name.  If it cannot be
Xtranslated as either, an error occurs.
X.SH "SEE ALSO"
XThe Unify\*R Programmer's Manual
X.SH ACKNOWLEDGEMENTS
XUnify is a registered trademark of Unify Corporation.
X.SH BUGS
XIt is likely that hand-coding selections would produce more optimal code,
Xalthough 
X.B usp
Xtries valiantly and recognizes at least twelve kinds of queries.
X.P
XThe 
X.B $field
Xconstruct should allow
X.I field.record
Xsyntax.  This, alas, would require a much more complex parser.
X.P
XAll programs have a two-line definition prepended to them, whether the
Xdefinition is used or not.
X.P
XIf two separate source files for a program use the `$(today)' structure, each
Xfile will have a static function prepended to it.  This is somewhat wasteful
Xbut avoids having to link a special library into the program.
________This_Is_The_END________
if test `wc -l < usp.man` -ne 205; then
	echo 'shar: usp.man was damaged during transit (should have been 205 bytes)'
fi
fi		; : end of overwriting check
echo 'x - usp.y'
if test -f usp.y; then echo 'shar: not overwriting usp.y'; else
sed 's/^X//' << '________This_Is_The_END________' > usp.y
X%token FOREACH OF WHERE BY AND BETWEEN kNOT DEFINE LIKE STRING AMOUNT kDATE
X%token TIME NUMERIC FLOAT GET PUT SORT MESSAGES INTERRUPT OFF ON KEY SELECT
X%token GE LE NE PTR
X%token tRECORD tFIELD tCONST tNUM
X
X%union {
X	char str[256];
X	int fld;
X	int rec;
X	int opcode;
X	struct {
X		int nfld;
X		int *spec;
X	} sort;
X	int flag;
X	int num;
X}
X
X%type <fld> field of
X%type <rec> tRECORD
X%type <str> tCONST tFIELD type varlist
X%type <sort> sortspec
X%type <opcode> op
X%type <flag> by not switch where key
X%type <num> tNUM selection
X
X%{
X
X#include <unisel.h>
X#include <fdesc.h>
X#include <dbtypes.h>
X
Xint crec, jrec, jfld;
Xlong seqn = 0L, xseq = 0L;
Xint didumsg = 0, didusdcl = 0, didssdcl = 0;
X
Xextern char *malloc();
Xextern char *realloc();
Xextern char *recname();
Xextern char *fldsyn();
X
X#define SEL_REL		8
X#define SEL_VALUE	4
X#define SEL_KEY		2
X#define SEL_SORT	1
X
X%}
X
X%%
X
Xcommand		: FOREACH selection '{'
X			{
X				if ($2 & SEL_KEY) {
X					yyerror("`foreach ... key' makes no sense");
X					YYERROR;
X				}
X				switch ($2) {
X				case 0:
X					putsel("for (__i__er_ = seqacc(%d, 1); __i__er_ == 0; __i__er_ = seqacc(%d, 2)) {", crec, crec);
X					break;
X				case SEL_VALUE:
X				case SEL_REL|SEL_VALUE:
X					putsel("\n\1for ((__i__er_ != 0? __i__er_: (__i__er_ = frstsel(__f_%d))); __i__er_ > 0; __i__er_ = nextsel(__f_%d)) {", seqn, seqn);
X					break;
X				case SEL_REL:
X					if (jfld < 0) {
X						yyerror("cannot use `foreach' on join to parent");
X						YYERROR;
X					}
X					putsel("\n\1for (__i__er_ = nextrec(%d, %d); __i__er_ == 0; __i__er_ = nextrec(%d, %d)) {", reckey(jrec), jfld, reckey(jrec), jfld);
X					break;
X				case SEL_REL|SEL_SORT:
X				case SEL_REL|SEL_VALUE|SEL_SORT:
X				case SEL_VALUE|SEL_SORT:
X				case SEL_SORT:
X					putsel("\n\1for (__i__er_ = sfrstrec(%d, %d); __i__er_ == 0; __i__er_ = snextrec(%d, %d)) {", reckey(jrec), jfld, reckey(jrec), jfld);
X					break;
X				}
X				YYACCEPT;
X			}
X		| DEFINE varlist type ';'
X			{
X				char vbuf[1024];
X
X				sprintf(vbuf, $3, $2);
X				putsel("%s;", vbuf);
X				YYACCEPT;
X			}
X		| GET tCONST '=' field ';'
X			{
X				FLDESC fd;
X				char *cp;
X
X				if ($2[0] == '"') {
X					yyerror("syntax error");
X					YYERROR;
X				}
X				fldesc($4, &fd);
X				if (fd.f_typ != STRNG && fd.f_typ != COMB && $2[0] != '&')
X					cp = "&";
X				else
X					cp = "";
X				putsel("gfield(%d, %s%s)", $4, cp, $2);
X				if (fd.f_typ == STRNG)
X					putsel(", %s[%d] = '\\0'", $2, fd.f_len);
X				putsel(";");
X				YYACCEPT;
X			}
X		| PUT field '=' tCONST ';'
X			{
X				FLDESC fd;
X				char *cp;
X
X				fldesc($2, &fd);
X				if (fd.f_typ != STRNG && fd.f_typ != COMB && $4[0] != '&')
X					cp = "&";
X				else
X					cp = "";
X				putsel("if ((__i__er_ = pfield(%d, %s%s)) != 0)\n\1\terror(\"pfield %s\", __i__er_);", $2, cp, $4);
X				YYACCEPT;
X			}
X		| SORT MESSAGES switch ';'
X			{
X				if (!didumsg)
X					puthead("extern int _No_Umsgs;\n");
X				didumsg = 1;
X				putsel("_No_Umsgs = %d;", !$3);
X				YYACCEPT;
X			}
X		| SELECT select_cmd ';'
X			{
X				YYACCEPT;
X			}
X		;
X
Xselect_cmd	: INTERRUPT switch
X			{
X				putsel("setintr(%d);", ($2? INTR_ON: INTR_OFF));
X
X			}
X		| selection
X			{
X				if ($1 & SEL_SORT) {
X					yyerror("you cannot use a `by' phrase in a `select' statement");
X					YYERROR;
X				}
X				switch ($1) {
X				case 0:
X					puthead("static long __n_%d;\n", seqn);
X					putsel("if ((__n_%d = getnrec(%d)) != 1)\n\1\terror(\"seqacc %s returned not exactly one record\", __n_%d);", seqn, crec, recname(crec), seqn);
X					putsel("\n\1seqacc(%d, 1);", crec);
X					break;
X				case SEL_KEY:
X					break;
X				case SEL_REL:
X					if (jfld < 0)
X						break;
X					putsel("\n\1if (__n_%d != 1L)\n\1\terror(\"select %s returned not exactly one record\", __n_%d);\n\1", seqn, recname(crec), seqn);
X					/*FALLTHROUGH*/
X				default:
X					putsel("\n\1if ((__i__er_ = frstrec(__f_%d)) != 0)\n\1\terror(\"frstrec %s\", __i__er_);", seqn, recname(crec));
X				}
X			}
X		;
X
Xswitch		: OFF
X			{
X				$$ = 0;
X			}
X		| ON
X			{
X				$$ = 1;
X			}
X		;
X
Xselection	: tRECORD
X			{
X				seqn++;
X				crec = $1;
X			}
X		  of where key by
X		  	{
X				int v;
X				char vbuf[256];
X				FLDESC fd;
X
X				v = ($3 == 0? 0: SEL_REL)|($4? SEL_VALUE: 0)|($5? SEL_KEY: 0)|($6? SEL_SORT: 0);
X				if ($5 && ($3 != 0 || $4 || $6)) {
X					yyerror("cannot use `key' with `of' or `where'");
X					YYERROR;
X				}
X				if ($3 < 0 && ($4 || $6)) {
X					yyerror("cannot use `where' or `by' on join to parent");
X					YYERROR;
X				}
X				switch (v) {
X				case SEL_REL:
X					if ($3 < 0)
X						putsel("if ((__i__er_ = faccess(%d, %d)) != 0)\n\1\terror(\"faccess %s\", __i__er_);", crec, - $3, recname(crec));
X					else {
X						puthead("static long __n_%d;\n", seqn);
X						putsel("if ((__i__er_ = makeset(%d, %d, 1)) != 0)\n\1\terror(\"makeset(%s, %s)\", __i__er_);", reckey(jrec), $3, fldsyn(reckey(jrec)), fldsyn($3));
X						putsel("\n\1setsize(%d, %d, &__n_%d);", reckey(jrec), $3, seqn);
X					}
X					jfld = $3;
X					break;
X				case SEL_REL|SEL_SORT:
X					if (!didssdcl) {
X						didssdcl = 1;
X						puthead("static int (*__no_f__[])() = {0, 0, 0, 0};\n");
X					}
X					putsel("(void) unisort(%d, %d, __s_%d, __no_f__);", jrec, $3, seqn);
X					jfld = $3;
X					break;
X				case 0:
X				case SEL_KEY:
X					break;
X				case SEL_REL|SEL_VALUE:
X					fldesc(reckey(jrec), &fd);
X					sprintf(vbuf, utype(fd.f_typ, (fd.f_typ == FLT? fd.f_len * 10: fd.f_len)), "__j_%d");
X					puthead("static ");
X					puthead(vbuf, ++xseq);
X					puthead(";\n");
X					fldesc($3, &fd);
X					putsel("gfield(%d, __j_%d);\n\1entsitm(%d, __j_%d, (char *) 0, %d);\n\1", fd.f_rpfld, xseq, $3, xseq, EQ);
X					/*FALLTHROUGH*/
X				case SEL_VALUE:
X					if (!didusdcl) {
X						didusdcl = 1;
X						puthead("extern struct uselfil *opensf();\n");
X					}
X					puthead("static struct uselfil *__f_%d = (struct uselfil *) 0;\nstatic char __t_%d[] = \"/tmp/,ts_XXXXXX\";\nstatic long __n_%d;\n\n", seqn, seqn, seqn);
X					putsel("mktemp(__t_%d);\n\1if (__f_%d != (struct uselfil *) 0)\n\1\tclosesf(__f_%d);\n\1", seqn, seqn, seqn);
X					putsel("if ((__i__er_ = unisel(__t_%d, %d, &__n_%d)) != 0 && __i__er_ != -1 && __i__er_ != -7)\n\1\terror(\"unisel %s\", __i__er_);\n\1", seqn, crec, seqn, recname(crec));
X					putsel("if ((int) (__f_%d = opensf(__t_%d)) == -1)\n\1\terror(\"opensf %s\", -1);\n\1unlink(__t_%d);", seqn, seqn, recname(crec), seqn);
X					break;
X				case SEL_REL|SEL_VALUE|SEL_SORT:
X					fldesc(reckey(jrec), &fd);
X					sprintf(vbuf, utype(fd.f_typ, (fd.f_typ == FLT? fd.f_len * 10: fd.f_len)), "__j_%d");
X					puthead("static ");
X					puthead(vbuf, ++xseq);
X					puthead(";\n");
X					fldesc($3, &fd);
X					putsel("gfield(%d, __j_%d);\n\1entsitm(%d, __j_%d, (char *) 0, %d);\n\1", fd.f_rpfld, xseq, $3, xseq, EQ);
X					/*FALLTHROUGH*/
X				case SEL_SORT:
X				case SEL_VALUE|SEL_SORT:
X					if (!didssdcl) {
X						didssdcl = 1;
X						puthead("static int (*__no_f__[])() = {0, 0, 0, 0};\n");
X					}
X					putsel("if ((__i__er_ = selsort(%d, __s_%d, __no_f__)) != 0 && __i__er_ != -1)\n\1\terror(\"unisort %s\", __i__er_);", crec, seqn, recname(crec));
X					jfld = SS;
X					jrec = crec;
X					break;
X				default:
X					yyerror("illegal combination of selection phrases (%d)", v);
X					YYERROR;
X				}
X				$$ = v;
X			}
X		;
X
Xwhere		: /* none */
X			{
X				$$ = 0;
X			}
X		| WHERE selfield
X			{
X				$$ = 1;
X			}
X		;
X
Xof		: /* none */
X			{
X				$$ = 0;
X			}
X		| OF tRECORD
X			{
X				int cnt;
X				FLDESC fd;
X
X				for (cnt = numflds(); cnt > 0; cnt--)
X					if (!fldesc(cnt, &fd))
X						continue;
X					else if (fd.f_rec == crec && fd.f_rprec == $2)
X						break;
X					else if (fd.f_rec == $2 && fd.f_rprec == crec)
X						break;
X				if (cnt == 0) {
X					yyerror("record type %s does not join to %s", recname($2), recname(crec));
X					YYERROR;
X				}
X				jrec = $2;
X				$$ = (fd.f_rec == crec? cnt: -cnt);
X			}
X		;
X
Xkey		: /* none */
X			{
X				$$ = 0;
X			}
X		| KEY tCONST
X			{
X				FLDESC fd;
X				char *cp;
X				int thekey;
X
X				if ((thekey = reckey(crec)) == 0) {
X					yyerror("record type %s has no key", recname(crec));
X					YYERROR;
X				}
X				fldesc(thekey, &fd);
X				if (fd.f_typ != STRNG && fd.f_typ != COMB && $2[0] != '&')
X					cp = "&";
X				else
X					cp = "";
X				putsel("if ((__i__er_ = acckey(%d, %s%s)) != 0)\n\1\terror(\"acckey %s\", __i__er_);", crec, cp, $2, recname(crec));
X				$$ = 1;
X			}
X		;
X
Xselfield	: sel
X		| selfield AND sel
X		;
X
Xsel		: field op tCONST
X			{
X				FLDESC fd;
X
X				fldesc($1, &fd);
X				if (fd.f_rec != crec) {
X					yyerror("field %s is not in record type %s", fldsyn($1), recname(crec));
X					YYERROR;
X				}
X				putsel("entsitm(%d, %s, (char *) 0, %d);\n\1", $1, $3, $2);
X			}
X		| field not BETWEEN tCONST AND tCONST
X			{
X				FLDESC fd;
X
X				fldesc($1, &fd);
X				if (fd.f_rec != crec) {
X					yyerror("field %s is not in record type %s", fldsyn($1), recname(crec));
X					YYERROR;
X				}
X				putsel("entsitm(%d, %s, %s, %d);\n\1", $1, $4, $6, ($2? NOT: EQ));
X			}
X		;
X
Xnot		: /* none */
X			{
X				$$ = 0;
X			}
X		| kNOT
X			{
X				$$ = 1;
X			}
X		;
X
Xby		: /* none */
X			{
X				$$ = 0;
X			}
X		| BY
X			{
X				puthead("static int __s_%d[] = {\n", seqn);
X			}
X		  sortlist
X			{
X				puthead("-1};\n");
X				$$ = 1;
X			}
X		;
X
Xsortlist	: sort
X		| sortlist ',' sort
X		;
X
Xsort		: sortspec
X			{
X				int cnt;
X
X				for (cnt = $1.nfld; cnt > 0; cnt--)
X					puthead(" %d,", $1.spec[cnt - 1]);
X				puthead(" 0,\n");
X				free($1.spec);
X			}
X		;
X
Xsortspec	: field
X			{
X				FLDESC fd;
X
X				fldesc($1, &fd);
X				if (fd.f_rec != crec) {
X					yyerror("field %s is not in record type %s", fldsyn($1), recname(crec));
X					YYERROR;
X				}
X				$$.nfld = 1;
X				if (($$.spec = (int *) malloc(sizeof (int))) == (int *) 0) {
X					yyerror("out of memory in firstsort");
X					YYERROR;
X				}
X 				$$.spec[0] = $1;
X			}
X		| sortspec PTR field
X			{
X				FLDESC fd, jfd;
X
X				fldesc($3, &fd);
X				fldesc($1.spec[$$.nfld - 1], &jfd);
X				if (jfd.f_rprec != fd.f_rec) {
X					yyerror("no explicit relationship between %s and %s.%s", fldsyn($1), recname(fd.f_rec), fldsyn(reckey(fd.f_rec)));
X					YYERROR;
X				}
X				$$ = $1;
X				if (($$.spec = (int *) realloc($$.spec, (unsigned) ++$$.nfld * sizeof (int))) == (int *) 0) {
X					yyerror("out of memory in nextsort");
X					YYERROR;
X				}
X				$$.spec[$$.nfld - 1] = $3;
X			}
X		;
X
Xfield		: tFIELD
X			{
X				int cnt;
X				char *cp;
X
X				for (cnt = 1; cnt <= numflds(); cnt++) {
X					if ((cp = fldsyn(cnt)) == (char *) 0)
X						continue;
X					if (strcmp(cp, $1) == 0)
X						break;
X				}
X				$$ = cnt;
X			}
X		| tRECORD '.' tFIELD
X			{
X				FLDESC fd;
X				int cnt;
X				char *cp;
X
X				for (cnt = numflds(); cnt > 0; cnt--) {
X					if ((cp = fldsyn(cnt)) == (char *) 0)
X						continue;
X					if (strcmp(cp, $3) != 0)
X						continue;
X					fldesc(cnt, &fd);
X					if (fd.f_rec == $1)
X						break;
X				}
X				if (cnt == 0) {
X					yyerror("field %s is not in record type %s", $3, recname($1));
X					YYERROR;
X				}
X				$$ = cnt;
X			}
X		;
X
Xop		: '>'
X			{
X				$$ = GT;
X			}
X		| '='
X			{
X				$$ = EQ;
X			}
X		| '<'
X			{
X				$$ = LT;
X			}
X		| LE
X			{
X				$$ = LTE;
X			}
X		| GE
X			{
X				$$ = GTE;
X			}
X		| NE
X			{
X				$$ = NOT;
X			}
X		;
X
Xtype		: LIKE field
X			{
X				FLDESC fd;
X
X				fldesc($2, &fd);
X				strcpy($$, utype(fd.f_typ, (fd.f_typ == FLT? fd.f_len * 10: fd.f_len)));
X			}
X		| STRING tNUM
X			{
X				strcpy($$, utype(STRNG, $2));
X			}
X		| NUMERIC tNUM
X			{
X				strcpy($$, utype(($2 > 4? LONG: INT), $2));
X			}
X		| AMOUNT tNUM
X			{
X				strcpy($$, utype(($2 > 7? HAMT: AMT), $2));
X			}
X		| FLOAT tNUM
X			{
X				strcpy($$, utype(FLT, $2));
X			}
X		| kDATE
X			{
X				strcpy($$, utype(DATE, 0));
X			}
X		| TIME
X			{
X				strcpy($$, utype(HR, 0));
X			}
X		;
X
Xvarlist		: tCONST
X			{
X				if ($1[0] == '"' || $1[0] == '&') {
X					yyerror("syntax error");
X					YYERROR;
X				}
X				strcpy($$, $1);
X			}
X		| varlist ',' tCONST
X			{
X				if ($3[0] == '"' || $3[0] == '&') {
X					yyerror("syntax error");
X					YYERROR;
X				}
X				strcpy($$, $1);
X				strcat($$, ", ");
X				strcat($$, $3);
X			}
X		;
X
X%%
________This_Is_The_END________
if test `wc -l < usp.y` -ne 541; then
	echo 'shar: usp.y was damaged during transit (should have been 541 bytes)'
fi
fi		; : end of overwriting check
echo 'x - usptok.l'
if test -f usptok.l; then echo 'shar: not overwriting usptok.l'; else
sed 's/^X//' << '________This_Is_The_END________' > usptok.l
X%{
X
X#include "y.tab.h"
X
X#undef input
X#undef unput
X
Xchar _curline[1024];
Xchar _unput[1024];
Xint _curcol;
Xint _curunp = 0;
Xint indent = 0;
Xint _ign_ = 0;
Xextern int nlflag;
Xextern char *srcfile;
X
Xstatic g_input() {
X	if (_curunp > 0) {
X		if (_unput[--_curunp] == '\n')
X			yylineno++;
X		return _unput[_curunp];
X	}
X	while (_curline[_curcol] == '\0') {
X		if (fgets(_curline, sizeof _curline, yyin) == (char *) 0)
X			return 0;
X		_curcol = 0;
X	}
X	if (_curline[_curcol] == '\n')
X		yylineno++;
X	return _curline[_curcol++];
X}
X		
Xinput() {
X	int ch;
X
X	ch = g_input();
X	if (!_ign_ && nlflag) {
X		if (ch == ' ')
X			indent++;
X		else if (ch == '\t')
X			do {
X				indent++;
X			} while (indent % 8 != 0);
X	}
X	return ch;
X}
X
Xunput(c) {
X	if (_curunp == 0 && _curcol > 0 && _curline[_curcol - 1] == c)
X		_curcol--;
X	else if (_curunp == sizeof _unput) {
X		yyerror("internal error: pushback overflow, char %o (octal)", c);
X		exit(1);
X	}
X	else
X		_unput[_curunp++] = c;
X	if (c == '\n') {
X		yylineno--;
X		nlflag = 0;
X	}
X}
X
Xextern char *scanon();
Xextern char *fldsyn();
Xextern char *recname();
X
X#include <dbtypes.h>
X
X%}
X
X%%
X
Xdefine { return DEFINE; }
Xlike { return LIKE; }
Xnumeric { return NUMERIC; }
Xstring { return STRING; }
Xfloat { return FLOAT; }
Xamount { return AMOUNT; }
Xdate { return kDATE; }
Xtime { return TIME; }
Xget { return GET; }
Xput { return PUT; }
Xforeach { return FOREACH; }
Xof { return OF; }
Xwhere { return WHERE; }
Xby { return BY; }
Xand { return AND; }
Xbetween { return BETWEEN; }
Xnot { return kNOT; }
Xselect { return SELECT; }
Xkey { return KEY; }
Xsort { return SORT; }
Xmessages { return MESSAGES; }
Xinterrupt { return INTERRUPT; }
Xon { return ON; }
Xoff { return OFF; }
X">=" { return GE; }
X"<=" { return LE; }
X"!=" { return NE; }
X"^=" { return NE; }
X"->" { return PTR; }
X\&?[A-Za-z_][A-Za-z0-9_]* {
X	int cnt;
X	char *p;
X
X	strcpy(yylval.str, yytext);
X	for (cnt = numrecs(); cnt > 0; cnt--) {
X		if ((p = recname(cnt)) == (char *) 0)
X			continue;
X		if (strcmp(p, yytext) == 0) {
X			yylval.rec = cnt;
X			return tRECORD;
X		}
X	}
X	for (cnt = numflds(); cnt > 0; cnt--) {
X		if ((p = fldsyn(cnt)) == (char *) 0)
X			continue;
X		if (strcmp(p, yytext) == 0)
X			return tFIELD;
X	}
X	return tCONST;
X}
X-?[0-9]+ {
X	yylval.num = atoi(yytext);
X	return tNUM;
X}
X\"([^\\n]*\\\")*[^"\n"]*\" {
X	strcpy(yylval.str, yytext);
X	return tCONST;
X}
X[ \t\n]+ ;
X. return *yytext;
X
X%%
X
X#include <varargs.h>
X
Xchar *scanon(buf)
Xregister char *buf; {
X	static char cbuf[1024];
X	register short bufc;
X	char ibuf;
X
X	ibuf = *buf;
X	bufc = 0;
X	for (buf++; *buf != '\0'; buf++) {
X		if (*buf == '\\')
X			cbuf[bufc++] = *++buf;
X		else if (*buf == ibuf)
X			break;
X		else
X			cbuf[bufc++] = *buf;
X	}
X	cbuf[bufc] = '\0';
X	if (*buf == ibuf && *++buf != '\0')
X		yyerror("internal error (canon trailing text \"%s\")", buf);
X	return cbuf;
X}
X
Xyyerror(va_alist)
Xva_dcl {
X	va_list args;
X	char *format;
X	short uc;
X
X	va_start(args);
X	format = va_arg(args, char *);
X	fprintf(stderr, "\n\"%s\", line %d: ", srcfile, yylineno);
X	vfprintf(stderr, format, args);
X	va_end(args);
X	fprintf(stderr, "\n> ");
X	if (_curunp == 0) {
X		short col;
X
X		fprintf(stderr, "%s>-", _curline);
X		for (uc = 0, col = 2; uc < _curcol - 1; uc++) {
X			if (_curline[uc] == '\t') {
X				do {
X					putc('-', stderr);
X				} while (++col % 8 != 0);
X			}
X			else {
X				putc('-', stderr);
X				col++;
X			}
X		}
X		fprintf(stderr, "^\n");
X	}
X 	else {
X		for (uc = _curunp; uc > 0; uc--)
X			putc(_unput[uc - 1], stderr);
X		fprintf(stderr, "\n>-^\n");
X	}
X}
________This_Is_The_END________
if test `wc -l < usptok.l` -ne 194; then
	echo 'shar: usptok.l was damaged during transit (should have been 194 bytes)'
fi
fi		; : end of overwriting check
exit 0



More information about the Comp.sources.misc mailing list