From fa080de7afc95aa1c19a6e6fc0e0708ced2eadc4 Mon Sep 17 00:00:00 2001 From: Joseph Hunkeler Date: Wed, 8 Jul 2015 20:46:52 -0400 Subject: Initial commit --- unix/boot/generic/generic.c | 892 ++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 892 insertions(+) create mode 100644 unix/boot/generic/generic.c (limited to 'unix/boot/generic/generic.c') diff --git a/unix/boot/generic/generic.c b/unix/boot/generic/generic.c new file mode 100644 index 00000000..07d19885 --- /dev/null +++ b/unix/boot/generic/generic.c @@ -0,0 +1,892 @@ +/* Copyright(c) 1986 Association of Universities for Research in Astronomy Inc. + */ + +#include +#include +#include +#include +#include +#define import_spp +#include + +/* + * GENERIC -- This filter takes a file containing a generic operator as input + * and generates as output either a set of files, one for each of the data + * types in the generic family, or a single file wherein the generic section + * has been duplicated for each case. + */ + +#define input lex_input +#define unput lex_unput +extern char yytext[]; +extern int yyleng; +extern FILE *yyin; +extern FILE *yyout; + +#define MAXFILES 512 +#define MAXNEST 50 +#define OK 0 +#define SZ_FORSTK 20 + +/* $FOR contstruct descriptor. + */ +struct _for { + char f_prevtype; /* type before $for */ + char f_types[20]; /* "csilrdx" */ + char *f_curtype; /* pointer into f_types */ + long f_fpos; /* seek offset of $FOR */ +}; + +struct _for forstk[SZ_FORSTK]; +int forlev; +char *type_string; +char xtype_string[SZ_FNAME+1]; +char type_char; +int pass_output = 1; +int clobber = NO; + +extern long k_ftell (FILE *cx_i); +extern FILE *k_fopen (char *fname, char *mode); +extern int k_fseek (FILE *cx_i, long offset, int type); +extern int k_fclose (FILE *cx_i); + +extern int yylex (void); +extern int lex_input (void); +extern void lex_unput (int ch); + + +char *make_typed_filename (char *template, char type_char); +void set_type_string (char ch); +void copy_line (void); +void copy_string (void); +void copy_comment (void); +void make_float (char type_ch); +void output_indef (char ch); +void output_upper (char *s); +void pass_through (void); +void do_for (void); +void do_endfor (void); +void do_if (void); +void do_else (void); +void do_endif (void); + +int evaluate_expr (void); +int parse_relational (int *size1, int *size2, int *op); + +int relop (void); +int gsize (char ch); +char nextch (void); +char gch (void); +void uch (char ch); + +void output (char ch); +void outstr (char *s); + + + + +/** + * GENERIC: e.g., generic [-k] [-t csilrdx] file + */ +int main (int argc, char *argv[]) +{ + char *files[MAXFILES], *s, **p, *ip; + char fname[SZ_FNAME], *extension; + char *types = "i", *t; + char *prefix = ""; + char genfname[SZ_FNAME+1]; + char template[SZ_FNAME+1]; + char input_file[SZ_FNAME+1]; + char *index(), *rindex(); + int n, nfiles; + FILE *fp; + + genfname[0] = EOS; + nfiles = 0; + + for (p = &argv[1]; *p != NULL; p++) { + s = *p; + if (s[0] == '-') { + switch (s[1]) { + case 'k': + clobber = YES; + break; + case 't': + if (*(p+1) != NULL) + types = *++p; + break; + case 'o': + if (*(p+1) != NULL) + strcpy (genfname, *++p); + break; + case 'p': + if (*(p+1) != NULL) + prefix = *++p; + break; + } + } else { + files[nfiles++] = s; + if (genfname[0] != EOS && nfiles > 1) { + fprintf (stderr, + "Cannot process multiple files with '-o' flag\n"); + exit (OSOK+1); + } + } + } + + for (n=0; n < nfiles; n++) { + strcpy (input_file, files[n]); + yyin = k_fopen (input_file, "r"); + if (yyin == NULL) { + fprintf (stderr, "Cannot open input file '%s'\n", input_file); + continue; + } + + /* Set pointer to the filename extension string. If the file name + * has an extension, lop it off by overwriting the '.' with EOS. + * The first character of the extension of a generic file is + * normally a 'g', e.g., ".gx" or ".gc", but we want to generate + * a ".x" or ".c" file, so lop off any leading g in the extension. + */ + if ((extension = rindex (input_file, '.')) != NULL) { + *extension++ = EOS; + if (*extension == 'g') + extension++; + } else + extension = ""; + + for (t=types; *t != EOS; t++) { + /* Make output file name */ + strcpy (fname, prefix); + + /* Expand a template of the form "chars$tchars" into the root + * name of the new file, replacing the $t by the type char. + * If using input filename as the root, add "$t"; otherwise, + * check whether or not the generic filename string has a + * "$t" in it, and add one at end if it does not. + */ + if (genfname[0] == EOS) { + strcpy (template, input_file); + strcat (template, "$t"); + + } else { + strcpy (template, genfname); + + for (ip=index(genfname,'$'); ip != NULL; + ip = index(ip,'$')) { + + if (*(ip+1) == '$') + ip += 2; + else if (*(ip+1) == 't') + break; + } + + if (ip == NULL && strlen(types) > 1) + strcat (ip, "$t"); + } + + if (genfname[0] == EOS || strlen (types) > 1) + strcat (fname, make_typed_filename (template, *t)); + else + strcat (fname, template); + + /* If the user supplied the output filename template, we + * assume that it already contains an extension. + */ + if (genfname[0] == EOS) { + strcat (fname, "."); + strcat (fname, extension); + } + + if (access(fname,0) == 0) { + if (clobber == NO) { + fprintf (stderr, "File `%s' already exists\n", fname); + continue; + } else + unlink (fname); + } + if ((fp = fopen (fname, "w")) == NULL) { + fprintf (stderr, "Cannot open file `%s'\n", fname); + continue; + } + + yyout = fp; + set_type_string (*t); + type_char = *t; + forlev = -1; + + yylex(); /* do it */ + + fclose (fp); + k_fseek (yyin,0L,0); + } + + k_fclose (yyin); + } + + exit (OSOK); +} + + +/* MAKE_TYPED_FILENAME -- Make a copy of a filename string, substituting + * the given type suffix character for the every sequence "$t" found in the + * input string. The output string is retained in an internal static buffer. + * Any sequence "$$" is converted into a single "$". + */ +char * +make_typed_filename (char *template, char type_char) +{ + register char *ip, *op; + char ch; + static char fname[SZ_FNAME+1]; + + if (isupper (type_char)) + ch = tolower (type_char); + else + ch = type_char; + + for (ip=template, op=fname; *ip != EOS; ) + if (*ip == '$' && *(ip+1) == '$') { + *op++ = '$'; + ip += 2; + } else if (*ip == '$' && *(ip+1) == 't') { + *op++ = ch; + ip += 2; + } else + *op++ = *ip++; + + return (fname); +} + + +/* SET_TYPE_STRING -- Given the type suffix character, set the external + * array "type_string" to the name of the corresponding SPP datatype. + */ +void +set_type_string (char ch) +{ + char *ip, *op; + + switch (ch) { + case 'B': + type_string = "ubyte"; /* unsigned byte */ + break; + case 'U': + type_string = "ushort"; + break; + case 'b': + type_string = "bool"; + break; + case 'c': + type_string = "char"; + break; + case 's': + type_string = "short"; + break; + case 'i': + type_string = "int"; + break; + case 'l': + type_string = "long"; + break; + case 'r': + type_string = "real"; + break; + case 'd': + type_string = "double"; + break; + case 'x': + type_string = "complex"; + break; + case 'p': + type_string = "pointer"; + break; + default: + fprintf (stderr, "Unknown type suffix char `%c'\n", ch); + } + + op = xtype_string; + *op++ = 'X'; + for (ip=type_string; *ip != EOS; ip++) + *op++ = toupper (*ip); + *op++ = EOS; +} + + +/* COPY_LINE -- Output whatever is in the yylex token buffer, followed by the + * remainder of the line from which the token was extracted. + */ +void +copy_line (void) +{ + char ch; + + outstr(yytext); + while ((ch = input()) != '\n') + output(ch); + unput(ch); +} + + +/* COPY_STRING -- Called when the opening quote of a string is seen in the + * input. Copy the opening quote followed by all input characters until the + * end of string is seen. + */ +void +copy_string (void) +{ + char ch; + + outstr(yytext); + for (;;) { + switch (ch = input()) { + case '"': + output(ch); + return; + case '\\': + output(ch); + if ((ch = input()) != '\n') + output(ch); + else + unput(ch); + break; + case '\n': + unput(ch); + return; + default: + output(ch); + } + } +} + + +/* COPY_COMMENT -- Copy a C style comment to the output file. + */ +void +copy_comment (void) +{ + char ch; + int flag = 0; + + outstr (yytext); + + while ((ch = input()) != EOF) { + output (ch); + switch (ch) { + case '*': + flag = 1; + break; + case '/': + if (flag == 1) + return; + else + flag = 0; + break; + default: + flag = 0; + break; + } + } +} + + +/* MAKE_FLOAT -- Called when a n$f is seen in the input to convert a numeric + * constant to the form appropriate for the indicated datatype, e.g., "0", + * "0.", "0.0D0", etc. + */ +void +make_float (char type_ch) +{ + char *p; + + for (p=yytext; *p != '$'; p++) + ; + *p = EOS; + + if (type_ch == 'x') { + output ('('); + outstr (yytext); + outstr (".0,"); + outstr (yytext); + outstr (".0)"); + } else { + outstr (yytext); + switch (type_ch) { + case 'r': + outstr (".0"); + break; + case 'd': + outstr (".0D0"); + break; + } + } +} + + +/* OUTPUT_INDEF -- Output the INDEF string for the indicated datatype. + */ +void +output_indef (char ch) /* output INDEF, INDEFS, INDEFL, etc. */ +{ + outstr(yytext); + + switch (ch) { + case 's': + output ('S'); + break; + case 'i': + output ('I'); + break; + case 'l': + output ('L'); + break; + case 'r': + output ('R'); + break; + case 'd': + output ('D'); + break; + case 'x': + output ('X'); + break; + } +} + + +/* OUTPUT_UPPER -- Output the name of the current datatype (INT, REAL, etc.) + * in upper case. + */ +void +output_upper (char *s) +{ + char ch, *p; + + outstr(s); + for (p=type_string; (ch = *p) != EOS; p++) + output(toupper(ch)); +} + + +/* PASS_THROUGH -- Used to pass text on to the output without modification. + * The text is delimited as "$/ (text) /" in the input file. The delimited + * section may enclose newlines. + */ +void +pass_through (void) +{ + char ch; + + while ((ch = input()) != '/') + output(ch); +} + + +/* DO_FOR -- Process a "$FOR (types)" statement. The sequence of statements + * bracketed by $for ... $endfor will be processed and output (to a single + * output stream) for each datatype named in the for predicate. + */ +void +do_for (void) +{ + register char *op; + register int ch; + register struct _for *fp; + char types[20]; + + if (++forlev + 1 >= SZ_FORSTK) { + fprintf (stderr, "$for statements nested too deeply\n"); + exit (OSOK+1); + } + + /* Extract list of types. + */ + while ((ch = input()) != '(') + if (ch == EOF || ch == '\n') { + fprintf (stderr, "$for must have () delimited list of types\n"); + strcpy (types, "i"); + goto init_; + } + + for (op=types; (ch = input()) != ')'; op++) + if (ch == EOF || ch == '\n') { + fprintf (stderr, "missing right paren in $for statement\n"); + break; + } else + *op = ch; + + *op = EOS; + if (op == types) { + fprintf (stderr, "null typelist in $for statement\n"); + strcpy (types, "i"); + } + +init_: + fp = &forstk[forlev]; + fp->f_prevtype = type_char; + strcpy (fp->f_types, types); + fp->f_curtype = fp->f_types; + fp->f_fpos = k_ftell (yyin); + + type_char = *(fp->f_curtype)++; + set_type_string (type_char); +} + + +/* DO_ENDFOR -- Called to process a $ENDFOR. Set the next datatype and seek + * back to the line following the matching $FOR statement. When the type list + * is exhausted pop the $for stack and continue normal processing. + */ +void +do_endfor (void) +{ + register struct _for *fp; + + if (forlev < 0) { + fprintf (stderr, "$endfor with no matching $for\n"); + return; + } + + fp = &forstk[forlev]; + if ((type_char = *(fp->f_curtype)++) != EOS) { + set_type_string (type_char); + k_fseek (yyin, fp->f_fpos, 0); + } else { + type_char = fp->f_prevtype; + set_type_string (type_char); + --forlev; + } +} + + +/* + * Conditional Compilation + * ------------------------- + */ + +#define TRUE 1 +#define FALSE 0 +#define EQ 0 +#define NE 1 +#define LE 2 +#define LT 3 +#define GE 4 +#define GT 5 + +char expr_buf[80], *expr; +int level = 0; + +struct if_stack { + int oldstate; + int active; +} stk[MAXNEST]; + + +/* DO_IF -- Process a $IF statement. Evaluate the predicate and push a + * pass or stop output flag on the if stack. + */ +void +do_if (void) +{ + char ch; + int expr_value; + struct if_stack *p; + + level += 1; + p = &stk[level]; + p->oldstate = pass_output; + p->active = (pass_output == TRUE); + + if ((expr_value = evaluate_expr()) == ERR) + expr_value = FALSE; + + if ((ch = input()) != '\n') + unput(ch); + + if (p->active == FALSE) + return; + else if (expr_value == FALSE) + pass_output = FALSE; +} + + +/* DO_ELSE -- Process a $ELSE statement. Toggle the pass/stop output flag + * on top of the if stack. + */ +void +do_else (void) +{ + char ch; + + if (level == 0) + fprintf (stderr, "Unmatched $else statement\n"); + else if (stk[level].active) /* toggle pass_output */ + pass_output = (pass_output == FALSE); + + if ((ch = input()) != '\n') + unput(ch); +} + + +/* DO_ENDIF -- Process a $ENDIF statement. Pop the if stack. + */ +void +do_endif (void) /* $endif statement */ +{ + char ch; + + if (level == 0) + fprintf (stderr, "Too many $endif statements\n"); + else + pass_output = stk[level--].oldstate; + + if ((ch = input()) != '\n') + unput(ch); +} + + +/* EVALUATE_EXPR -- Kludge to evaluate boolean expressions in $if statements. + * Two kinds of expressions are permitted: (datatype relop chars), or + * (sizeof(char) relop sizeof(char)), where relop = (==, !=, <= etc.). + * + * Examples: $if (datatype != dx) + * (code to be compiled if type not d or x) + * + * $if (sizeof(i) <= sizeof(r)) + * (code to be compiled if size int <= real) + */ +int +evaluate_expr (void) +{ + char ch=0, *p, *index(); + int lpar, size1, size2, op; + + + /* Advance to start of expression (discard '(') */ + if (nextch() != '(') + goto err; + else + input(); + + /* Extract expression string into buffer */ + expr = expr_buf; + nextch(); + + for (p=expr_buf, lpar=1; lpar > 0 && (*p = input()) != EOF; p++) + switch (ch = *p) { + case '(': + lpar++; + break; + case ')': + if (--lpar == 0) + *p = EOS; + break; + case '\n': + goto err; + } + + /* Is current type in set or not in set */ + if (strncmp (expr,"datatype",8) == 0) { + expr += 8; + switch (relop()) { + case EQ: + return (index(expr,type_char) != NULL); + case NE: + return (index(expr,type_char) == NULL); + default: + goto err; + } + + /* Compare sizes of two data types */ + } else if (strncmp(expr,"sizeof",6) == 0) { + if (parse_relational (&size1, &size2, &op) == ERR) { + ch = 0; + goto err; + } + switch (op) { + case EQ: + return (size1 == size2); + case NE: + return (size1 != size2); + case LE: + return (size1 <= size2); + case LT: + return (size1 < size2); + case GE: + return (size1 >= size2); + case GT: + return (size1 > size2); + } + + /* only "type" and "sizeof" are implemented */ + } else { +err: fprintf (stderr, "Syntax error in $if statement\n"); + if (ch != '\n') { + /* skip rest of line */ + while ((ch = input()) != '\n') + ; + unput(ch); + } + } + + return (ERR); +} + + +/* PARSE_RELATIONAL -- Parse "sizeof(t1) relop sizeof(t2)" (via brute force...) */ +int +parse_relational (int *size1, int *size2, int *op) +{ + expr += 6; /* ... (t1) */ + + if (gch() != '(') + return (ERR); + if ((*size1 = gsize(gch())) == ERR) + return (ERR); + if (gch() != ')') + return (ERR); /* relop */ + if ((*op = relop()) == ERR) + return (ERR); + + uch (gch()); /* skip whitespace */ + + if (strncmp(expr,"sizeof",6) != 0) /* sizeof(t2) */ + return (ERR); + + expr += 6; + + if (gch() != '(') + return (ERR); + if ((*size2 = gsize(gch())) == ERR) + return (ERR); + if (gch() != ')') + return (ERR); + + return (OK); +} + + +/* RELOP -- Return a code for the next relational operator token in the input + * stream. + */ +int +relop (void) +{ + char ch; + + + switch (gch()) { + case '!': + if (gch() == '=') + return (NE); + return (ERR); + case '=': + if (gch() == '=') + return (EQ); + return (ERR); + case '<': + if ((ch = gch()) == '=') + return (LE); + uch(ch); + return (LT); + case '>': + if ((ch = gch()) == '=') + return (GE); + uch(ch); + return (GT); + default: + return (ERR); + } +} + + +/* GSIZE -- Return the size of a datatype given its character code. + */ +int +gsize (char ch) +{ + switch (ch) { + case 'B': + return (sizeof(XUBYTE)); + case 'U': + return (sizeof(XUSHORT)); + case 't': + return (gsize(type_char)); + case 'c': + return (sizeof(XCHAR)); + case 's': + return (sizeof(XSHORT)); + case 'i': + return (sizeof(XINT)); + case 'l': + return (sizeof(XLONG)); + case 'r': + return (sizeof(XREAL)); + case 'd': + return (sizeof(XDOUBLE)); + case 'x': + return (sizeof(XCOMPLEX)); + case 'p': + return (sizeof(XPOINTER)); + default: + return (ERR); + } +} + + +/* NEXTCH -- Advance to next non-whitespace character. + */ +char +nextch (void) +{ + char ch; + + for (ch=input(); ch == ' ' || ch == '\t'; ch=input()) + ; + unput (ch); + return (ch); +} + + +/* GCH -- Get next nonwhite char from expression buffer. + */ +char +gch (void) +{ + while (*expr == ' ' || *expr == '\t') + expr++; + + if (*expr != EOS) + return (*expr++); + else + return (EOS); +} + + +/* UCH -- Put char back into expression buffer. + */ +void +uch (char ch) +{ + *--expr = ch; +} + + +/* OUTPUT -- Write a single character to the output file, if output is + * currently enabled (else throw it away). + */ +void +output (char ch) +{ + if (pass_output) + putc (ch, yyout); +} + + +/* OUTSTR -- Output a string. + */ +void +outstr (char *s) +{ + if (pass_output) + fputs (s, yyout); +} -- cgit