1 /* read.c: Input functions and primitives; the Scheme reader/parser.
2  *
3  * $Id$
4  *
5  * Copyright 1990, 1991, 1992, 1993, 1994, 1995, Oliver Laumann, Berlin
6  * Copyright 2002, 2003 Sam Hocevar <sam@hocevar.net>, Paris
7  *
8  * This software was derived from Elk 1.2, which was Copyright 1987, 1988,
9  * 1989, Nixdorf Computer AG and TELES GmbH, Berlin (Elk 1.2 has been written
10  * by Oliver Laumann for TELES Telematic Services, Berlin, in a joint project
11  * between TELES and Nixdorf Microprocessor Engineering, Berlin).
12  *
13  * Oliver Laumann, TELES GmbH, Nixdorf Computer AG and Sam Hocevar, as co-
14  * owners or individual owners of copyright in this software, grant to any
15  * person or company a worldwide, royalty free, license to
16  *
17  *    i) copy this software,
18  *   ii) prepare derivative works based on this software,
19  *  iii) distribute copies of this software or derivative works,
20  *   iv) perform this software, or
21  *    v) display this software,
22  *
23  * provided that this notice is not removed and that neither Oliver Laumann
24  * nor Teles nor Nixdorf are deemed to have made any representations as to
25  * the suitability of this software for any purpose nor are held responsible
26  * for any defects of this software.
27  *
28  * THERE IS ABSOLUTELY NO WARRANTY FOR THIS SOFTWARE.
29  */
30 
31 #include "config.h"
32 
33 #include <ctype.h>
34 #include <limits.h>
35 #include <string.h>
36 
37 #if defined(HAVE_TERMIO_H)
38 #   include <termio.h>
39 #elif defined(HAVE_TERMIOS_H)
40 #   include <termios.h>
41 #endif
42 
43 #if defined(HAVE_SYS_IOCTL_H)
44 #   include <sys/ioctl.h>
45 #endif
46 
47 #if defined(HAVE_SYS_FILIO_H)
48 #   include <sys/filio.h>
49 #endif
50 
51 #include "kernel.h"
52 
53 extern void Flush_Output (Object);
54 
55 extern double atof();
56 
57 int Skip_Comment (Object);
58 void Reader_Error (Object, char *) elk_attribute(__noreturn__);
59 
60 Object Sym_Quote,
61        Sym_Quasiquote,
62        Sym_Unquote,
63        Sym_Unquote_Splicing;
64 
65 #define Octal(c) ((c) >= '0' && (c) <= '7')
66 
67 static READFUN Readers[256];
68 
69 static char *Read_Buf;
70 static int Read_Size, Read_Max;
71 
72 #define Read_Reset()   (Read_Size = 0)
73 #define Read_Store(c)  (Read_Size == Read_Max ? \
74     (Read_Grow(), Read_Buf[Read_Size++] = (c)) : (Read_Buf[Read_Size++] = (c)))
75 
Read_Grow()76 static void Read_Grow () {
77     Read_Max *= 2;
78     Read_Buf = Safe_Realloc (Read_Buf, Read_Max);
79 }
80 
81 Object General_Read(), Read_Sequence(), Read_Atom(), Read_Special();
82 Object Read_String(), Read_Sharp(), Read_True(), Read_False(), Read_Void();
83 Object Read_Kludge(), Read_Vector_Paren(), Read_Vector_Bracket(), Read_Radix(), Read_Char();
84 
Init_Read()85 void Init_Read () {
86     Define_Symbol (&Sym_Quote, "quote");
87     Define_Symbol (&Sym_Quasiquote, "quasiquote");
88     Define_Symbol (&Sym_Unquote, "unquote");
89     Define_Symbol (&Sym_Unquote_Splicing, "unquote-splicing");
90 
91     Readers['t'] = Readers['T'] = Read_True;
92     Readers['f'] = Readers['F'] = Read_False;
93     Readers['v'] = Readers['V'] = Read_Void;
94     Readers['!'] = Read_Kludge;  /* for interpreter files */
95     Readers['('] = Read_Vector_Paren;
96     Readers['['] = Read_Vector_Bracket;
97     Readers['b'] = Readers['B'] =
98     Readers['o'] = Readers['O'] =
99     Readers['d'] = Readers['D'] =
100     Readers['x'] = Readers['X'] =
101     Readers['e'] = Readers['E'] =
102     Readers['i'] = Readers['I'] = Read_Radix;
103     Readers['\\'] = Read_Char;
104 
105     Read_Max = 128;
106     Read_Buf = Safe_Malloc (Read_Max);
107 }
108 
String_Getc(Object port)109 int String_Getc (Object port) {
110     register struct S_Port *p;
111     register struct S_String *s;
112 
113     p = PORT(port);
114     if (p->flags & P_UNREAD) {
115         p->flags &= ~P_UNREAD;
116         return p->unread;
117     }
118     s = STRING(p->name);
119     return p->ptr >= s->size ? EOF : s->data[p->ptr++];
120 }
121 
String_Ungetc(Object port,register int c)122 void String_Ungetc (Object port, register int c) {
123     PORT(port)->flags |= P_UNREAD;
124     PORT(port)->unread = c;
125 }
126 
Check_Input_Port(Object port)127 void Check_Input_Port (Object port) {
128     Check_Type (port, T_Port);
129     if (!(PORT(port)->flags & P_OPEN))
130         Primitive_Error ("port has been closed: ~s", port);
131     if (!IS_INPUT(port))
132         Primitive_Error ("not an input port: ~s", port);
133 }
134 
P_Clear_Input_Port(int argc,Object * argv)135 Object P_Clear_Input_Port (int argc, Object *argv) {
136     Discard_Input (argc == 1 ? argv[0] : Curr_Input_Port);
137     return Void;
138 }
139 
Discard_Input(Object port)140 void Discard_Input (Object port) {
141     register FILE *f;
142 
143     Check_Input_Port (port);
144     if (PORT(port)->flags & P_STRING)
145         return;
146     f = PORT(port)->file;
147 #if defined(HAVE_FPURGE)
148     (void)fpurge (f);
149 #elif defined(HAVE_BSD_FLUSH)
150     f->_cnt = 0;
151     f->_ptr = f->_base;
152 #endif
153 
154 #if defined(TIOCFLUSH)
155     (void)ioctl (fileno (f), TIOCFLUSH, (char *)0);
156 #elif defined(TCFLSH)
157     (void)ioctl (fileno (f), TCFLSH, (char *)0);
158 #endif
159 }
160 
P_Unread_Char(int argc,Object * argv)161 Object P_Unread_Char (int argc, Object *argv) {
162     Object port, ch;
163     register struct S_Port *p;
164 
165     ch = argv[0];
166     Check_Type (ch, T_Character);
167     port = argc == 2 ? argv[1] : Curr_Input_Port;
168     Check_Input_Port (port);
169     p = PORT(port);
170     if (p->flags & P_STRING) {
171         if (p->flags & P_UNREAD)
172             Primitive_Error ("cannot push back more than one char");
173         String_Ungetc (port, CHAR(ch));
174     } else {
175         if (ungetc (CHAR(ch), p->file) == EOF)
176             Primitive_Error ("failed to push back char");
177     }
178     if (CHAR(ch) == '\n' && PORT(port)->lno > 1) PORT(port)->lno--;
179     return ch;
180 }
181 
P_Read_Char(int argc,Object * argv)182 Object P_Read_Char (int argc, Object *argv) {
183     Object port;
184     register FILE *f;
185     register int c, str, flags;
186 
187     port = argc == 1 ? argv[0] : Curr_Input_Port;
188     Check_Input_Port (port);
189     f = PORT(port)->file;
190     flags = PORT(port)->flags;
191     str = flags & P_STRING;
192     Reader_Getc;
193     Reader_Tweak_Stream;
194     return c == EOF ? Eof : Make_Char (c);
195 }
196 
P_Peek_Char(int argc,Object * argv)197 Object P_Peek_Char (int argc, Object *argv) {
198     Object a[2];
199 
200     a[0] = P_Read_Char (argc, argv);
201     if (argc == 1)
202         a[1] = argv[0];
203     return EQ(a[0], Eof) ? Eof : P_Unread_Char (argc+1, a);
204 }
205 
206 /* char-ready? cannot be implemented correctly based on FILE pointers.
207  * The following is only an approximation; even if FIONREAD is supported,
208  * the primitive may return #f although a call to read-char would not block.
209  */
P_Char_Readyp(int argc,Object * argv)210 Object P_Char_Readyp (int argc, Object *argv) {
211     Object port;
212 
213     port = argc == 1 ? argv[0] : Curr_Input_Port;
214     Check_Input_Port (port);
215     if (PORT(port)->flags & P_STRING || feof (PORT(port)->file))
216         return True;
217 #ifdef FIONREAD
218     {
219         long num = 0;
220         (void)ioctl (fileno (PORT(port)->file), FIONREAD, (char *)&num);
221         if (num != 0)
222             return True;
223     }
224 #endif
225     return False;
226 }
227 
P_Read_String(int argc,Object * argv)228 Object P_Read_String (int argc, Object *argv) {
229     Object port;
230     register FILE *f;
231     register int c, str;
232 
233     port = argc == 1 ? argv[0] : Curr_Input_Port;
234     Check_Input_Port (port);
235     f = PORT(port)->file;
236     str = PORT(port)->flags & P_STRING;
237     Read_Reset ();
238     while (1) {
239         Reader_Getc;
240         if (c == '\n' || c == EOF)
241             break;
242         Read_Store (c);
243     }
244     Reader_Tweak_Stream;
245     return c == EOF ? Eof : Make_String (Read_Buf, Read_Size);
246 }
247 
P_Read(int argc,Object * argv)248 Object P_Read (int argc, Object *argv) {
249     return General_Read (argc == 1 ? argv[0] : Curr_Input_Port, 0);
250 }
251 
General_Read(Object port,int konst)252 Object General_Read (Object port, int konst) {
253     register FILE *f;
254     register int c, str;
255     Object ret;
256 
257     Check_Input_Port (port);
258     Flush_Output (Curr_Output_Port);
259     f = PORT(port)->file;
260     str = PORT(port)->flags & P_STRING;
261     while (1) {
262         Reader_Getc;
263         if (c == EOF) {
264             ret = Eof;
265             break;
266         }
267         if (Whitespace (c))
268             continue;
269         if (c == ';') {
270 comment:
271             if (Skip_Comment (port) == EOF) {
272                 ret = Eof;
273                 break;
274             }
275             continue;
276         }
277         if (c == '(' || c == '[') {
278             ret = Read_Sequence (port, 0, konst, c);
279         } else if (c == '#') {
280             ret = Read_Sharp (port, konst);
281             if (TYPE(ret) == T_Special)      /* it was a #! */
282                 goto comment;
283         } else {
284             Reader_Ungetc;
285             ret = Read_Atom (port, konst);
286         }
287         break;
288     }
289     Reader_Tweak_Stream;
290     return ret;
291 }
292 
Skip_Comment(Object port)293 int Skip_Comment (Object port) {
294     register FILE *f;
295     register int c, str;
296 
297     f = PORT(port)->file;
298     str = PORT(port)->flags & P_STRING;
299     do {
300         Reader_Getc;
301     } while (c != '\n' && c != EOF);
302     return c;
303 }
304 
Read_Atom(Object port,int konst)305 Object Read_Atom (Object port, int konst) {
306     Object ret;
307 
308     ret = Read_Special (port, konst);
309     if (TYPE(ret) == T_Special)
310         Reader_Error (port, "syntax error");
311     return ret;
312 }
313 
Read_Special(Object port,int konst)314 Object Read_Special (Object port, int konst) {
315     Object ret;
316     register int c, str;
317     register FILE *f;
318 
319 #define READ_QUOTE(sym) \
320     ( ret = Read_Atom (port, konst),\
321       konst ? (ret = Const_Cons (ret, Null), Const_Cons (sym, ret))\
322            : (ret = Cons (ret, Null), Cons (sym, ret)))
323 
324     f = PORT(port)->file;
325     str = PORT(port)->flags & P_STRING;
326 again:
327     Reader_Getc;
328     switch (c) {
329     case EOF:
330 eof:
331         Reader_Tweak_Stream;
332         Reader_Error (port, "premature end of file");
333     case ';':
334         if (Skip_Comment (port) == EOF)
335             goto eof;
336         goto again;
337     case ']':
338     case ')':
339         SET(ret, T_Special, c);
340         return ret;
341     case '[':
342     case '(':
343         return Read_Sequence (port, 0, konst, c);
344     case '\'':
345         return READ_QUOTE(Sym_Quote);
346     case '`':
347         return READ_QUOTE(Sym_Quasiquote);
348     case ',':
349         Reader_Getc;
350         if (c == EOF)
351             goto eof;
352         if (c == '@') {
353             return READ_QUOTE(Sym_Unquote_Splicing);
354         } else {
355             Reader_Ungetc;
356             return READ_QUOTE(Sym_Unquote);
357         }
358     case '"':
359         return Read_String (port, konst);
360     case '#':
361         ret = Read_Sharp (port, konst);
362         if (TYPE(ret) == T_Special)
363             goto again;
364         return ret;
365     default:
366         if (Whitespace (c))
367             goto again;
368         Read_Reset ();
369         if (c == '.') {
370             Reader_Getc;
371             if (c == EOF)
372                 goto eof;
373             if (Whitespace (c)) {
374                 Reader_Ungetc;
375                 SET(ret, T_Special, '.');
376                 return ret;
377             }
378             Read_Store ('.');
379         }
380         while (!Whitespace (c) && !Delimiter (c) && c != EOF) {
381             if (c == '\\') {
382                 Reader_Getc;
383                 if (c == EOF)
384                     break;
385             }
386             Read_Store (c);
387             Reader_Getc;
388         }
389         Read_Store ('\0');
390         if (c != EOF)
391             Reader_Ungetc;
392         ret = Parse_Number (port, Read_Buf, 10);
393         if (Nullp (ret))
394             ret = Intern (Read_Buf);
395         return ret;
396     }
397     /*NOTREACHED*/
398 }
399 
Read_Sequence(Object port,int vec,int konst,int start_chr)400 Object Read_Sequence (Object port, int vec, int konst, int start_chr) {
401     Object ret, e, tail, t;
402     GC_Node3;
403 
404     ret = tail = Null;
405     GC_Link3 (ret, tail, port);
406     while (1) {
407         e = Read_Special (port, konst);
408         if (TYPE(e) == T_Special) {
409             if (CHAR(e) == ')' || CHAR(e) == ']') {
410                 if ((start_chr == '(' && CHAR(e) == ']')
411                       || (start_chr == '[' && CHAR(e) == ')')) {
412                     char buf[64];
413                     sprintf(buf, "expression starts with '%c' but ends "
414                                  "with '%c'", start_chr, CHAR(e));
415                     Reader_Error (port, buf);
416                 }
417                 GC_Unlink;
418                 return ret;
419             }
420             if (vec)
421                 Reader_Error (port, "wrong syntax in vector");
422             if (CHAR(e) == '.') {
423                 if (Nullp (tail)) {
424                     ret = Read_Atom (port, konst);
425                 } else {
426                     e = Read_Atom (port, konst);
427                     /*
428                      * Possibly modifying pure cons.  Must be fixed!
429                      */
430                     Cdr (tail) = e;
431                 }
432                 e = Read_Special (port, konst);
433                 if (TYPE(e) == T_Special && (CHAR(e) == ')' || CHAR(e) == ']')) {
434                     GC_Unlink;
435                     return ret;
436                 }
437                 Reader_Error (port, "dot in wrong context");
438             }
439             Reader_Error (port, "syntax error");
440         }
441         if (konst) t = Const_Cons (e, Null); else t = Cons (e, Null);
442         if (!Nullp (tail))
443             /*
444              * Possibly modifying pure cons.  Must be fixed!
445              */
446             Cdr (tail) = t;
447         else
448             ret = t;
449         tail = t;
450     }
451     /*NOTREACHED*/
452 }
453 
Read_String(Object port,int konst)454 Object Read_String (Object port, int konst) {
455     register FILE *f;
456     register int n, c, oc, str;
457 
458     Read_Reset ();
459     f = PORT(port)->file;
460     str = PORT(port)->flags & P_STRING;
461     while (1) {
462         Reader_Getc;
463         if (c == EOF) {
464 eof:
465             Reader_Tweak_Stream;
466             Reader_Error (port, "end of file in string");
467         }
468         if (c == '\\') {
469             Reader_Getc;
470             switch (c) {
471             case EOF: goto eof;
472             case 'b': c = '\b'; break;
473             case 't': c = '\t'; break;
474             case 'r': c = '\r'; break;
475             case 'n': c = '\n'; break;
476             case '0': case '1': case '2': case '3':
477             case '4': case '5': case '6': case '7':
478                 oc = n = 0;
479                 do {
480                     oc <<= 3; oc += c - '0';
481                     Reader_Getc;
482                     if (c == EOF) goto eof;
483                 } while (Octal (c) && ++n <= 2);
484                 Reader_Ungetc;
485                 c = oc;
486             }
487         } else if (c == '"')
488             break;
489         Read_Store (c);
490     }
491     return General_Make_String (Read_Buf, Read_Size, konst);
492 }
493 
Read_Sharp(Object port,int konst)494 Object Read_Sharp (Object port, int konst) {
495     int c, str;
496     FILE *f;
497     char buf[32];
498 
499     f = PORT(port)->file;
500     str = PORT(port)->flags & P_STRING;
501     Reader_Getc;
502     if (c == EOF)
503         Reader_Sharp_Eof;
504     if (!Readers[c]) {
505         sprintf (buf, "no reader for syntax #%c", c);
506         Reader_Error (port, buf);
507     }
508     return Readers[c](port, c, konst);
509 }
510 
511 /*ARGSUSED*/
Read_True(Object port,int chr,int konst)512 Object Read_True (Object port, int chr, int konst) {
513     return True;
514 }
515 
516 /*ARGSUSED*/
Read_False(Object port,int chr,int konst)517 Object Read_False (Object port, int chr, int konst) {
518     return False;
519 }
520 
521 /*ARGSUSED*/
Read_Void(Object port,int chr,int konst)522 Object Read_Void (Object port, int chr, int konst) {
523     Object ret;
524 
525     ret = Const_Cons (Void, Null);
526     return Const_Cons (Sym_Quote, ret);
527 }
528 
529 /*ARGSUSED*/
Read_Kludge(Object port,int chr,int konst)530 Object Read_Kludge (Object port, int chr, int konst) {
531     return Special;
532 }
533 
534 /*ARGSUSED*/
Read_Vector_Paren(Object port,int chr,int konst)535 Object Read_Vector_Paren (Object port, int chr, int konst) {
536     return List_To_Vector (Read_Sequence (port, 1, konst, '('), konst);
537 }
538 
539 /*ARGSUSED*/
Read_Vector_Bracket(Object port,int chr,int konst)540 Object Read_Vector_Bracket (Object port, int chr, int konst) {
541     return List_To_Vector (Read_Sequence (port, 1, konst, '['), konst);
542 }
543 
544 /*ARGSUSED*/
Read_Radix(Object port,int chr,int konst)545 Object Read_Radix (Object port, int chr, int konst) {
546     int c, str;
547     FILE *f;
548     Object ret;
549 
550     Read_Reset ();
551     f = PORT(port)->file;
552     str = PORT(port)->flags & P_STRING;
553     Read_Store ('#'); Read_Store (chr);
554     while (1) {
555         Reader_Getc;
556         if (c == EOF)
557             Reader_Sharp_Eof;
558         if (Whitespace (c) || Delimiter (c))
559             break;
560         Read_Store (c);
561     }
562     Reader_Ungetc;
563     Read_Store ('\0');
564     ret = Parse_Number (port, Read_Buf, 10);
565     if (Nullp (ret))
566         Reader_Error (port, "radix not followed by a valid number");
567     return ret;
568 }
569 
570 /*ARGSUSED*/
Read_Char(Object port,int chr,int konst)571 Object Read_Char (Object port, int chr, int konst) {
572     int c, str;
573     FILE *f;
574     char buf[10], *p = buf;
575 
576     f = PORT(port)->file;
577     str = PORT(port)->flags & P_STRING;
578     Reader_Getc;
579     if (c == EOF)
580         Reader_Sharp_Eof;
581     *p++ = c;
582     while (1) {
583         Reader_Getc;
584         if (c == EOF)
585             Reader_Sharp_Eof;
586         if (Whitespace (c) || Delimiter (c))
587             break;
588         if (p == buf+9)
589             Reader_Error (port, "syntax error in character constant");
590         *p++ = c;
591     }
592     Reader_Ungetc;
593     if (p == buf+1)
594         return Make_Char (*buf);
595     *p = '\0';
596     if (p == buf+3) {
597         for (c = 0, p = buf; p < buf+3 && Octal (*p); p++)
598             c = c << 3 | (*p - '0');
599         if (p == buf+3)
600             return Make_Char (c);
601     }
602     for (p = buf; *p; p++)
603         if (isupper (*p))
604             *p = tolower (*p);
605     if (strcmp (buf, "space") == 0)
606         return Make_Char (' ');
607     if (strcmp (buf, "newline") == 0)
608         return Make_Char ('\n');
609     if (strcmp (buf, "return") == 0)
610         return Make_Char ('\r');
611     if (strcmp (buf, "tab") == 0)
612         return Make_Char ('\t');
613     if (strcmp (buf, "formfeed") == 0)
614         return Make_Char ('\f');
615     if (strcmp (buf, "backspace") == 0)
616         return Make_Char ('\b');
617     Reader_Error (port, "syntax error in character constant");
618     /*NOTREACHED*/
619 }
620 
Define_Reader(int c,READFUN fun)621 void Define_Reader (int c, READFUN fun) {
622     if (Readers[c] && Readers[c] != fun)
623         Primitive_Error ("reader for `~a' already defined", Make_Char (c));
624     Readers[c] = fun;
625 }
626 
Parse_Number(Object port,char const * buf,int radix)627 Object Parse_Number (Object port, char const *buf, int radix) {
628     char const *p;
629     int c, i;
630     int mdigit = 0, edigit = 0, expo = 0, neg = 0, point = 0;
631     int gotradix = 0, exact = 0, inexact = 0;
632     unsigned int max;
633     int maxdig;
634     Object ret;
635 
636     for ( ; *buf == '#'; buf++) {
637         switch (*++buf) {
638         case 'b': case 'B':
639             if (gotradix++) return Null;
640             radix = 2;
641             break;
642         case 'o': case 'O':
643             if (gotradix++) return Null;
644             radix = 8;
645             break;
646         case 'd': case 'D':
647             if (gotradix++) return Null;
648             radix = 10;
649             break;
650         case 'x': case 'X':
651             if (gotradix++) return Null;
652             radix = 16;
653             break;
654         case 'e': case 'E':
655             if (exact++ || inexact) return Null;
656             break;
657         case 'i': case 'I':
658             if (inexact++ || exact) return Null;
659             break;
660         default:
661             return Null;
662         }
663     }
664     p = buf;
665     if (*p == '+' || (neg = *p == '-'))
666         p++;
667     for ( ; (c = *p); p++) {
668         if (c == '.') {
669             if (expo || point++)
670                 return Null;
671         } else if (radix != 16 && (c == 'e' || c == 'E')) {
672             if (expo++)
673                 return Null;
674             if (p[1] == '+' || p[1] == '-')
675                 p++;
676 #ifdef HAVE_INDEX
677         } else if (radix == 16 && !index ("0123456789abcdefABCDEF", c)) {
678 #else
679         } else if (radix == 16 && !strchr ("0123456789abcdefABCDEF", c)) {
680 #endif
681             return Null;
682         } else if (radix < 16 && (c < '0' || c > '0' + radix-1)) {
683             return Null;
684         } else {
685             if (expo) edigit++; else mdigit++;
686         }
687     }
688     if (!mdigit || (expo && !edigit))
689         return Null;
690     if (point || expo) {
691         if (radix != 10) {
692             if (Nullp (port))
693                 return Null;
694             Reader_Error (port, "reals must be given in decimal");
695         }
696         /* Lacking ratnums, there's nothing we can do if #e has been
697          * specified-- just return the inexact number.
698          */
699         return Make_Flonum (atof (buf));
700     }
701     max = (neg ? -(unsigned int)INT_MIN : INT_MAX);
702     maxdig = max % radix;
703     max /= radix;
704     for (i = 0, p = buf; (c = *p); p++) {
705         if (c == '-' || c == '+') {
706             buf++;
707             continue;
708         }
709         if (radix == 16) {
710             if (isupper (c))
711                 c = tolower (c);
712             if (c >= 'a')
713                 c = '9' + c - 'a' + 1;
714         }
715         c -= '0';
716         if ((unsigned int)i > max || ((unsigned int)i == max && c > maxdig)) {
717             ret = Make_Bignum (buf, neg, radix);
718             return inexact ? Make_Flonum (Bignum_To_Double (ret)) : ret;
719         }
720         i *= radix; i += c;
721     }
722     if (neg)
723         i = -i;
724     return inexact ? Make_Flonum ((double)i) : Make_Integer (i);
725 }
726 
Reader_Error(Object port,char * msg)727 void Reader_Error (Object port, char *msg) {
728     char buf[100];
729 
730     if (PORT(port)->flags & P_STRING) {
731         sprintf (buf, "[string-port]: %u: %s", PORT(port)->lno, msg);
732         Primitive_Error (buf);
733     } else {
734         sprintf (buf, "~s: %u: %s", PORT(port)->lno, msg);
735         Primitive_Error (buf, PORT(port)->name);
736     }
737 }
738