Mercurial > hg > xemacs-beta

comparison src/lread.c @ 442:abe6d1db359e r21-2-36

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r21-2-36
author cvs
date Mon, 13 Aug 2007 11:35:02 +0200
parents 8de8e3f6228a
children 576fb035e263
comparison
equal deleted inserted replaced
441:72a7cfa4a488 442:abe6d1db359e
216 ? (build_string ("internal input stream")) \ 216 ? (build_string ("internal input stream")) \
217 : (x)) 217 : (x))
218 218
219 219
220 static DOESNT_RETURN 220 static DOESNT_RETURN
221 syntax_error (CONST char *string) 221 read_syntax_error (const char *string)
222 { 222 {
223 signal_error (Qinvalid_read_syntax, 223 signal_error (Qinvalid_read_syntax,
224 list1 (build_translated_string (string))); 224 list1 (build_translated_string (string)));
225 } 225 }
226 226
227 static Lisp_Object 227 static Lisp_Object
228 continuable_syntax_error (CONST char *string) 228 continuable_read_syntax_error (const char *string)
229 { 229 {
230 return Fsignal (Qinvalid_read_syntax, 230 return Fsignal (Qinvalid_read_syntax,
231 list1 (build_translated_string (string))); 231 list1 (build_translated_string (string)));
232 } 232 }
233 233
257 { 257 {
258 Emchar c = Lstream_get_emchar (XLSTREAM (readcharfun)); 258 Emchar c = Lstream_get_emchar (XLSTREAM (readcharfun));
259 #ifdef DEBUG_XEMACS /* testing Mule */ 259 #ifdef DEBUG_XEMACS /* testing Mule */
260 static int testing_mule = 0; /* Change via debugger */ 260 static int testing_mule = 0; /* Change via debugger */
261 if (testing_mule) { 261 if (testing_mule) {
262 if (c >= 0x20 && c <= 0x7E) fprintf (stderr, "%c", c); 262 if (c >= 0x20 && c <= 0x7E) stderr_out ("%c", c);
263 else if (c == '\n') fprintf (stderr, "\\n\n"); 263 else if (c == '\n') stderr_out ("\\n\n");
264 else fprintf (stderr, "\\%o ", c); 264 else stderr_out ("\\%o ", c);
265 } 265 }
266 #endif 266 #endif
267 return c; 267 return c;
268 } 268 }
269 else if (MARKERP (readcharfun)) 269 else if (MARKERP (readcharfun))
621 if (! fstat (fd, &s1)) /* can't fail, right? */ 621 if (! fstat (fd, &s1)) /* can't fail, right? */
622 { 622 {
623 int result; 623 int result;
624 /* temporarily hack the 'c' off the end of the filename */ 624 /* temporarily hack the 'c' off the end of the filename */
625 foundstr[foundlen - 1] = '\0'; 625 foundstr[foundlen - 1] = '\0';
626 result = stat (foundstr, &s2); 626 result = xemacs_stat (foundstr, &s2);
627 if (result >= 0 && 627 if (result >= 0 &&
628 (unsigned) s1.st_mtime < (unsigned) s2.st_mtime) 628 (unsigned) s1.st_mtime < (unsigned) s2.st_mtime)
629 { 629 {
630 Lisp_Object newer_name = make_string ((Bufbyte *) foundstr, 630 Lisp_Object newer_name = make_string ((Bufbyte *) foundstr,
631 foundlen - 1); 631 foundlen - 1);
674 PRINT_LOADING_MESSAGE (""); 674 PRINT_LOADING_MESSAGE ("");
675 675
676 { 676 {
677 /* Lisp_Object's must be malloc'ed, not stack-allocated */ 677 /* Lisp_Object's must be malloc'ed, not stack-allocated */
678 Lisp_Object lispstream = Qnil; 678 Lisp_Object lispstream = Qnil;
679 CONST int block_size = 8192; 679 const int block_size = 8192;
680 struct gcpro ngcpro1; 680 struct gcpro ngcpro1;
681 681
682 NGCPRO1 (lispstream); 682 NGCPRO1 (lispstream);
683 lispstream = make_filedesc_input_stream (fd, 0, -1, LSTR_CLOSING); 683 lispstream = make_filedesc_input_stream (fd, 0, -1, LSTR_CLOSING);
684 /* 64K is used for normal files; 8K should be OK here because Lisp 684 /* 64K is used for normal files; 8K should be OK here because Lisp
976 } 976 }
977 } 977 }
978 else 978 else
979 { 979 {
980 /* Case c) */ 980 /* Case c) */
981 CONST char *nsuffix = (CONST char *) XSTRING_DATA (suffixes); 981 const char *nsuffix = (const char *) XSTRING_DATA (suffixes);
982 982
983 while (1) 983 while (1)
984 { 984 {
985 char *esuffix = (char *) strchr (nsuffix, ':'); 985 char *esuffix = (char *) strchr (nsuffix, ':');
986 int lsuffix = ((esuffix) ? (esuffix - nsuffix) : strlen (nsuffix)); 986 int lsuffix = esuffix ? esuffix - nsuffix : strlen (nsuffix);
987 987
988 /* Concatenate path element/specified name with the suffix. */ 988 /* Concatenate path element/specified name with the suffix. */
989 strncpy (fn + fn_len, nsuffix, lsuffix); 989 strncpy (fn + fn_len, nsuffix, lsuffix);
990 fn[fn_len + lsuffix] = 0; 990 fn[fn_len + lsuffix] = 0;
991 991
1012 struct locate_file_in_directory_mapper_closure *closure = 1012 struct locate_file_in_directory_mapper_closure *closure =
1013 (struct locate_file_in_directory_mapper_closure *)arg; 1013 (struct locate_file_in_directory_mapper_closure *)arg;
1014 struct stat st; 1014 struct stat st;
1015 1015
1016 /* Ignore file if it's a directory. */ 1016 /* Ignore file if it's a directory. */
1017 if (stat (fn, &st) >= 0 1017 if (xemacs_stat (fn, &st) >= 0
1018 && (st.st_mode & S_IFMT) != S_IFDIR) 1018 && (st.st_mode & S_IFMT) != S_IFDIR)
1019 { 1019 {
1020 /* Check that we can access or open it. */ 1020 /* Check that we can access or open it. */
1021 if (closure->mode >= 0) 1021 if (closure->mode >= 0)
1022 closure->fd = access (fn, closure->mode); 1022 closure->fd = access (fn, closure->mode);
1027 { 1027 {
1028 /* We succeeded; return this descriptor and filename. */ 1028 /* We succeeded; return this descriptor and filename. */
1029 if (closure->storeptr) 1029 if (closure->storeptr)
1030 *closure->storeptr = build_string (fn); 1030 *closure->storeptr = build_string (fn);
1031 1031
1032 #ifndef WINDOWSNT 1032 #ifndef WIN32_NATIVE
1033 /* If we actually opened the file, set close-on-exec flag 1033 /* If we actually opened the file, set close-on-exec flag
1034 on the new descriptor so that subprocesses can't whack 1034 on the new descriptor so that subprocesses can't whack
1035 at it. */ 1035 at it. */
1036 if (closure->mode < 0) 1036 if (closure->mode < 0)
1037 (void) fcntl (closure->fd, F_SETFD, FD_CLOEXEC); 1037 (void) fcntl (closure->fd, F_SETFD, FD_CLOEXEC);
1228 Lisp_Object hash_table; 1228 Lisp_Object hash_table;
1229 Lisp_Object tail; 1229 Lisp_Object tail;
1230 int found = 0; 1230 int found = 0;
1231 1231
1232 /* If this path element is relative, we have to look by hand. */ 1232 /* If this path element is relative, we have to look by hand. */
1233 if (NILP (Ffile_name_absolute_p (pathel))) 1233 if (NILP (pathel) || NILP (Ffile_name_absolute_p (pathel)))
1234 { 1234 {
1235 val = locate_file_in_directory (pathel, str, suffixes, storeptr, 1235 val = locate_file_in_directory (pathel, str, suffixes, storeptr,
1236 mode); 1236 mode);
1237 if (val >= 0) 1237 if (val >= 0)
1238 { 1238 {
1868 Lstream_flush (XLSTREAM (Vread_buffer_stream)); 1868 Lstream_flush (XLSTREAM (Vread_buffer_stream));
1869 1869
1870 return Lstream_byte_count (XLSTREAM (Vread_buffer_stream)) - 1; 1870 return Lstream_byte_count (XLSTREAM (Vread_buffer_stream)) - 1;
1871 } 1871 }
1872 1872
1873 static Lisp_Object parse_integer (CONST Bufbyte *buf, Bytecount len, int base); 1873 static Lisp_Object parse_integer (const Bufbyte *buf, Bytecount len, int base);
1874 1874
1875 static Lisp_Object 1875 static Lisp_Object
1876 read_atom (Lisp_Object readcharfun, 1876 read_atom (Lisp_Object readcharfun,
1877 Emchar firstchar, 1877 Emchar firstchar,
1878 int uninterned_symbol) 1878 int uninterned_symbol)
1948 } 1948 }
1949 } 1949 }
1950 1950
1951 1951
1952 static Lisp_Object 1952 static Lisp_Object
1953 parse_integer (CONST Bufbyte *buf, Bytecount len, int base) 1953 parse_integer (const Bufbyte *buf, Bytecount len, int base)
1954 { 1954 {
1955 CONST Bufbyte *lim = buf + len; 1955 const Bufbyte *lim = buf + len;
1956 CONST Bufbyte *p = buf; 1956 const Bufbyte *p = buf;
1957 EMACS_UINT num = 0; 1957 EMACS_UINT num = 0;
1958 int negativland = 0; 1958 int negativland = 0;
1959 1959
1960 if (*p == '-') 1960 if (*p == '-')
1961 { 1961 {
2118 struct structure_type *st; 2118 struct structure_type *st;
2119 struct gcpro gcpro1, gcpro2; 2119 struct gcpro gcpro1, gcpro2;
2120 2120
2121 GCPRO2 (orig_list, already_seen); 2121 GCPRO2 (orig_list, already_seen);
2122 if (c != '(') 2122 if (c != '(')
2123 RETURN_UNGCPRO (continuable_syntax_error ("#s not followed by paren")); 2123 RETURN_UNGCPRO (continuable_read_syntax_error ("#s not followed by paren"));
2124 list = read_list (readcharfun, ')', 0, 0); 2124 list = read_list (readcharfun, ')', 0, 0);
2125 orig_list = list; 2125 orig_list = list;
2126 { 2126 {
2127 int len = XINT (Flength (list)); 2127 int len = XINT (Flength (list));
2128 if (len == 0) 2128 if (len == 0)
2129 RETURN_UNGCPRO (continuable_syntax_error 2129 RETURN_UNGCPRO (continuable_read_syntax_error
2130 ("structure type not specified")); 2130 ("structure type not specified"));
2131 if (!(len & 1)) 2131 if (!(len & 1))
2132 RETURN_UNGCPRO 2132 RETURN_UNGCPRO
2133 (continuable_syntax_error 2133 (continuable_read_syntax_error
2134 ("structures must have alternating keyword/value pairs")); 2134 ("structures must have alternating keyword/value pairs"));
2135 } 2135 }
2136 2136
2137 st = recognized_structure_type (XCAR (list)); 2137 st = recognized_structure_type (XCAR (list));
2138 if (!st) 2138 if (!st)
2694 #define TRAIL_INT 4 2694 #define TRAIL_INT 4
2695 #define E_CHAR 8 2695 #define E_CHAR 8
2696 #define EXP_INT 16 2696 #define EXP_INT 16
2697 2697
2698 int 2698 int
2699 isfloat_string (CONST char *cp) 2699 isfloat_string (const char *cp)
2700 { 2700 {
2701 int state = 0; 2701 int state = 0;
2702 CONST Bufbyte *ucp = (CONST Bufbyte *) cp; 2702 const Bufbyte *ucp = (const Bufbyte *) cp;
2703 2703
2704 if (*ucp == '+' || *ucp == '-') 2704 if (*ucp == '+' || *ucp == '-')
2705 ucp++; 2705 ucp++;
2706 2706
2707 if (*ucp >= '0' && *ucp <= '9') 2707 if (*ucp >= '0' && *ucp <= '9')
2765 return state; 2765 return state;
2766 else 2766 else
2767 unreadchar (readcharfun, ch); 2767 unreadchar (readcharfun, ch);
2768 #ifdef FEATUREP_SYNTAX 2768 #ifdef FEATUREP_SYNTAX
2769 if (ch == ']') 2769 if (ch == ']')
2770 syntax_error ("\"]\" in a list"); 2770 read_syntax_error ("\"]\" in a list");
2771 else if (ch == ')') 2771 else if (ch == ')')
2772 syntax_error ("\")\" in a vector"); 2772 read_syntax_error ("\")\" in a vector");
2773 #endif 2773 #endif
2774 state = ((conser) (readcharfun, state, len)); 2774 state = ((conser) (readcharfun, state, len));
2775 } 2775 }
2776 } 2776 }
2777 2777
2807 { 2807 {
2808 unreadchar (readcharfun, s->terminator); 2808 unreadchar (readcharfun, s->terminator);
2809 goto done; 2809 goto done;
2810 } 2810 }
2811 else if (ch == ']') 2811 else if (ch == ']')
2812 syntax_error ("']' in a list"); 2812 read_syntax_error ("']' in a list");
2813 else if (ch == ')') 2813 else if (ch == ')')
2814 syntax_error ("')' in a vector"); 2814 read_syntax_error ("')' in a vector");
2815 else 2815 else
2816 #endif 2816 #endif
2817 if (ch != '.') 2817 if (ch != '.')
2818 signal_simple_error ("BUG! Internal reader error", elt); 2818 signal_simple_error ("BUG! Internal reader error", elt);
2819 else if (!s->allow_dotted_lists) 2819 else if (!s->allow_dotted_lists)
2820 syntax_error ("\".\" in a vector"); 2820 read_syntax_error ("\".\" in a vector");
2821 else 2821 else
2822 { 2822 {
2823 if (!NILP (s->tail)) 2823 if (!NILP (s->tail))
2824 XCDR (s->tail) = read0 (readcharfun); 2824 XCDR (s->tail) = read0 (readcharfun);
2825 else 2825 else
2833 { 2833 {
2834 unreadchar (readcharfun, s->terminator); 2834 unreadchar (readcharfun, s->terminator);
2835 goto done; 2835 goto done;
2836 } 2836 }
2837 } 2837 }
2838 syntax_error (". in wrong context"); 2838 read_syntax_error (". in wrong context");
2839 } 2839 }
2840 } 2840 }
2841 2841
2842 #if 0 /* FSFmacs defun hack, or something ... */ 2842 #if 0 /* FSFmacs defun hack, or something ... */
2843 if (NILP (tail) && defun_hack && EQ (elt, Qdefun) && !read_pure) 2843 if (NILP (tail) && defun_hack && EQ (elt, Qdefun) && !read_pure)
3028 instructions and constants differently. */ 3028 instructions and constants differently. */
3029 stuff = read_list (readcharfun, terminator, 0, 0); 3029 stuff = read_list (readcharfun, terminator, 0, 0);
3030 len = XINT (Flength (stuff)); 3030 len = XINT (Flength (stuff));
3031 if (len < COMPILED_STACK_DEPTH + 1 || len > COMPILED_DOMAIN + 1) 3031 if (len < COMPILED_STACK_DEPTH + 1 || len > COMPILED_DOMAIN + 1)
3032 return 3032 return
3033 continuable_syntax_error ("#[...] used with wrong number of elements"); 3033 continuable_read_syntax_error ("#[...] used with wrong number of elements");
3034 3034
3035 for (iii = 0; CONSP (stuff); iii++) 3035 for (iii = 0; CONSP (stuff); iii++)
3036 { 3036 {
3037 Lisp_Cons *victim = XCONS (stuff); 3037 Lisp_Cons *victim = XCONS (stuff);
3038 make_byte_code_args[iii] = Fcar (stuff); 3038 make_byte_code_args[iii] = Fcar (stuff);