Rename branch.

--HG--
branch : unlabeled-1.1.1-branch

util/ack/pc/em_pc.c

@@ -1,690 +0,0 @@
-/*
- * (c) copyright 1983 by the Vrije Universiteit, Amsterdam, The Netherlands.
- *
- *          This product is part of the Amsterdam Compiler Kit.
- *
- * Permission to use, sell, duplicate or disclose this software must be
- * obtained in writing. Requests for such permissions may be sent to
- *
- *      Dr. Andrew S. Tanenbaum
- *      Wiskundig Seminarium
- *      Vrije Universiteit
- *      Postbox 7161
- *      1007 MC Amsterdam
- *      The Netherlands
- *
- */
-
-/*
- * put all the pieces of the pascal part of the EM project together
- *      original author: Johan Stevenson, Vrije Universiteit, Amsterdam
- *      heavily modified by: Ed Keizer, Vrije Universiteit, Amsterdam
- */
-
-#include        <stdio.h>
-#include        <signal.h>
-#include        <sys/types.h>
-#include        <sys/dir.h>
-#include        <em_path.h>
-#include        <pc_size.h>
-#include        <local.h>
-
-#define	MAX_FLAG		40	/* The Max. no of '{' flags allowed */
-
-#define void                    int
-
-char	def_pc_path[200] ;
-char	def_err_path[200] ;
-
-char	*pc_path	=	def_pc_path ;
-char    *err_path       =	def_err_path ;
-
-int     toterr;
-int     parent;
-
-char    *eeflag;
-char    *vvflag = "-V";
-int	no_pemflag = 0 ;
-char    *pemflag[MAX_FLAG];
-char    *eflag;
-char    *wflag;
-
-int     sizes[sz_last+1] = {
-	2,      /* sz_addr */
-	8,      /* sz_real */
-	0,      /* sz_head */
-	512,    /* sz_buff */
-	4096,   /* sz_mset */
-	2,      /* sz_iset */
-};
-
-#define CALLSIZE                60
-char    *callvector[CALLSIZE];
-char    **av;
-int     ac;
-int     fileargs;               /* number of recognized, processed args */
-int     flagargs;
-char    *progname;
-char    *source;
-
-#define CHARSIZE                2500
-#define CHARMARG                50
-char    charbuf[CHARSIZE];
-char    *charp                  = charbuf;
-
-char    *tmp_dir                = TMP_DIR;
-char    *unique                 = "pcXXXXXX";
-
-char    sigs[] = {
-	SIGHUP,
-	SIGINT,
-	SIGTERM,
-	0
-};
-
-/*
- * forward function declarations
- */
-void    finish();
-void    pem();
-int     list();
-char    *flag();
-char    *tempfile();
-char    **initvector();
-char    *basename();
-
-/*
- * used library routines and data
- */
-
-extern  char    *sys_errlist[];
-extern  int     errno;
-
-int     atoi();
-void    exit();
-void    sleep();
-void    execv();
-char    *sbrk();
-int     chdir();
-int     fork();
-int     wait();
-int     getpid();
-int     open();
-int     close();
-int     read();
-
-main(argc,argv) char **argv; {
-	register char *p;
-	char *files[3] ;
-
-	for (p = sigs; *p; p++)
-		if (signal(*p,finish) == SIG_IGN)
-			signal(*p,SIG_IGN);
-	ac = argc;
-	av = argv;
-	progname = *av++;
-	init();
-	while ( --ac>0 ) {
-		p = *av++;
-		if (*p == '-') {
-			flagargs++;
-			p = flag(p);
-		} else {
-			if ( fileargs>=3 ) fatal("Too many file arguments") ;
-			files[fileargs++]= p;
-		}
-	}
-	if ( fileargs!=3 ) fatal("Not enough arguments") ;
-	source=files[2] ;
-	pem(files[0],files[1]) ;
-	finish();
-}
-
-char *flag(f) char *f; {
-	register char *p;
-
-	p = f+1;
-	switch (*p++) {
-	case 'e':
-		eflag = f;
-		break;
-	case 'E':
-		eeflag = f;
-		break;
-	case 'w':
-		wflag = f;
-		break;
-	case 'V':
-		vvflag = f;
-		return(0);
-	case '{':
-		if ( no_pemflag>=MAX_FLAG ) {
-			ermess("too many flags, ignored %s",f) ;
-		} else {
-			pemflag[no_pemflag++] = p;
-		}
-		return(0);
-	case 'R':
-		pc_path= p ;
-		return 0 ;
-	case 'r' :
-		err_path= p ;
-		return 0 ;
-	default:
-		return(f);
-	}
-	if (*p)
-		fatal("bad flag %s",f);
-	return(0);
-}
-
-initsizes(f) FILE *f; {
-	register c, i;
-	register char *p;
-
-	p = vvflag + 2;
-	while (c = *p++) {
-		i = atoi(p);
-		while (*p >= '0' && *p <= '9')
-			p++;
-		switch (c) {
-		case 'p': sz_addr = i; continue;
-		case 'f': sz_real = i; continue;
-		case 'h': sz_head = i; continue;
-		case 'b': sz_buff = i; continue;
-		case 'm': sz_mset = i; continue;
-		case 'j': sz_iset = i; continue;
-		case 'w':
-		case 'i': if (i == 2) continue; break;
-		case 'l': if (i == 4) continue; break;
-		}
-		fatal("bad V-flag %s",vvflag);
-	}
-	if (sz_head == 0)
-		sz_head = 6*sz_word + 2*sz_addr;
-	for (i = 0; i <= sz_last; i++)
-		fprintf(f, "%d\n",sizes[i]);
-}
-
-/* ------------------ calling sequences -------------------- */
-
-pem(p,q) char *p,*q; {
-	register char **v,*d;
-	int i;
-	FILE *erfil;
-
-	v = initvector(pc_path);
-	d = tempfile('d');
-	if ((erfil = fopen(d,"w")) == NULL)
-		syserr(d);
-	initsizes(erfil);
-	fprintf(erfil,"%s\n",basename(source));
-	for ( i=0 ; i<no_pemflag ; i++ ) fprintf(erfil,"%s\n",pemflag[i]);
-	fclose(erfil);
-	*v++ = q;
-	*v++ = d;
-	call(v,p,(char *)0);
-	if (toterr == 0)
-		if (list(p,d) < 0)
-			toterr++;
-	donewith(d);
-}
-
-/* ------------------- miscellaneous routines --------------- */
-
-char *basename(p) char *p; {
-	register char *q;
-
-	q = p;
-	while (*q)
-		if (*q++ == '/')
-			p = q;
-	return(p);
-}
-
-char *tempfile(suf) {
-	register char *p,*q;
-	register i;
-
-	p = charp; q = tmp_dir;
-	while (*p = *q++)
-		p++;
-	*p++ = '/';
-	q = unique;
-	while (*p = *q++)
-		p++;
-	i = fileargs;
-	do
-		*p++ = i % 10 + '0';
-	while (i /= 10);
-	*p++ = '.'; *p++ = suf; *p++ = '\0';
-	q = charp; charp = p;
-	return(q);
-}
-
-call(v,in,out) char **v,*in,*out; {
-	register pid;
-	int     status;
-
-	while ((parent = fork()) < 0)
-		sleep(1);
-	if (parent == 0) {
-		if (in) {
-			close(0);
-			if (open(in,0) != 0)
-				syserr(in);
-		}
-		if (out) {
-			close(1);
-			if (creat(out,0666) != 1)
-				syserr(out);
-		}
-		*v = 0;
-		execv(callvector[0],callvector+1);
-		syserr(callvector[0]);
-	}
-	while ((pid = wait(&status)) != parent) {
-		if (pid == -1)
-			fatal("process %d disappeared",parent);
-		fatal("unknown child %d died",pid);
-	}
-	if ((status & 0177) > 3) {
-/*
-		if ((status & 0200) && tflag==0)
-			unlink("core");
-*/
-		fatal("signal %d in %s. Ask an expert for help",
-				status&0177,callvector[0]);
-	}
-	if (status & 0177400)
-		toterr++;
-}
-
-char **initvector(path) char *path; {
-	register char *p,**v;
-
-	v = callvector;
-	p = path;
-	*v++ = p;
-	*v++ = basename(p);
-	return(v);
-}
-
-finish() {
-	register char *p,*q;
-	register fd;
-	struct direct dir;
-
-	signal(SIGINT,SIG_IGN);
-	if (parent != 0) {
-		chdir(tmp_dir);
-		fd = open(".",0);
-		while (read(fd,(char *) &dir,sizeof dir) == sizeof dir) {
-			if (dir.d_ino == 0)
-				continue;
-			p = unique;
-			q = dir.d_name;
-			while (*p++ == *q++)
-				if (*p == '\0') {
-					unlink(dir.d_name);
-					break;
-				}
-		}
-		close(fd);
-	}
-	exit(toterr ? -1 : 0);
-}
-
-
-donewith(p) char *p; {
-
-	if (p >= charbuf && p < &charbuf[CHARSIZE])
-		unlink(p);
-}
-
-init() {
-	register char *p,*s ;
-	register i,fd;
-
-	if ((fd = open(tmp_dir,0)) < 0)
-		tmp_dir = ".";
-	close(fd);
-	p= def_pc_path ;
-	s= EM_DIR ; while ( *p++ = *s++ ) ; *p='/' ;
-	s= PEM_PATH ; while ( *p++ = *s++ ) ;
-	p= def_err_path ;
-	s= EM_DIR ; while ( *p++ = *s++ ) ; *p='/' ;
-	s= ERR_PATH ; while ( *p++ = *s++ ) ;
-	p = unique+2;
-	parent = i = getpid();
-	do
-		*p++ = i % 10 + '0';
-	while (i /= 10);
-	*p++ = '.'; *p = '\0';
-}
-
-/* ------------------- pascal listing ----------------------- */
-
-#define MAXERNO         300
-#define MAXERRLIST      10
-#define IDMAX           8
-
-struct errec {
-	int     erno;
-	char    mess[IDMAX+1];
-	int     mesi;
-	int     chno;
-	int     lino;
-};
-
-struct  errec   curr;
-struct  errec   next;
-
-int     *index          = 0;
-int     maxerno;
-
-int     errerr;
-int     errfat;
-
-int     listlino;
-int     listorig;
-int     listrela;
-char    *listfnam;
-
-FILE    *inpfil;
-FILE    *mesfil;
-FILE    *errfil;
-
-int     errorline();
-int     geterrec();
-int     nexterror();
-
-int list(p,q) char *p,*q; {
-
-	if ((errfil = fopen(q,"r")) == NULL)
-		syserr(q);
-	if (geterrec() == 0)
-		if (eeflag==0) {
-			fclose(errfil);
-			return(0);
-		}
-	if (index == 0) {
-		index = (int *) sbrk(MAXERNO * sizeof index[0]);
-		fillindex();
-	}
-	if ((inpfil = fopen(p,"r")) == NULL)
-		syserr(p);
-	errerr = 0;
-	errfat = 0;
-	listlino = 0;
-	listorig = 0;
-	listrela = 0;
-	listfnam = source;
-	if (eeflag)
-		listfull();
-	else if (eflag)
-		listpartial();
-	else
-		listshort();
-	fclose(errfil);
-	fclose(inpfil);
-	fflush(stdout);
-	return(errfat ? -1 : 1);
-}
-
-listshort() {
-
-	while (nexterror()) {
-		while (listlino < curr.lino)
-			nextline(0);
-		printf("%s, line %d: ",listfnam,listrela);
-		string(&curr);
-	}
-}
-
-listfull() {
-
-	if (nexterror())
-		do {
-			do {
-				nextline(1);
-			} while (listlino < curr.lino);
-		} while (errorline());
-	while (nextline(1))
-		;
-}
-
-listpartial() {
-
-	if (nexterror())
-		do {
-			do {
-				nextline(listlino >= curr.lino-2);
-			} while (listlino < curr.lino);
-		} while (errorline());
-}
-
-int nextline(printing) {
-	register ch;
-
-	listlino++;
-	ch = getc(inpfil);
-	if (ch == '#') {
-		if (lineline(printing) == 0)
-			fatal("bad line directive");
-		return(1);
-	}
-	listrela++;
-	if (listfnam == source)
-		listorig++;
-	if (ch != EOF) {
-		if (printing)
-			printf("%5d\t",listorig);
-		do {
-			if (printing)
-				putchar(ch);
-			if (ch == '\n')
-				return(1);
-		} while ((ch = getc(inpfil)) != EOF);
-	}
-	return(0);
-}
-
-lineline(printing) {
-	register ch;
-	register char *p,*q;
-	static char line[100];
-
-	p = line;
-	while ((ch = getc(inpfil)) != '\n') {
-		if (ch == EOF || p == &line[100-1])
-			return(0);
-		*p++ = ch;
-	}
-	*p = '\0'; p = line;
-	if (printing)
-		printf("\t#%s\n",p);
-	if ((listrela = atoi(p)-1) < 0)
-		return(0);
-	while ((ch = *p++) != '"')
-		if (ch == '\0')
-			return(0);
-	q = p;
-	while (ch = *p++) {
-		if (ch == '"') {
-			*--p = '\0';
-			if ( source ) {
-				listfnam = strcmp(q,source)==0 ? source : q;
-				return(1);
-			}
-			source=q ; listfnam=q ;
-			return 1 ;
-		}
-		if (ch == '/')
-			q = p;
-	}
-	return(0);
-}
-
-int errorline() {
-	register c;
-	register struct errec *p,*q;
-	struct  errec   lerr[MAXERRLIST];
-	int     goon;
-
-	printf("*** ***");
-	p = lerr;
-	c = 0;
-	do {
-		if (c < curr.chno) {
-			printf("%*c",curr.chno-c,'^');
-			c = curr.chno;
-		}
-		if (p < &lerr[MAXERRLIST])
-			*p++ = curr;
-		goon = nexterror();
-	} while (goon && curr.lino==listlino);
-	putchar('\n');
-	for (q = lerr; q < p; q++)
-		string(q);
-	putchar('\n');
-	return(goon);
-}
-
-int geterrec() {
-	register ch;
-	register char *p;
-
-	ch = getc(errfil);
-	next.erno = 0;
-	next.mesi = -1;
-	next.mess[0] = '\0';
-	if (ch == EOF)
-		return(0);
-	if (ch >= '0' && ch <= '9') {
-		ch = getnum(ch,&next.mesi);
-	} else if (ch == '\'') {
-		p = next.mess;
-		while ((ch = getc(errfil)) != ' ' && ch != EOF)
-			if (p < &next.mess[IDMAX])
-				*p++ = ch;
-		*p = '\0';
-	}
-	ch = getnum(ch, &next.erno);
-	ch = getnum(ch, &next.lino);
-	ch = getnum(ch, &next.chno);
-	if (ch != '\n')
-		fatal("bad error line");
-	return(1);
-}
-
-int getnum(ch, ip) register ch; register *ip; {
-	register neg;
-
-	*ip = 0;
-	while (ch == ' ')
-		ch = getc(errfil);
-	if (neg = ch=='-')
-		ch = getc(errfil);
-	while (ch >= '0' && ch <= '9') {
-		*ip = *ip * 10 - '0' + ch;
-		ch = getc(errfil);
-	}
-	if (neg)
-		*ip = -(*ip);
-	return(ch);
-}
-
-int nexterror() {
-
-	do {    /* skip warnings if wflag */
-		curr = next;
-		if (curr.erno == 0)
-			return(0);
-		for (;;) {
-			if (geterrec() == 0)
-				break;
-			if (next.lino != curr.lino || next.chno != curr.chno)
-				break;
-			if (curr.erno < 0 && next.erno > 0)
-				/* promote warnings if they cause fatals */
-				curr.erno = -curr.erno;
-			if (next.mess[0] != '\0' || next.mesi != -1)
-				/* give all parameterized errors */
-				break;
-			if (curr.mess[0] != '\0' || curr.mesi != -1)
-				/* and at least a non-parameterized one */
-				break;
-		}
-	} while (curr.erno < 0 && wflag != 0);
-	return(1);
-}
-
-fillindex() {
-	register *ip,n,c;
-
-	if ((mesfil = fopen(err_path,"r")) == NULL)
-		syserr(err_path);
-	ip = index;
-	*ip++ = 0;
-	n = 0;
-	while ((c = getc(mesfil)) != EOF) {
-		n++;
-		if (c == '\n') {
-			*ip++ = n;
-			if (ip > &index[MAXERNO])
-				fatal("too many errors on %s",err_path);
-		}
-	}
-	maxerno = ip - index;
-}
-
-string(ep) register struct errec *ep; {
-	register i,n;
-
-	errerr++;
-	if ((i = ep->erno) < 0) {
-		i = -i;
-		printf("Warning: ");
-	} else
-		errfat++;
-	if (i == 0 || i >= maxerno)
-		fatal("bad error number %d",i);
-	n = index[i] - index[i-1];
-	fseek(mesfil,(long)index[i-1],0);
-	while (--n >= 0) {
-		i = getc(mesfil);
-		if (i == '%' && --n>=0) {
-			i = getc(mesfil);
-			if (i == 'i')
-				printf("%d", ep->mesi);
-			else if (i == 's')
-				printf("%s", ep->mess);
-			else
-				putchar(i);
-		} else
-			putchar(i);
-	}
-}
-
-/* ------------------- error routines -------------------------- */
-
-/* VARARGS1 */
-void ermess(s,a1,a2,a3,a4) char *s; {
-
-	fprintf(stderr,"%s: ",progname);
-	fprintf(stderr,s,a1,a2,a3,a4);
-	fprintf(stderr,"\n");
-}
-
-syserr(s) char *s; {
-	fatal("%s: %s",s,sys_errlist[errno]);
-}
-
-/* VARARGS1 */
-void fatal(s,a1,a2,a3,a4) char *s; {
-
-	ermess(s,a1,a2,a3,a4);
-	toterr++;
-	finish();
-}

