diff options
Diffstat (limited to 'repl.c')
| -rw-r--r-- | repl.c | 78 |
1 files changed, 54 insertions, 24 deletions
@@ -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)) { ... } */ |