aboutsummaryrefslogtreecommitdiffstats
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/bytecode.c8
-rw-r--r--src/data.c76
-rw-r--r--src/fileio.c3
-rw-r--r--src/lisp.h10
4 files changed, 59 insertions, 38 deletions
diff --git a/src/bytecode.c b/src/bytecode.c
index e0e7b22ea13..3ac8b452fbe 100644
--- a/src/bytecode.c
+++ b/src/bytecode.c
@@ -1367,7 +1367,7 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth,
1367 Lisp_Object v1; 1367 Lisp_Object v1;
1368 BEFORE_POTENTIAL_GC (); 1368 BEFORE_POTENTIAL_GC ();
1369 v1 = POP; 1369 v1 = POP;
1370 TOP = Fgtr (TOP, v1); 1370 TOP = arithcompare (TOP, v1, ARITH_GRTR);
1371 AFTER_POTENTIAL_GC (); 1371 AFTER_POTENTIAL_GC ();
1372 NEXT; 1372 NEXT;
1373 } 1373 }
@@ -1377,7 +1377,7 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth,
1377 Lisp_Object v1; 1377 Lisp_Object v1;
1378 BEFORE_POTENTIAL_GC (); 1378 BEFORE_POTENTIAL_GC ();
1379 v1 = POP; 1379 v1 = POP;
1380 TOP = Flss (TOP, v1); 1380 TOP = arithcompare (TOP, v1, ARITH_LESS);
1381 AFTER_POTENTIAL_GC (); 1381 AFTER_POTENTIAL_GC ();
1382 NEXT; 1382 NEXT;
1383 } 1383 }
@@ -1387,7 +1387,7 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth,
1387 Lisp_Object v1; 1387 Lisp_Object v1;
1388 BEFORE_POTENTIAL_GC (); 1388 BEFORE_POTENTIAL_GC ();
1389 v1 = POP; 1389 v1 = POP;
1390 TOP = Fleq (TOP, v1); 1390 TOP = arithcompare (TOP, v1, ARITH_LESS_OR_EQUAL);
1391 AFTER_POTENTIAL_GC (); 1391 AFTER_POTENTIAL_GC ();
1392 NEXT; 1392 NEXT;
1393 } 1393 }
@@ -1397,7 +1397,7 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth,
1397 Lisp_Object v1; 1397 Lisp_Object v1;
1398 BEFORE_POTENTIAL_GC (); 1398 BEFORE_POTENTIAL_GC ();
1399 v1 = POP; 1399 v1 = POP;
1400 TOP = Fgeq (TOP, v1); 1400 TOP = arithcompare (TOP, v1, ARITH_GRTR_OR_EQUAL);
1401 AFTER_POTENTIAL_GC (); 1401 AFTER_POTENTIAL_GC ();
1402 NEXT; 1402 NEXT;
1403 } 1403 }
diff --git a/src/data.c b/src/data.c
index 9f4bd1f1c02..7f28028f604 100644
--- a/src/data.c
+++ b/src/data.c
@@ -2255,10 +2255,8 @@ bool-vector. IDX starts at 0. */)
2255 2255
2256/* Arithmetic functions */ 2256/* Arithmetic functions */
2257 2257
2258enum comparison { equal, notequal, less, grtr, less_or_equal, grtr_or_equal }; 2258Lisp_Object
2259 2259arithcompare (Lisp_Object num1, Lisp_Object num2, enum Arith_Comparison comparison)
2260static Lisp_Object
2261arithcompare (Lisp_Object num1, Lisp_Object num2, enum comparison comparison)
2262{ 2260{
2263 double f1 = 0, f2 = 0; 2261 double f1 = 0, f2 = 0;
2264 bool floatp = 0; 2262 bool floatp = 0;
@@ -2275,32 +2273,32 @@ arithcompare (Lisp_Object num1, Lisp_Object num2, enum comparison comparison)
2275 2273
2276 switch (comparison) 2274 switch (comparison)
2277 { 2275 {
2278 case equal: 2276 case ARITH_EQUAL:
2279 if (floatp ? f1 == f2 : XINT (num1) == XINT (num2)) 2277 if (floatp ? f1 == f2 : XINT (num1) == XINT (num2))
2280 return Qt; 2278 return Qt;
2281 return Qnil; 2279 return Qnil;
2282 2280
2283 case notequal: 2281 case ARITH_NOTEQUAL:
2284 if (floatp ? f1 != f2 : XINT (num1) != XINT (num2)) 2282 if (floatp ? f1 != f2 : XINT (num1) != XINT (num2))
2285 return Qt; 2283 return Qt;
2286 return Qnil; 2284 return Qnil;
2287 2285
2288 case less: 2286 case ARITH_LESS:
2289 if (floatp ? f1 < f2 : XINT (num1) < XINT (num2)) 2287 if (floatp ? f1 < f2 : XINT (num1) < XINT (num2))
2290 return Qt; 2288 return Qt;
2291 return Qnil; 2289 return Qnil;
2292 2290
2293 case less_or_equal: 2291 case ARITH_LESS_OR_EQUAL:
2294 if (floatp ? f1 <= f2 : XINT (num1) <= XINT (num2)) 2292 if (floatp ? f1 <= f2 : XINT (num1) <= XINT (num2))
2295 return Qt; 2293 return Qt;
2296 return Qnil; 2294 return Qnil;
2297 2295
2298 case grtr: 2296 case ARITH_GRTR:
2299 if (floatp ? f1 > f2 : XINT (num1) > XINT (num2)) 2297 if (floatp ? f1 > f2 : XINT (num1) > XINT (num2))
2300 return Qt; 2298 return Qt;
2301 return Qnil; 2299 return Qnil;
2302 2300
2303 case grtr_or_equal: 2301 case ARITH_GRTR_OR_EQUAL:
2304 if (floatp ? f1 >= f2 : XINT (num1) >= XINT (num2)) 2302 if (floatp ? f1 >= f2 : XINT (num1) >= XINT (num2))
2305 return Qt; 2303 return Qt;
2306 return Qnil; 2304 return Qnil;
@@ -2310,48 +2308,60 @@ arithcompare (Lisp_Object num1, Lisp_Object num2, enum comparison comparison)
2310 } 2308 }
2311} 2309}
2312 2310
2313DEFUN ("=", Feqlsign, Seqlsign, 2, 2, 0, 2311static Lisp_Object
2314 doc: /* Return t if two args, both numbers or markers, are equal. */) 2312arithcompare_driver (ptrdiff_t nargs, Lisp_Object *args,
2315 (register Lisp_Object num1, Lisp_Object num2) 2313 enum Arith_Comparison comparison)
2316{ 2314{
2317 return arithcompare (num1, num2, equal); 2315 for (ptrdiff_t argnum = 1; argnum < nargs; ++argnum)
2316 {
2317 if (EQ (Qnil, arithcompare (args[argnum-1], args[argnum], comparison)))
2318 return Qnil;
2319 }
2320 return Qt;
2318} 2321}
2319 2322
2320DEFUN ("<", Flss, Slss, 2, 2, 0, 2323DEFUN ("=", Feqlsign, Seqlsign, 1, MANY, 0,
2321 doc: /* Return t if first arg is less than second arg. Both must be numbers or markers. */) 2324 doc: /* Return t if args, all numbers or markers, are equal. */)
2322 (register Lisp_Object num1, Lisp_Object num2) 2325 (ptrdiff_t nargs, Lisp_Object *args)
2323{ 2326{
2324 return arithcompare (num1, num2, less); 2327 return arithcompare_driver (nargs, args, ARITH_EQUAL);
2325} 2328}
2326 2329
2327DEFUN (">", Fgtr, Sgtr, 2, 2, 0, 2330DEFUN ("<", Flss, Slss, 1, MANY, 0,
2328 doc: /* Return t if first arg is greater than second arg. Both must be numbers or markers. */) 2331 doc: /* Return t if each arg is less than the next arg. All must be numbers or markers. */)
2329 (register Lisp_Object num1, Lisp_Object num2) 2332 (ptrdiff_t nargs, Lisp_Object *args)
2330{ 2333{
2331 return arithcompare (num1, num2, grtr); 2334 return arithcompare_driver (nargs, args, ARITH_LESS);
2332} 2335}
2333 2336
2334DEFUN ("<=", Fleq, Sleq, 2, 2, 0, 2337DEFUN (">", Fgtr, Sgtr, 1, MANY, 0,
2335 doc: /* Return t if first arg is less than or equal to second arg. 2338 doc: /* Return t if each arg is greater than the next arg. All must be numbers or markers. */)
2336Both must be numbers or markers. */) 2339 (ptrdiff_t nargs, Lisp_Object *args)
2337 (register Lisp_Object num1, Lisp_Object num2)
2338{ 2340{
2339 return arithcompare (num1, num2, less_or_equal); 2341 return arithcompare_driver (nargs, args, ARITH_GRTR);
2340} 2342}
2341 2343
2342DEFUN (">=", Fgeq, Sgeq, 2, 2, 0, 2344DEFUN ("<=", Fleq, Sleq, 1, MANY, 0,
2343 doc: /* Return t if first arg is greater than or equal to second arg. 2345 doc: /* Return t if each arg is less than or equal to the next arg.
2344Both must be numbers or markers. */) 2346All must be numbers or markers. */)
2345 (register Lisp_Object num1, Lisp_Object num2) 2347 (ptrdiff_t nargs, Lisp_Object *args)
2348{
2349 return arithcompare_driver (nargs, args, ARITH_LESS_OR_EQUAL);
2350}
2351
2352DEFUN (">=", Fgeq, Sgeq, 1, MANY, 0,
2353 doc: /* Return t if each arg is greater than or equal to the next arg.
2354All must be numbers or markers. */)
2355 (ptrdiff_t nargs, Lisp_Object *args)
2346{ 2356{
2347 return arithcompare (num1, num2, grtr_or_equal); 2357 return arithcompare_driver (nargs, args, ARITH_GRTR_OR_EQUAL);
2348} 2358}
2349 2359
2350DEFUN ("/=", Fneq, Sneq, 2, 2, 0, 2360DEFUN ("/=", Fneq, Sneq, 2, 2, 0,
2351 doc: /* Return t if first arg is not equal to second arg. Both must be numbers or markers. */) 2361 doc: /* Return t if first arg is not equal to second arg. Both must be numbers or markers. */)
2352 (register Lisp_Object num1, Lisp_Object num2) 2362 (register Lisp_Object num1, Lisp_Object num2)
2353{ 2363{
2354 return arithcompare (num1, num2, notequal); 2364 return arithcompare (num1, num2, ARITH_NOTEQUAL);
2355} 2365}
2356 2366
2357DEFUN ("zerop", Fzerop, Szerop, 1, 1, 0, 2367DEFUN ("zerop", Fzerop, Szerop, 1, 1, 0,
diff --git a/src/fileio.c b/src/fileio.c
index 0e6113f349d..1a2bdfa237c 100644
--- a/src/fileio.c
+++ b/src/fileio.c
@@ -5121,7 +5121,8 @@ DEFUN ("car-less-than-car", Fcar_less_than_car, Scar_less_than_car, 2, 2, 0,
5121 doc: /* Return t if (car A) is numerically less than (car B). */) 5121 doc: /* Return t if (car A) is numerically less than (car B). */)
5122 (Lisp_Object a, Lisp_Object b) 5122 (Lisp_Object a, Lisp_Object b)
5123{ 5123{
5124 return Flss (Fcar (a), Fcar (b)); 5124 Lisp_Object args[2] = { Fcar (a), Fcar (b), };
5125 return Flss (2, args);
5125} 5126}
5126 5127
5127/* Build the complete list of annotations appropriate for writing out 5128/* Build the complete list of annotations appropriate for writing out
diff --git a/src/lisp.h b/src/lisp.h
index 38b538d9bc2..2b1af1faa19 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -3160,6 +3160,16 @@ EXFUN (Fbyteorder, 0) ATTRIBUTE_CONST;
3160/* Defined in data.c. */ 3160/* Defined in data.c. */
3161extern Lisp_Object indirect_function (Lisp_Object); 3161extern Lisp_Object indirect_function (Lisp_Object);
3162extern Lisp_Object find_symbol_value (Lisp_Object); 3162extern Lisp_Object find_symbol_value (Lisp_Object);
3163enum Arith_Comparison {
3164 ARITH_EQUAL,
3165 ARITH_NOTEQUAL,
3166 ARITH_LESS,
3167 ARITH_GRTR,
3168 ARITH_LESS_OR_EQUAL,
3169 ARITH_GRTR_OR_EQUAL
3170};
3171extern Lisp_Object arithcompare (Lisp_Object num1, Lisp_Object num2,
3172 enum Arith_Comparison comparison);
3163 3173
3164/* Convert the integer I to an Emacs representation, either the integer 3174/* Convert the integer I to an Emacs representation, either the integer
3165 itself, or a cons of two or three integers, or if all else fails a float. 3175 itself, or a cons of two or three integers, or if all else fails a float.