util/ack/rmach.c

@@ -0,0 +1,303 @@
+/*
+ * (c) copyright 1983 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ *
+ *          This product is part of the Amsterdam Compiler Kit.
+ *
+ * Permission to use, sell, duplicate or disclose this software must be
+ * obtained in writing. Requests for such permissions may be sent to
+ *
+ *      Dr. Andrew S. Tanenbaum
+ *      Wiskundig Seminarium
+ *      Vrije Universiteit
+ *      Postbox 7161
+ *      1007 MC Amsterdam
+ *      The Netherlands
+ *
+ */
+
+#include "ack.h"
+#include "../../h/em_path.h"
+#include "list.h"
+#include "trans.h"
+#include "grows.h"
+#include "dmach.h"
+#include "data.h"
+#include <stdio.h>
+
+/************************************************************************/
+/*                                                                      */
+/*           Read machine definitions and transformations               */
+/*                                                                      */
+/************************************************************************/
+
+#define COMMENT '#'
+
+#define VAR     "var"
+#define PASS    "name"
+#define IN      "from"
+#define OUT     "to"
+#define PROG    "program"
+#define MAPF    "mapflag"
+#define ARGS    "args"
+#define PROP    "prop"
+#define RUNT    "rts"
+#define NEEDT	"need"
+#define END     "end"
+
+extern growstring scanb();
+extern growstring scanvars();
+
+int getline() ;
+int getinchar() ;
+static char *ty_name ;
+static char *bol ;
+
+
+static char *inname ;
+
+setlist(name) char *name ; {
+	/* Name is sought in the internal tables,
+	   if not present, the a file of that name is sought
+	   in first the current and then the EM Lib directory
+	*/
+
+	inname=name ;
+	open_in(name) ;
+	while ( getline() ) {
+		if ( strcmp(VAR,ty_name)==0 ) {
+			doassign(bol,(char *)0,0) ;
+		} else
+		if ( strcmp(PASS,ty_name)==0 ) {
+			intrf() ;
+		} else
+			error("unknown keyword %s",ty_name) ;
+	}
+	close_in();
+#ifdef DEBUG
+	if ( debug>=3 ) vprint("End %s\n",name) ;
+#endif
+}
+
+intrf() {
+	register trf *new ;
+	register char *ptr ;
+	growstring bline, vline ;
+	int twice ;
+
+	new= (trf *)getcore(sizeof *new) ;
+	new->t_name= keeps(bol) ;
+	for (;;) {
+		if ( !getline() ) {
+			fuerror("unexpected EOF on %s",inname) ;
+		}
+		twice= NO ;
+		if ( strcmp(ty_name,IN)==0 ) {
+			if ( new->t_in ) twice=YES ;
+			new->t_in= keeps(bol);
+		} else
+		if ( strcmp(ty_name,OUT)==0 ) {
+			if ( new->t_out ) twice=YES ;
+			new->t_out= keeps(bol);
+		} else
+		if ( strcmp(ty_name,PROG)==0 ) {
+			if ( new->t_prog ) twice=YES ;
+			bline= scanb(bol);                /* Scan for \ */
+			vline= scanvars(gr_start(bline)); /* Scan for {} */
+			gr_throw(&bline);
+			new->t_prog= gr_final(&vline);
+			clr_noscan(new->t_prog);
+		} else
+		if ( strcmp(ty_name,MAPF)==0 ) {
+			/* First read the mapflags line
+				and scan for backslashes */
+			bline= scanb(bol) ;
+			l_add(&new->t_mapf,gr_final(&bline)) ;
+		} else
+		if ( strcmp(ty_name,ARGS)==0 ) {
+			if ( new->t_argd ) twice=YES ;
+			bline= scanb(bol) ;
+			new->t_argd= keeps(gr_start(bline)) ;
+			gr_throw(&bline) ;
+		} else
+		if ( strcmp(ty_name,PROP)==0 ) {
+			for ( ptr=bol ; *ptr ; ptr++ ) {
+				switch( *ptr ) {
+				case C_IN: new->t_stdin= YES ; break ;
+				case C_OUT: new->t_stdout= YES ; break ;
+				case 'P': new->t_isprep= YES ; break ;
+				case 'p': new->t_prep= YES ; break ;
+				case 'm': new->t_prep= MAYBE ; break ;
+				case 'O': new->t_optim= YES ; break ;
+				case 'C': new->t_combine= YES ; break ;
+				default :
+				  error("Unkown option %c in %s for %s",
+					*ptr,new->t_name,inname) ;
+				  break ;
+				}
+			}
+		} else
+		if ( strcmp(ty_name,RUNT)==0 ) {
+			if ( new->t_rts ) twice=YES ;
+			new->t_rts= keeps(bol) ;
+		} else
+		if ( strcmp(ty_name,NEEDT)==0 ) {
+			if ( new->t_needed ) twice=YES ;
+			new->t_needed= keeps(bol) ;
+		} else
+		if ( strcmp(ty_name,END)==0 ) {
+			break ;
+		} else {
+			fuerror("illegal keyword %s %s",ty_name,bol);
+		}
+		if ( twice ) {
+			werror("%s: specified twice for %s",
+				ty_name, new->t_name) ;
+		}
+	}
+	if ( ! ( new->t_name && new->t_out && new->t_prog ) ) {
+		fuerror("insufficient specification for %s in %s",
+			new->t_name,inname) ;
+	}
+	if ( ! new->t_argd ) new->t_argd="" ;
+#ifdef DEBUG
+	if ( debug>=3 ) {
+		register list_elem *elem ;
+		vprint("%s: from %s to %s '%s'\n",
+			new->t_name,new->t_in,new->t_out,new->t_prog) ;
+		vprint("\targs: ") ; prns(new->t_argd) ;
+		scanlist( l_first(new->t_mapf), elem ) {
+			vprint("\t%s\n",l_content(*elem)) ;
+		}
+		if ( new->t_rts ) vprint("\trts: %s\n",new->t_rts) ;
+		if ( new->t_needed ) vprint("\tneeded: %s\n",new->t_needed) ;
+	}
+#endif
+	l_add(&tr_list,(char *)new) ;
+}
+
+/************************** IO from core or file *******************/
+
+static  int             incore ;
+static  growstring      rline ;
+static  FILE            *infile ;
+static  char            *inptr ;
+
+open_in(name) register char *name ; {
+	register dmach *cmac ;
+
+	gr_init(&rline) ;
+	for ( cmac= massoc ; cmac->ma_index!= -1 ; cmac++ ) {
+		if ( strcmp(name,cmac->ma_name)==0 ) {
+			incore=YES ;
+			inptr= &intable[cmac->ma_index] ;
+			return ;
+		}
+	}
+	/* Not in core */
+	incore= NO ;
+#ifdef NEW
+	gr_cat(&rline,EM_DIR) ;
+	gr_cat(&rline,"/lib/n_ack/") ;
+#else
+	gr_cat(&rline,ACK_DIR); gr_cat(&rline,"/") ;
+#endif
+	gr_cat(&rline,name) ;
+	infile= fopen(gr_start(rline),"r") ;
+#ifdef NEW
+	if ( !infile ) {
+		/* Try to read EM_DIR/lib/MACH/plan */
+		gr_throw(&rline) ;
+		gr_cat(&rline,EM_DIR) ;
+		gr_cat(&rline,"/lib/") ; gr_cat(&rline,name) ;
+		gr_cat(&rline,"/plan") ;
+		infile= fopen(gr_start(rline),"r") ;
+	}
+#endif
+	if ( !infile ) {
+		infile= fopen(name,"r") ;
+	}
+	if ( infile==NULL ) {
+		fuerror("Cannot find description for %s",name) ;
+	}
+}
+
+close_in() {
+	if ( !incore ) fclose(infile) ;
+	gr_throw(&rline) ;
+}
+
+char *readline() {
+	/* Get a line from the input,
+	   return 0 if at end,
+	   The line is stored in a volatile buffer,
+	   a pointer to the line is returned.
+	*/
+	register int nchar ;
+	enum { BOL, ESCAPE, SKIPPING, MOL } state = BOL ;
+
+	gr_throw(&rline) ;
+	for (;;) {
+		nchar= getinchar() ;
+		if ( nchar==EOF ) {
+			if ( state!=BOL ) {
+				werror("incomplete line in %s", inname) ;
+			}
+			return 0 ;
+		}
+		if ( state==SKIPPING ) {
+			if ( nchar=='\n' ) {
+				state= MOL ;
+			} else {
+				continue ;
+			}
+		}
+		if ( state==ESCAPE ) {
+			switch( nchar ) {
+			case '\n' :
+				break ;
+			default :
+				gr_add(&rline,BSLASH) ;
+			case COMMENT :
+			case BSLASH :
+				gr_add(&rline,nchar) ;
+				break ;
+			}
+			state= MOL ;
+			continue ;
+		}
+		switch ( nchar ) {
+		case '\n' :     gr_add(&rline,0) ;
+				return gr_start(rline) ;
+		case COMMENT :  state= SKIPPING ;
+				break ;
+		case BSLASH :   state= ESCAPE ;
+				break ;
+		default :       gr_add(&rline,nchar) ;
+				state= MOL ;
+		}
+	}
+}
+
+int getinchar() {
+	if ( incore ) {
+		if ( *inptr==0 ) return EOF ;
+		return *inptr++ ;
+	}
+	return getc(infile) ;
+}
+
+int getline() {
+	register char *c_ptr ;
+
+	do {
+		if ( (c_ptr=readline())==(char *)0 ) return 0 ;
+		ty_name= skipblank(c_ptr) ;
+	} while ( *ty_name==0 ) ;
+	c_ptr= firstblank(ty_name) ;
+	if ( *c_ptr ) {
+		*c_ptr++ =0 ;
+		c_ptr= skipblank(c_ptr) ;
+	}
+	bol= c_ptr ;
+	return 1 ;
+}