Up for discussion: Move the "main runtime" of es out of C and into es script

Makefile.in

@@ -52,13 +52,13 @@ VPATH = $(srcdir)
 HFILES	= config.h es.h gc.h input.h prim.h print.h sigmsgs.h \
 	  stdenv.h syntax.h term.h var.h
 CFILES	= access.c closure.c conv.c dict.c eval.c except.c fd.c gc.c glob.c \
-	  glom.c input.c heredoc.c list.c main.c match.c open.c opt.c \
-	  prim-ctl.c prim-etc.c prim-io.c prim-sys.c prim.c print.c proc.c \
+	  glom.c input.c heredoc.c list.c main.c match.c open.c \
+	  prim-ctl.c prim-etc.c prim-io.c prim-sys.c prim-dump.c prim.c print.c proc.c \
 	  sigmsgs.c signal.c split.c status.c str.c syntax.c term.c token.c \
 	  tree.c util.c var.c vec.c version.c y.tab.c dump.c
 OFILES	= access.o closure.o conv.o dict.o eval.o except.o fd.o gc.o glob.o \
-	  glom.o input.o heredoc.o list.o main.o match.o open.o opt.o \
-	  prim-ctl.o prim-etc.o prim-io.o prim-sys.o prim.o print.o proc.o \
+	  glom.o input.o heredoc.o list.o main.o match.o open.o \
+	  prim-ctl.o prim-etc.o prim-io.o prim-sys.o prim-dump.o prim.o print.o proc.o \
 	  sigmsgs.o signal.o split.o status.o str.o syntax.o term.o token.o \
 	  tree.o util.o var.o vec.o version.o y.tab.o
 OTHER	= Makefile parse.y mksignal
@@ -102,7 +102,7 @@ y.tab.c y.tab.h : parse.y
 token.h : y.tab.h
 	-cmp -s y.tab.h token.h || cp y.tab.h token.h
 
-initial.c : esdump $(srcdir)/initial.es
+initial.c : esdump $(srcdir)/initial.es $(srcdir)/runtime.es
 	./esdump < $(srcdir)/initial.es > initial.c
 
 sigmsgs.c : mksignal $(SIGFILES)
@@ -130,12 +130,12 @@ list.o : list.c es.h config.h stdenv.h gc.h
 main.o : main.c es.h config.h stdenv.h 
 match.o : match.c es.h config.h stdenv.h 
 open.o : open.c es.h config.h stdenv.h 
-opt.o : opt.c es.h config.h stdenv.h 
 prim.o : prim.c es.h config.h stdenv.h prim.h 
 prim-ctl.o : prim-ctl.c es.h config.h stdenv.h prim.h 
 prim-etc.o : prim-etc.c es.h config.h stdenv.h prim.h 
 prim-io.o : prim-io.c es.h config.h stdenv.h gc.h prim.h 
 prim-sys.o : prim-sys.c es.h config.h stdenv.h prim.h 
+prim-dump.o : prim-dump.c es.h config.h stdenv.h prim.h 
 print.o : print.c es.h config.h stdenv.h print.h 
 proc.o : proc.c es.h config.h stdenv.h prim.h 
 signal.o : signal.c es.h config.h stdenv.h sigmsgs.h 

access.c

@@ -69,108 +69,64 @@ static int testfile(char *path, int perm, unsigned int type) {
 	return testperm(&st, perm);
 }
 
