summaryrefslogtreecommitdiffstats
path: root/repl.c
diff options
context:
space:
mode:
authorThomas Bushnell <tb@debian.org>2005-10-27 12:00:49 -0700
committerBryan Newbold <bnewbold@robocracy.org>2017-02-20 00:05:29 -0800
commit4e063c0de0bf319c9201cefa6f399364041bb7b9 (patch)
tree61a326cd4ab69f610d2e10313db2a641b6d0b4dd /repl.c
parent5f7b0413c1bb0f96bb613ad74c0978f44116a136 (diff)
parent302e3218b7d487539ec305bf23881a6ee7d5be99 (diff)
downloadscm-4e063c0de0bf319c9201cefa6f399364041bb7b9.tar.gz
scm-4e063c0de0bf319c9201cefa6f399364041bb7b9.zip
Import Debian changes 5e1-1debian/5e1-1
scm (5e1-1) unstable; urgency=low * New upstream release. (Closes: #335970) * debian/rules (SCM_OPTIONS): Remove -F turtlegr; the file supporting this option seems to have gone by the wayside. * debian/rules (binary-arch): Don't try to install grtest.scm; it's gone now. * debian/rules (build-stamp): Use tee to capture output of ./build so that we can capture a copy of the file in the build log. * scm.1: Fix spelling errors in manual page: verobse -> verbose; qoutes -> quotes; aguments -> arguments; neccessary -> necessary; preceeds -> precedes. syncronization -> synchronization. (Closes: #300131) * debian/postinst, debian/prerm: Assume that install-docs is in the standard place, and test for it there with test -x. (Closes: #292996)
Diffstat (limited to 'repl.c')
-rw-r--r--repl.c78
1 files changed, 54 insertions, 24 deletions
diff --git a/repl.c b/repl.c
index c04d230..a3204dc 100644
--- a/repl.c
+++ b/repl.c
@@ -316,7 +316,22 @@ taloop:
break;
}
case tcs_symbols:
- lfwrite(CHARS(exp), (sizet)sizeof(char), (sizet)LENGTH(exp), port);
+ if (writing) { /* slashified symbol */
+ for(i = 0;i<LENGTH(exp);++i) switch (CHARS(exp)[i]) {
+ case '\\': case '\"': case '\'': case '(': case ')': case '#':
+ case 'A': case 'B': case 'C': case 'D': case 'E':
+ case 'F': case 'G': case 'H': case 'I': case 'J':
+ case 'K': case 'L': case 'M': case 'N': case 'O':
+ case 'P': case 'Q': case 'R': case 'S': case 'T':
+ case 'U': case 'V': case 'W': case 'X': case 'Y': case 'Z':
+ lputc('\\', port);
+ default:
+ lputc(CHARS(exp)[i], port);
+ }
+ break;
+ }
+ else
+ lfwrite(CHARS(exp), (sizet)sizeof(char), (sizet)LENGTH(exp), port);
break;
case tc7_vector:
lputs("#(", port);
@@ -849,7 +864,7 @@ static int flush_ws(port)
/* Top-level readers */
static SCM p_read_numbered, p_read_for_load, p_read;
-char s_read[] = "read";
+static char s_read[] = "read";
static char s_read_for_load[] = "read-for-load";
static char s_read_numbered[] = "read-numbered";
SCM scm_read(port)
@@ -945,7 +960,10 @@ static SCM lreadpr(tok_buf, port, flgs)
else goto unkshrp;
case '\\':
c = lgetc(port);
- j = read_token(c, tok_buf, port);
+ if ('\\'==c) {
+ CHARS(tok_buf)[0] = c;
+ j = 1;
+ } else j = read_token(c, tok_buf, port);
if (j==1) return MAKICHR(c);
for (c = 0;c<sizeof charnames/sizeof(char *);c++)
if (charnames[c]
@@ -1087,7 +1105,7 @@ static sizet read_token(ic, tok_buf, port)
register sizet j = 1;
register int c = ic;
register char *p = CHARS(tok_buf);
- p[0] = downcase[c];
+ p[0] = '\\'==c ? lgetc(port) : downcase[c];
while(1) {
if (j+1 >= LENGTH(tok_buf)) p = grow_tok_buf(tok_buf);
switch (c = lgetc(port)) {
@@ -1103,6 +1121,9 @@ static sizet read_token(ic, tok_buf, port)
case EOF:
p[j] = 0;
return j;
+ case '\\': /* slashified symbol */
+ p[j++] = lgetc(port);
+ break;
default:
p[j++] = downcase[c];
}
@@ -1260,20 +1281,25 @@ int handle_it(i)
char *name = errmsgs[i-WNA].s_response;
if (errjmp_bad || errjmp_recursive)
wta(UNDEFINED, (char *)i, ""); /* sends it to def_err_response */
+ /* NEWCELL does not defer interrupts; so be careful to maintain the
+ freelist integrity. */
if (name) {
- SCM n[2];
int j;
+ SCM n[2]; /* GC-protect discarded cells (possibly being used
+ by interrupted code). */
DEFER_INTS;
- for (j=0; j<2; j++) {
- NEWCELL(n[j]); /* discard 2 possibly-used cells */
- }
- CDR(n[1]) = EOL;
+ /* Two cells are discarded because NEWCELL may have been
+ interrupted between computing the right-hand-side of
+ freelist = CDR(freelist)
+ and assigning it to freelist. */
+ for (j=0; j<2; j++) NEWCELL(n[j]); /* discard 2 possibly-used cells */
+ CDR(n[1]) = EOL; /* lose pointer to freelist */
ALLOW_INTS;
+ /* discarding was necessary here because intern() may do NEWCELL */
proc = CDR(intern(name, (sizet)strlen(name)));
- if NIMP(proc) { /* Save environment stack, in case it
- moves when applying proc. Do an ecache gc
- to protect contents of stack. */
-
+ if NIMP(proc) { /* Save environment stack, in case it moves
+ when applying proc. Do an ecache gc to
+ protect contents of stack. */
SCM estk, *estk_ptr, env, env_tmp;
DEFER_INTS;
#ifndef NO_ENV_CACHE
@@ -1299,6 +1325,10 @@ int handle_it(i)
return i;
}
}
+ /* Ensure that freelist is not empty when returning from interrupt */
+ DEFER_INTS;
+ scm_fill_freelist();
+ ALLOW_INTS;
return errmsgs[i-WNA].parent_err;
}
@@ -1314,13 +1344,12 @@ SCM scm_top_level(initpath, toplvl_fun)
#else
long i;
#endif
+ if (!toplvl_fun) toplvl_fun = repl;
CONT(rootcont)->stkbse = (STACKITEM *)&i;
i = setjump(CONT(rootcont)->jmpbuf);
#ifndef SHORT_INT
if (i) i = UNCOOK(i);
#endif
- if (!toplvl_fun) toplvl_fun = repl;
- /* printf("scm_top_level got %d\n", i); */
drloop:
switch ((int)i) {
default:
@@ -1914,16 +1943,17 @@ static void err_head(str)
int oerrno = errno;
exitval = MAKINUM(EXIT_FAILURE);
if (NIMP(cur_outp) && OPOUTPORTP(cur_outp)) lfflush(cur_outp);
- for (lps = loadports; NIMP(lps); lps = CDR(lps)) {
- lputs(lps==loadports ? "\n;While loading " : "\n ;loaded from ",
- cur_errp);
- iprin1(scm_port_filename(CAR(lps)), cur_errp, 1);
- lputs(", line ", cur_errp);
- iprin1(scm_port_line(CAR(lps)), cur_errp, 1);
- lputs(": ", cur_errp);
+ lps = IMP(loadports) ? loadports : CDR(loadports);
+ if (NIMP(lps)) {
+ lputs("\n;In file loaded from ", cur_errp);
+ for (; NIMP(lps); lps = CDR(lps)) {
+ iprin1(scm_port_filename(CAR(lps)), cur_errp, 0);
+ lputs(":", cur_errp);
+ iprin1(scm_port_line(CAR(lps)), cur_errp, 1);
+ lputs(IMP(CDR(lps)) ? ":" : ",\n; loaded from ", cur_errp);
+ }
}
- if (NIMP(loadports) && NIMP(CDR(loadports)))
- lputs("\n;", cur_errp);
+ lputs("\n;", cur_errp);
lfflush(cur_errp);
errno = oerrno;
/* if (NIMP(cur_errp) && stderr==STREAM(cur_errp)) { ... } */