Mercurial > hg > xemacs-beta

comparison src/lread.c @ 380:8626e4521993 r21-2-5

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r21-2-5
author cvs
date Mon, 13 Aug 2007 11:07:10 +0200
parents 6240c7796c7a
children 74fd4e045ea6
comparison
equal deleted inserted replaced
379:76b7d63099ad 380:8626e4521993
27 #include <config.h> 27 #include <config.h>
28 #include "lisp.h" 28 #include "lisp.h"
29 29
30 #include "buffer.h" 30 #include "buffer.h"
31 #include "bytecode.h" 31 #include "bytecode.h"
32 #include "commands.h" 32 #include "elhash.h"
33 #include "insdel.h"
34 #include "lstream.h" 33 #include "lstream.h"
35 #include "opaque.h" 34 #include "opaque.h"
36 #include <paths.h>
37 #ifdef FILE_CODING 35 #ifdef FILE_CODING
38 #include "file-coding.h" 36 #include "file-coding.h"
39 #endif 37 #endif
40 38
41 #include "sysfile.h" 39 #include "sysfile.h"
399 /* We don't check for `eq', `equal', and the others that have 397 /* We don't check for `eq', `equal', and the others that have
400 bytecode opcodes. This might lose if someone passes #'eq or 398 bytecode opcodes. This might lose if someone passes #'eq or
401 something to `funcall', but who would really do that? As 399 something to `funcall', but who would really do that? As
402 they say in law, we've made a "good-faith effort" to 400 they say in law, we've made a "good-faith effort" to
403 unfuckify ourselves. And doing it this way avoids screwing 401 unfuckify ourselves. And doing it this way avoids screwing
404 up args to `make-hashtable' and such. As it is, we have to 402 up args to `make-hash-table' and such. As it is, we have to
405 add an extra Ebola check in decode_weak_list_type(). --ben */ 403 add an extra Ebola check in decode_weak_list_type(). --ben */
406 if (EQ (el, Qassoc)) 404 if (EQ (el, Qassoc)) el = Qold_assoc;
407 el = Qold_assoc; 405 else if (EQ (el, Qdelq)) el = Qold_delq;
408 if (EQ (el, Qdelq))
409 el = Qold_delq;
410 #if 0 406 #if 0
411 /* I think this is a bad idea because it will probably mess 407 /* I think this is a bad idea because it will probably mess
412 with keymap code. */ 408 with keymap code. */
413 if (EQ (el, Qdelete)) 409 else if (EQ (el, Qdelete)) el = Qold_delete;
414 el = Qold_delete; 410 #endif
415 #endif 411 else if (EQ (el, Qrassq)) el = Qold_rassq;
416 if (EQ (el, Qrassq)) 412 else if (EQ (el, Qrassoc)) el = Qold_rassoc;
417 el = Qold_rassq; 413
418 if (EQ (el, Qrassoc))
419 el = Qold_rassoc;
420 XVECTOR_DATA (vector)[i] = el; 414 XVECTOR_DATA (vector)[i] = el;
421 } 415 }
422 } 416 }
423 417
424 static Lisp_Object 418 static Lisp_Object
468 else 462 else
469 { 463 {
470 Lisp_Object doc; 464 Lisp_Object doc;
471 465
472 assert (COMPILED_FUNCTIONP (john)); 466 assert (COMPILED_FUNCTIONP (john));
473 if (CONSP (XCOMPILED_FUNCTION (john)->bytecodes)) 467 if (CONSP (XCOMPILED_FUNCTION (john)->instructions))
474 { 468 {
475 struct gcpro ngcpro1; 469 struct gcpro ngcpro1;
476 Lisp_Object juan = (pas_de_lache_ici 470 Lisp_Object juan = (pas_de_lache_ici
477 (fd, XCOMPILED_FUNCTION (john)->bytecodes)); 471 (fd, XCOMPILED_FUNCTION (john)->instructions));
478 Lisp_Object ivan; 472 Lisp_Object ivan;
479 473
480 NGCPRO1 (juan); 474 NGCPRO1 (juan);
481 ivan = Fread (juan); 475 ivan = Fread (juan);
482 if (!CONSP (ivan)) 476 if (!CONSP (ivan))
483 signal_simple_error ("invalid lazy-loaded byte code", ivan); 477 signal_simple_error ("invalid lazy-loaded byte code", ivan);
484 /* Remember to purecopy; see above. */ 478 /* Remember to purecopy; see above. */
485 XCOMPILED_FUNCTION (john)->bytecodes = Fpurecopy (XCAR (ivan)); 479 XCOMPILED_FUNCTION (john)->instructions = Fpurecopy (XCAR (ivan));
486 /* v18 or v19 bytecode file. Need to Ebolify. */ 480 /* v18 or v19 bytecode file. Need to Ebolify. */
487 if (XCOMPILED_FUNCTION (john)->flags.ebolified 481 if (XCOMPILED_FUNCTION (john)->flags.ebolified
488 && VECTORP (XCDR (ivan))) 482 && VECTORP (XCDR (ivan)))
489 ebolify_bytecode_constants (XCDR (ivan)); 483 ebolify_bytecode_constants (XCDR (ivan));
490 XCOMPILED_FUNCTION (john)->constants = Fpurecopy (XCDR (ivan)); 484 XCOMPILED_FUNCTION (john)->constants = Fpurecopy (XCDR (ivan));
791 785
792 /*#ifdef DEBUG_XEMACS*/ 786 /*#ifdef DEBUG_XEMACS*/
793 if (purify_flag && noninteractive) 787 if (purify_flag && noninteractive)
794 { 788 {
795 if (EQ (last_file_loaded, file)) 789 if (EQ (last_file_loaded, file))
796 message_append (" (%ld)", 790 message_append (" (%ld)",
797 (unsigned long) (purespace_usage() - pure_usage)); 791 (unsigned long) (purespace_usage() - pure_usage));
798 else 792 else
799 message ("Loading %s ...done (%ld)", XSTRING_DATA (file), 793 message ("Loading %s ...done (%ld)", XSTRING_DATA (file),
800 (unsigned long) (purespace_usage() - pure_usage)); 794 (unsigned long) (purespace_usage() - pure_usage));
801 } 795 }
846 if (!NILP (suffixes)) 840 if (!NILP (suffixes))
847 CHECK_STRING (suffixes); 841 CHECK_STRING (suffixes);
848 if (!NILP (mode)) 842 if (!NILP (mode))
849 CHECK_NATNUM (mode); 843 CHECK_NATNUM (mode);
850 844
851 locate_file (path_list, filename, 845 locate_file (path_list,
852 ((NILP (suffixes)) ? "" : 846 filename,
853 (char *) (XSTRING_DATA (suffixes))), 847 NILP (suffixes) ? "" : (char *) XSTRING_DATA (suffixes),
854 &tp, (NILP (mode) ? R_OK : XINT (mode))); 848 &tp,
849 NILP (mode) ? R_OK : XINT (mode));
855 return tp; 850 return tp;
856 } 851 }
857 852
858 /* recalculate the hash table for the given string */ 853 /* recalculate the hash table for the given string */
859 854
860 static Lisp_Object 855 static Lisp_Object
861 locate_file_refresh_hashing (Lisp_Object str) 856 locate_file_refresh_hashing (Lisp_Object str)
862 { 857 {
863 Lisp_Object hash = 858 Lisp_Object hash = make_directory_hash_table ((char *) XSTRING_DATA (str));
864 make_directory_hash_table ((char *) XSTRING_DATA (str));
865 Fput (str, Qlocate_file_hash_table, hash); 859 Fput (str, Qlocate_file_hash_table, hash);
866 return hash; 860 return hash;
867 } 861 }
868 862
869 /* find the hash table for the given string, recalculating if necessary */ 863 /* find the hash table for the given string, recalculating if necessary */
870 864
871 static Lisp_Object 865 static Lisp_Object
872 locate_file_find_directory_hash_table (Lisp_Object str) 866 locate_file_find_directory_hash_table (Lisp_Object str)
873 { 867 {
874 Lisp_Object hash = Fget (str, Qlocate_file_hash_table, Qnil); 868 Lisp_Object hash = Fget (str, Qlocate_file_hash_table, Qnil);
875 if (NILP (Fhashtablep (hash))) 869 if (! HASH_TABLEP (hash))
876 return locate_file_refresh_hashing (str); 870 return locate_file_refresh_hashing (str);
877 return hash; 871 return hash;
878 } 872 }
879 873
880 /* look for STR in PATH, optionally adding suffixes in SUFFIX */ 874 /* look for STR in PATH, optionally adding suffixes in SUFFIX */
902 /* If there are non-absolute elts in PATH (eg ".") */ 896 /* If there are non-absolute elts in PATH (eg ".") */
903 /* Of course, this could conceivably lose if luser sets 897 /* Of course, this could conceivably lose if luser sets
904 default-directory to be something non-absolute ... */ 898 default-directory to be something non-absolute ... */
905 { 899 {
906 if (NILP (filename)) 900 if (NILP (filename))
907 /* NIL means current dirctory */ 901 /* NIL means current directory */
908 filename = current_buffer->directory; 902 filename = current_buffer->directory;
909 else 903 else
910 filename = Fexpand_file_name (filename, 904 filename = Fexpand_file_name (filename,
911 current_buffer->directory); 905 current_buffer->directory);
912 if (NILP (Ffile_name_absolute_p (filename))) 906 if (NILP (Ffile_name_absolute_p (filename)))
1117 suffixtab = locate_file_construct_suffixed_files (str, suffix); 1111 suffixtab = locate_file_construct_suffixed_files (str, suffix);
1118 1112
1119 for (pathtail = path; !NILP (pathtail); pathtail = Fcdr (pathtail)) 1113 for (pathtail = path; !NILP (pathtail); pathtail = Fcdr (pathtail))
1120 { 1114 {
1121 Lisp_Object pathel = Fcar (pathtail); 1115 Lisp_Object pathel = Fcar (pathtail);
1122 Lisp_Object hashtab; 1116 Lisp_Object hash_table;
1123 Lisp_Object tail; 1117 Lisp_Object tail;
1124 int found; 1118 int found;
1125 1119
1126 /* If this path element is relative, we have to look by hand. 1120 /* If this path element is relative, we have to look by hand.
1127 Can't set string property in a pure string. */ 1121 Can't set string property in a pure string. */
1136 return val; 1130 return val;
1137 } 1131 }
1138 continue; 1132 continue;
1139 } 1133 }
1140 1134
1141 hashtab = locate_file_find_directory_hash_table (pathel); 1135 hash_table = locate_file_find_directory_hash_table (pathel);
1142 1136
1143 /* Loop over suffixes. */ 1137 /* Loop over suffixes. */
1144 for (tail = suffixtab, found = 0; !found && CONSP (tail); 1138 for (tail = suffixtab, found = 0; !found && CONSP (tail);
1145 tail = XCDR (tail)) 1139 tail = XCDR (tail))
1146 { 1140 {
1147 if (!NILP (Fgethash (XCAR (tail), hashtab, Qnil))) 1141 if (!NILP (Fgethash (XCAR (tail), hash_table, Qnil)))
1148 found = 1; 1142 found = 1;
1149 } 1143 }
1150 1144
1151 if (found) 1145 if (found)
1152 { 1146 {
1272 Lisp_Object (*evalfun) (Lisp_Object), 1266 Lisp_Object (*evalfun) (Lisp_Object),
1273 int printflag) 1267 int printflag)
1274 { 1268 {
1275 /* This function can GC */ 1269 /* This function can GC */
1276 REGISTER Emchar c; 1270 REGISTER Emchar c;
1277 REGISTER Lisp_Object val; 1271 REGISTER Lisp_Object val = Qnil;
1278 int speccount = specpdl_depth (); 1272 int speccount = specpdl_depth ();
1279 struct gcpro gcpro1; 1273 struct gcpro gcpro1, gcpro2;
1280 struct buffer *b = 0; 1274 struct buffer *b = 0;
1281 1275
1282 if (BUFFERP (readcharfun)) 1276 if (BUFFERP (readcharfun))
1283 b = XBUFFER (readcharfun); 1277 b = XBUFFER (readcharfun);
1284 else if (MARKERP (readcharfun)) 1278 else if (MARKERP (readcharfun))
1291 specbind (Qcurrent_load_list, Qnil); 1285 specbind (Qcurrent_load_list, Qnil);
1292 1286
1293 #ifdef COMPILED_FUNCTION_ANNOTATION_HACK 1287 #ifdef COMPILED_FUNCTION_ANNOTATION_HACK
1294 Vcurrent_compiled_function_annotation = Qnil; 1288 Vcurrent_compiled_function_annotation = Qnil;
1295 #endif 1289 #endif
1296 GCPRO1 (sourcename); 1290 GCPRO2 (val, sourcename);
1297 1291
1298 LOADHIST_ATTACH (sourcename); 1292 LOADHIST_ATTACH (sourcename);
1299 1293
1300 while (1) 1294 while (1)
1301 { 1295 {
2399 2393
2400 fexp = read0(readcharfun); 2394 fexp = read0(readcharfun);
2401 obj = read0(readcharfun); 2395 obj = read0(readcharfun);
2402 2396
2403 /* the call to `featurep' may GC. */ 2397 /* the call to `featurep' may GC. */
2404 GCPRO2(fexp, obj); 2398 GCPRO2 (fexp, obj);
2405 tem = call1(Qfeaturep, fexp); 2399 tem = call1 (Qfeaturep, fexp);
2406 UNGCPRO; 2400 UNGCPRO;
2407 2401
2408 if (c == '+' && NILP(tem)) goto retry; 2402 if (c == '+' && NILP(tem)) goto retry;
2409 if (c == '-' && !NILP(tem)) goto retry; 2403 if (c == '-' && !NILP(tem)) goto retry;
2410 return obj; 2404 return obj;
2411 } 2405 }
2412 #endif 2406 #endif
2413 case '0': case '1': case '2': case '3': case '4': 2407 case '0': case '1': case '2': case '3': case '4':
2989 init_lread (void) 2983 init_lread (void)
2990 { 2984 {
2991 Vvalues = Qnil; 2985 Vvalues = Qnil;
2992 2986
2993 load_in_progress = 0; 2987 load_in_progress = 0;
2994 2988
2995 Vload_descriptor_list = Qnil; 2989 Vload_descriptor_list = Qnil;
2996 2990
2997 /* kludge: locate-file does not work for a null load-path, even if 2991 /* kludge: locate-file does not work for a null load-path, even if
2998 the file name is absolute. */ 2992 the file name is absolute. */
2999 2993