[gimp-tiny-fu] Merge of GIMPs TinyScheme files from git master as of commit f3b78cb2.
- From: Kevin Cozens <kcozens src gnome org>
- To: commits-list gnome org
- Cc:
- Subject: [gimp-tiny-fu] Merge of GIMPs TinyScheme files from git master as of commit f3b78cb2.
- Date: Sat, 11 Jun 2022 19:12:18 +0000 (UTC)
commit a64d85eec23b997e535488d67f55b44395ba3f2e
Author: Kevin Cozens <kevin ve3syb ca>
Date: Wed Dec 11 21:08:58 2013 -0500
Merge of GIMPs TinyScheme files from git master as of commit f3b78cb2.
tinyscheme/CHANGES | 33 +++++++++-
tinyscheme/Manual.txt | 4 +-
tinyscheme/hack.txt | 111 ++++++++++++++++-----------------
tinyscheme/init.scm | 9 ++-
tinyscheme/opdefines.h | 4 +-
tinyscheme/scheme.c | 166 ++++++++++++++++++++++++++++++++++---------------
6 files changed, 212 insertions(+), 115 deletions(-)
---
diff --git a/tinyscheme/CHANGES b/tinyscheme/CHANGES
index fcbe942..824e105 100644
--- a/tinyscheme/CHANGES
+++ b/tinyscheme/CHANGES
@@ -1,6 +1,37 @@
Change Log
----------
+Version 1.41
+ Bugs fixed:
+ #3020389 - Added makefile section for Mac OS X (SL)
+ #3286135 - Fixed num_mod routine which caused errors in use of modulo
+ #3290232 - Corrected version number shown on startup (GM)
+ #3394882 - Added missing #if in opdefines.h around get and put (DC)
+ #3395547 - Fix for the modulo procedure (DC)
+ #3400290 - Optimized append to make it an O(n) operation (DC)
+ #3493926 - Corrected flag used when building shared files on OSX (J)
+
+ R5RS related changes:
+ #2866196 - Parser does not handle delimiters correctly
+ #3395548 - Add a decimal point to inexact numbers in atom2str (DC)
+ #3399331 - Make min/max return inexact when any argument is inexact
+ #3399332 - Compatability fix for expt.
+ #3399335 - Optional radix for string->number and number->string (DC)
+ #3400202 - Append with one argument should not return a list (DC)
+ #3400284 - Compatability fix for integer?
+
+ Other changes:
+ - Added flags to makefile for MinGW/MSYS (TC)
+ - Moved variable declarations to avoid warnings with some compilers
+ - Don't print space after initial #( when printing vectors.
+ - Minor optimization for is_nonneg().
+ - No need to round integers in OP_ROUND (#3400284)
+ - Fixes to code that reports line number with error (RC)
+
+ Contributors:
+ Kevin Cozens, Gordon McNutt, Doug Currie, Sean Long, Tim Cas, Joey,
+ and Richard Copley, and CMarinier.
+
Version 1.40
Bugs fixed:
#1964950 - Stop core dumps due to bad syntax in LET (and variants)
@@ -147,7 +178,7 @@ Version 1.26
try a more gradual approach next time.
Version 1.25
- Types have been homogenized to be able to accomodate a different
+ Types have been homogenized to be able to accommodate a different
representation. Plus, promises are no longer closures. Unfortunately,
I discovered that continuations and force/delay do not pass the SCM
test (and never did)... However, on the bright side, what little
diff --git a/tinyscheme/Manual.txt b/tinyscheme/Manual.txt
index e395e79..bf0e8ea 100644
--- a/tinyscheme/Manual.txt
+++ b/tinyscheme/Manual.txt
@@ -1,6 +1,6 @@
- TinySCHEME Version 1.40
+ TinySCHEME Version 1.41
"Safe if used as prescribed"
-- Philip K. Dick, "Ubik"
@@ -140,7 +140,7 @@ Please read accompanying file COPYING.
with #\return and #\tab, with obvious meanings. Hex character
representations are allowed (e.g. #\x20 is #\space).
When USE_ASCII_NAMES is defined, various control characters can be
- refered to by their ASCII name.
+ referred to by their ASCII name.
0 #\nul 17 #\dc1
1 #\soh 18 #\dc2
2 #\stx 19 #\dc3
diff --git a/tinyscheme/hack.txt b/tinyscheme/hack.txt
index 5a5cc9a..72a3de6 100644
--- a/tinyscheme/hack.txt
+++ b/tinyscheme/hack.txt
@@ -20,29 +20,29 @@
In the sequel, lines that begin with '>' denote lines to add to the
code. Lines that begin with '|' are just citations of existing code.
+ Lines that begin with X are deleted.
First of all, we need to assign a typeid to our new type. Typeids
in TinyScheme are small integers declared in an enum, very close to
- the top; it begins with T_STRING. Add a new one at the end, say
- T_MEMBLOCK. There can be at most 31 types, but you don't have to
- worry about that limit yet.
+ the top of scheme.c; it begins with T_STRING. Add a new one before the
+ end, call it T_MEMBLOCK. Adjust T_LAST_SYSTEM_TYPE.
-| ...
-| T_PORT,
-| T_VECTOR, /* remember to add a comma to the preceding item! */
-| T_MEMBLOCK
-} };
+| T_ENVIRONMENT=14,
+X T_LAST_SYSTEM_TYPE=14
+> T_MEMBLOCK=15,
+> T_LAST_SYSTEM_TYPE=15
+| };
- Then, some helper macros would be useful. Go to where isstring() and
+ Then, some helper macros would be useful. Go to where is_string() and
the rest are defined and define:
-> int ismemblock(pointer p) { return (type(p)==T_MEMBLOCK); }
+> int is_memblock(pointer p) { return (type(p)==T_MEMBLOCK); }
This actually is a function, because it is meant to be exported by
scheme.h. If no foreign function will ever manipulate a memory block,
you can instead define it as a macro
-> #define ismemblock(p) (type(p)==T_MEMBLOCK)
+> #define is_memblock(p) (type(p)==T_MEMBLOCK)
Then we make space for the new type in the main data structure:
struct cell. As it happens, the _string part of the union _object
@@ -81,62 +81,59 @@
that staff, function finalize_cell(), currently handling strings only.
| static void finalize_cell(scheme *sc, pointer a) {
-| if(isstring(a)) {
+| if(is_string(a)) {
| sc->free(strvalue(a));
-| }
-> else if(ismemblock(a)) {
-> sc->free(strvalue(x));
-> }
-| }
+> else if(is_memblock(a)) {
+> sc->free(strvalue(a));
+| } else if(is_port(a)) {
- There are no MEMBLOCK literals, so we don't concern ourselfs with
+ There are no MEMBLOCK literals, so we don't concern ourselves with
the READER part (yet!). We must cater to the PRINTER, though. We
- add one case more in printatom().
+ add one case more in atom2str().
-| } else if (iscontinuation(l)) {
-| p = "#<CONTINUATION>";
-> } else if (ismemblock(l)) {
-> p = "#<MEMORY BLOCK>";
-| }
+| } else if (is_foreign(l)) {
+| p = sc->strbuff;
+| snprintf(p,STRBUFFSIZE,"#<FOREIGN PROCEDURE %ld>", procnum(l));
+> } else if (ismemblock(l)) {
+> p = "#<MEMBLOCK>";
+| } else if (is_continuation(l)) {
+| p = "#<CONTINUATION>";
+| } else {
Whenever a MEMBLOCK is displayed, it will look like that.
+
Now, we must add the interface functions: constructor, predicate,
- accessor, modifier. We must in fact create new op-codes for the virtual
- machine underlying TinyScheme. There is a huge enum with OP_XXX values.
- That's where the op-codes are declared. For reasons of cohesion, we add
- the new op-codes right after those for vectors:
-
-| OP_VECSET,
-> OP_MKBLOCK,
-> OP_MEMBLOCKP,
-> OP_BLOCKLEN,
-> OP_BLOCKREF,
-> OP_BLOCKSET,
-| OP_NOT,
+ accessor, modifier. We must in fact create new op-codes for the
+ virtual machine underlying TinyScheme. Since version 1.30, TinyScheme
+ uses macros and a single source text to keep the enums and the
+ dispatch table in sync. That's where the op-codes are declared. Note
+ that the opdefines.h file uses unusually long lines to accomodate
+ all the information; adjust your editor to handle this. The file has
+ six columns: A to Z. they contain:
+ - Column A is the name of a routine to handle the scheme function.
+ - Column B is the name the scheme function.
+ - Columns C and D are the minimum and maximum number of arguments
+ that are accepted by the scheme function.
+ - Column E is a set of flags that are used when the interpreter
+ verifies that the passed parameters are of the correct type.
+ - Column F is used to create a set of enums. The enum is used in a
+ switch in the routine listed in column A to get to the code that
+ does the work needed for the scheme function.
+ For reasons of cohesion, we add the new op-codes right after those
+ for vectors:
+
+| _OP_DEF(opexe_2, "vector-set!", 3, 3, TST_VECTOR TST_NATURAL TST_ANY,
OP_VECSET )
+> _OP_DEF(opexe_2, "make-block", 1, 2, TST_NATURAL TST_CHAR,
OP_MKBLOCK )
+> _OP_DEF(opexe_2, "block-length", 1, 1, T_MEMBLOCK,
OP_BLOCKLEN )
+> _OP_DEF(opexe_2, "block-ref", 2, 2, T_MEMBLOCK TST_NATURAL,
OP_BLOCKREF )
+> _OP_DEF(opexe_2, "block-set!", 1, 1, T_MEMBLOCK TST_NATURAL TST_CHAR,
OP_BLOCKSET )
+| _OP_DEF(opexe_3, "not", 1, 1, TST_NONE, OP_NOT
)
We add the predicate along the other predicates:
-| OP_VECTORP,
-> OP_BLOCKP,
-| OP_EQ,
-
- Op-codes are really just tags for a huge C switch, only this switch
- is broke up in a number of different opexe_X functions. The
- correspondence is made in table "dispatch_table". There, we assign
- the new op-codes to opexe_2, where the equivalent ones for vectors
- are situated. We also assign a name for them, and specify the minimum
- and maximum arity. INF_ARG as a maximum arity means "unlimited".
-
-| {opexe_2, "vector-set!", 3, 3}, /* OP_VECSET */
-> {opexe_2, "make-block", 1, 2}, /* OP_MKBLOCK */
-> {opexe_2, "block-length", 1, 1}, /* OP_BLOCKLEN */
-> {opexe_2, "block-ref", 2, 2}, /* OP_BLOCKREF */
-> {opexe_2, "block-set!",3 ,3}, /* OP_BLOCKSET */
-
- The predicate goes with the other predicates, in opexe_3.
-
-| {opexe_3, "vector?", 1, 1}, /* OP_VECTORP, */
-> {opexe_3, "block?", 1, 1}, /* OP_BLOCKP, */
+| _OP_DEF(opexe_3, "vector?", 1, 1, TST_ANY,
OP_VECTORP )
+> _OP_DEF(opexe_3, "block?", 1, 1, TST_ANY,
OP_BLOCKP )
+| _OP_DEF(opexe_3, "eq?", 2, 2, TST_ANY, OP_EQ
)
All that remains is to write the actual processing in opexe_2, right
after OP_VECSET.
diff --git a/tinyscheme/init.scm b/tinyscheme/init.scm
index 120ecc7..223e421 100644
--- a/tinyscheme/init.scm
+++ b/tinyscheme/init.scm
@@ -1,4 +1,4 @@
-; Initialization file for TinySCHEME 1.40
+; Initialization file for TinySCHEME 1.41
; Per R5RS, up to four deep compositions should be defined
(define (caar x) (car (car x)))
@@ -142,15 +142,18 @@
(if (pred a) a
(error "string->xxx: not a xxx" a))))
-(define (string->number str) (string->anyatom str number?))
+(define (string->number str . base)
+ (let ((n (string->atom str (if (null? base) 10 (car base)))))
+ (if (number? n) n #f)))
(define (anyatom->string n pred)
(if (pred n)
(atom->string n)
(error "xxx->string: not a xxx" n)))
+(define (number->string n . base)
+ (atom->string n (if (null? base) 10 (car base))))
-(define (number->string n) (anyatom->string n number?))
(define (char-cmp? cmp a b)
(cmp (char->integer a) (char->integer b)))
diff --git a/tinyscheme/opdefines.h b/tinyscheme/opdefines.h
index 3101eef..ceb4d0e 100644
--- a/tinyscheme/opdefines.h
+++ b/tinyscheme/opdefines.h
@@ -88,9 +88,9 @@
_OP_DEF(opexe_2, "char-upcase", 1, 1, TST_CHAR,
OP_CHARUPCASE )
_OP_DEF(opexe_2, "char-downcase", 1, 1, TST_CHAR,
OP_CHARDNCASE )
_OP_DEF(opexe_2, "symbol->string", 1, 1, TST_SYMBOL,
OP_SYM2STR )
- _OP_DEF(opexe_2, "atom->string", 1, 1, TST_ANY,
OP_ATOM2STR )
+ _OP_DEF(opexe_2, "atom->string", 1, 2, TST_ANY TST_NATURAL,
OP_ATOM2STR )
_OP_DEF(opexe_2, "string->symbol", 1, 1, TST_STRING,
OP_STR2SYM )
- _OP_DEF(opexe_2, "string->atom", 1, 1, TST_STRING,
OP_STR2ATOM )
+ _OP_DEF(opexe_2, "string->atom", 1, 2, TST_STRING TST_NATURAL,
OP_STR2ATOM )
_OP_DEF(opexe_2, "make-string", 1, 2, TST_NATURAL TST_CHAR,
OP_MKSTRING )
_OP_DEF(opexe_2, "string-length", 1, 1, TST_STRING,
OP_STRLEN )
_OP_DEF(opexe_2, "string-ref", 2, 2, TST_STRING TST_NATURAL,
OP_STRREF )
diff --git a/tinyscheme/scheme.c b/tinyscheme/scheme.c
index e90b30c..c824a46 100644
--- a/tinyscheme/scheme.c
+++ b/tinyscheme/scheme.c
@@ -1,4 +1,4 @@
-/* T I N Y S C H E M E 1 . 4 0
+/* T I N Y S C H E M E 1 . 4 1
* Dimitrios Souflis (dsouflis acm org)
* Based on MiniScheme (original credits follow)
* (MINISCM) coded by Atsushi Moriwaki (11/5/1989)
@@ -95,13 +95,14 @@ ts_output_string (TsOutputType type,
#define TOK_VEC 12
#define TOK_USCORE 13
-# define BACKQUOTE '`'
+#define BACKQUOTE '`'
+#define DELIMITERS "()\";\f\t\v\n\r "
/*
* Basic memory allocation units
*/
-#define banner "TinyScheme 1.40 (with UTF-8 support)\n"
+#define banner "TinyScheme 1.41 (with UTF-8 support)"
#include <string.h>
#include <stdlib.h>
@@ -1235,14 +1236,14 @@ static pointer mk_sharp_const(scheme *sc, char *name) {
return (sc->F);
else if (*name == 'o') {/* #o (octal) */
snprintf(tmp, STRBUFFSIZE, "0%s", name+1);
- sscanf(tmp, "%lo", &x);
+ sscanf(tmp, "%lo", (long unsigned *)&x);
return (mk_integer(sc, x));
} else if (*name == 'd') { /* #d (decimal) */
- sscanf(name+1, "%ld", &x);
+ sscanf(name+1, "%ld", (long int *)&x);
return (mk_integer(sc, x));
} else if (*name == 'x') { /* #x (hex) */
snprintf(tmp, STRBUFFSIZE, "0x%s", name+1);
- sscanf(tmp, "%lx", &x);
+ sscanf(tmp, "%lx", (long unsigned *)&x);
return (mk_integer(sc, x));
} else if (*name == 'b') { /* #b (binary) */
x = binary_decode(name+1);
@@ -1259,7 +1260,7 @@ static pointer mk_sharp_const(scheme *sc, char *name) {
c='\t';
} else if(name[1]=='x' && name[2]!=0) {
int c1=0;
- if(sscanf(name+2,"%x",&c1)==1 && c1 < UCHAR_MAX) {
+ if(sscanf(name+2,"%x",(unsigned int *)&c1)==1 && c1 < UCHAR_MAX) {
c=c1;
} else {
return sc->NIL;
@@ -1436,7 +1437,6 @@ static int file_push(scheme *sc, const char *fname) {
if(fname)
sc->load_stack[sc->file_i].rep.stdio.filename = store_string(sc, strlen(fname), fname, 0);
#endif
-
}
return fin!=0;
}
@@ -1949,7 +1949,8 @@ static INLINE int skipspace(scheme *sc) {
/* record it */
#if SHOW_ERROR_LINE
- sc->load_stack[sc->file_i].rep.stdio.curr_line += curr_line;
+ if (sc->load_stack[sc->file_i].kind & port_file)
+ sc->load_stack[sc->file_i].rep.stdio.curr_line += curr_line;
#endif
if(c!=EOF) {
@@ -1988,7 +1989,7 @@ static int token(scheme *sc) {
;
#if SHOW_ERROR_LINE
- if(c == '\n')
+ if(c == '\n' && sc->load_stack[sc->file_i].kind & port_file)
sc->load_stack[sc->file_i].rep.stdio.curr_line++;
#endif
@@ -2021,7 +2022,7 @@ static int token(scheme *sc) {
;
#if SHOW_ERROR_LINE
- if(c == '\n')
+ if(c == '\n' && sc->load_stack[sc->file_i].kind & port_file)
sc->load_stack[sc->file_i].rep.stdio.curr_line++;
#endif
@@ -2125,17 +2126,38 @@ static void atom2str(scheme *sc, pointer l, int f, char **pp, int *plen) {
snprintf(p, STRBUFFSIZE, "#<PORT>");
} else if (is_number(l)) {
p = sc->strbuff;
- if(num_is_integer(l)) {
- snprintf(p, STRBUFFSIZE, "%ld", ivalue_unchecked(l));
+ if (f <= 1 || f == 10) /* f is the base for numbers if > 1 */ {
+ if(num_is_integer(l)) {
+ snprintf(p, STRBUFFSIZE, "%ld", ivalue_unchecked(l));
+ } else {
+ snprintf(p, STRBUFFSIZE, "%.10g", rvalue_unchecked(l));
+ /* r5rs says there must be a '.' (unless 'e'?) */
+ f = strcspn(p, ".e");
+ if (p[f] == 0) {
+ p[f] = '.'; /* not found, so add '.0' at the end */
+ p[f+1] = '0';
+ p[f+2] = 0;
+ }
+ }
} else {
- snprintf(p, STRBUFFSIZE, "%.10g", rvalue_unchecked(l));
- /* R5RS says there must be a '.' (unless 'e'?) */
- f = strcspn(p, ".e");
- if (p[f] == 0) {
- p[f] = '.'; // not found, so add '.0' at the end
- p[f+1] = '0';
- p[f+2] = 0;
- }
+ long v = ivalue(l);
+ if (f == 16) {
+ if (v >= 0)
+ snprintf(p, STRBUFFSIZE, "%lx", v);
+ else
+ snprintf(p, STRBUFFSIZE, "-%lx", -v);
+ } else if (f == 8) {
+ if (v >= 0)
+ snprintf(p, STRBUFFSIZE, "%lo", v);
+ else
+ snprintf(p, STRBUFFSIZE, "-%lo", -v);
+ } else if (f == 2) {
+ unsigned long b = (v < 0) ? -v : v;
+ p = &p[STRBUFFSIZE-1];
+ *p = 0;
+ do { *--p = (b&1) ? '1' : '0'; b >>= 1; } while (b != 0);
+ if (v < 0) *--p = '-';
+ }
}
} else if (is_string(l)) {
if (!f) {
@@ -2476,7 +2498,8 @@ static pointer _Error_1(scheme *sc, const char *s, pointer a) {
char sbuf[STRBUFFSIZE];
/* make sure error is not in REPL */
- if(sc->load_stack[sc->file_i].rep.stdio.file != stdin) {
+ if (sc->load_stack[sc->file_i].kind & port_file &&
+ sc->load_stack[sc->file_i].rep.stdio.file != stdin) {
int ln = sc->load_stack[sc->file_i].rep.stdio.curr_line;
const char *fname = sc->load_stack[sc->file_i].rep.stdio.filename;
@@ -2980,7 +3003,7 @@ static pointer opexe_0(scheme *sc, enum scheme_opcodes op) {
sc->code = car(sc->code);
else
sc->code = cadr(sc->code); /* (if #f 1) ==> () because
- * car(sc->NIL) = sc->NIL */
+ * car(sc->NIL) = sc->NIL */
s_goto(sc,OP_EVAL);
case OP_LET0: /* let */
@@ -3344,7 +3367,7 @@ static pointer opexe_2(scheme *sc, enum scheme_opcodes op) {
x=car(sc->args);
if (num_is_integer(x) && num_is_integer(y))
real_result=0;
- /* This 'if' is an R5RS compatability fix. */
+ /* This 'if' is an R5RS compatibility fix. */
/* NOTE: Remove this 'if' fix for R6RS. */
if (rvalue(x) == 0 && rvalue(y) < 0) {
result = 0.0;
@@ -3527,28 +3550,70 @@ static pointer opexe_2(scheme *sc, enum scheme_opcodes op) {
s_return(sc,mk_symbol(sc,strvalue(car(sc->args))));
case OP_STR2ATOM: /* string->atom */ {
- char *s=strvalue(car(sc->args));
- if(*s=='#') {
- s_return(sc, mk_sharp_const(sc, s+1));
- } else {
- s_return(sc, mk_atom(sc, s));
- }
- }
+ char *s=strvalue(car(sc->args));
+ long pf = 0;
+ if(cdr(sc->args)!=sc->NIL) {
+ /* we know cadr(sc->args) is a natural number */
+ /* see if it is 2, 8, 10, or 16, or error */
+ pf = ivalue_unchecked(cadr(sc->args));
+ if(pf == 16 || pf == 10 || pf == 8 || pf == 2) {
+ /* base is OK */
+ }
+ else {
+ pf = -1;
+ }
+ }
+ if (pf < 0) {
+ Error_1(sc, "string->atom: bad base:", cadr(sc->args));
+ } else if(*s=='#') /* no use of base! */ {
+ s_return(sc, mk_sharp_const(sc, s+1));
+ } else {
+ if (pf == 0 || pf == 10) {
+ s_return(sc, mk_atom(sc, s));
+ }
+ else {
+ char *ep;
+ long iv = strtol(s,&ep,(int )pf);
+ if (*ep == 0) {
+ s_return(sc, mk_integer(sc, iv));
+ }
+ else {
+ s_return(sc, sc->F);
+ }
+ }
+ }
+ }
case OP_SYM2STR: /* symbol->string */
x=mk_string(sc,symname(car(sc->args)));
setimmutable(x);
s_return(sc,x);
- case OP_ATOM2STR: /* atom->string */
- x=car(sc->args);
- if(is_number(x) || is_character(x) || is_string(x) || is_symbol(x)) {
- char *p;
- int len;
- atom2str(sc,x,0,&p,&len);
- s_return(sc,mk_counted_string(sc,p,len));
- } else {
- Error_1(sc, "atom->string: not an atom:", x);
- }
+
+ case OP_ATOM2STR: /* atom->string */ {
+ long pf = 0;
+ x=car(sc->args);
+ if(cdr(sc->args)!=sc->NIL) {
+ /* we know cadr(sc->args) is a natural number */
+ /* see if it is 2, 8, 10, or 16, or error */
+ pf = ivalue_unchecked(cadr(sc->args));
+ if(is_number(x) && (pf == 16 || pf == 10 || pf == 8 || pf == 2)) {
+ /* base is OK */
+ }
+ else {
+ pf = -1;
+ }
+ }
+ if (pf < 0) {
+ Error_1(sc, "atom->string: bad base:", cadr(sc->args));
+ } else if(is_number(x) || is_character(x) || is_string(x) || is_symbol(x)) {
+ char *p;
+ int len;
+ atom2str(sc,x,(int )pf,&p,&len);
+ s_return(sc,mk_counted_string(sc,p,len));
+ } else {
+ Error_1(sc, "atom->string: not an atom:", x);
+ }
+ }
case OP_MKSTRING: { /* make-string */
gunichar fill=' ';
@@ -4309,7 +4374,7 @@ static pointer opexe_5(scheme *sc, enum scheme_opcodes op) {
sc->tok = token(sc);
s_goto(sc,OP_RDSEXPR);
case TOK_ATOM:
- s_return(sc,mk_atom(sc, readstr_upto(sc, "();\t\n\r ")));
+ s_return(sc,mk_atom(sc, readstr_upto(sc, DELIMITERS)));
case TOK_DQUOTE:
x=readstrexp(sc);
if(x==sc->F) {
@@ -4340,7 +4405,7 @@ static pointer opexe_5(scheme *sc, enum scheme_opcodes op) {
}
}
case TOK_SHARP_CONST:
- if ((x = mk_sharp_const(sc, readstr_upto(sc, "();\t\n\r "))) == sc->NIL) {
+ if ((x = mk_sharp_const(sc, readstr_upto(sc, DELIMITERS))) == sc->NIL) {
Error_0(sc,"undefined sharp expression");
} else {
s_return(sc,x);
@@ -4368,7 +4433,7 @@ static pointer opexe_5(scheme *sc, enum scheme_opcodes op) {
if (c != '\n')
backchar(sc,c);
#if SHOW_ERROR_LINE
- else
+ else if (sc->load_stack[sc->file_i].kind & port_file)
sc->load_stack[sc->file_i].rep.stdio.curr_line++;
#endif
sc->nesting_stack[sc->file_i]--;
@@ -5019,11 +5084,12 @@ void scheme_deinit(scheme *sc) {
}
#if SHOW_ERROR_LINE
- fname = sc->load_stack[i].rep.stdio.filename;
-
for(i=0; i<sc->file_i; i++) {
- if(fname)
- sc->free(fname);
+ if (sc->load_stack[sc->file_i].kind & port_file) {
+ fname = sc->load_stack[i].rep.stdio.filename;
+ if(fname)
+ sc->free(fname);
+ }
}
#endif
}
@@ -5231,7 +5297,7 @@ int main(int argc, char **argv) {
if(strcmp(file_name,"-")==0) {
fin=stdin;
} else if(isfile) {
- fin=g_fopen(file_name,"rb");
+ fin=g_fopen(file_name,"r");
}
for(;*argv;argv++) {
pointer value=mk_string(&sc,*argv);
@@ -5241,7 +5307,7 @@ int main(int argc, char **argv) {
scheme_define(&sc,sc.global_env,mk_symbol(&sc,"*args*"),args);
} else {
- fin=g_fopen(file_name,"rb");
+ fin=g_fopen(file_name,"r");
}
if(isfile && fin==0) {
fprintf(stderr,"Could not open file %s\n",file_name);
[
Date Prev][
Date Next] [
Thread Prev][
Thread Next]
[
Thread Index]
[
Date Index]
[
Author Index]
