75 |
"Style of keyword recognition: #f or 'prefix."} |
"Style of keyword recognition: #f or 'prefix."} |
76 |
}; |
}; |
77 |
|
|
78 |
|
/* |
79 |
|
Give meaningful error messages for errors |
80 |
|
|
81 |
|
We use the format |
82 |
|
|
83 |
|
MESSAGE |
84 |
|
This happened in .... |
85 |
|
|
86 |
|
This is not standard GNU format, but the test-suite likes the real |
87 |
|
message to be in front. |
88 |
|
|
89 |
|
Hmmm. |
90 |
|
|
91 |
|
Maybe this is a kludge? Perhaps we should throw (list EXPR FILENAME |
92 |
|
LINENO COLUMNO), and have the exception handler sort out the error |
93 |
|
message?Where does the handler live, what are the conventions for |
94 |
|
the expression argument of the handler? How does this work for an |
95 |
|
error message like |
96 |
|
|
97 |
|
Backtrace: |
98 |
|
In standard input: |
99 |
|
4: 0* [list ... |
100 |
|
|
101 |
|
standard input:4:1: While evaluating arguments to list in expression (list a b):standard input:4:1: Unbound variable: a |
102 |
|
ABORT: (unbound-variable) |
103 |
|
|
104 |
|
|
105 |
|
|
106 |
|
In any case, we would have to assemble that information anyway. |
107 |
|
*/ |
108 |
|
|
109 |
|
|
110 |
|
#if 0 |
111 |
|
|
112 |
|
#ifndef HAVE_SNPRINTF |
113 |
|
#define snprintf sprintf |
114 |
|
/* |
115 |
|
should warn about buffer overflow? |
116 |
|
*/ |
117 |
|
#endif |
118 |
|
|
119 |
|
#define INPUT_ERROR(port, message, arg) { \ |
120 |
|
char s[1024];\ |
121 |
|
int fn_found = SCM_STRINGP (SCM_FILENAME(port));\ |
122 |
|
char *fn = "";\ |
123 |
|
if (fn_found)\ |
124 |
|
fn = SCM_STRING_CHARS(SCM_FILENAME(port));\ |
125 |
|
snprintf (s, 1024, "%s\nThis happened in %s%s%s line %d column %d", message, \ |
126 |
|
fn_found ? "`" : "", \ |
127 |
|
fn,\ |
128 |
|
fn_found ? "'" : "", \ |
129 |
|
SCM_LINUM(port) + 1, SCM_COL(port) + 1); \ |
130 |
|
SCM_MISC_ERROR(s, arg); \ |
131 |
|
} |
132 |
|
#else |
133 |
|
#define INPUT_ERROR(port, message, arg) SCM_MISC_ERROR(message, arg) |
134 |
|
#endif |
135 |
|
|
136 |
|
|
137 |
SCM_DEFINE (scm_read_options, "read-options-interface", 0, 1, 0, |
SCM_DEFINE (scm_read_options, "read-options-interface", 0, 1, 0, |
138 |
(SCM setting), |
(SCM setting), |
139 |
"Option interface for the read options. Instead of using\n" |
"Option interface for the read options. Instead of using\n" |
359 |
? scm_lreadrecparen (tok_buf, port, s_list, copy) |
? scm_lreadrecparen (tok_buf, port, s_list, copy) |
360 |
: scm_lreadparen (tok_buf, port, s_list, copy); |
: scm_lreadparen (tok_buf, port, s_list, copy); |
361 |
case ')': |
case ')': |
362 |
SCM_MISC_ERROR ("unexpected \")\"", SCM_EOL); |
INPUT_ERROR(port,"unexpected \")\"", SCM_EOL); |
363 |
goto tryagain; |
goto tryagain; |
364 |
|
|
365 |
case '\'': |
case '\'': |
489 |
if (scm_charnames[c] |
if (scm_charnames[c] |
490 |
&& (scm_casei_streq (scm_charnames[c], SCM_STRING_CHARS (*tok_buf)))) |
&& (scm_casei_streq (scm_charnames[c], SCM_STRING_CHARS (*tok_buf)))) |
491 |
return SCM_MAKE_CHAR (scm_charnums[c]); |
return SCM_MAKE_CHAR (scm_charnums[c]); |
492 |
SCM_MISC_ERROR ("unknown # object", SCM_EOL); |
INPUT_ERROR (port, "unknown # object", SCM_EOL); |
493 |
|
|
494 |
/* #:SYMBOL is a syntax for keywords supported in all contexts. */ |
/* #:SYMBOL is a syntax for keywords supported in all contexts. */ |
495 |
case ':': |
case ':': |
519 |
} |
} |
520 |
} |
} |
521 |
unkshrp: |
unkshrp: |
522 |
scm_misc_error (s_scm_read, "Unknown # object: ~S", |
INPUT_ERROR (port, "Unknown # object: ~S", |
523 |
scm_list_1 (SCM_MAKE_CHAR (c))); |
scm_list_1 (SCM_MAKE_CHAR (c))); |
524 |
} |
} |
525 |
|
|
526 |
case '"': |
case '"': |
528 |
while ('"' != (c = scm_getc (port))) |
while ('"' != (c = scm_getc (port))) |
529 |
{ |
{ |
530 |
if (c == EOF) |
if (c == EOF) |
531 |
SCM_MISC_ERROR ("end of file in string constant", SCM_EOL); |
INPUT_ERROR (port, "end of file in string constant", SCM_EOL); |
532 |
|
|
533 |
while (j + 2 >= SCM_STRING_LENGTH (*tok_buf)) |
while (j + 2 >= SCM_STRING_LENGTH (*tok_buf)) |
534 |
scm_grow_tok_buf (tok_buf); |
scm_grow_tok_buf (tok_buf); |
590 |
c = SCM_STRING_CHARS (*tok_buf)[1]; |
c = SCM_STRING_CHARS (*tok_buf)[1]; |
591 |
goto callshrp; |
goto callshrp; |
592 |
} |
} |
593 |
SCM_MISC_ERROR ("unknown # object", SCM_EOL); |
INPUT_ERROR (port, "unknown # object", SCM_EOL); |
594 |
} |
} |
595 |
goto tok; |
goto tok; |
596 |
|
|
721 |
ans = scm_lreadr (tok_buf, port, copy); |
ans = scm_lreadr (tok_buf, port, copy); |
722 |
closeit: |
closeit: |
723 |
if (')' != (c = scm_flush_ws (port, name))) |
if (')' != (c = scm_flush_ws (port, name))) |
724 |
SCM_MISC_ERROR ("missing close paren", SCM_EOL); |
INPUT_ERROR (port, "missing close paren", SCM_EOL); |
725 |
return ans; |
return ans; |
726 |
} |
} |
727 |
ans = tl = scm_cons (tmp, SCM_EOL); |
ans = tl = scm_cons (tmp, SCM_EOL); |
761 |
{ |
{ |
762 |
ans = scm_lreadr (tok_buf, port, copy); |
ans = scm_lreadr (tok_buf, port, copy); |
763 |
if (')' != (c = scm_flush_ws (port, name))) |
if (')' != (c = scm_flush_ws (port, name))) |
764 |
SCM_MISC_ERROR ("missing close paren", SCM_EOL); |
INPUT_ERROR (port, "missing close paren", SCM_EOL); |
765 |
return ans; |
return ans; |
766 |
} |
} |
767 |
/* Build the head of the list structure. */ |
/* Build the head of the list structure. */ |
785 |
: tmp, |
: tmp, |
786 |
SCM_EOL)); |
SCM_EOL)); |
787 |
if (')' != (c = scm_flush_ws (port, name))) |
if (')' != (c = scm_flush_ws (port, name))) |
788 |
SCM_MISC_ERROR ("missing close paren", SCM_EOL); |
INPUT_ERROR (port, "missing close paren", SCM_EOL); |
789 |
goto exit; |
goto exit; |
790 |
} |
} |
791 |
|
|