Mercurial > hg > xemacs-beta

comparison src/lread.c @ 1123:37bdd24225ef

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
[xemacs-hg @ 2002-11-27 07:15:02 by ben] bug fixes, profiling debugging improvements configure.in: Check for GCC version and only use -Wpacked in v3. .cvsignore: Add .idb, .ilk for MS Windows VC++. cl-macs.el: Document better. cmdloop.el: Removed. Remove nonworking breakpoint-on-error now that debug-on-error works as documented. help.el: Extract out with-displaying-help-buffer into a more general mechanism. lib-complete.el: Support thunks in find-library-source-path. startup.el: Don't catch errors when noninteractive, because that makes stack traces from stack-trace-on-error useless. .cvsignore: Windows shit. alloc.c: Better redisplay-related assert. elhash.c: Comment change. eval.c: Don't generate large warning strings (e.g. backtraces) when they will be discarded. Implement debug-on-error as documented -- it will enter the debugger and crash when an uncaught signal happens noninteractively and we are --debug. Better redisplay-related asserts. frame-msw.c, frame.c, lisp.h, redisplay.c, scrollbar-gtk.c, scrollbar-x.c, signal.c, sysdep.c: Fix up documentation related to QUIT (which CANNOT garbage-collect under any circumstances), and to redisplay critical sections. lread.c: Add load-ignore-out-of-date-elc-files, load-always-display-messages, load-show-full-path-in-messages for more robust package compilation and debugging. profile.c: Overhaul profile code. Change format to include call count and be extensible for further info. Remove call-count-profile-table. Add set-profiling-info. See related profile.el changes (which SHOULD ABSOLUTELY be in the core! Get rid of xemacs-devel and xemacs-base packages *yesterday*!).
author ben
date Wed, 27 Nov 2002 07:15:36 +0000
parents 8b464283e891
children 465bd3c7d932
comparison
equal deleted inserted replaced
1122:7abc2b15a990 1123:37bdd24225ef
87 int load_warn_when_source_newer; 87 int load_warn_when_source_newer;
88 /* Whether Fload_internal() should check whether the .elc doesn't exist */ 88 /* Whether Fload_internal() should check whether the .elc doesn't exist */
89 int load_warn_when_source_only; 89 int load_warn_when_source_only;
90 /* Whether Fload_internal() should ignore .elc files when no suffix is given */ 90 /* Whether Fload_internal() should ignore .elc files when no suffix is given */
91 int load_ignore_elc_files; 91 int load_ignore_elc_files;
92 /* Whether Fload_internal() should ignore out-of-date .elc files when no
93 suffix is given */
94 int load_ignore_out_of_date_elc_files;
95 /* Always display messages showing when a file is loaded, regardless of
96 whether the flag to `load' tries to suppress them. */
97 int load_always_display_messages;
98 /* Show the full path in loading messages. */
99 int load_show_full_path_in_messages;
92 100
93 /* Search path for files to be loaded. */ 101 /* Search path for files to be loaded. */
94 Lisp_Object Vload_path; 102 Lisp_Object Vload_path;
95 103
96 /* Search path for files when dumping. */ 104 /* Search path for files when dumping. */
197 static int saved_doc_string_length; 205 static int saved_doc_string_length;
198 /* This is the file position that string came from. */ 206 /* This is the file position that string came from. */
199 static int saved_doc_string_position; 207 static int saved_doc_string_position;
200 #endif 208 #endif
201 209
210 static int locate_file_open_or_access_file (Ibyte *fn, int access_mode);
202 EXFUN (Fread_from_string, 3); 211 EXFUN (Fread_from_string, 3);
203 212
204 /* When errors are signaled, the actual readcharfun should not be used 213 /* When errors are signaled, the actual readcharfun should not be used
205 as an argument if it is an lstream, so that lstreams don't escape 214 as an argument if it is an lstream, so that lstreams don't escape
206 to the Lisp level. */ 215 to the Lisp level. */
480 { 489 {
481 /* This function can GC */ 490 /* This function can GC */
482 int fd = -1; 491 int fd = -1;
483 int speccount = specpdl_depth (); 492 int speccount = specpdl_depth ();
484 int source_only = 0; 493 int source_only = 0;
494 /* NEWER and OLDER are filenames w/o directory, used in loading messages
495 to e.g. warn of newer .el files when the .elc is being loaded. */
485 Lisp_Object newer = Qnil; 496 Lisp_Object newer = Qnil;
497 Lisp_Object older = Qnil;
486 Lisp_Object handler = Qnil; 498 Lisp_Object handler = Qnil;
487 Lisp_Object found = Qnil; 499 Lisp_Object found = Qnil;
488 struct gcpro gcpro1, gcpro2, gcpro3; 500 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
489 int reading_elc = 0; 501 int reading_elc = 0;
490 int from_require = EQ (nomessage, Qrequire); 502 int from_require = EQ (nomessage, Qrequire);
491 int message_p = NILP (nomessage) || from_require; 503 int message_p =
504 NILP (nomessage) || from_require || load_always_display_messages;
492 /*#ifdef DEBUG_XEMACS*/ 505 /*#ifdef DEBUG_XEMACS*/
493 static Lisp_Object last_file_loaded; 506 static Lisp_Object last_file_loaded;
494 /*#endif*/ 507 /*#endif*/
495 struct stat s1, s2; 508 struct stat s1, s2;
496 GCPRO3 (file, newer, found); 509 GCPRO4 (file, newer, older, found);
497 510
498 CHECK_STRING (file); 511 CHECK_STRING (file);
499 512
500 /*#ifdef DEBUG_XEMACS*/ 513 /*#ifdef DEBUG_XEMACS*/
501 if (purify_flag && noninteractive) 514 if (purify_flag && noninteractive)
549 foundlen = qxestrlen (foundstr); 562 foundlen = qxestrlen (foundstr);
550 563
551 /* The omniscient JWZ thinks this is worthless, but I beg to 564 /* The omniscient JWZ thinks this is worthless, but I beg to
552 differ. --ben */ 565 differ. --ben */
553 if (load_ignore_elc_files) 566 if (load_ignore_elc_files)
554 { 567 newer = Ffile_name_nondirectory (found);
555 newer = Ffile_name_nondirectory (found); 568 else if ((load_warn_when_source_newer ||
556 } 569 load_ignore_out_of_date_elc_files) &&
557 else if (load_warn_when_source_newer &&
558 !memcmp (".elc", foundstr + foundlen - 4, 4)) 570 !memcmp (".elc", foundstr + foundlen - 4, 4))
559 { 571 {
560 if (! qxe_fstat (fd, &s1)) /* can't fail, right? */ 572 if (! qxe_fstat (fd, &s1)) /* can't fail, right? */
561 { 573 {
562 int result; 574 int result;
563 /* temporarily hack the 'c' off the end of the filename */ 575 /* temporarily hack the 'c' off the end of the filename */
564 foundstr[foundlen - 1] = '\0'; 576 foundstr[foundlen - 1] = '\0';
565 result = qxe_stat (foundstr, &s2); 577 result = qxe_stat (foundstr, &s2);
566 if (result >= 0 && 578 if (result >= 0 &&
567 (unsigned) s1.st_mtime < (unsigned) s2.st_mtime) 579 (unsigned) s1.st_mtime < (unsigned) s2.st_mtime)
568 { 580 {
569 Lisp_Object newer_name = make_string (foundstr, 581 /* .elc exists and is out-of-date wrt .el */
570 foundlen - 1); 582 Lisp_Object el_name = make_string (foundstr, foundlen - 1);
571 struct gcpro nngcpro1; 583 struct gcpro nngcpro1;
572 NNGCPRO1 (newer_name); 584 NNGCPRO1 (el_name);
573 newer = Ffile_name_nondirectory (newer_name); 585 newer = Ffile_name_nondirectory (el_name);
574 NNUNGCPRO; 586 if (load_ignore_out_of_date_elc_files)
575 } 587 {
588 int newfd =
589 locate_file_open_or_access_file
590 (XSTRING_DATA (el_name), -1);
591
592 if (newfd >= 0)
593 {
594 older = Ffile_name_nondirectory (found);
595 found = el_name;
596 retry_close (fd);
597 fd = newfd;
598 }
599 }
600 NNUNGCPRO;
601 }
576 /* put the 'c' back on (kludge-o-rama) */ 602 /* put the 'c' back on (kludge-o-rama) */
577 foundstr[foundlen - 1] = 'c'; 603 foundstr[foundlen - 1] = 'c';
578 } 604 }
579 } 605 }
580 else if (load_warn_when_source_only && 606 else if (load_warn_when_source_only &&
582 !memcmp (".el", foundstr + foundlen - 3, 3) && 608 !memcmp (".el", foundstr + foundlen - 3, 3) &&
583 /* `file' does not end in ".el" */ 609 /* `file' does not end in ".el" */
584 memcmp (".el", 610 memcmp (".el",
585 XSTRING_DATA (file) + XSTRING_LENGTH (file) - 3, 611 XSTRING_DATA (file) + XSTRING_LENGTH (file) - 3,
586 3)) 612 3))
587 { 613 source_only = 1;
588 source_only = 1;
589 }
590 614
591 if (!memcmp (".elc", foundstr + foundlen - 4, 4)) 615 if (!memcmp (".elc", foundstr + foundlen - 4, 4))
592 reading_elc = 1; 616 reading_elc = 1;
593 } 617 }
594 618
595 #define PRINT_LOADING_MESSAGE_1(loading, done) do { \ 619 #define PRINT_LOADING_MESSAGE_1(loading, done) \
596 if (load_ignore_elc_files) \ 620 do { \
597 { \ 621 if (load_ignore_elc_files) \
598 if (message_p) \ 622 { \
599 message (loading done, XSTRING_DATA (newer)); \ 623 if (message_p) \
600 } \ 624 message (loading done, \
601 else if (!NILP (newer)) \ 625 XSTRING_DATA (load_show_full_path_in_messages ? \
602 message (loading done " (file %s is newer)", \ 626 found : newer)); \
603 XSTRING_DATA (file), \ 627 } \
604 XSTRING_DATA (newer)); \ 628 else if (!NILP (older)) \
605 else if (source_only) \ 629 { \
606 message (loading done " (file %s.elc does not exist)", \ 630 assert (load_ignore_out_of_date_elc_files); \
607 XSTRING_DATA (file), \ 631 message (loading done " (file %s is out-of-date)", \
608 XSTRING_DATA (Ffile_name_nondirectory (file))); \ 632 XSTRING_DATA (load_show_full_path_in_messages ? \
609 else if (message_p) \ 633 found : newer), \
610 message (loading done, XSTRING_DATA (file)); \ 634 XSTRING_DATA (older)); \
635 } \
636 else if (!NILP (newer)) \
637 message (loading done " (file %s is newer)", \
638 XSTRING_DATA (load_show_full_path_in_messages ? \
639 found : file), \
640 XSTRING_DATA (newer)); \
641 else if (source_only) \
642 message (loading done " (file %s.elc does not exist)", \
643 XSTRING_DATA (load_show_full_path_in_messages ? \
644 found : file), \
645 XSTRING_DATA (Ffile_name_nondirectory (file))); \
646 else if (message_p) \
647 message (loading done, \
648 XSTRING_DATA (load_show_full_path_in_messages ? \
649 found : file)); \
611 } while (0) 650 } while (0)
612 651
613 #define PRINT_LOADING_MESSAGE(done) \ 652 #define PRINT_LOADING_MESSAGE(done) \
614 do { \ 653 do { \
615 if (from_require) \ 654 if (from_require) \
692 /* #### An even more disgusting kludge. There is horrible code */ 731 /* #### An even more disgusting kludge. There is horrible code */
693 /* that is relying on the fact that dumped lisp files are found */ 732 /* that is relying on the fact that dumped lisp files are found */
694 /* via `load-path' search. */ 733 /* via `load-path' search. */
695 Lisp_Object name = file; 734 Lisp_Object name = file;
696 735
697 if (!NILP(Ffile_name_absolute_p(file))) 736 if (!NILP (Ffile_name_absolute_p (file)))
698 { 737 name = Ffile_name_nondirectory (file);
699 name = Ffile_name_nondirectory(file);
700 }
701 738
702 { 739 {
703 struct gcpro ngcpro1; 740 struct gcpro ngcpro1;
704 741
705 NGCPRO1 (name); 742 NGCPRO1 (name);
716 Feval (tem); 753 Feval (tem);
717 NUNGCPRO; 754 NUNGCPRO;
718 } 755 }
719 } 756 }
720 757
721 /*#ifdef DEBUG_XEMACS*/ 758 /* #ifdef DEBUG_XEMACS */
722 if (purify_flag && noninteractive) 759 if (purify_flag && noninteractive)
723 { 760 {
724 if (!EQ (last_file_loaded, file)) 761 if (!EQ (last_file_loaded, file))
725 message ("Loading %s ...done", XSTRING_DATA (file)); 762 message ("Loading %s ...done", XSTRING_DATA (file));
726 } 763 }
727 /*#endif / * DEBUG_XEMACS */ 764 /* #endif / * DEBUG_XEMACS */
728 765
729 if (!noninteractive) 766 if (!noninteractive)
730 PRINT_LOADING_MESSAGE ("done"); 767 PRINT_LOADING_MESSAGE ("done");
731 768
732 UNGCPRO; 769 UNGCPRO;
946 int fd; 983 int fd;
947 Lisp_Object *storeptr; 984 Lisp_Object *storeptr;
948 int mode; 985 int mode;
949 }; 986 };
950 987
988 /* open() or access() a file to be returned by locate_file(). if
989 ACCESS_MODE >= 0, do an access() with that mode, else open(). Does
990 various magic, e.g. opening the file read-only and binary and setting
991 the close-on-exec flag on the file. */
992
993 static int
994 locate_file_open_or_access_file (Ibyte *fn, int access_mode)
995 {
996 int val;
997
998 /* Check that we can access or open it. */
999 if (access_mode >= 0)
1000 val = qxe_access (fn, access_mode);
1001 else
1002 {
1003 val = qxe_open (fn, O_RDONLY | OPEN_BINARY, 0);
1004
1005 #ifndef WIN32_NATIVE
1006 if (val >= 0)
1007 /* If we actually opened the file, set close-on-exec flag
1008 on the new descriptor so that subprocesses can't whack
1009 at it. */
1010 (void) fcntl (val, F_SETFD, FD_CLOEXEC);
1011 #endif
1012 }
1013
1014 return val;
1015 }
1016
951 static int 1017 static int
952 locate_file_in_directory_mapper (Ibyte *fn, void *arg) 1018 locate_file_in_directory_mapper (Ibyte *fn, void *arg)
953 { 1019 {
954 struct locate_file_in_directory_mapper_closure *closure = 1020 struct locate_file_in_directory_mapper_closure *closure =
955 (struct locate_file_in_directory_mapper_closure *) arg; 1021 (struct locate_file_in_directory_mapper_closure *) arg;
958 /* Ignore file if it's a directory. */ 1024 /* Ignore file if it's a directory. */
959 if (qxe_stat (fn, &st) >= 0 1025 if (qxe_stat (fn, &st) >= 0
960 && (st.st_mode & S_IFMT) != S_IFDIR) 1026 && (st.st_mode & S_IFMT) != S_IFDIR)
961 { 1027 {
962 /* Check that we can access or open it. */ 1028 /* Check that we can access or open it. */
963 if (closure->mode >= 0) 1029 closure->fd = locate_file_open_or_access_file (fn, closure->mode);
964 closure->fd = qxe_access (fn, closure->mode);
965 else
966 closure->fd = qxe_open (fn, O_RDONLY | OPEN_BINARY, 0);
967 1030
968 if (closure->fd >= 0) 1031 if (closure->fd >= 0)
969 { 1032 {
970 /* We succeeded; return this descriptor and filename. */ 1033 /* We succeeded; return this descriptor and filename. */
971 if (closure->storeptr) 1034 if (closure->storeptr)
972 *closure->storeptr = build_intstring (fn); 1035 *closure->storeptr = build_intstring (fn);
973
974 #ifndef WIN32_NATIVE
975 /* If we actually opened the file, set close-on-exec flag
976 on the new descriptor so that subprocesses can't whack
977 at it. */
978 if (closure->mode < 0)
979 (void) fcntl (closure->fd, F_SETFD, FD_CLOEXEC);
980 #endif
981 1036
982 return 1; 1037 return 1;
983 } 1038 }
984 } 1039 }
985 /* Keep mapping. */ 1040 /* Keep mapping. */
3076 *Whether `load' should ignore `.elc' files when a suffix is not given. 3131 *Whether `load' should ignore `.elc' files when a suffix is not given.
3077 This is normally used only to bootstrap the `.elc' files when building XEmacs. 3132 This is normally used only to bootstrap the `.elc' files when building XEmacs.
3078 */ ); 3133 */ );
3079 load_ignore_elc_files = 0; 3134 load_ignore_elc_files = 0;
3080 3135
3136 DEFVAR_BOOL ("load-ignore-out-of-date-elc-files",
3137 &load_ignore_out_of_date_elc_files /*
3138 *Whether `load' should ignore out-of-date `.elc' files when no suffix is given.
3139 This is normally used when compiling packages of elisp files that may have
3140 complex dependencies. Ignoring all elc files with `load-ignore-elc-files'
3141 would also be safe, but much slower.
3142 */ );
3143 load_ignore_out_of_date_elc_files = 0;
3144
3145 DEFVAR_BOOL ("load-always-display-messages",
3146 &load_always_display_messages /*
3147 *Whether `load' should always display loading messages.
3148 If this is true, every file loaded will be shown, regardless of the setting
3149 of the NOMESSAGE parameter, and even when files are loaded indirectly, e.g.
3150 due to `requre'.
3151 */ );
3152 load_always_display_messages = 0;
3153
3154 DEFVAR_BOOL ("load-show-full-path-in-messages",
3155 &load_show_full_path_in_messages /*
3156 *Whether `load' should show the full path in all loading messages.
3157 */ );
3158 load_show_full_path_in_messages = 0;
3159
3081 #ifdef LOADHIST 3160 #ifdef LOADHIST
3082 DEFVAR_LISP ("load-history", &Vload_history /* 3161 DEFVAR_LISP ("load-history", &Vload_history /*
3083 Alist mapping source file names to symbols and features. 3162 Alist mapping source file names to symbols and features.
3084 Each alist element is a list that starts with a file name, 3163 Each alist element is a list that starts with a file name,
3085 except for one element (optional) that starts with nil and describes 3164 except for one element (optional) that starts with nil and describes