comparison src/lread.c @ 424:11054d720c21 r21-2-20

Import from CVS: tag r21-2-20
author cvs
date Mon, 13 Aug 2007 11:26:11 +0200
parents 697ef44129c6
children
comparison
equal deleted inserted replaced
423:28d9c139be4c 424:11054d720c21
441 { 441 {
442 struct gcpro gcpro1; 442 struct gcpro gcpro1;
443 Lisp_Object list = Vload_force_doc_string_list; 443 Lisp_Object list = Vload_force_doc_string_list;
444 Lisp_Object tail; 444 Lisp_Object tail;
445 int fd = XINT (XCAR (Vload_descriptor_list)); 445 int fd = XINT (XCAR (Vload_descriptor_list));
446 /* NOTE: If purify_flag is true, we're in-place modifying objects that
447 may be in purespace (and if not, they will be). Therefore, we have
448 to be VERY careful to make sure that all objects that we create
449 are purecopied -- objects in purespace are not marked for GC, and
450 if we leave any impure objects inside of pure ones, we're really
451 screwed. */
452 446
453 GCPRO1 (list); 447 GCPRO1 (list);
454 /* restore the old value first just in case an error occurs. */ 448 /* restore the old value first just in case an error occurs. */
455 Vload_force_doc_string_list = oldlist; 449 Vload_force_doc_string_list = oldlist;
456 450
477 471
478 NGCPRO1 (juan); 472 NGCPRO1 (juan);
479 ivan = Fread (juan); 473 ivan = Fread (juan);
480 if (!CONSP (ivan)) 474 if (!CONSP (ivan))
481 signal_simple_error ("invalid lazy-loaded byte code", ivan); 475 signal_simple_error ("invalid lazy-loaded byte code", ivan);
482 /* Remember to purecopy; see above. */ 476 XCOMPILED_FUNCTION (john)->instructions = XCAR (ivan);
483 XCOMPILED_FUNCTION (john)->instructions = Fpurecopy (XCAR (ivan));
484 /* v18 or v19 bytecode file. Need to Ebolify. */ 477 /* v18 or v19 bytecode file. Need to Ebolify. */
485 if (XCOMPILED_FUNCTION (john)->flags.ebolified 478 if (XCOMPILED_FUNCTION (john)->flags.ebolified
486 && VECTORP (XCDR (ivan))) 479 && VECTORP (XCDR (ivan)))
487 ebolify_bytecode_constants (XCDR (ivan)); 480 ebolify_bytecode_constants (XCDR (ivan));
488 XCOMPILED_FUNCTION (john)->constants = Fpurecopy (XCDR (ivan)); 481 XCOMPILED_FUNCTION (john)->constants = XCDR (ivan);
489 NUNGCPRO; 482 NUNGCPRO;
490 } 483 }
491 doc = compiled_function_documentation (XCOMPILED_FUNCTION (john)); 484 doc = compiled_function_documentation (XCOMPILED_FUNCTION (john));
492 if (CONSP (doc)) 485 if (CONSP (doc))
493 { 486 {
923 difference. */ 916 difference. */
924 917
925 /* Map FUN over SUFFIXES, as described above. FUN will be called with a 918 /* Map FUN over SUFFIXES, as described above. FUN will be called with a
926 char * containing the current file name, and ARG. Mapping stops when 919 char * containing the current file name, and ARG. Mapping stops when
927 FUN returns non-zero. */ 920 FUN returns non-zero. */
928 void 921 static void
929 locate_file_map_suffixes (Lisp_Object filename, Lisp_Object suffixes, 922 locate_file_map_suffixes (Lisp_Object filename, Lisp_Object suffixes,
930 int (*fun) (char *, void *), 923 int (*fun) (char *, void *),
931 void *arg) 924 void *arg)
932 { 925 {
933 /* This function can GC */ 926 /* This function can GC */
982 } 975 }
983 } 976 }
984 else 977 else
985 { 978 {
986 /* Case c) */ 979 /* Case c) */
987 CONST char *nsuffix = XSTRING_DATA (suffixes); 980 CONST char *nsuffix = (CONST char *) XSTRING_DATA (suffixes);
988 981
989 while (1) 982 while (1)
990 { 983 {
991 char *esuffix = (char *) strchr (nsuffix, ':'); 984 char *esuffix = (char *) strchr (nsuffix, ':');
992 int lsuffix = ((esuffix) ? (esuffix - nsuffix) : strlen (nsuffix)); 985 int lsuffix = ((esuffix) ? (esuffix - nsuffix) : strlen (nsuffix));
1945 Lisp_Object sym; 1938 Lisp_Object sym;
1946 if (uninterned_symbol) 1939 if (uninterned_symbol)
1947 sym = Fmake_symbol ( make_string ((Bufbyte *) read_ptr, len)); 1940 sym = Fmake_symbol ( make_string ((Bufbyte *) read_ptr, len));
1948 else 1941 else
1949 { 1942 {
1950 /* intern will purecopy pname if necessary */
1951 Lisp_Object name = make_string ((Bufbyte *) read_ptr, len); 1943 Lisp_Object name = make_string ((Bufbyte *) read_ptr, len);
1952 sym = Fintern (name, Qnil); 1944 sym = Fintern (name, Qnil);
1953 } 1945 }
1954 return sym; 1946 return sym;
1955 } 1947 }
3003 for (i = 0, p = &(XVECTOR_DATA (s.head)[0]); 2995 for (i = 0, p = &(XVECTOR_DATA (s.head)[0]);
3004 i < len; 2996 i < len;
3005 i++, p++) 2997 i++, p++)
3006 { 2998 {
3007 struct Lisp_Cons *otem = XCONS (tem); 2999 struct Lisp_Cons *otem = XCONS (tem);
3008 #if 0 /* FSFmacs defun hack */ 3000 tem = Fcar (tem);
3009 if (read_pure)
3010 tem = Fpurecopy (Fcar (tem));
3011 else
3012 #endif
3013 tem = Fcar (tem);
3014 *p = tem; 3001 *p = tem;
3015 tem = otem->cdr; 3002 tem = otem->cdr;
3016 free_cons (otem); 3003 free_cons (otem);
3017 } 3004 }
3018 return s.head; 3005 return s.head;
3147 { 3134 {
3148 the_structure_type_dynarr = Dynarr_new (structure_type); 3135 the_structure_type_dynarr = Dynarr_new (structure_type);
3149 } 3136 }
3150 3137
3151 void 3138 void
3139 reinit_vars_of_lread (void)
3140 {
3141 Vread_buffer_stream = Qnil;
3142 staticpro_nodump (&Vread_buffer_stream);
3143 }
3144
3145 void
3152 vars_of_lread (void) 3146 vars_of_lread (void)
3153 { 3147 {
3148 reinit_vars_of_lread ();
3149
3154 DEFVAR_LISP ("values", &Vvalues /* 3150 DEFVAR_LISP ("values", &Vvalues /*
3155 List of values of all expressions which were read, evaluated and printed. 3151 List of values of all expressions which were read, evaluated and printed.
3156 Order is reverse chronological. 3152 Order is reverse chronological.
3157 */ ); 3153 */ );
3158 3154
3266 3262
3267 /* This must be initialized in init_lread otherwise it may start out 3263 /* This must be initialized in init_lread otherwise it may start out
3268 with values saved when the image is dumped. */ 3264 with values saved when the image is dumped. */
3269 staticpro (&Vload_descriptor_list); 3265 staticpro (&Vload_descriptor_list);
3270 3266
3271 Vread_buffer_stream = Qnil;
3272 staticpro (&Vread_buffer_stream);
3273
3274 /* Initialized in init_lread. */ 3267 /* Initialized in init_lread. */
3275 staticpro (&Vload_force_doc_string_list); 3268 staticpro (&Vload_force_doc_string_list);
3276 3269
3277 Vload_file_name_internal = Qnil; 3270 Vload_file_name_internal = Qnil;
3278 staticpro (&Vload_file_name_internal); 3271 staticpro (&Vload_file_name_internal);