Mercurial > hg > xemacs-beta

comparison src/fns.c @ 5272:66dbef5f8076

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Be better about bounds-checking, #'subseq, #'fill; add same, #'reduce. 2010-09-16 Aidan Kehoe <kehoea@parhasard.net> * fns.c (Fsubseq): Change the string code to better fit in with the rest of this function (it still uses get_string_range_char(), though, which *may* diverge algorithmically from what we're doing). If dealing with a cons, only call #'length if we have reason to believe that the START and END arguments are badly specified, and check for circular lists ourselves when that's appropriate. If dealing with a vector, call Fvector() on the appropriate subset of the old vector's data directly, don't initialise the result with nil and then copy. (Ffill): Only check the range arguments for a cons SEQUENCE if we have good reason to think they were badly specified. (Freduce): Handle multiple values properly. Add bounds checking to this function, as specificied by ANSI Common Lisp.
author Aidan Kehoe <kehoea@parhasard.net>
date Thu, 16 Sep 2010 18:46:05 +0100
parents 75bcb5bef459
children 799742b751c8
comparison
equal deleted inserted replaced
5271:2def0d83a5e3 5272:66dbef5f8076
1009 } 1009 }
1010 1010
1011 DEFUN ("subseq", Fsubseq, 2, 3, 0, /* 1011 DEFUN ("subseq", Fsubseq, 2, 3, 0, /*
1012 Return the subsequence of SEQUENCE starting at START and ending before END. 1012 Return the subsequence of SEQUENCE starting at START and ending before END.
1013 END may be omitted; then the subsequence runs to the end of SEQUENCE. 1013 END may be omitted; then the subsequence runs to the end of SEQUENCE.
1014 If START or END is negative, it counts from the end. 1014
1015 If START or END is negative, it counts from the end, in contravention of
1016 Common Lisp.
1015 The returned subsequence is always of the same type as SEQUENCE. 1017 The returned subsequence is always of the same type as SEQUENCE.
1016 If SEQUENCE is a string, relevant parts of the string-extent-data 1018 If SEQUENCE is a string, relevant parts of the string-extent-data
1017 are copied to the new string. 1019 are copied to the new string.
1018 1020
1019 See also `substring-no-properties', which only operates on strings, and does 1021 See also `substring-no-properties', which only operates on strings, and does
1020 not copy extent data. 1022 not copy extent data.
1021 */ 1023 */
1022 (sequence, start, end)) 1024 (sequence, start, end))
1023 { 1025 {
1024 EMACS_INT len, s, e; 1026 Elemcount len, ss, ee = EMACS_INT_MAX, ii;
1027 Lisp_Object result = Qnil;
1028
1029 CHECK_SEQUENCE (sequence);
1030 CHECK_INT (start);
1031 ss = XINT (start);
1032
1033 if (!NILP (end))
1034 {
1035 CHECK_INT (end);
1036 ee = XINT (end);
1037 }
1025 1038
1026 if (STRINGP (sequence)) 1039 if (STRINGP (sequence))
1027 { 1040 {
1028 Charcount ccstart, ccend;
1029 Bytecount bstart, blen; 1041 Bytecount bstart, blen;
1030 Lisp_Object val; 1042
1031 1043 get_string_range_char (sequence, start, end, &ss, &ee,
1032 CHECK_INT (start);
1033 get_string_range_char (sequence, start, end, &ccstart, &ccend,
1034 GB_HISTORICAL_STRING_BEHAVIOR); 1044 GB_HISTORICAL_STRING_BEHAVIOR);
1035 bstart = string_index_char_to_byte (sequence, ccstart); 1045 bstart = string_index_char_to_byte (sequence, ss);
1036 blen = string_offset_char_to_byte_len (sequence, bstart, ccend - ccstart); 1046 blen = string_offset_char_to_byte_len (sequence, bstart, ee - ss);
1037 val = make_string (XSTRING_DATA (sequence) + bstart, blen); 1047
1048 result = make_string (XSTRING_DATA (sequence) + bstart, blen);
1038 /* Copy any applicable extent information into the new string. */ 1049 /* Copy any applicable extent information into the new string. */
1039 copy_string_extents (val, sequence, 0, bstart, blen); 1050 copy_string_extents (result, sequence, 0, bstart, blen);
1040 return val; 1051 }
1041 } 1052 else if (CONSP (sequence))
1042 1053 {
1043 CHECK_SEQUENCE (sequence); 1054 Lisp_Object result_tail, saved = sequence;
1044 1055
1045 len = XINT (Flength (sequence)); 1056 if (ss < 0 || ee < 0)
1046 1057 {
1047 CHECK_INT (start); 1058 len = XINT (Flength (sequence));
1048 s = XINT (start); 1059 if (ss < 0)
1049 if (s < 0) 1060 {
1050 s = len + s; 1061 ss = len + ss;
1051 1062 start = make_integer (ss);
1052 if (NILP (end)) 1063 }
1053 e = len; 1064
1054 else 1065 if (ee < 0)
1055 { 1066 {
1056 CHECK_INT (end); 1067 ee = len + ee;
1057 e = XINT (end); 1068 end = make_integer (ee);
1058 if (e < 0) 1069 }
1059 e = len + e; 1070 else
1060 } 1071 {
1061 1072 ee = min (ee, len);
1062 check_sequence_range (sequence, make_int (s), make_int (e), 1073 }
1063 make_int (len)); 1074 }
1064 1075
1065 if (VECTORP (sequence)) 1076 if (0 != ss)
1066 { 1077 {
1067 Lisp_Object result = make_vector (e - s, Qnil); 1078 sequence = Fnthcdr (make_int (ss), sequence);
1068 EMACS_INT i; 1079 }
1069 Lisp_Object *in_elts = XVECTOR_DATA (sequence); 1080
1070 Lisp_Object *out_elts = XVECTOR_DATA (result); 1081 if (ss < ee && !NILP (sequence))
1071 1082 {
1072 for (i = s; i < e; i++)
1073 out_elts[i - s] = in_elts[i];
1074 return result;
1075 }
1076 else if (LISTP (sequence))
1077 {
1078 Lisp_Object result = Qnil, result_tail;
1079 EMACS_INT i;
1080
1081 sequence = Fnthcdr (make_int (s), sequence);
1082
1083 if (s < e)
1084 {
1085 result = result_tail = Fcons (Fcar (sequence), Qnil); 1083 result = result_tail = Fcons (Fcar (sequence), Qnil);
1086 sequence = Fcdr (sequence); 1084 sequence = Fcdr (sequence);
1087 for (i = s + 1; i < e; i++) 1085 ii = ss + 1;
1088 { 1086
1089 XSETCDR (result_tail, Fcons (Fcar (sequence), Qnil)); 1087 {
1090 sequence = Fcdr (sequence); 1088 EXTERNAL_LIST_LOOP_2 (elt, sequence)
1091 result_tail = XCDR (result_tail); 1089 {
1092 } 1090 if (!(ii < ee))
1091 {
1092 break;
1093 }
1094
1095 XSETCDR (result_tail, Fcons (elt, Qnil));
1096 result_tail = XCDR (result_tail);
1097 ii++;
1098 }
1099 }
1100 }
1101
1102 if (NILP (result) || (ii < ee && !NILP (end)))
1103 {
1104 /* We were handed a cons, which definitely has elements. nil
1105 result means either ss >= ee or SEQUENCE was nil after the
1106 nthcdr; in both cases that means START and END were incorrectly
1107 specified for this sequence. ii < ee with a non-nil end means
1108 the user handed us a bogus end value. */
1109 check_sequence_range (saved, start, end, Flength (saved));
1110 }
1111 }
1112 else
1113 {
1114 len = XINT (Flength (sequence));
1115 if (ss < 0)
1116 {
1117 ss = len + ss;
1118 start = make_integer (ss);
1093 } 1119 }
1094 1120
1095 return result; 1121 if (ee < 0)
1096 } 1122 {
1097 else if (BIT_VECTORP (sequence)) 1123 ee = len + ee;
1098 { 1124 end = make_integer (ee);
1099 Lisp_Object result = make_bit_vector (e - s, Qzero); 1125 }
1100 EMACS_INT i; 1126 else
1101 1127 {
1102 for (i = s; i < e; i++) 1128 ee = min (len, ee);
1103 set_bit_vector_bit (XBIT_VECTOR (result), i - s, 1129 }
1104 bit_vector_bit (XBIT_VECTOR (sequence), i)); 1130
1105 return result; 1131 check_sequence_range (sequence, start, end, make_int (len));
1106 } 1132
1107 else 1133 if (VECTORP (sequence))
1108 { 1134 {
1109 ABORT (); /* unreachable, since CHECK_SEQUENCE (sequence) did not 1135 result = Fvector (ee - ss, XVECTOR_DATA (sequence) + ss);
1110 error */ 1136 }
1111 return Qnil; 1137 else if (BIT_VECTORP (sequence))
1112 } 1138 {
1139 result = make_bit_vector (ee - ss, Qzero);
1140
1141 for (ii = ss; ii < ee; ii++)
1142 {
1143 set_bit_vector_bit (XBIT_VECTOR (result), ii - ss,
1144 bit_vector_bit (XBIT_VECTOR (sequence), ii));
1145 }
1146 }
1147 else if (NILP (sequence))
1148 {
1149 DO_NOTHING;
1150 }
1151 else
1152 {
1153 /* Won't happen, since CHECK_SEQUENCE didn't error. */
1154 ABORT ();
1155 }
1156 }
1157
1158 return result;
1113 } 1159 }
1114 1160
1115 DEFUN ("substring-no-properties", Fsubstring_no_properties, 1, 3, 0, /* 1161 DEFUN ("substring-no-properties", Fsubstring_no_properties, 1, 3, 0, /*
1116 Return a substring of STRING, without copying the extents. 1162 Return a substring of STRING, without copying the extents.
1117 END may be nil or omitted; then the substring runs to the end of STRING. 1163 END may be nil or omitted; then the substring runs to the end of STRING.
4003 } 4049 }
4004 } 4050 }
4005 ++counting; 4051 ++counting;
4006 } 4052 }
4007 4053
4008 if (counting != ending) 4054 if (counting < starting || (counting != ending && !NILP (end)))
4009 { 4055 {
4010 check_sequence_range (sequence, start, end, Flength (sequence)); 4056 check_sequence_range (args[0], start, end, Flength (args[0]));
4011 } 4057 }
4012 } 4058 }
4013 else 4059 else
4014 { 4060 {
4015 sequence = wrong_type_argument (Qsequencep, sequence); 4061 sequence = wrong_type_argument (Qsequencep, sequence);
4968 CHECK_SEQUENCE (sequence); 5014 CHECK_SEQUENCE (sequence);
4969 CHECK_NATNUM (start); 5015 CHECK_NATNUM (start);
4970 5016
4971 CHECK_KEY_ARGUMENT (key); 5017 CHECK_KEY_ARGUMENT (key);
4972 5018
4973 #define KEY(key, item) (EQ (key, Qidentity) ? item : call1 (key, item)) 5019 #define KEY(key, item) (EQ (Qidentity, key) ? item : \
5020 IGNORE_MULTIPLE_VALUES (call1 (key, item)))
5021 #define CALL2(function, accum, item) \
5022 IGNORE_MULTIPLE_VALUES (call2 (function, accum, item))
4974 5023
4975 starting = XINT (start); 5024 starting = XINT (start);
4976 if (!NILP (end)) 5025 if (!NILP (end))
4977 { 5026 {
4978 CHECK_NATNUM (end); 5027 CHECK_NATNUM (end);
4979 ending = XINT (end); 5028 ending = XINT (end);
4980 } 5029 }
4981 5030
5031 if (!(starting <= ending))
5032 {
5033 check_sequence_range (sequence, start, end, Flength (sequence));
5034 }
5035
4982 if (VECTORP (sequence)) 5036 if (VECTORP (sequence))
4983 { 5037 {
4984 Lisp_Vector *vv = XVECTOR (sequence); 5038 Lisp_Vector *vv = XVECTOR (sequence);
5039
5040 check_sequence_range (sequence, start, end, make_int (vv->size));
5041
4985 ending = min (ending, vv->size); 5042 ending = min (ending, vv->size);
4986 5043
4987 if (!UNBOUNDP (initial_value)) 5044 if (!UNBOUNDP (initial_value))
4988 { 5045 {
4989 accum = initial_value; 5046 accum = initial_value;
4990 } 5047 }
4991 else if (ending - starting && starting < ending) 5048 else if (ending - starting)
4992 { 5049 {
4993 if (NILP (from_end)) 5050 if (NILP (from_end))
4994 { 5051 {
4995 accum = KEY (key, vv->contents[starting]); 5052 accum = KEY (key, vv->contents[starting]);
4996 starting++; 5053 starting++;
5004 5061
5005 if (NILP (from_end)) 5062 if (NILP (from_end))
5006 { 5063 {
5007 for (ii = starting; ii < ending; ++ii) 5064 for (ii = starting; ii < ending; ++ii)
5008 { 5065 {
5009 accum = call2 (function, accum, KEY (key, vv->contents[ii])); 5066 accum = CALL2 (function, accum, KEY (key, vv->contents[ii]));
5010 } 5067 }
5011 } 5068 }
5012 else 5069 else
5013 { 5070 {
5014 for (ii = ending - 1; ii >= starting; --ii) 5071 for (ii = ending - 1; ii >= starting; --ii)
5015 { 5072 {
5016 accum = call2 (function, KEY (key, vv->contents[ii]), accum); 5073 accum = CALL2 (function, KEY (key, vv->contents[ii]), accum);
5017 } 5074 }
5018 } 5075 }
5019 } 5076 }
5020 else if (BIT_VECTORP (sequence)) 5077 else if (BIT_VECTORP (sequence))
5021 { 5078 {
5022 Lisp_Bit_Vector *bv = XBIT_VECTOR (sequence); 5079 Lisp_Bit_Vector *bv = XBIT_VECTOR (sequence);
5023 5080
5081 check_sequence_range (sequence, start, end, make_int (bv->size));
5082
5024 ending = min (ending, bv->size); 5083 ending = min (ending, bv->size);
5025 5084
5026 if (!UNBOUNDP (initial_value)) 5085 if (!UNBOUNDP (initial_value))
5027 { 5086 {
5028 accum = initial_value; 5087 accum = initial_value;
5029 } 5088 }
5030 else if (ending - starting && starting < ending) 5089 else if (ending - starting)
5031 { 5090 {
5032 if (NILP (from_end)) 5091 if (NILP (from_end))
5033 { 5092 {
5034 accum = KEY (key, make_int (bit_vector_bit (bv, starting))); 5093 accum = KEY (key, make_int (bit_vector_bit (bv, starting)));
5035 starting++; 5094 starting++;
5043 5102
5044 if (NILP (from_end)) 5103 if (NILP (from_end))
5045 { 5104 {
5046 for (ii = starting; ii < ending; ++ii) 5105 for (ii = starting; ii < ending; ++ii)
5047 { 5106 {
5048 accum = call2 (function, accum, 5107 accum = CALL2 (function, accum,
5049 KEY (key, make_int (bit_vector_bit (bv, ii)))); 5108 KEY (key, make_int (bit_vector_bit (bv, ii))));
5050 } 5109 }
5051 } 5110 }
5052 else 5111 else
5053 { 5112 {
5054 for (ii = ending - 1; ii >= starting; --ii) 5113 for (ii = ending - 1; ii >= starting; --ii)
5055 { 5114 {
5056 accum = call2 (function, KEY (key, 5115 accum = CALL2 (function, KEY (key,
5057 make_int (bit_vector_bit (bv, 5116 make_int (bit_vector_bit (bv,
5058 ii))), 5117 ii))),
5059 accum); 5118 accum);
5060 } 5119 }
5061 } 5120 }
5062
5063 } 5121 }
5064 else if (STRINGP (sequence)) 5122 else if (STRINGP (sequence))
5065 { 5123 {
5066 if (NILP (from_end)) 5124 if (NILP (from_end))
5067 { 5125 {
5078 5136
5079 if (!UNBOUNDP (initial_value)) 5137 if (!UNBOUNDP (initial_value))
5080 { 5138 {
5081 accum = initial_value; 5139 accum = initial_value;
5082 } 5140 }
5083 else if (ending - starting && starting < ending) 5141 else if (ending - starting)
5084 { 5142 {
5085 accum = KEY (key, make_char (itext_ichar (cursor))); 5143 accum = KEY (key, make_char (itext_ichar (cursor)));
5086 starting++; 5144 starting++;
5087 startp = XSTRING_DATA (sequence); 5145 startp = XSTRING_DATA (sequence);
5088 cursor = startp + cursor_offset; 5146 cursor = startp + cursor_offset;
5095 5153
5096 INC_IBYTEPTR (cursor); 5154 INC_IBYTEPTR (cursor);
5097 cursor_offset = cursor - startp; 5155 cursor_offset = cursor - startp;
5098 } 5156 }
5099 5157
5100 while (cursor_offset < byte_len && starting < ending) 5158 while (cursor_offset < byte_len && ii < ending)
5101 { 5159 {
5102 accum = call2 (function, accum, 5160 accum = CALL2 (function, accum,
5103 KEY (key, make_char (itext_ichar (cursor)))); 5161 KEY (key, make_char (itext_ichar (cursor))));
5104 5162
5105 startp = XSTRING_DATA (sequence); 5163 startp = XSTRING_DATA (sequence);
5106 cursor = startp + cursor_offset; 5164 cursor = startp + cursor_offset;
5107 5165
5111 mapping_interaction_error (Qreduce, sequence); 5169 mapping_interaction_error (Qreduce, sequence);
5112 } 5170 }
5113 5171
5114 INC_IBYTEPTR (cursor); 5172 INC_IBYTEPTR (cursor);
5115 cursor_offset = cursor - startp; 5173 cursor_offset = cursor - startp;
5116 ++starting; 5174 ++ii;
5117 } 5175 }
5176
5177 if (ii < starting || (ii < ending && !NILP (end)))
5178 {
5179 check_sequence_range (sequence, start, end, Flength (sequence));
5180 ABORT ();
5181 }
5118 } 5182 }
5119 else 5183 else
5120 { 5184 {
5121 Elemcount len = string_char_length (sequence); 5185 Elemcount len = string_char_length (sequence);
5122 Bytecount cursor_offset, byte_len = XSTRING_LENGTH (sequence); 5186 Bytecount cursor_offset, byte_len = XSTRING_LENGTH (sequence);
5123 const Ibyte *cursor; 5187 const Ibyte *cursor;
5124 5188
5189 check_sequence_range (sequence, start, end, make_int (len));
5190
5125 ending = min (ending, len); 5191 ending = min (ending, len);
5126 cursor = string_char_addr (sequence, ending - 1); 5192 cursor = string_char_addr (sequence, ending - 1);
5127 cursor_offset = cursor - XSTRING_DATA (sequence); 5193 cursor_offset = cursor - XSTRING_DATA (sequence);
5128 5194
5129 if (!UNBOUNDP (initial_value)) 5195 if (!UNBOUNDP (initial_value))
5130 { 5196 {
5131 accum = initial_value; 5197 accum = initial_value;
5132 } 5198 }
5133 else if (ending - starting && starting < ending) 5199 else if (ending - starting)
5134 { 5200 {
5135 accum = KEY (key, make_char (itext_ichar (cursor))); 5201 accum = KEY (key, make_char (itext_ichar (cursor)));
5136 ending--; 5202 ending--;
5137 if (ending > 0) 5203 if (ending > 0)
5138 { 5204 {
5148 } 5214 }
5149 } 5215 }
5150 5216
5151 for (ii = ending - 1; ii >= starting; --ii) 5217 for (ii = ending - 1; ii >= starting; --ii)
5152 { 5218 {
5153 accum = call2 (function, KEY (key, 5219 accum = CALL2 (function, KEY (key,
5154 make_char (itext_ichar (cursor))), 5220 make_char (itext_ichar (cursor))),
5155 accum); 5221 accum);
5156 if (ii > 0) 5222 if (ii > 0)
5157 { 5223 {
5158 cursor = XSTRING_DATA (sequence) + cursor_offset; 5224 cursor = XSTRING_DATA (sequence) + cursor_offset;
5180 5246
5181 if (!UNBOUNDP (initial_value)) 5247 if (!UNBOUNDP (initial_value))
5182 { 5248 {
5183 accum = initial_value; 5249 accum = initial_value;
5184 } 5250 }
5185 else if (ending - starting && starting < ending) 5251 else if (ending - starting)
5186 { 5252 {
5187 Elemcount counting = 0; 5253 ii = 0;
5188 EXTERNAL_LIST_LOOP_3 (elt, sequence, tail) 5254 EXTERNAL_LIST_LOOP_3 (elt, sequence, tail)
5189 { 5255 {
5190 /* KEY may amputate the list behind us; make sure what 5256 /* KEY may amputate the list behind us; make sure what
5191 remains to be processed is still reachable. */ 5257 remains to be processed is still reachable. */
5192 tailed = tail; 5258 tailed = tail;
5193 if (counting == starting) 5259 if (ii == starting)
5194 { 5260 {
5195 accum = KEY (key, elt); 5261 accum = KEY (key, elt);
5196 starting++; 5262 starting++;
5197 break; 5263 break;
5198 } 5264 }
5199 ++counting; 5265 ++ii;
5200 } 5266 }
5201 } 5267 }
5202 5268
5203 if (ending - starting && starting < ending) 5269 if (ending - starting)
5204 { 5270 {
5205 Elemcount counting = 0; 5271 ii = 0;
5206 5272
5207 EXTERNAL_LIST_LOOP_3 (elt, sequence, tail) 5273 EXTERNAL_LIST_LOOP_3 (elt, sequence, tail)
5208 { 5274 {
5209 /* KEY or FUNCTION may amputate the list behind us; make 5275 /* KEY or FUNCTION may amputate the list behind us; make
5210 sure what remains to be processed is still 5276 sure what remains to be processed is still
5211 reachable. */ 5277 reachable. */
5212 tailed = tail; 5278 tailed = tail;
5213 if (counting >= starting) 5279 if (ii >= starting)
5214 { 5280 {
5215 if (counting < ending) 5281 if (ii < ending)
5216 { 5282 {
5217 accum = call2 (function, accum, KEY (key, elt)); 5283 accum = CALL2 (function, accum, KEY (key, elt));
5218 } 5284 }
5219 else if (counting == ending) 5285 else if (ii == ending)
5220 { 5286 {
5221 break; 5287 break;
5222 } 5288 }
5223 } 5289 }
5224 ++counting; 5290 ++ii;
5225 } 5291 }
5226 } 5292 }
5227 5293
5228 UNGCPRO; 5294 UNGCPRO;
5295
5296 if (ii < starting || (ii < ending && !NILP (end)))
5297 {
5298 check_sequence_range (sequence, start, end, Flength (sequence));
5299 ABORT ();
5300 }
5229 } 5301 }
5230 else 5302 else
5231 { 5303 {
5232 Boolint need_accum = 0; 5304 Boolint need_accum = 0;
5233 Lisp_Object *subsequence = NULL; 5305 Lisp_Object *subsequence = NULL;
5234 Elemcount counting = 0, len = 0; 5306 Elemcount counting = 0, len = 0;
5235 struct gcpro gcpro1; 5307 struct gcpro gcpro1;
5236 5308
5237 if (ending - starting && starting < ending 5309 len = XINT (Flength (sequence));
5238 && EMACS_INT_MAX == ending) 5310 check_sequence_range (sequence, start, end, make_int (len));
5239 { 5311 ending = min (ending, len);
5240 ending = XINT (Flength (sequence));
5241 }
5242 5312
5243 /* :from-end with a list; make an alloca copy of the relevant list 5313 /* :from-end with a list; make an alloca copy of the relevant list
5244 data, attempting to go backwards isn't worth the trouble. */ 5314 data, attempting to go backwards isn't worth the trouble. */
5245 if (!UNBOUNDP (initial_value)) 5315 if (!UNBOUNDP (initial_value))
5246 { 5316 {
5293 } 5363 }
5294 5364
5295 for (ii = len; ii != 0;) 5365 for (ii = len; ii != 0;)
5296 { 5366 {
5297 --ii; 5367 --ii;
5298 accum = call2 (function, KEY (key, subsequence[ii]), accum); 5368 accum = CALL2 (function, KEY (key, subsequence[ii]), accum);
5299 } 5369 }
5300 5370
5301 if (subsequence != NULL) 5371 if (subsequence != NULL)
5302 { 5372 {
5303 UNGCPRO; 5373 UNGCPRO;
5308 /* At this point, if ACCUM is unbound, SEQUENCE has no elements; we 5378 /* At this point, if ACCUM is unbound, SEQUENCE has no elements; we
5309 need to return the result of calling FUNCTION with zero 5379 need to return the result of calling FUNCTION with zero
5310 arguments. */ 5380 arguments. */
5311 if (UNBOUNDP (accum)) 5381 if (UNBOUNDP (accum))
5312 { 5382 {
5313 accum = call0 (function); 5383 accum = IGNORE_MULTIPLE_VALUES (call0 (function));
5314 } 5384 }
5315 5385
5316 return accum; 5386 return accum;
5317 } 5387 }
5318 5388
5468 (int nargs, Lisp_Object *args)) 5538 (int nargs, Lisp_Object *args))
5469 { 5539 {
5470 Lisp_Object sequence1 = args[0], sequence2 = args[1], 5540 Lisp_Object sequence1 = args[0], sequence2 = args[1],
5471 result = sequence1; 5541 result = sequence1;
5472 Elemcount starting1, ending1 = EMACS_INT_MAX, starting2; 5542 Elemcount starting1, ending1 = EMACS_INT_MAX, starting2;
5473 Elemcount ending2 = EMACS_INT_MAX, counting, startcounting; 5543 Elemcount ending2 = EMACS_INT_MAX, counting = 0, startcounting;
5474 Boolint sequence1_listp, sequence2_listp, 5544 Boolint sequence1_listp, sequence2_listp,
5475 overwriting = EQ (sequence1, sequence2); 5545 overwriting = EQ (sequence1, sequence2);
5476 5546
5477 PARSE_KEYWORDS (Qreplace, nargs, args, 2, 4, (start1, end1, start2, end2), 5547 PARSE_KEYWORDS (Qreplace, nargs, args, 2, 4, (start1, end1, start2, end2),
5478 (start1 = start2 = Qzero), 0); 5548 (start1 = start2 = Qzero), 0);
5514 5584
5515 overwriting = overwriting && starting2 <= starting1; 5585 overwriting = overwriting && starting2 <= starting1;
5516 5586
5517 if (sequence1_listp && !ZEROP (start1)) 5587 if (sequence1_listp && !ZEROP (start1))
5518 { 5588 {
5519 Lisp_Object nthcdrd = Fnthcdr (start1, sequence1); 5589 sequence1 = Fnthcdr (start1, sequence1);
5520 5590
5521 if (NILP (nthcdrd)) 5591 if (NILP (sequence1))
5522 { 5592 {
5523 check_sequence_range (sequence1, start1, end1, Flength (sequence1)); 5593 check_sequence_range (args[0], start1, end1, Flength (args[0]));
5524 /* Give up early here. */ 5594 /* Give up early here. */
5525 return result; 5595 return result;
5526 } 5596 }
5527 5597
5528 sequence1 = nthcdrd;
5529 ending1 -= starting1; 5598 ending1 -= starting1;
5530 starting1 = 0; 5599 starting1 = 0;
5531 } 5600 }
5532 5601
5533 if (sequence2_listp && !ZEROP (start2)) 5602 if (sequence2_listp && !ZEROP (start2))
5534 { 5603 {
5535 Lisp_Object nthcdrd = Fnthcdr (start2, sequence2); 5604 sequence2 = Fnthcdr (start2, sequence2);
5536 5605
5537 if (NILP (nthcdrd)) 5606 if (NILP (sequence2))
5538 { 5607 {
5539 check_sequence_range (sequence1, start1, end1, Flength (sequence1)); 5608 check_sequence_range (args[1], start1, end1, Flength (args[1]));
5540 /* Nothing available to replace sequence1's contents. */ 5609 /* Nothing available to replace sequence1's contents. */
5541 return result; 5610 return result;
5542 } 5611 }
5543 5612
5544 sequence2 = nthcdrd;
5545 ending2 -= starting2; 5613 ending2 -= starting2;
5546 starting2 = 0; 5614 starting2 = 0;
5547 } 5615 }
5548 5616
5549 if (overwriting) 5617 if (overwriting)
5558 if (CONSP (sequence2)) 5626 if (CONSP (sequence2))
5559 { 5627 {
5560 Elemcount len = XINT (Flength (sequence2)); 5628 Elemcount len = XINT (Flength (sequence2));
5561 Lisp_Object *subsequence 5629 Lisp_Object *subsequence
5562 = alloca_array (Lisp_Object, min (ending2, len)); 5630 = alloca_array (Lisp_Object, min (ending2, len));
5563 Elemcount counting = 0, ii = 0; 5631 Elemcount ii = 0;
5564 5632
5565 LIST_LOOP_2 (elt, sequence2) 5633 LIST_LOOP_2 (elt, sequence2)
5566 { 5634 {
5567 if (counting == ending2) 5635 if (counting == ending2)
5568 { 5636 {