Mercurial > hg > xemacs-beta
diff src/fns.c @ 5437:002cb5224e4f
Merge with 21.5 trunk.
author | Mats Lidell <matsl@xemacs.org> |
---|---|
date | Mon, 15 Nov 2010 22:33:52 +0100 |
parents | 46491edfd94a 4c4085177ca5 |
children | 8d29f1c4bb98 |
line wrap: on
line diff
--- a/src/fns.c Sat Nov 13 00:15:58 2010 +0100 +++ b/src/fns.c Mon Nov 15 22:33:52 2010 +0100 @@ -212,9 +212,10 @@ DEFUN ("random", Frandom, 0, 1, 0, /* Return a pseudo-random number. All fixnums are equally likely. On most systems, this is 31 bits' worth. -With positive integer argument N, return random number in interval [0,N). -N can be a bignum, in which case the range of possible values is extended. -With argument t, set the random number seed from the current time and pid. +With positive integer argument LIMIT, return random number in interval [0, +LIMIT). LIMIT can be a bignum, in which case the range of possible values +is extended. With argument t, set the random number seed from the current +time and pid. */ (limit)) { @@ -1105,11 +1106,12 @@ sequence = Fnthcdr (make_int (ss), sequence); } + ii = ss + 1; + if (ss < ee && !NILP (sequence)) { result = result_tail = Fcons (Fcar (sequence), Qnil); sequence = Fcdr (sequence); - ii = ss + 1; { EXTERNAL_LIST_LOOP_2 (elt, sequence) @@ -2125,6 +2127,7 @@ Elemcount length = XVECTOR_LENGTH (sequence), ii = length; Elemcount half = length / 2; Lisp_Object swap = Qnil; + CHECK_LISP_WRITEABLE (sequence); while (ii > half) { @@ -2141,6 +2144,7 @@ Ibyte *staging = alloca_ibytes (length), *staging_end = staging + length; Ibyte *cursor = XSTRING_DATA (sequence), *endp = cursor + length; + CHECK_LISP_WRITEABLE (sequence); while (cursor < endp) { staging_end -= itext_ichar_len (cursor); @@ -2162,6 +2166,7 @@ Elemcount half = length / 2; int swap = 0; + CHECK_LISP_WRITEABLE (sequence); while (ii > half) { swap = bit_vector_bit (bv, length - ii); @@ -4447,7 +4452,7 @@ { Lisp_Object called, *args; struct gcpro gcpro1, gcpro2; - Ibyte *lisp_vals_staging, *cursor; + Ibyte *lisp_vals_staging = NULL, *cursor = NULL; int i, j; assert ((EQ (caller, Qsome) || EQ (caller, Qevery)) ? vals == NULL : 1); @@ -4494,7 +4499,7 @@ } else { - enum lrecord_type lisp_vals_type; + enum lrecord_type lisp_vals_type = lrecord_type_symbol; Binbyte *sequence_types = alloca_array (Binbyte, nsequences); for (j = 0; j < nsequences; ++j) { @@ -4513,6 +4518,10 @@ lisp_vals_staging = cursor = alloca_ibytes (call_count * MAX_ICHAR_LEN); } + else if (ARRAYP (lisp_vals)) + { + CHECK_LISP_WRITEABLE (lisp_vals); + } } for (i = 0; i < call_count; ++i) @@ -4638,9 +4647,9 @@ } } - if (!EQ (caller, Qsome) && !EQ (caller, Qevery) && - lrecord_type_string == lisp_vals_type) + if (lisp_vals_staging != NULL) { + CHECK_LISP_WRITEABLE (lisp_vals); replace_string_range (lisp_vals, Qzero, make_int (call_count), lisp_vals_staging, cursor); } @@ -4656,7 +4665,7 @@ shortest_length_among_sequences (int nsequences, Lisp_Object *sequences) { Elemcount len = EMACS_INT_MAX; - Lisp_Object length; + Lisp_Object length = Qnil; int i; for (i = 0; i < nsequences; ++i) @@ -4950,6 +4959,10 @@ With optional SEQUENCES, call PREDICATE each time with as many arguments as there are SEQUENCES (plus one for the element from SEQUENCE). +See also `find-if', which returns the corresponding element of SEQUENCE, +rather than the value given by PREDICATE, and accepts bounding index +keywords. + arguments: (PREDICATE SEQUENCE &rest SEQUENCES) */ (int nargs, Lisp_Object *args)) @@ -5202,11 +5215,14 @@ if (VECTORP (sequence)) { Lisp_Vector *vv = XVECTOR (sequence); + struct gcpro gcpro1; check_sequence_range (sequence, start, end, make_int (vv->size)); ending = min (ending, vv->size); + GCPRO1 (accum); + if (!UNBOUNDP (initial_value)) { accum = initial_value; @@ -5239,15 +5255,19 @@ accum = CALL2 (function, KEY (key, vv->contents[ii]), accum); } } + + UNGCPRO; } else if (BIT_VECTORP (sequence)) { Lisp_Bit_Vector *bv = XBIT_VECTOR (sequence); + struct gcpro gcpro1; check_sequence_range (sequence, start, end, make_int (bv->size)); - ending = min (ending, bv->size); + GCPRO1 (accum); + if (!UNBOUNDP (initial_value)) { accum = initial_value; @@ -5284,9 +5304,16 @@ accum); } } + + UNGCPRO; + } else if (STRINGP (sequence)) { + struct gcpro gcpro1; + + GCPRO1 (accum); + if (NILP (from_end)) { Bytecount byte_len = XSTRING_LENGTH (sequence); @@ -5304,7 +5331,7 @@ { accum = initial_value; } - else if (ending - starting) + else if (ending - starting && cursor_offset < byte_len) { accum = KEY (key, make_char (itext_ichar (cursor))); starting++; @@ -5319,6 +5346,7 @@ INC_IBYTEPTR (cursor); cursor_offset = cursor - startp; + ii++; } while (cursor_offset < byte_len && ii < ending) @@ -5343,7 +5371,6 @@ if (ii < starting || (ii < ending && !NILP (end))) { check_sequence_range (sequence, start, end, Flength (sequence)); - ABORT (); } } else @@ -5353,7 +5380,6 @@ const Ibyte *cursor; check_sequence_range (sequence, start, end, make_int (len)); - ending = min (ending, len); cursor = string_char_addr (sequence, ending - 1); cursor_offset = cursor - XSTRING_DATA (sequence); @@ -5400,15 +5426,17 @@ } } } + + UNGCPRO; } else if (LISTP (sequence)) { if (NILP (from_end)) { - struct gcpro gcpro1; + struct gcpro gcpro1, gcpro2; Lisp_Object tailed = Qnil; - GCPRO1 (tailed); + GCPRO2 (tailed, accum); if (!UNBOUNDP (initial_value)) { @@ -5461,7 +5489,6 @@ if (ii < starting || (ii < ending && !NILP (end))) { check_sequence_range (sequence, start, end, Flength (sequence)); - ABORT (); } } else @@ -5927,12 +5954,12 @@ if (NILP (sequence1)) { - check_sequence_range (sequence1, start1, end1, + check_sequence_range (args[0], start1, end1, make_int (XINT (start1) + shortest_len)); } else if (NILP (sequence2)) { - check_sequence_range (sequence2, start2, end2, + check_sequence_range (args[1], start2, end2, make_int (XINT (start2) + shortest_len)); } } @@ -5995,7 +6022,7 @@ if (NILP (sequence1)) { - check_sequence_range (sequence1, start1, end1, + check_sequence_range (args[0], start1, end1, make_int (XINT (start1) + starting1)); } } @@ -6052,7 +6079,7 @@ if (NILP (sequence2)) { - check_sequence_range (sequence2, start2, end2, + check_sequence_range (args[1], start2, end2, make_int (XINT (start2) + starting2)); } }