Hi Vin! This patch fixes a stack overflow bug in mapconcat. The recipe to reproduce the bug is... (let ((str (make-string 1600000 ?x))) (mapconcat #'(lambda (el) el) (list str) "")) 21.4 patch: ChangeLog files diff command: cvs -q diff -U 0 Files affected: src/ChangeLog Source files diff command: cvs -q diff -uN Files affected: src/fns.c Index: src/ChangeLog =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/ChangeLog,v retrieving revision 1.290.2.113 diff -u -p -U0 -r1.290.2.113 ChangeLog --- src/ChangeLog 20 Nov 2006 18:29:42 -0000 1.290.2.113 +++ src/ChangeLog 7 Dec 2006 17:58:48 -0000 ＠＠ -0,0 +1,8 ＠＠ +2006-12-08 Nelson Ferreira <njsf(a)sxemacs.org&gt; + + * src/fns.c (XMALLOC_OR_ALLOCA,free_malloced_ptr,XMALLOC_UNBIND): + relocated the definitions to be used sooner in file. + (concat,plists_differ,mapcar1,Fmapconcat,Fmapcar): Use + XMALLOC_OR_ALLOCA macro instead of alloca to prevent stack + overflow. + Index: src/fns.c =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/fns.c,v retrieving revision 1.33.2.4 diff -u -p -u -r1.33.2.4 fns.c --- src/fns.c 31 Jan 2005 02:55:15 -0000 1.33.2.4 +++ src/fns.c 7 Dec 2006 17:57:54 -0000 ＠＠ -49,6 +49,42 ＠＠ Boston, MA 02111-1307, USA. */ #include "lstream.h" #include "opaque.h" + + +static Lisp_Object free_malloced_ptr(Lisp_Object unwind_obj) +{ + void *ptr = (void *)get_opaque_ptr(unwind_obj); + xfree(ptr); + free_opaque_ptr(unwind_obj); + return Qnil; +} + +/* Don't use alloca for regions larger than this, lest we overflow + the stack. */ +#define MAX_ALLOCA 65536 + +/* We need to setup proper unwinding, because there is a number of + ways these functions can blow up, and we don't want to have memory + leaks in those cases. */ +#define XMALLOC_OR_ALLOCA(ptr, len, type) do { \ + size_t XOA_len = (len); \ + if (XOA_len > MAX_ALLOCA ) { \ + ptr = xnew_array (type, XOA_len); \ + record_unwind_protect (free_malloced_ptr, \ + make_opaque_ptr ((void *)ptr)); \ + } \ + else \ + ptr = alloca_array (type, XOA_len); \ +} while (0) + +#define XMALLOC_UNBIND(ptr, len, speccount) do { \ + if ((len) > MAX_ALLOCA) \ + unbind_to (speccount, Qnil); \ +} while (0) + + + + /* NOTE: This symbol is also used in lread.c */ #define FEATUREP_SYNTAX ＠＠ -604,6 +640,8 ＠＠ concat (int nargs, Lisp_Object *args, Bufbyte *string_result = 0; Bufbyte *string_result_ptr = 0; struct gcpro gcpro1; + int speccount = specpdl_depth(); + Charcount total_length; /* The modus operandi in Emacs is "caller gc-protects args". However, concat is called many times in Emacs on freshly ＠＠ -621,7 +659,7 ＠＠ concat (int nargs, Lisp_Object *args, the result in the returned string's `string-translatable' property. */ #endif if (target_type == c_string) - args_mse = alloca_array (struct merge_string_extents_struct, nargs); + XMALLOC_OR_ALLOCA(args_mse, nargs, struct merge_string_extents_struct); /* In append, the last arg isn't treated like the others */ if (last_special && nargs > 0) ＠＠ -670,7 +708,7 ＠＠ concat (int nargs, Lisp_Object *args, /* Charcount is a misnomer here as we might be dealing with the length of a vector or list, but emphasizes that we're not dealing with Bytecounts in strings */ - Charcount total_length; + /* Charcount total_length; */ for (argnum = 0, total_length = 0; argnum < nargs; argnum++) { ＠＠ -686,8 +724,11 ＠＠ concat (int nargs, Lisp_Object *args, { case c_cons: if (total_length == 0) + { /* In append, if all but last arg are nil, return last arg */ + XMALLOC_UNBIND(args_mse, nargs, speccount); RETURN_UNGCPRO (last_tail); + } val = Fmake_list (make_int (total_length), Qnil); break; case c_vector: ＠＠ -707,7 +748,9 ＠＠ concat (int nargs, Lisp_Object *args, realloc()ing in order to make the char fit properly. O(N^2) yuckage. */ val = Qnil; - string_result = (Bufbyte *) alloca (total_length * MAX_EMCHAR_LEN); + XMALLOC_OR_ALLOCA( string_result, + total_length * MAX_EMCHAR_LEN, + Bufbyte ); string_result_ptr = string_result; break; default: ＠＠ -820,6 +863,8 ＠＠ concat (int nargs, Lisp_Object *args, args_mse[argnum].entry_offset, 0, args_mse[argnum].entry_length); } + XMALLOC_UNBIND(string_result, total_length * MAX_EMCHAR_LEN, speccount); + XMALLOC_UNBIND(args_mse, nargs, speccount); } if (!NILP (prev)) ＠＠ -1840,6 +1885,7 ＠＠ plists_differ (Lisp_Object a, Lisp_Objec Lisp_Object *keys, *vals; char *flags; Lisp_Object rest; + int speccount = specpdl_depth(); if (NILP (a) && NILP (b)) return 0; ＠＠ -1851,9 +1897,9 ＠＠ plists_differ (Lisp_Object a, Lisp_Objec lb = XINT (Flength (b)); m = (la > lb ? la : lb); fill = 0; - keys = alloca_array (Lisp_Object, m); - vals = alloca_array (Lisp_Object, m); - flags = alloca_array (char, m); + XMALLOC_OR_ALLOCA(keys, m, Lisp_Object); + XMALLOC_OR_ALLOCA(vals, m, Lisp_Object); + XMALLOC_OR_ALLOCA(flags, m, char); /* First extract the pairs from A. */ for (rest = a; !NILP (rest); rest = XCDR (XCDR (rest))) ＠＠ -1898,10 +1944,17 ＠＠ plists_differ (Lisp_Object a, Lisp_Objec if (flags [i] == 0) goto MISMATCH; + + XMALLOC_UNBIND(flags, m, speccount); + XMALLOC_UNBIND(vals, m, speccount); + XMALLOC_UNBIND(keys, m, speccount); /* Ok. */ return 0; MISMATCH: + XMALLOC_UNBIND(flags, m, speccount); + XMALLOC_UNBIND(vals, m, speccount); + XMALLOC_UNBIND(keys, m, speccount); return 1; } ＠＠ -2995,8 +3048,12 ＠＠ mapcar1 (size_t leni, Lisp_Object *vals, { /* The string data of `sequence' might be relocated during GC. */ Bytecount slen = XSTRING_LENGTH (sequence); - Bufbyte *p = alloca_array (Bufbyte, slen); - Bufbyte *end = p + slen; + Bufbyte *p = NULL; + Bufbyte *end = NULL; + int speccount = specpdl_depth(); + + XMALLOC_OR_ALLOCA(p, slen, Bufbyte); + end = p + slen; memcpy (p, XSTRING_DATA (sequence), slen); ＠＠ -3007,6 +3064,7 ＠＠ mapcar1 (size_t leni, Lisp_Object *vals, result = Ffuncall (2, args); if (vals) vals[gcpro1.nvars++] = result; } + XMALLOC_UNBIND(p, slen, speccount); } else if (BIT_VECTORP (sequence)) { ＠＠ -3038,12 +3096,14 ＠＠ may be a list, a vector, a bit vector, o { EMACS_INT len = XINT (Flength (sequence)); Lisp_Object *args; + Lisp_Object result; EMACS_INT i; EMACS_INT nargs = len + len - 1; + int speccount = specpdl_depth(); if (len == 0) return build_string (""); - args = alloca_array (Lisp_Object, nargs); + XMALLOC_OR_ALLOCA(args, nargs, Lisp_Object); mapcar1 (len, args, function, sequence); ＠＠ -3053,7 +3113,9 ＠＠ may be a list, a vector, a bit vector, o for (i = 1; i < nargs; i += 2) args[i] = separator; - return Fconcat (nargs, args); + result = Fconcat(nargs, args); + XMALLOC_UNBIND(args, nargs, speccount); + return result; } DEFUN ("mapcar", Fmapcar, 2, 2, 0, /* ＠＠ -3064,11 +3126,17 ＠＠ SEQUENCE may be a list, a vector, a bit (function, sequence)) { size_t len = XINT (Flength (sequence)); - Lisp_Object *args = alloca_array (Lisp_Object, len); + Lisp_Object *args = NULL; + Lisp_Object result; + int speccount = specpdl_depth(); + + XMALLOC_OR_ALLOCA(args, len, Lisp_Object); mapcar1 (len, args, function, sequence); - return Flist (len, args); + result = Flist(len, args); + XMALLOC_UNBIND(args, len, speccount); + return result; } DEFUN ("mapvector", Fmapvector, 2, 2, 0, /* ＠＠ -3571,38 +3639,6 ＠＠ base64_decode_1 (Lstream *istream, Bufby #undef ADVANCE_INPUT_IGNORE_NONBASE64 #undef STORE_BYTE -static Lisp_Object -free_malloced_ptr (Lisp_Object unwind_obj) -{ - void *ptr = (void *)get_opaque_ptr (unwind_obj); - xfree (ptr); - free_opaque_ptr (unwind_obj); - return Qnil; -} - -/* Don't use alloca for regions larger than this, lest we overflow - the stack. */ -#define MAX_ALLOCA 65536 - -/* We need to setup proper unwinding, because there is a number of - ways these functions can blow up, and we don't want to have memory - leaks in those cases. */ -#define XMALLOC_OR_ALLOCA(ptr, len, type) do { \ - size_t XOA_len = (len); \ - if (XOA_len > MAX_ALLOCA) \ - { \ - ptr = xnew_array (type, XOA_len); \ - record_unwind_protect (free_malloced_ptr, \ - make_opaque_ptr ((void *)ptr)); \ - } \ - else \ - ptr = alloca_array (type, XOA_len); \ -} while (0) - -#define XMALLOC_UNBIND(ptr, len, speccount) do { \ - if ((len) > MAX_ALLOCA) \ - unbind_to (speccount, Qnil); \ -} while (0) DEFUN ("base64-encode-region", Fbase64_encode_region, 2, 3, "r", /* Base64-encode the region between START and END. -- |---<Steve Youngs>---------------<GnuPG KeyID: A94B3003>---| | SXEmacs - The only _______ you'll ever need. | | Fill in the blank, yes, it's THAT good! | |------------------------------------&lt;steve(a)sxemacs.org&gt;---| _______________________________________________ XEmacs-Patches mailing list XEmacs-Patches(a)xemacs.org http://calypso.tux.org/cgi-bin/mailman/listinfo/xemacs-patches