-static char *pathcat(char *prefix, char *suffix) {
-	char *s;
-	size_t plen, slen, len;
-	static char *pathbuf = NULL;
-	static size_t pathlen = 0;
-
-	if (*prefix == '\0')
-		return suffix;
-	if (*suffix == '\0')
-		return prefix;
-
-	plen = strlen(prefix);
-	slen = strlen(suffix);
-	len = plen + slen + 2;		/* one for '/', one for '\0' */
-	if (pathlen < len) {
-		pathlen = len;
-		pathbuf = erealloc(pathbuf, pathlen);
+static int *permtab[256] = { NULL };
+static int *typetab[256] = { NULL };
+
+PRIM(access) {
+	int c, *p, perm = 0, type = 0, estatus;
+
+	if (length(list) != 3)
+		fail("$&access", "usage: access access-type file-type name");
+
+	Ref(List *, result, NULL);
+	Ref(char *, atype, getstr(list->term));
+	Ref(char *, ftype, getstr(list->next->term));
+	Ref(char *, name, getstr(list->next->next->term));
+
+	for (c = 0; atype[c] != '\0'; c++) {
+		if ((p = permtab[(unsigned char)atype[c]]) == NULL)
+			fail("$&access", "bad access type '%c'", c);
+		perm |= *p;
 	}
 
-	memcpy(pathbuf, prefix, plen);
-	s = pathbuf + plen;
-	if (s[-1] != '/')
-		*s++ = '/';
-	memcpy(s, suffix, slen + 1);
-	return pathbuf;
+	if (ftype[0] == '\0' || ftype[1] != '\0')
+		fail("$&access", "file type argument must be one character");
+	if ((p = typetab[(unsigned char)ftype[0]]) == NULL)
+		fail("$&access", "bad file type argument '%c'", ftype[0]);
+	type = *p;
+
+	estatus = testfile(name, perm, type);
+	result = mklist(mkstr(estatus == 0 ? "0" : esstrerror(estatus)), NULL);
+
+	RefEnd3(name, ftype, atype);
+	RefReturn(result);
 }
 
-PRIM(access) {
-	int c, perm = 0, type = 0, estatus = ENOENT;
-	Boolean first = FALSE, exception = FALSE;
-	char *suffix = NULL;
-	List *lp;
-	const char * const usage = "access [-n name] [-1e] [-rwx] [-fdcblsp] path ...";
-
-	gcdisable();
-	esoptbegin(list, "$&access", usage, TRUE);
-	while ((c = esopt("bcdefln:prswx1")) != EOF)
-		switch (c) {
-		case 'n':	suffix = getstr(esoptarg());	break;
-		case '1':	first = TRUE;			break;
-		case 'e':	exception = TRUE;		break;
-		case 'r':	perm |= READ;			break;
-		case 'w':	perm |= WRITE;			break;
-		case 'x':	perm |= EXEC;			break;
-		case 'f':	type = S_IFREG;			break;
-		case 'd':	type = S_IFDIR;			break;
-		case 'c':	type = S_IFCHR;			break;
-		case 'b':	type = S_IFBLK;			break;
+#define FLAGTAB(type, c, def) \
+	STMT(static int CONCAT(type,c) = def; \
+	     CONCAT(type,tab)[(unsigned char)(STRING(c)[0])] = &CONCAT(type,c))
+
+extern Dict *initprims_access(Dict *primdict) {
+	FLAGTAB(perm, e, 0);
+	FLAGTAB(perm, r, READ);
+	FLAGTAB(perm, w, WRITE);
+	FLAGTAB(perm, x, EXEC);
+
+	FLAGTAB(type, a, 0);
+	FLAGTAB(type, f, S_IFREG);
+	FLAGTAB(type, d, S_IFDIR);
+	FLAGTAB(type, c, S_IFCHR);
+	FLAGTAB(type, b, S_IFBLK);
 #ifdef S_IFLNK
-		case 'l':	type = S_IFLNK;			break;
+	FLAGTAB(type, l, S_IFLNK);
 #endif
 #ifdef S_IFSOCK
-		case 's':	type = S_IFSOCK;		break;
+	FLAGTAB(type, s, S_IFSOCK);
 #endif
 #ifdef S_IFIFO
-		case 'p':	type = S_IFIFO;			break;
+	FLAGTAB(type, p, S_IFIFO);
 #endif
-		default:
-			esoptend();
-			fail("$&access", "access -%c is not supported on this system", c);
-		}
-	list = esoptend();
-
-	for (lp = NULL; list != NULL; list = list->next) {
-		int error;
-		char *name;
-
-		name = getstr(list->term);
-		if (suffix != NULL)
-			name = pathcat(name, suffix);
-		error = testfile(name, perm, type);
-
-		if (first) {
-			if (error == 0) {
-				Ref(List *, result,
-					mklist(mkstr(suffix == NULL
-							? name
-							: gcdup(name)),
-					       NULL));
-				gcenable();
-				RefReturn(result);
-			} else if (error != ENOENT)
-				estatus = error;
-		} else
-			lp = mklist(mkstr(error == 0 ? "0" : esstrerror(error)),
-				    lp);
-	}
-
-	if (first && exception) {
-		gcenable();
-		if (suffix)
-			fail("$&access", "%s: %s", suffix, esstrerror(estatus));
-		else
-			fail("$&access", "%s", esstrerror(estatus));
-	}
 
-	Ref(List *, result, reverse(lp));
-	gcenable();
-	RefReturn(result);
-}
-
-extern Dict *initprims_access(Dict *primdict) {
 	X(access);
 	return primdict;
 }