oz@yetti.UUCP (Ozan Yigit) (06/19/85)
The following is a C version of Ratfor. It is almost a direct
translation from a Ratfor in ratfor, distributed by the University
of Arizona. The code is full of peculiarities, indicative of such
a translation. The preprocessor seem to work well, but it probably
contains many bugs, some of which were discovered and fixed by
the software tools group for their own brand of ratfor. I have
used this particular pre-processor to create many other pre-processors,
including one for VMS DCL. So, if you need such a pre-processor,
and do not have fortran, or UN*X version of it, here it is !!!
Ps: I would appreciate receiving any bug fixes you may have.
Oz (whizzard of something or another, no doubt..)
Usenet: [dacvax|allegra|ihnp4|linus]!utzoo!yetti!oz
Bitnet: oz@[yuleo|yuyetti]
---------- CUT -------------------- CUT ------------------
#!/bin/sh
# This is a shell archive, meaning:
# 1. Remove everything above the #!/bin/sh line.
# 2. Save the resulting text in a file.
# 3. Execute the file with /bin/sh (not csh) to create the files:
# ratfor.c
# ratcom.h
# ratdef.h
# makefile
# lookup.c
# lookup.h
# This archive created: Wed Jun 19 15:01:06 1985
export PATH; PATH=/bin:$PATH
if test -f 'ratfor.c'
then
echo shar: over-writing existing file "'ratfor.c'"
fi
cat << \SHAR_EOF > 'ratfor.c'
/*
* ratfor
*
* A ratfor pre-processor in C. It is almost a direct
* translation of a pre-processor distributed by the
* University of Arizona. It closely corresponds to the
* pre-processor described in the "SOFTWARE TOOLS" book.
* It lacks the "case" construct available in the UNIX
* version of ratfor.
*
* By: Oz
* March 1984
*
*/
#include <stdio.h>
#include "ratdef.h"
#include "ratcom.h"
/* keywords: */
char sdo[3] = {
LETD,LETO,EOS};
char vdo[2] = {
LEXDO,EOS};
char sif[3] = {
LETI,LETF,EOS};
char vif[2] = {
LEXIF,EOS};
char selse[5] = {
LETE,LETL,LETS,LETE,EOS};
char velse[2] = {
LEXELSE,EOS};
char swhile[6] = {
LETW, LETH, LETI, LETL, LETE, EOS};
char vwhile[2] = {
LEXWHILE, EOS};
char sbreak[6] = {
LETB, LETR, LETE, LETA, LETK, EOS};
char vbreak[2] = {
LEXBREAK, EOS};
char snext[5] = {
LETN,LETE, LETX, LETT, EOS};
char vnext[2] = {
LEXNEXT, EOS};
char sfor[4] = {
LETF,LETO, LETR, EOS};
char vfor[2] = {
LEXFOR, EOS};
char srept[7] = {
LETR, LETE, LETP, LETE, LETA, LETT, EOS};
char vrept[2] = {
LEXREPEAT, EOS};
char suntil[6] = {
LETU, LETN, LETT, LETI, LETL, EOS};
char vuntil[2] = {
LEXUNTIL, EOS};
char sret[7] = {
LETR, LETE, LETT, LETU, LETR, LETN, EOS};
char vret[2] = {
LEXRETURN, EOS};
char sstr[7] = {
LETS, LETT, LETR, LETI, LETN, LETG, EOS};
char vstr[2] = {
LEXSTRING, EOS};
char deftyp[2] = {
DEFTYPE, EOS};
/* constant strings */
char *errmsg = "error at line ";
char *in = " in ";
char *ifnot = "if(.not.";
char *incl = "include";
char *fncn = "function";
char *def = "define";
char *bdef = "DEFINE";
char *contin = "continue";
char *rgoto = "goto ";
char *dat = "data ";
char *eoss = "EOS/";
extern char ngetch();
/* ------------------------------ */
/* M A I N L I N E & I N I T */
/* ------------------------------ */
main(argc,argv)
int argc;
char *argv[];
{
int i;
char *p;
if (argc == 1)
usage();
if ((infile[0] = fopen(argv[1], "r")) == NULL) {
fprintf(stderr,"%s: cannot open.\n",argv[1]);
exit(1);
}
if (p = argv[2])
if ((freopen(p, "w", stdout)) == NULL) {
fprintf(stderr,"%s: cannot create.\n",p);
exit(1);
}
/*
* initialise our stuff..
*
*/
outp = 0; /* output character pointer */
level = 0; /* file control */
linect[0] = 1; /* line count of first file */
fnamp = 0;
fnames[0] = EOS;
bp = -1; /* pushback buffer pointer */
fordep = 0; /* for stack */
for( i = 0; i <= 126; i++)
tabptr[i] = 0;
install(def, deftyp); /* default definitions */
install(bdef, deftyp);
fcname[0] = EOS; /* current function name */
label = 23000; /* next generated label */
parse(); /* call parser.. */
exit(1);
}
/* ------------------------------ */
/* P A R S E R */
/* ------------------------------ */
parse()
{
char lexstr[MAXTOK];
int lab, labval[MAXSTACK], lextyp[MAXSTACK], sp, token;
sp = 0;
lextyp[0] = EOF;
for (token = lex(lexstr); token != EOF; token = lex(lexstr)) {
if (token == LEXIF)
ifcode(&lab);
else if (token == LEXDO)
docode(&lab);
else if (token == LEXWHILE)
whilec(&lab);
else if (token == LEXFOR)
forcod(&lab);
else if (token == LEXREPEAT)
repcod(&lab);
else if (token == LEXDIGITS)
labelc(lexstr);
else if (token == LEXELSE) {
if (lextyp[sp] == LEXIF)
elseif(labval[sp]);
else
synerr("illegal else.");
}
if (token == LEXIF || token == LEXELSE || token == LEXWHILE
|| token == LEXFOR || token == LEXREPEAT
|| token == LEXDO || token == LEXDIGITS
|| token == LBRACE) {
sp++; /* beginning of statement */
if (sp > MAXSTACK)
baderr("stack overflow in parser.");
lextyp[sp] = token; /* stack type and value */
labval[sp] = lab;
}
else { /* end of statement - prepare to unstack */
if (token == RBRACE) {
if (lextyp[sp] == LBRACE)
sp--;
else
synerr("illegal right brace.");
}
else if (token == LEXOTHER)
otherc(lexstr);
else if (token == LEXBREAK || token == LEXNEXT)
brknxt(sp, lextyp, labval, token);
else if (token == LEXRETURN)
retcod();
else if (token == LEXSTRING)
strdcl();
token = lex(lexstr); /* peek at next token */
pbstr(lexstr);
unstak(&sp, lextyp, labval, token);
}
}
if (sp != 0)
synerr("unexpected EOF.");
}
/* ------------------------------ */
/* L E X I C A L A N A L Y S E R */
/* ------------------------------ */
/*
* alldig - return YES if str is all digits
*
*/
int
alldig(str)
char str[];
{
int i,j;
j = NO;
if (str[0] == EOS)
return(j);
for (i = 0; str[i] != EOS; i++)
if (type(str[i]) != DIGIT)
return(j);
j = YES;
return(j);
}
/*
* balpar - copy balanced paren string
*
*/
balpar()
{
char token[MAXTOK];
int t,nlpar;
if (gnbtok(token, MAXTOK) != LPAREN) {
synerr("missing left paren.");
return;
}
outstr(token);
nlpar = 1;
do {
t = gettok(token, MAXTOK);
if (t==SEMICOL || t==LBRACE || t==RBRACE || t==EOF) {
pbstr(token);
break;
}
if (t == NEWLINE) /* delete newlines */
token[0] = EOS;
else if (t == LPAREN)
nlpar++;
else if (t == RPAREN)
nlpar--;
/* else nothing special */
outstr(token);
}
while (nlpar > 0);
if (nlpar != 0)
synerr("missing parenthesis in condition.");
}
/*
* deftok - get token; process macro calls and invocations
*
*/
int
deftok(token, toksiz, fd)
char token[];
int toksiz;
FILE *fd;
{
char defn[MAXDEF];
int t;
for (t=gtok(token, toksiz, fd); t!=EOF; t=gtok(token, toksiz, fd)) {
if (t != ALPHA) /* non-alpha */
break;
if (look(token, defn) == NO) /* undefined */
break;
if (defn[0] == DEFTYPE) { /* get definition */
getdef(token, toksiz, defn, MAXDEF, fd);
install(token, defn);
}
else
pbstr(defn); /* push replacement onto input */
}
if (t == ALPHA) /* convert to single case */
fold(token);
return(t);
}
/*
* eatup - process rest of statement; interpret continuations
*
*/
eatup()
{
char ptoken[MAXTOK], token[MAXTOK];
int nlpar, t;
nlpar = 0;
do {
t = gettok(token, MAXTOK);
if (t == SEMICOL || t == NEWLINE)
break;
if (t == RBRACE || t == LBRACE) {
pbstr(token);
break;
}
if (t == EOF) {
synerr("unexpected EOF.");
pbstr(token);
break;
}
if (t == COMMA || t == PLUS
|| t == MINUS || t == STAR || t == LPAREN
|| t == AND || t == BAR || t == BANG
|| t == EQUALS || t == UNDERLINE ) {
while (gettok(ptoken, MAXTOK) == NEWLINE)
;
pbstr(ptoken);
if (t == UNDERLINE)
token[0] = EOS;
}
if (t == LPAREN)
nlpar++;
else if (t == RPAREN)
nlpar--;
outstr(token);
} while (nlpar >= 0);
if (nlpar != 0)
synerr("unbalanced parentheses.");
}
/*
* getdef (for no arguments) - get name and definition
*
*/
getdef(token, toksiz, defn, defsiz, fd)
char token[];
int toksiz;
char defn[];
int defsiz;
FILE *fd;
{
int i, nlpar, t;
char c, ptoken[MAXTOK];
skpblk(fd);
/*
* define(name,defn) or
* define name defn
*
*/
if ((t = gtok(ptoken, MAXTOK, fd)) != LPAREN) {;
t = BLANK; /* define name defn */
pbstr(ptoken);
}
skpblk(fd);
if (gtok(token, toksiz, fd) != ALPHA)
baderr("non-alphanumeric name.");
skpblk(fd);
c = (char) gtok(ptoken, MAXTOK, fd);
if (t == BLANK) { /* define name defn */
pbstr(ptoken);
i = 0;
do {
c = ngetch(&c, fd);
if (i > defsiz)
baderr("definition too long.");
defn[i++] = c;
}
while (c != SHARP && c != NEWLINE && c != EOF);
if (c == SHARP)
putbak(c);
}
else if (t == LPAREN) { /* define (name, defn) */
if (c != COMMA)
baderr("missing comma in define.");
/* else got (name, */
nlpar = 0;
for (i = 0; nlpar >= 0; i++)
if (i > defsiz)
baderr("definition too long.");
else if (ngetch(&defn[i], fd) == EOF)
baderr("missing right paren.");
else if (defn[i] == LPAREN)
nlpar++;
else if (defn[i] == RPAREN)
nlpar--;
/* else normal character in defn[i] */
}
else
baderr("getdef is confused.");
defn[i-1] = EOS;
}
/*
* gettok - get token. handles file inclusion and line numbers
*
*/
int
gettok(token, toksiz)
char token[];
int toksiz;
{
int t, i;
int tok;
char name[MAXNAME];
for ( ; level >= 0; level--) {
for (tok = deftok(token, toksiz, infile[level]); tok != EOF;
tok = deftok(token, toksiz, infile[level])) {
if (equal(token, fncn) == YES) {
skpblk(infile[level]);
t = deftok(fcname, MAXNAME, infile[level]);
pbstr(fcname);
if (t != ALPHA)
synerr("missing function name.");
putbak(BLANK);
return(tok);
}
else if (equal(token, incl) == NO)
return(tok);
for (i = 0 ;; i = strlen(name)) {
t = deftok(&name[i], MAXNAME, infile[level]);
if (t == NEWLINE || t == SEMICOL) {
pbstr(&name[i]);
break;
}
}
name[i] = EOS;
if (name[1] == SQUOTE) {
outtab();
outstr(token);
outstr(name);
outdon();
eatup();
return(tok);
}
if (level >= NFILES)
synerr("includes nested too deeply.");
else {
infile[level+1] = fopen(name, "r");
linect[level+1] = 1;
if (infile[level+1] == NULL)
synerr("can't open include.");
else {
level++;
if (fnamp + i <= MAXFNAMES) {
scopy(name, 0, fnames, fnamp);
fnamp = fnamp + i; /* push file name stack */
}
}
}
}
if (level > 0) { /* close include and pop file name stack */
fclose(infile[level]);
for (fnamp--; fnamp > 0; fnamp--)
if (fnames[fnamp-1] == EOS)
break;
}
}
token[0] = EOF; /* in case called more than once */
token[1] = EOS;
tok = EOF;
return(tok);
}
/*
* gnbtok - get nonblank token
*
*/
int
gnbtok(token, toksiz)
char token[];
int toksiz;
{
int tok;
skpblk(infile[level]);
tok = gettok(token, toksiz);
return(tok);
}
/*
* gtok - get token for Ratfor
*
*/
int
gtok(lexstr, toksiz, fd)
char lexstr[];
int toksiz;
FILE *fd;
{
int i, b, n, tok;
char c;
c = ngetch(&lexstr[0], fd);
if (c == BLANK || c == TAB) {
lexstr[0] = BLANK;
while (c == BLANK || c == TAB) /* compress many blanks to one */
c = ngetch(&c, fd);
if (c == SHARP)
while (ngetch(&c, fd) != NEWLINE) /* strip comments */
;
if (c != NEWLINE)
putbak(c);
else
lexstr[0] = NEWLINE;
lexstr[1] = EOS;
return((int)lexstr[0]);
}
i = 0;
tok = type(c);
if (tok == LETTER) { /* alpha */
for (i = 0; i < toksiz - 3; i++) {
tok = type(ngetch(&lexstr[i+1], fd));
/* Test for DOLLAR added by BM, 7-15-80 */
if (tok != LETTER && tok != DIGIT
&& tok != UNDERLINE && tok!=DOLLAR
&& tok != PERIOD)
break;
}
putbak(lexstr[i+1]);
tok = ALPHA;
}
else if (tok == DIGIT) { /* digits */
b = c - DIG0; /* in case alternate base number */
for (i = 0; i < toksiz - 3; i++) {
if (type(ngetch(&lexstr[i+1], fd)) != DIGIT)
break;
b = 10*b + lexstr[i+1] - DIG0;
}
if (lexstr[i+1] == RADIX && b >= 2 && b <= 36) {
/* n%ddd... */
for (n = 0;; n = b*n + c - DIG0) {
c = ngetch(&lexstr[0], fd);
if (c >= LETA && c <= LETZ)
c = c - LETA + DIG9 + 1;
else if (c >= BIGA && c <= BIGZ)
c = c - BIGA + DIG9 + 1;
if (c < DIG0 || c >= DIG0 + b)
break;
}
putbak(lexstr[0]);
i = itoc(n, lexstr, toksiz);
}
else
putbak(lexstr[i+1]);
tok = DIGIT;
}
#ifdef SQUAREB
else if (c == LBRACK) { /* allow [ for { */
lexstr[0] = LBRACE;
tok = LBRACE;
}
else if (c == RBRACK) { /* allow ] for } */
lexstr[0] = RBRACE;
tok = RBRACE;
}
#endif
else if (c == SQUOTE || c == DQUOTE) {
for (i = 1; ngetch(&lexstr[i], fd) != lexstr[0]; i++) {
if (lexstr[i] == UNDERLINE)
if (ngetch(&c, fd) == NEWLINE) {
while (c == NEWLINE || c == BLANK || c == TAB)
c = ngetch(&c, fd);
lexstr[i] = c;
}
else
putbak(c);
if (lexstr[i] == NEWLINE || i >= toksiz-1) {
synerr("missing quote.");
lexstr[i] = lexstr[0];
putbak(NEWLINE);
break;
}
}
}
else if (c == SHARP) { /* strip comments */
while (ngetch(&lexstr[0], fd) != NEWLINE)
;
tok = NEWLINE;
}
else if (c == GREATER || c == LESS || c == NOT
|| c == BANG || c == CARET || c == EQUALS
|| c == AND || c == OR)
i = relate(lexstr, fd);
if (i >= toksiz-1)
synerr("token too long.");
lexstr[i+1] = EOS;
if (lexstr[0] == NEWLINE)
linect[level] = linect[level] + 1;
return(tok);
}
/*
* lex - return lexical type of token
*
*/
int
lex(lexstr)
char lexstr[];
{
int tok;
for (tok = gnbtok(lexstr, MAXTOK);
tok == NEWLINE; tok = gnbtok(lexstr, MAXTOK))
;
if (tok == EOF || tok == SEMICOL || tok == LBRACE || tok == RBRACE)
return(tok);
if (tok == DIGIT)
tok = LEXDIGITS;
else if (equal(lexstr, sif) == YES)
tok = vif[0];
else if (equal(lexstr, selse) == YES)
tok = velse[0];
else if (equal(lexstr, swhile) == YES)
tok = vwhile[0];
else if (equal(lexstr, sdo) == YES)
tok = vdo[0];
else if (equal(lexstr, sbreak) == YES)
tok = vbreak[0];
else if (equal(lexstr, snext) == YES)
tok = vnext[0];
else if (equal(lexstr, sfor) == YES)
tok = vfor[0];
else if (equal(lexstr, srept) == YES)
tok = vrept[0];
else if (equal(lexstr, suntil) == YES)
tok = vuntil[0];
else if (equal(lexstr, sret) == YES)
tok = vret[0];
else if (equal(lexstr, sstr) == YES)
tok = vstr[0];
else
tok = LEXOTHER;
return(tok);
}
/*
* ngetch - get a (possibly pushed back) character
*
*/
char
ngetch(c, fd)
char *c;
FILE *fd;
{
if (bp >= 0) {
*c = buf[bp];
bp--;
}
else
*c = (char) getc(fd);
return(*c);
}
/*
* pbstr - push string back onto input
*
*/
pbstr(in)
char in[];
{
int i;
for (i = strlen(in) - 1; i >= 0; i--)
putbak(in[i]);
}
/*
* putbak - push char back onto input
*
*/
putbak(c)
char c;
{
bp++;
if (bp > BUFSIZE)
baderr("too many characters pushed back.");
buf[bp] = c;
}
/*
* relate - convert relational shorthands into long form
*
*/
int
relate(token, fd)
char token[];
FILE *fd;
{
if (ngetch(&token[1], fd) != EQUALS) {
putbak(token[1]);
token[2] = LETT;
}
else
token[2] = LETE;
token[3] = PERIOD;
token[4] = EOS;
token[5] = EOS; /* for .not. and .and. */
if (token[0] == GREATER)
token[1] = LETG;
else if (token[0] == LESS)
token[1] = LETL;
else if (token[0] == NOT || token[0] == BANG || token[0] == CARET) {
if (token[1] != EQUALS) {
token[2] = LETO;
token[3] = LETT;
token[4] = PERIOD;
}
token[1] = LETN;
}
else if (token[0] == EQUALS) {
if (token[1] != EQUALS) {
token[2] = EOS;
return(0);
}
token[1] = LETE;
token[2] = LETQ;
}
else if (token[0] == AND) {
token[1] = LETA;
token[2] = LETN;
token[3] = LETD;
token[4] = PERIOD;
}
else if (token[0] == OR) {
token[1] = LETO;
token[2] = LETR;
}
else /* can't happen */
token[1] = EOS;
token[0] = PERIOD;
return(strlen(token)-1);
}
/*
* skpblk - skip blanks and tabs in file fd
*
*/
skpblk(fd)
FILE *fd;
{
char c;
for (c = ngetch(&c, fd); c == BLANK || c == TAB; c = ngetch(&c, fd))
;
putbak(c);
}
/*
* type - return LETTER, DIGIT or char; works with ascii alphabet
*
*/
int
type(c)
char c;
{
int t;
if (c >= DIG0 && c <= DIG9)
t = DIGIT;
else if (c >= LETA && c <= LETZ)
t = LETTER;
else if (c >= BIGA && c <= BIGZ)
t = LETTER;
else
t = c;
return(t);
}
/* ------------------------------ */
/* C O D E G E N E R A T I O N */
/* ------------------------------ */
/*
* brknxt - generate code for break n and next n; n = 1 is default
*
*/
brknxt(sp, lextyp, labval, token)
int sp;
int lextyp[];
int labval[];
int token;
{
int i, n;
char t, ptoken[MAXTOK];
n = 0;
t = gnbtok(ptoken, MAXTOK);
if (alldig(ptoken) == YES) { /* have break n or next n */
i = 0;
n = ctoi(ptoken, &i) - 1;
}
else if (t != SEMICOL) /* default case */
pbstr(ptoken);
for (i = sp; i >= 0; i--)
if (lextyp[i] == LEXWHILE || lextyp[i] == LEXDO
|| lextyp[i] == LEXFOR || lextyp[i] == LEXREPEAT) {
if (n > 0) {
n--;
continue; /* seek proper level */
}
else if (token == LEXBREAK)
outgo(labval[i]+1);
else
outgo(labval[i]);
xfer = YES;
return;
}
if (token == LEXBREAK)
synerr("illegal break.");
else
synerr("illegal next.");
return;
}
/*
* docode - generate code for beginning of do
*
*/
docode(lab)
int *lab;
{
xfer = NO;
outtab();
outstr(sdo);
*lab = labgen(2);
outnum(*lab);
eatup();
outdon();
}
/*
* dostat - generate code for end of do statement
*
*/
dostat(lab)
int lab;
{
outcon(lab);
outcon(lab+1);
}
/*
* elseif - generate code for end of if before else
*
*/
elseif(lab)
int lab;
{
outgo(lab+1);
outcon(lab);
}
/*
* forcod - beginning of for statement
*
*/
forcod(lab)
int *lab;
{
char t, token[MAXTOK];
int i, j, nlpar,tlab;
tlab = *lab;
tlab = labgen(3);
outcon(0);
if (gnbtok(token, MAXTOK) != LPAREN) {
synerr("missing left paren.");
return;
}
if (gnbtok(token, MAXTOK) != SEMICOL) { /* real init clause */
pbstr(token);
outtab();
eatup();
outdon();
}
if (gnbtok(token, MAXTOK) == SEMICOL) /* empty condition */
outcon(tlab);
else { /* non-empty condition */
pbstr(token);
outnum(tlab);
outtab();
outstr(ifnot);
outch(LPAREN);
nlpar = 0;
while (nlpar >= 0) {
t = gettok(token, MAXTOK);
if (t == SEMICOL)
break;
if (t == LPAREN)
nlpar++;
else if (t == RPAREN)
nlpar--;
if (t == EOF) {
pbstr(token);
return;
}
if (t != NEWLINE && t != UNDERLINE)
outstr(token);
}
outch(RPAREN);
outch(RPAREN);
outgo((tlab)+2);
if (nlpar < 0)
synerr("invalid for clause.");
}
fordep++; /* stack reinit clause */
j = 0;
for (i = 1; i < fordep; i++) /* find end *** should i = 1 ??? *** */
j = j + strlen(&forstk[j]) + 1;
forstk[j] = EOS; /* null, in case no reinit */
nlpar = 0;
t = gnbtok(token, MAXTOK);
pbstr(token);
while (nlpar >= 0) {
t = gettok(token, MAXTOK);
if (t == LPAREN)
nlpar++;
else if (t == RPAREN)
nlpar--;
if (t == EOF) {
pbstr(token);
break;
}
if (nlpar >= 0 && t != NEWLINE && t != UNDERLINE) {
if (j + strlen(token) >= MAXFORSTK)
baderr("for clause too long.");
scopy(token, 0, forstk, j);
j = j + strlen(token);
}
}
tlab++; /* label for next's */
*lab = tlab;
}
/*
* fors - process end of for statement
*
*/
fors(lab)
int lab;
{
int i, j;
xfer = NO;
outnum(lab);
j = 0;
for (i = 1; i < fordep; i++)
j = j + strlen(&forstk[j]) + 1;
if (strlen(&forstk[j]) > 0) {
outtab();
outstr(&forstk[j]);
outdon();
}
outgo(lab-1);
outcon(lab+1);
fordep--;
}
/*
* ifcode - generate initial code for if
*
*/
ifcode(lab)
int *lab;
{
xfer = NO;
*lab = labgen(2);
ifgo(*lab);
}
/*
* ifgo - generate "if(.not.(...))goto lab"
*
*/
ifgo(lab)
int lab;
{
outtab(); /* get to column 7 */
outstr(ifnot); /* " if(.not. " */
balpar(); /* collect and output condition */
outch(RPAREN); /* " ) " */
outgo(lab); /* " goto lab " */
}
/*
* labelc - output statement number
*
*/
labelc(lexstr)
char lexstr[];
{
xfer = NO; /* can't suppress goto's now */
if (strlen(lexstr) == 5) /* warn about 23xxx labels */
if (lexstr[0] == DIG2 && lexstr[1] == DIG3)
synerr("warning: possible label conflict.");
outstr(lexstr);
outtab();
}
/*
* labgen - generate n consecutive labels, return first one
*
*/
int
labgen(n)
int n;
{
int i;
i = label;
label = label + n;
return(i);
}
/*
* otherc - output ordinary Fortran statement
*
*/
otherc(lexstr)
char lexstr[];
{
xfer = NO;
outtab();
outstr(lexstr);
eatup();
outdon();
}
/*
* outch - put one char into output buffer
*
*/
outch(c)
char c;
{
int i;
if (outp >= 72) { /* continuation card */
outdon();
/*** should output "-" for dcl continuation.. ***/
for (i = 0; i < 6; i++)
outbuf[i] = BLANK;
outp = 6;
}
outbuf[outp] = c;
outp++;
}
/*
* outcon - output "n continue"
*
*/
outcon(n)
int n;
{
xfer = NO;
if (n <= 0 && outp == 0)
return; /* don't need unlabeled continues */
if (n > 0)
outnum(n);
outtab();
outstr(contin);
outdon();
}
/*
* outdon - finish off an output line
*
*/
outdon()
{
outbuf[outp] = NEWLINE;
outbuf[outp+1] = EOS;
printf(outbuf);
outp = 0;
}
/*
* outgo - output "goto n"
*
*/
outgo(n)
int n;
{
if (xfer == YES)
return;
outtab();
outstr(rgoto);
outnum(n);
outdon();
}
/*
* outnum - output positive decimal number
*
*/
outnum(n)
int n;
{
char chars[MAXCHARS];
int i, m;
m = n;
i = -1;
do {
i++;
chars[i] = (m % 10) + DIG0;
m = m / 10;
}
while (m > 0 && i < MAXCHARS);
for ( ; i >= 0; i--)
outch(chars[i]);
}
/*
* outstr - output string
*
*/
outstr(str)
char str[];
{
int i;
for (i=0; str[i] != EOS; i++)
outch(str[i]);
}
/*
* outtab - get past column 6
*
*/
outtab()
{
while (outp < 6)
outch(BLANK);
}
/*
* repcod - generate code for beginning of repeat
*
*/
repcod(lab)
int *lab;
{
int tlab;
tlab = *lab;
outcon(0); /* in case there was a label */
tlab = labgen(3);
outcon(tlab);
*lab = ++tlab; /* label to go on next's */
}
/*
* retcod - generate code for return
*
*/
retcod()
{
char token[MAXTOK], t;
t = gnbtok(token, MAXTOK);
if (t != NEWLINE && t != SEMICOL && t != RBRACE) {
pbstr(token);
outtab();
outstr(fcname);
outch(EQUALS);
eatup();
outdon();
}
else if (t == RBRACE)
pbstr(token);
outtab();
outstr(sret);
outdon();
xfer = YES;
}
/* strdcl - generate code for string declaration */
strdcl()
{
char t, name[MAXNAME], init[MAXTOK];
int i, len;
t = gnbtok(name, MAXNAME);
if (t != ALPHA)
synerr("missing string name.");
if (gnbtok(init, MAXTOK) != LPAREN) { /* make size same as initial value */
len = strlen(init) + 1;
if (init[1] == SQUOTE || init[1] == DQUOTE)
len = len - 2;
}
else { /* form is string name(size) init */
t = gnbtok(init, MAXTOK);
i = 0;
len = ctoi(init, &i);
if (init[i] != EOS)
synerr("invalid string size.");
if (gnbtok(init, MAXTOK) != RPAREN)
synerr("missing right paren.");
else
t = gnbtok(init, MAXTOK);
}
outtab();
/*
* outstr(int);
*/
outstr(name);
outch(LPAREN);
outnum(len);
outch(RPAREN);
outdon();
outtab();
outstr(dat);
len = strlen(init) + 1;
if (init[0] == SQUOTE || init[0] == DQUOTE) {
init[len-1] = EOS;
scopy(init, 1, init, 0);
len = len - 2;
}
for (i = 1; i <= len; i++) { /* put out variable names */
outstr(name);
outch(LPAREN);
outnum(i);
outch(RPAREN);
if (i < len)
outch(COMMA);
else
outch(SLASH);
;
}
for (i = 0; init[i] != EOS; i++) { /* put out init */
outnum(init[i]);
outch(COMMA);
}
pbstr(eoss); /* push back EOS for subsequent substitution */
}
/*
* unstak - unstack at end of statement
*
*/
unstak(sp, lextyp, labval, token)
int *sp;
int lextyp[];
int labval[];
char token;
{
int tp;
tp = *sp;
for ( ; tp > 0; tp--) {
if (lextyp[tp] == LBRACE)
break;
if (lextyp[tp] == LEXIF && token == LEXELSE)
break;
if (lextyp[tp] == LEXIF)
outcon(labval[tp]);
else if (lextyp[tp] == LEXELSE) {
if (*sp > 1)
tp--;
outcon(labval[tp]+1);
}
else if (lextyp[tp] == LEXDO)
dostat(labval[tp]);
else if (lextyp[tp] == LEXWHILE)
whiles(labval[tp]);
else if (lextyp[tp] == LEXFOR)
fors(labval[tp]);
else if (lextyp[tp] == LEXREPEAT)
untils(labval[tp], token);
}
*sp = tp;
}
/*
* untils - generate code for until or end of repeat
*
*/
untils(lab, token)
int lab;
int token;
{
char ptoken[MAXTOK];
xfer = NO;
outnum(lab);
if (token == LEXUNTIL) {
lex(ptoken);
ifgo(lab-1);
}
else
outgo(lab-1);
outcon(lab+1);
}
/*
* whilec - generate code for beginning of while
*
*/
whilec(lab)
int *lab;
{
int tlab;
tlab = *lab;
outcon(0); /* unlabeled continue, in case there was a label */
tlab = labgen(2);
outnum(tlab);
ifgo(tlab+1);
*lab = tlab;
}
/*
* whiles - generate code for end of while
*
*/
whiles(lab)
int lab;
{
outgo(lab);
outcon(lab+1);
}
/* ------------------------------ */
/* E R R O R M E S S A G E S */
/* ------------------------------ */
/*
* baderr - print error message, then die
*
*/
baderr(msg)
char msg[];
{
synerr(msg);
exit(1);
}
/*
* synerr - report Ratfor syntax error
*
*/
synerr(msg)
char msg[];
{
char lc[MAXCHARS];
int i;
fprintf(stderr,errmsg);
if (level >= 0)
i = level;
else
i = 0; /* for EOF errors */
itoc(linect[i], lc, MAXCHARS);
fprintf(stderr,lc);
for (i = fnamp - 1; i > 1; i = i - 1)
if (fnames[i-1] == EOS) { /* print file name */
fprintf(stderr,in);
fprintf(stderr,fnames[i]);
break;
}
fprintf(stderr,": \n %s\n",msg);
}
/*
* usage
*
*/
usage()
{
fprintf(stderr,"usage: ratfor <input file> [output file]\n");
exit(1);
}
/* ------------------------------ */
/* U T I L I T Y R O U T I N E S */
/* ------------------------------ */
/*
* ctoi - convert string at in[i] to int, increment i
*
*/
int
ctoi(in, i)
char in[];
int *i;
{
int k, j;
j = *i;
while (in[j] == BLANK || in[j] == TAB)
j++;
for (k = 0; in[j] != EOS; j++) {
if (in[j] < DIG0 || in[j] > DIG9)
break;
k = 10 * k + in[j] - DIG0;
}
*i = j;
return(k);
}
/*
* fold - convert alphabetic token to single case
*
*/
fold(token)
char token[];
{
int i;
/* WARNING - this routine depends heavily on the */
/* fact that letters have been mapped into internal */
/* right-adjusted ascii. god help you if you */
/* have subverted this mechanism. */
for (i = 0; token[i] != EOS; i++)
if (token[i] >= BIGA && token[i] <= BIGZ)
token[i] = token[i] - BIGA + LETA;
}
/*
* equal - compare str1 to str2; return YES if equal, NO if not
*
*/
int
equal(str1, str2)
char str1[];
char str2[];
{
int i;
for (i = 0; str1[i] == str2[i]; i++)
if (str1[i] == EOS) {
return(YES);
}
return(NO);
}
/*
* scopy - copy string at from[i] to to[j]
*
*/
scopy(from, i, to, j)
char from[];
int i;
char to[];
int j;
{
int k1, k2;
k2 = j;
for (k1 = i; from[k1] != EOS; k1++) {
to[k2] = from[k1];
k2++;
}
to[k2] = EOS;
}
#include "lookup.h"
/*
* look - look-up a definition
*
*/
int
look(name,defn)
char name[];
char defn[];
{
extern struct hashlist *lookup();
struct hashlist *p;
if ((p = lookup(name)) == NULL)
return(NO);
strcpy(defn,p->def);
return(YES);
}
/*
* itoc - special version of itoa
*
*/
int
itoc(n,str,size)
int n;
char str[];
int size;
{
int i,j,k,sign;
char c;
if ((sign = n) < 0)
n = -n;
i = 0;
do {
str[i++] = n % 10 + '0';
}
while ((n /= 10) > 0 && i < size-2);
if (sign < 0 && i < size-1)
str[i++] = '-';
str[i] = EOS;
/*
* reverse the string and plug it back in
*
*/
for (j = 0, k = strlen(str) - 1; j < k; j++, k--) {
c = str[j];
str[j] = str[k];
str[k] = c;
}
return(i-1);
}
SHAR_EOF
if test -f 'ratcom.h'
then
echo shar: over-writing existing file "'ratcom.h'"
fi
cat << \SHAR_EOF > 'ratcom.h'
int bp; /* next available char; init = 0 */
char buf[BUFSIZE]; /* pushed-back chars */
char fcname[MAXNAME]; /* text of current function name */
int fordep; /* current depth of for statements */
char forstk[MAXFORSTK]; /* stack of reinit strings */
int xfer; /* YES if just made transfer, NO otherwise */
int label; /* next label returned by labgen */
int level ; /* level of file inclusion; init = 1 */
int linect[NFILES]; /* line count on input file[level]; init = 1 */
FILE *infile[NFILES]; /* file number[level]; init infile[1] = STDIN */
int fnamp; /* next free slot in fnames; init = 2 */
char fnames[MAXFNAMES]; /* stack of include names; init fnames[1] = EOS */
int avail; /* first first location in table; init = 1 */
int tabptr[127]; /* name pointers; init = 0 */
int outp; /* last position filled in outbuf; init = 0 */
char outbuf[74]; /* output lines collected here */
char fname[MAXNAME][NFILES]; /* file names */
int nfiles; /* number of files */
SHAR_EOF
if test -f 'ratdef.h'
then
echo shar: over-writing existing file "'ratdef.h'"
fi
cat << \SHAR_EOF > 'ratdef.h'
#define ACCENT 96
#define AND 38
#define APPEND
#define ATSIGN 64
#define BACKSLASH 92
#define BACKSPACE 8
#define BANG 33
#define BAR 124
#define BIGA 65
#define BIGB 66
#define BIGC 67
#define BIGD 68
#define BIGE 69
#define BIGF 70
#define BIGG 71
#define BIGH 72
#define BIGI 73
#define BIGJ 74
#define BIGK 75
#define BIGL 76
#define BIGM 77
#define BIGN 78
#define BIGO 79
#define BIGP 80
#define BIGQ 81
#define BIGR 82
#define BIGS 83
#define BIGT 84
#define BIGU 85
#define BIGV 86
#define BIGW 87
#define BIGX 88
#define BIGY 89
#define BIGZ 90
#define BLANK 32
#define CARET 94
#define COLON 58
#define COMMA 44
#define CRLF 13
#define DIG0 48
#define DIG1 49
#define DIG2 50
#define DIG3 51
#define DIG4 52
#define DIG5 53
#define DIG6 54
#define DIG7 55
#define DIG8 56
#define DIG9 57
#define DOLLAR 36
#define DQUOTE 34
#define EOS 0
#define EQUALS 61
#define ESCAPE ATSIGN
#define GREATER 62
#define HUGE 30000
#define LBRACE 123
#define LBRACK 91
#define LESS 60
#define LETA 97
#define LETB 98
#define LETC 99
#define LETD 100
#define LETE 101
#define LETF 102
#define LETG 103
#define LETH 104
#define LETI 105
#define LETJ 106
#define LETK 107
#define LETL 108
#define LETM 109
#define LETN 110
#define LETO 111
#define LETP 112
#define LETQ 113
#define LETR 114
#define LETS 115
#define LETT 116
#define LETU 117
#define LETV 118
#define LETW 119
#define LETX 120
#define LETY 121
#define LETZ 122
#define LPAREN 40
#define MINUS 45
#define NEWLINE 10
#define NO 0
#define NOT 126
#define OR BAR /* same as | */
#define PERCENT 37
#define PERIOD 46
#define PLUS 43
#define QMARK 63
#define RBRACE 125
#define RBRACK 93
#define RPAREN 41
#define SEMICOL 59
#define SHARP 35
#define SLASH 47
#define SQUOTE 39
#define STAR 42
#define TAB 9
#define TILDE 126
#define UNDERLINE 95
#define YES 1
#define LIMIT 134217728
#define LIM1 28
#define LIM2 -28
/*
* lexical analyser symbols
*
*/
#define LETTER 1
#define DIGIT 2
#define ALPHA 3
#define LEXBREAK 4
#define LEXDIGITS 5
#define LEXDO 6
#define LEXELSE 7
#define LEXFOR 8
#define LEXIF 9
#define LEXNEXT 10
#define LEXOTHER 11
#define LEXREPEAT 12
#define LEXUNTIL 13
#define LEXWHILE 14
#define LEXRETURN 15
#define LEXEND 16
#define LEXSTOP 17
#define LEXSTRING 18
#define DEFTYPE 19
#define MAXCHARS 10 /* characters for outnum */
#define MAXDEF 200 /* max chars in a defn */
#define MAXFORSTK 200 /* max space for for reinit clauses */
#define MAXFNAMES 350 /* max chars in filename stack NFILES*MAXNAME */
#define MAXNAME 64 /* file name size in gettok */
#define MAXSTACK 100 /* max stack depth for parser */
#define MAXTBL 15000 /* max chars in all definitions */
#define MAXTOK 132 /* max chars in a token */
#define NFILES 7 /* max depth of file inclusion */
#define RADIX PERCENT /* % indicates alternate radix */
#define BUFSIZE 300 /* pushback buffer for ngetch and putbak */
SHAR_EOF
if test -f 'makefile'
then
echo shar: over-writing existing file "'makefile'"
fi
cat << \SHAR_EOF > 'makefile'
CFLAGS = -O
ratfor: ratfor.o lookup.o
cc -o ratfor ratfor.o lookup.o
ratfor.o: ratdef.h ratcom.h
lookup.o: lookup.h
clean:
rm -f *.o core ratfor
SHAR_EOF
if test -f 'lookup.c'
then
echo shar: over-writing existing file "'lookup.c'"
fi
cat << \SHAR_EOF > 'lookup.c'
#include <stdio.h>
#include "lookup.h"
static
struct hashlist *hashtab[HASHMAX];
/*
* from K&R "The C Programming language"
* Table lookup routines
*
* hash - for a hash value for string s
*
*/
hash(s)
char *s;
{
int hashval;
for (hashval = 0; *s != '\0';)
hashval += *s++;
return (hashval % HASHMAX);
}
/*
* lookup - lookup for a string s in the hash table
*
*/
struct hashlist
*lookup(s)
char *s;
{
struct hashlist *np;
for (np = hashtab[hash(s)]; np != NULL; np = np->next)
if (strcmp(s, np->name) == 0)
return(np); /* found */
return(NULL); /* not found */
}
/*
* install - install a string name in hashtable and its value def
*
*/
struct hashlist
*install(name,def)
char *name;
char *def;
{
int hashval;
struct hashlist *np, *lookup();
char *strsave(), *malloc();
if ((np = lookup(name)) == NULL) { /* not found.. */
np = (struct hashlist *) malloc(sizeof(*np));
if (np == NULL)
return(NULL);
if ((np->name = strsave(name)) == NULL)
return(NULL);
hashval = hash(np->name);
np->next = hashtab[hashval];
hashtab[hashval] = np;
} else /* found.. */
free(np->def); /* free prev. */
if ((np->def = strsave(def)) == NULL)
return(NULL);
return(np);
}
/*
* strsave - save string s somewhere
*
*/
char
*strsave(s)
char *s;
{
char *p, *malloc();
if ((p = malloc(strlen(s)+1)) != NULL)
strcpy(p, s);
return(p);
}
SHAR_EOF
if test -f 'lookup.h'
then
echo shar: over-writing existing file "'lookup.h'"
fi
cat << \SHAR_EOF > 'lookup.h'
/*
* from K&R "The C Programming language"
* Table lookup routines
* structure and definitions
*
*/
/* basic table entry */
struct hashlist {
char *name;
char *def;
struct hashlist *next; /* next in chain */
};
#define HASHMAX 100 /* size of hashtable */
/* hash table itself */
SHAR_EOF
# End of shell archive
exit 0ken@boring.UUCP (06/26/85)
These context diffs follow Ozan Yigit's posting of Ratfor in C. There
are 2 bug fixes, and changes to make it generate Fortran-77 code for
if and while statements. A short test program and output are included.
Please send bug reports on the original code to Ozan, bug reports on
the added code to me. Thanks for the posting, Ozan.
#! /bin/sh
# This is a shell archive, meaning:
# 1. Remove everything above the #! /bin/sh line.
# 2. Save the resulting text in a file.
# 3. Execute the file with /bin/sh (not csh) to create the files:
# ctxdiff
# test.r
# test.f
# This archive created: Wed Jun 26 13:29:08 1985
# By: Ken Yap ()
export PATH; PATH=/bin:$PATH
if test -f 'ctxdiff'
then
echo shar: will not over-write existing file "'ctxdiff'"
else
cat << \SHAR_EOF > 'ctxdiff'
*** ratfor.c Tue Jun 25 14:49:59 1985
--- rat77.c Wed Jun 26 13:19:13 1985
***************
*** 33,38
char velse[2] = {
LEXELSE,EOS};
char swhile[6] = {
LETW, LETH, LETI, LETL, LETE, EOS};
char vwhile[2] = {
--- 33,44 -----
char velse[2] = {
LEXELSE,EOS};
+ char sthen[5] = {
+ LETT,LETH,LETE,LETN,EOS};
+
+ char sendif[6] = {
+ LETE,LETN,LETD,LETI,LETF,EOS};
+
char swhile[6] = {
LETW, LETH, LETI, LETL, LETE, EOS};
char vwhile[2] = {
***************
*** 866,873
int lab;
{
! outgo(lab+1);
! outcon(lab);
}
/*
--- 872,880 -----
int lab;
{
! outtab();
! outstr(selse);
! outdon();
}
/*
***************
*** 986,992
xfer = NO;
*lab = labgen(2);
! ifgo(*lab);
}
/*
--- 993,999 -----
xfer = NO;
*lab = labgen(2);
! ifthen();
}
/*
***************
*** 990,995
}
/*
* ifgo - generate "if(.not.(...))goto lab"
*
*/
--- 997,1013 -----
}
/*
+ * ifend - generate code for end of if
+ *
+ */
+ ifend()
+ {
+ outtab();
+ outstr(sendif);
+ outdon();
+ }
+
+ /*
* ifgo - generate "if(.not.(...))goto lab"
*
*/
***************
*** 1004,1009
outgo(lab); /* " goto lab " */
}
/*
* labelc - output statement number
--- 1022,1033 -----
outgo(lab); /* " goto lab " */
}
+ /*
+ * ifthen - generate "if((...))then"
+ *
+ */
+ ifthen()
+ {
outtab();
outstr(sif);
***************
*** 1005,1010
}
/*
* labelc - output statement number
*
--- 1029,1041 -----
ifthen()
{
+ outtab();
+ outstr(sif);
+ balpar();
+ outstr(sthen);
+ outdon();
+ }
+
/*
* labelc - output statement number
*
***************
*** 1096,1102
outbuf[outp] = NEWLINE;
outbuf[outp+1] = EOS;
! printf(outbuf);
outp = 0;
}
--- 1127,1133 -----
outbuf[outp] = NEWLINE;
outbuf[outp+1] = EOS;
! printf("%s", outbuf);
outp = 0;
}
***************
*** 1286,1293
break;
if (lextyp[tp] == LEXIF && token == LEXELSE)
break;
! if (lextyp[tp] == LEXIF)
! outcon(labval[tp]);
else if (lextyp[tp] == LEXELSE) {
if (*sp > 1)
tp--;
--- 1317,1325 -----
break;
if (lextyp[tp] == LEXIF && token == LEXELSE)
break;
! if (lextyp[tp] == LEXIF) {
! ifend();
! }
else if (lextyp[tp] == LEXELSE) {
if (*sp > 1)
tp--;
***************
*** 1291,1297
else if (lextyp[tp] == LEXELSE) {
if (*sp > 1)
tp--;
! outcon(labval[tp]+1);
}
else if (lextyp[tp] == LEXDO)
dostat(labval[tp]);
--- 1323,1329 -----
else if (lextyp[tp] == LEXELSE) {
if (*sp > 1)
tp--;
! ifend();
}
else if (lextyp[tp] == LEXDO)
dostat(labval[tp]);
***************
*** 1339,1345
outcon(0); /* unlabeled continue, in case there was a label */
tlab = labgen(2);
outnum(tlab);
! ifgo(tlab+1);
*lab = tlab;
}
--- 1371,1377 -----
outcon(0); /* unlabeled continue, in case there was a label */
tlab = labgen(2);
outnum(tlab);
! ifthen();
*lab = tlab;
}
***************
*** 1352,1357
{
outgo(lab);
outcon(lab+1);
}
--- 1384,1390 -----
{
outgo(lab);
+ ifend();
outcon(lab+1);
}
***************
*** 1392,1398
for (i = fnamp - 1; i > 1; i = i - 1)
if (fnames[i-1] == EOS) { /* print file name */
fprintf(stderr,in);
! fprintf(stderr,fnames[i]);
break;
}
fprintf(stderr,": \n %s\n",msg);
--- 1425,1431 -----
for (i = fnamp - 1; i > 1; i = i - 1)
if (fnames[i-1] == EOS) { /* print file name */
fprintf(stderr,in);
! fprintf(stderr,&fnames[i]);
break;
}
fprintf(stderr,": \n %s\n",msg);
SHAR_EOF
fi # end of overwriting check
if test -f 'test.r'
then
echo shar: will not over-write existing file "'test.r'"
else
cat << \SHAR_EOF > 'test.r'
integer x,y
x=1; y=2
if(x == y)
write(6,600)
else if(x > y)
write(6,601)
else
write(6,602)
x=1
while(x < 10){
if(y != 2) break
if(y != 2) next
write(6,603)x
x=x+1
}
repeat
x=x-1
until(x == 0)
for(x=0; x < 10; x=x+1)
write(6,604)x
600 format('Wrong, x != y')
601 format('Also wrong, x < y')
602 format('Ok!')
603 format('x = ',i2)
604 format('x = ',i2)
end
SHAR_EOF
fi # end of overwriting check
if test -f 'test.f'
then
echo shar: will not over-write existing file "'test.f'"
else
cat << \SHAR_EOF > 'test.f'
integer x,y
x=1
y=2
if(x .eq. y)then
write(6,600)
else
if(x .gt. y)then
write(6,601)
else
write(6,602)
endif
endif
x=1
23004 if(x .lt. 10)then
if(y .ne. 2)then
goto 23005
endif
if(y .ne. 2)then
goto 23004
endif
write(6,603)x
x=x+1
goto 23004
endif
23005 continue
23010 continue
x=x-1
23011 if(.not.(x .eq. 0))goto 23010
23012 continue
x=0
23013 if(.not.(x .lt. 10))goto 23015
write(6,604)x
23014 x=x+1
goto 23013
23015 continue
600 format('Wrong, x != y')
601 format('Also wrong, x < y')
602 format('Ok!')
603 format('x = ',i2)
604 format('x = ',i2)
end
SHAR_EOF
fi # end of overwriting check
# End of shell archive
exit 0
--
UUCP: ..!{seismo,okstate,garfield,decvax,philabs}!mcvax!ken Voice: Ken!
Mail: Centrum voor Wiskunde en Informatica, Kruislaan 413, 1098 SJ, Amsterdam.rlk@wlcrjs.UUCP (Richard L. Klappal) (07/12/85)
With the postings of the ratfor preprocessor and the mention of PD YACC and LEX, I'm wondering if there is a public domain version of struct available. Lex, yacc, or C source (or ratfor/f77 for that matter). I'm looking for something to take unstructered source code and generate, as much as possible, structured source code with unnecessary goto's removed. (I have binary struct for f66->ratfor, but I'm looking for the algorithms.) I want to clean up some BASIC stuff that was written with an eggbeater, than cut up and pasted back together at random :-(. Richard Klappal UUCP: ..!ihnp4!wlcrjs!uklpl!rlk | "Money is truthful. If a man MCIMail: rklappal | speaks of his honor, make him Compuserve: 74106,1021 | pay cash." USPS: 1 S 299 Danby Street | Villa Park IL 60181 | Lazarus Long TEL: (312) 620-4988 | (aka R. Heinlein) -------------------------------------------------------------------------