aboutsummaryrefslogtreecommitdiffstats
path: root/src/eval.c
diff options
context:
space:
mode:
Diffstat (limited to 'src/eval.c')
-rw-r--r--src/eval.c105
1 files changed, 53 insertions, 52 deletions
diff --git a/src/eval.c b/src/eval.c
index af0912fd14f..0030271c533 100644
--- a/src/eval.c
+++ b/src/eval.c
@@ -1225,18 +1225,17 @@ usage: (condition-case VAR BODYFORM &rest HANDLERS) */)
1225 rather than passed in a list. Used by Fbyte_code. */ 1225 rather than passed in a list. Used by Fbyte_code. */
1226 1226
1227Lisp_Object 1227Lisp_Object
1228internal_lisp_condition_case (volatile Lisp_Object var, Lisp_Object bodyform, 1228internal_lisp_condition_case (Lisp_Object var, Lisp_Object bodyform,
1229 Lisp_Object handlers) 1229 Lisp_Object handlers)
1230{ 1230{
1231 Lisp_Object val;
1232 struct handler *oldhandlerlist = handlerlist; 1231 struct handler *oldhandlerlist = handlerlist;
1233 int clausenb = 0; 1232 ptrdiff_t clausenb = 0;
1234 1233
1235 CHECK_SYMBOL (var); 1234 CHECK_SYMBOL (var);
1236 1235
1237 for (val = handlers; CONSP (val); val = XCDR (val)) 1236 for (Lisp_Object tail = handlers; CONSP (tail); tail = XCDR (tail))
1238 { 1237 {
1239 Lisp_Object tem = XCAR (val); 1238 Lisp_Object tem = XCAR (tail);
1240 clausenb++; 1239 clausenb++;
1241 if (! (NILP (tem) 1240 if (! (NILP (tem)
1242 || (CONSP (tem) 1241 || (CONSP (tem)
@@ -1246,55 +1245,57 @@ internal_lisp_condition_case (volatile Lisp_Object var, Lisp_Object bodyform,
1246 SDATA (Fprin1_to_string (tem, Qt))); 1245 SDATA (Fprin1_to_string (tem, Qt)));
1247 } 1246 }
1248 1247
1249 { /* The first clause is the one that should be checked first, so it should 1248 /* The first clause is the one that should be checked first, so it
1250 be added to handlerlist last. So we build in `clauses' a table that 1249 should be added to handlerlist last. So build in CLAUSES a table
1251 contains `handlers' but in reverse order. SAFE_ALLOCA won't work 1250 that contains HANDLERS but in reverse order. CLAUSES is pointer
1252 here due to the setjmp, so impose a MAX_ALLOCA limit. */ 1251 to volatile to avoid issues with setjmp and local storage.
1253 if (MAX_ALLOCA / word_size < clausenb) 1252 SAFE_ALLOCA won't work here due to the setjmp, so impose a
1254 memory_full (SIZE_MAX); 1253 MAX_ALLOCA limit. */
1255 Lisp_Object *clauses = alloca (clausenb * sizeof *clauses); 1254 if (MAX_ALLOCA / word_size < clausenb)
1256 Lisp_Object *volatile clauses_volatile = clauses; 1255 memory_full (SIZE_MAX);
1257 int i = clausenb; 1256 Lisp_Object volatile *clauses = alloca (clausenb * sizeof *clauses);
1258 for (val = handlers; CONSP (val); val = XCDR (val)) 1257 clauses += clausenb;
1259 clauses[--i] = XCAR (val); 1258 for (Lisp_Object tail = handlers; CONSP (tail); tail = XCDR (tail))
1260 for (i = 0; i < clausenb; i++) 1259 *--clauses = XCAR (tail);
1261 { 1260 for (ptrdiff_t i = 0; i < clausenb; i++)
1262 Lisp_Object clause = clauses[i]; 1261 {
1263 Lisp_Object condition = CONSP (clause) ? XCAR (clause) : Qnil; 1262 Lisp_Object clause = clauses[i];
1264 if (!CONSP (condition)) 1263 Lisp_Object condition = CONSP (clause) ? XCAR (clause) : Qnil;
1265 condition = Fcons (condition, Qnil); 1264 if (!CONSP (condition))
1266 struct handler *c = push_handler (condition, CONDITION_CASE); 1265 condition = list1 (condition);
1267 if (sys_setjmp (c->jmp)) 1266 struct handler *c = push_handler (condition, CONDITION_CASE);
1268 { 1267 if (sys_setjmp (c->jmp))
1269 ptrdiff_t count = SPECPDL_INDEX (); 1268 {
1270 Lisp_Object val = handlerlist->val; 1269 Lisp_Object val = handlerlist->val;
1271 Lisp_Object *chosen_clause = clauses_volatile; 1270 Lisp_Object volatile *chosen_clause = clauses;
1272 for (c = handlerlist->next; c != oldhandlerlist; c = c->next) 1271 for (struct handler *h = handlerlist->next; h != oldhandlerlist;
1273 chosen_clause++; 1272 h = h->next)
1274 handlerlist = oldhandlerlist; 1273 chosen_clause++;
1275 if (!NILP (var)) 1274 Lisp_Object handler_body = XCDR (*chosen_clause);
1276 { 1275 handlerlist = oldhandlerlist;
1277 if (!NILP (Vinternal_interpreter_environment)) 1276
1278 specbind (Qinternal_interpreter_environment, 1277 if (NILP (var))
1279 Fcons (Fcons (var, val), 1278 return Fprogn (handler_body);
1280 Vinternal_interpreter_environment)); 1279
1281 else 1280 if (!NILP (Vinternal_interpreter_environment))
1282 specbind (var, val); 1281 {
1283 } 1282 val = Fcons (Fcons (var, val),
1284 val = Fprogn (XCDR (*chosen_clause)); 1283 Vinternal_interpreter_environment);
1285 /* Note that this just undoes the binding of var; whoever 1284 var = Qinternal_interpreter_environment;
1286 longjumped to us unwound the stack to c.pdlcount before 1285 }
1287 throwing. */ 1286
1288 if (!NILP (var)) 1287 /* Bind VAR to VAL while evaluating HANDLER_BODY. The
1289 unbind_to (count, Qnil); 1288 unbind_to just undoes VAR's binding; whoever longjumped
1290 return val; 1289 to us unwound the stack to C->pdlcount before throwing. */
1291 } 1290 ptrdiff_t count = SPECPDL_INDEX ();
1292 } 1291 specbind (var, val);
1293 } 1292 return unbind_to (count, Fprogn (handler_body));
1293 }
1294 }
1294 1295
1295 val = eval_sub (bodyform); 1296 Lisp_Object result = eval_sub (bodyform);
1296 handlerlist = oldhandlerlist; 1297 handlerlist = oldhandlerlist;
1297 return val; 1298 return result;
1298} 1299}
1299 1300
1300/* Call the function BFUN with no arguments, catching errors within it 1301/* Call the function BFUN with no arguments, catching errors within it