Mercurial > hg > xemacs-beta

comparison src/lread.c @ 265:8efd647ea9ca r20-5b31

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-5b31
author cvs
date Mon, 13 Aug 2007 10:25:37 +0200
parents 11cf20601dec
children 966663fcf606
comparison
equal deleted inserted replaced
264:682d2a9d41a5 265:8efd647ea9ca
205 static int saved_doc_string_length; 205 static int saved_doc_string_length;
206 /* This is the file position that string came from. */ 206 /* This is the file position that string came from. */
207 static int saved_doc_string_position; 207 static int saved_doc_string_position;
208 #endif 208 #endif
209 209
210 /* When errors are signaled, the actual readcharfun should not be used
211 as an argument if it is an lstream, so that lstreams don't escape
212 to the Lisp level. */
213 #define READCHARFUN_MAYBE(x) (LSTREAMP (x) \
214 ? (build_string ("internal input stream")) \
215 : (x))
210 216
211 217
212 static DOESNT_RETURN 218 static DOESNT_RETURN
213 syntax_error (CONST char *string) 219 syntax_error (CONST char *string)
214 { 220 {
567 int message_p = NILP (nomessage); 573 int message_p = NILP (nomessage);
568 /*#ifdef DEBUG_XEMACS*/ 574 /*#ifdef DEBUG_XEMACS*/
569 static Lisp_Object last_file_loaded; 575 static Lisp_Object last_file_loaded;
570 int pure_usage = 0; 576 int pure_usage = 0;
571 /*#endif*/ 577 /*#endif*/
572 #ifdef DOS_NT
573 int dosmode = O_TEXT;
574 #endif /* DOS_NT */
575 struct stat s1, s2; 578 struct stat s1, s2;
576 GCPRO3 (file, newer, found); 579 GCPRO3 (file, newer, found);
577 580
578 CHECK_STRING (file); 581 CHECK_STRING (file);
579 582
671 source_only = 1; 674 source_only = 1;
672 } 675 }
673 676
674 if (!memcmp (".elc", foundstr + foundlen - 4, 4)) 677 if (!memcmp (".elc", foundstr + foundlen - 4, 4))
675 reading_elc = 1; 678 reading_elc = 1;
676
677 #ifdef DOS_NT
678 /* The file was opened as binary, because that's what we'll
679 encounter most of the time. If we're loading a .el, we need
680 to reopen it in text mode. */
681 if (!reading_elc)
682 {
683 /* #### I would simply call _setmode (fd, O_RDONLY | O_TEXT).
684 This is ok on NT but maybe breaks DOS. Is there
685 any "DOS" still alive? - kkm */
686 close (fd);
687 fd = open (foundstr, O_RDONLY | O_TEXT);
688 if (fd < 0)
689 {
690 if (NILP (no_error))
691 signal_file_error ("Cannot open load file", file);
692 else
693 {
694 UNGCPRO;
695 return Qnil;
696 }
697 }
698 }
699 #endif /* DOS_NT */
700 } 679 }
701 680
702 #define PRINT_LOADING_MESSAGE(done) do { \ 681 #define PRINT_LOADING_MESSAGE(done) do { \
703 if (load_ignore_elc_files) \ 682 if (load_ignore_elc_files) \
704 { \ 683 { \
978 { 957 {
979 /* Check that we can access or open it. */ 958 /* Check that we can access or open it. */
980 if (mode >= 0) 959 if (mode >= 0)
981 fd = access (fn, mode); 960 fd = access (fn, mode);
982 else 961 else
983 #ifdef DOS_NT
984 fd = open (fn, O_RDONLY | O_BINARY, 0);
985 #else
986 fd = open (fn, O_RDONLY | OPEN_BINARY, 0); 962 fd = open (fn, O_RDONLY | OPEN_BINARY, 0);
987 #endif
988 963
989 if (fd >= 0) 964 if (fd >= 0)
990 { 965 {
991 /* We succeeded; return this descriptor and filename. */ 966 /* We succeeded; return this descriptor and filename. */
992 if (storeptr) 967 if (storeptr)
993 *storeptr = build_string (fn); 968 *storeptr = build_string (fn);
994 UNGCPRO; 969 UNGCPRO;
995 970
996 /* XXX FIX ME 971 #ifndef WINDOWSNT
997 Not sure about this on NT yet. Do nothing for now.
998 --marcpa */
999 #ifndef DOS_NT
1000 /* If we actually opened the file, set close-on-exec flag 972 /* If we actually opened the file, set close-on-exec flag
1001 on the new descriptor so that subprocesses can't whack 973 on the new descriptor so that subprocesses can't whack
1002 at it. */ 974 at it. */
1003 if (mode < 0) 975 if (mode < 0)
1004 (void) fcntl (fd, F_SETFD, FD_CLOEXEC); 976 (void) fcntl (fd, F_SETFD, FD_CLOEXEC);
1906 if (num < onum) 1878 if (num < onum)
1907 goto overflow; 1879 goto overflow;
1908 } 1880 }
1909 1881
1910 { 1882 {
1911 Lisp_Object result = make_int ((negativland) ? -num : num); 1883 int int_result = negativland ? -(int)num : (int)num;
1884 Lisp_Object result = make_int (int_result);
1912 if (num && ((XINT (result) < 0) != negativland)) 1885 if (num && ((XINT (result) < 0) != negativland))
1913 goto overflow; 1886 goto overflow;
1914 if (XINT (result) != ((negativland) ? -num : num)) 1887 if (XINT (result) != int_result)
1915 goto overflow; 1888 goto overflow;
1916 return result; 1889 return result;
1917 } 1890 }
1918 overflow: 1891 overflow:
1919 return Fsignal (Qinvalid_read_syntax, 1892 return Fsignal (Qinvalid_read_syntax,
2115 2088
2116 retry: 2089 retry:
2117 QUIT; 2090 QUIT;
2118 c = readchar (readcharfun); 2091 c = readchar (readcharfun);
2119 if (c < 0) 2092 if (c < 0)
2120 { 2093 signal_error (Qend_of_file, list1 (READCHARFUN_MAYBE (readcharfun)));
2121 if (LSTREAMP (readcharfun))
2122 signal_error (Qend_of_file,
2123 list1 (build_string ("internal input stream")));
2124 else
2125 signal_error (Qend_of_file, list1 (readcharfun));
2126 }
2127 2094
2128 switch (c) 2095 switch (c)
2129 { 2096 {
2130 default: 2097 default:
2131 { 2098 {
2535 case '?': 2502 case '?':
2536 { 2503 {
2537 /* Evil GNU Emacs "character" (ie integer) syntax */ 2504 /* Evil GNU Emacs "character" (ie integer) syntax */
2538 c = readchar (readcharfun); 2505 c = readchar (readcharfun);
2539 if (c < 0) 2506 if (c < 0)
2540 return Fsignal (Qend_of_file, list1 (readcharfun)); 2507 return Fsignal (Qend_of_file, list1 (READCHARFUN_MAYBE (readcharfun)));
2541 2508
2542 if (c == '\\') 2509 if (c == '\\')
2543 c = read_escape (readcharfun); 2510 c = read_escape (readcharfun);
2544 return make_char (c); 2511 return make_char (c);
2545 } 2512 }
2571 else 2538 else
2572 Lstream_put_emchar (XLSTREAM (Vread_buffer_stream), c); 2539 Lstream_put_emchar (XLSTREAM (Vread_buffer_stream), c);
2573 QUIT; 2540 QUIT;
2574 } 2541 }
2575 if (c < 0) 2542 if (c < 0)
2576 return Fsignal (Qend_of_file, list1 (readcharfun)); 2543 return Fsignal (Qend_of_file, list1 (READCHARFUN_MAYBE (readcharfun)));
2577 2544
2578 /* If purifying, and string starts with \ newline, 2545 /* If purifying, and string starts with \ newline,
2579 return zero instead. This is for doc strings 2546 return zero instead. This is for doc strings
2580 that we are really going to find in lib-src/DOC.nn.nn */ 2547 that we are really going to find in lib-src/DOC.nn.nn */
2581 if (purify_flag && NILP (Vdoc_file_name) && cancel) 2548 if (purify_flag && NILP (Vdoc_file_name) && cancel)