comparison src/data.c @ 173:8eaf7971accc r20-3b13

Import from CVS: tag r20-3b13
author cvs
date Mon, 13 Aug 2007 09:49:09 +0200
parents 929b76928fce
children 2d532a89d707
comparison
equal deleted inserted replaced
172:a38aed19690b 173:8eaf7971accc
277 DEFUN ("listp", Flistp, 1, 1, 0, /* 277 DEFUN ("listp", Flistp, 1, 1, 0, /*
278 T if OBJECT is a list. This includes nil. 278 T if OBJECT is a list. This includes nil.
279 */ 279 */
280 (object)) 280 (object))
281 { 281 {
282 return (CONSP (object) || NILP (object)) ? Qt : Qnil; 282 return CONSP (object) || NILP (object) ? Qt : Qnil;
283 } 283 }
284 284
285 DEFUN ("nlistp", Fnlistp, 1, 1, 0, /* 285 DEFUN ("nlistp", Fnlistp, 1, 1, 0, /*
286 T if OBJECT is not a list. Lists include nil. 286 T if OBJECT is not a list. Lists include nil.
287 */ 287 */
288 (object)) 288 (object))
289 { 289 {
290 return (CONSP (object) || NILP (object)) ? Qnil : Qt; 290 return CONSP (object) || NILP (object) ? Qnil : Qt;
291 } 291 }
292 292
293 DEFUN ("symbolp", Fsymbolp, 1, 1, 0, /* 293 DEFUN ("symbolp", Fsymbolp, 1, 1, 0, /*
294 T if OBJECT is a symbol. 294 T if OBJECT is a symbol.
295 */ 295 */
587 if (KEYWORDP (object)) return Qkeyword; 587 if (KEYWORDP (object)) return Qkeyword;
588 if (INTP (object)) return Qinteger; 588 if (INTP (object)) return Qinteger;
589 if (CHARP (object)) return Qcharacter; 589 if (CHARP (object)) return Qcharacter;
590 if (STRINGP (object)) return Qstring; 590 if (STRINGP (object)) return Qstring;
591 if (VECTORP (object)) return Qvector; 591 if (VECTORP (object)) return Qvector;
592 592
593 assert (LRECORDP (object)); 593 assert (LRECORDP (object));
594 return intern (XRECORD_LHEADER (object)->implementation->name); 594 return intern (XRECORD_LHEADER (object)->implementation->name);
595 } 595 }
596 596
597 597
683 This is like Findirect_function, except that it doesn't signal an 683 This is like Findirect_function, except that it doesn't signal an
684 error if the chain ends up unbound. */ 684 error if the chain ends up unbound. */
685 Lisp_Object 685 Lisp_Object
686 indirect_function (Lisp_Object object, int errorp) 686 indirect_function (Lisp_Object object, int errorp)
687 { 687 {
688 Lisp_Object tortoise = object; 688 Lisp_Object tortoise = object;
689 Lisp_Object hare = object; 689 Lisp_Object hare = object;
690 690
691 for (;;) 691 for (;;)
692 { 692 {
693 if (!SYMBOLP (hare) || UNBOUNDP (hare)) 693 if (!SYMBOLP (hare) || UNBOUNDP (hare))
698 hare = XSYMBOL (hare)->function; 698 hare = XSYMBOL (hare)->function;
699 699
700 tortoise = XSYMBOL (tortoise)->function; 700 tortoise = XSYMBOL (tortoise)->function;
701 701
702 if (EQ (hare, tortoise)) 702 if (EQ (hare, tortoise))
703 return (Fsignal (Qcyclic_function_indirection, list1 (object))); 703 return Fsignal (Qcyclic_function_indirection, list1 (object));
704 } 704 }
705 705
706 if (UNBOUNDP (hare) && errorp) 706 if (UNBOUNDP (hare) && errorp)
707 return Fsignal (Qvoid_function, list1 (object)); 707 return Fsignal (Qvoid_function, list1 (object));
708 return hare; 708 return hare;
741 lose: 741 lose:
742 args_out_of_range (array, idx); 742 args_out_of_range (array, idx);
743 } 743 }
744 if (VECTORP (array)) 744 if (VECTORP (array))
745 { 745 {
746 if (idxval >= vector_length (XVECTOR (array))) goto lose; 746 if (idxval >= XVECTOR_LENGTH (array)) goto lose;
747 return vector_data (XVECTOR (array))[idxval]; 747 return XVECTOR_DATA (array)[idxval];
748 } 748 }
749 else if (BIT_VECTORP (array)) 749 else if (BIT_VECTORP (array))
750 { 750 {
751 if (idxval >= bit_vector_length (XBIT_VECTOR (array))) goto lose; 751 if (idxval >= bit_vector_length (XBIT_VECTOR (array))) goto lose;
752 return make_int (bit_vector_bit (XBIT_VECTOR (array), idxval)); 752 return make_int (bit_vector_bit (XBIT_VECTOR (array), idxval));
753 } 753 }
754 else if (STRINGP (array)) 754 else if (STRINGP (array))
755 { 755 {
756 if (idxval >= string_char_length (XSTRING (array))) goto lose; 756 if (idxval >= string_char_length (XSTRING (array))) goto lose;
757 return (make_char (string_char (XSTRING (array), idxval))); 757 return make_char (string_char (XSTRING (array), idxval));
758 } 758 }
759 #ifdef LOSING_BYTECODE 759 #ifdef LOSING_BYTECODE
760 else if (COMPILED_FUNCTIONP (array)) 760 else if (COMPILED_FUNCTIONP (array))
761 { 761 {
762 /* Weird, gross compatibility kludge */ 762 /* Weird, gross compatibility kludge */
763 return (Felt (array, idx)); 763 return Felt (array, idx);
764 } 764 }
765 #endif 765 #endif
766 else 766 else
767 { 767 {
768 check_losing_bytecode ("aref", array); 768 check_losing_bytecode ("aref", array);
791 } 791 }
792 CHECK_IMPURE (array); 792 CHECK_IMPURE (array);
793 793
794 if (VECTORP (array)) 794 if (VECTORP (array))
795 { 795 {
796 if (idxval >= vector_length (XVECTOR (array))) goto lose; 796 if (idxval >= XVECTOR_LENGTH (array)) goto lose;
797 vector_data (XVECTOR (array))[idxval] = newval; 797 XVECTOR_DATA (array)[idxval] = newval;
798 } 798 }
799 else if (BIT_VECTORP (array)) 799 else if (BIT_VECTORP (array))
800 { 800 {
801 if (idxval >= bit_vector_length (XBIT_VECTOR (array))) goto lose; 801 if (idxval >= bit_vector_length (XBIT_VECTOR (array))) goto lose;
802 CHECK_BIT (newval); 802 CHECK_BIT (newval);
835 Lisp_Object 835 Lisp_Object
836 compiled_function_interactive (struct Lisp_Compiled_Function *b) 836 compiled_function_interactive (struct Lisp_Compiled_Function *b)
837 { 837 {
838 assert (b->flags.interactivep); 838 assert (b->flags.interactivep);
839 if (b->flags.documentationp && b->flags.domainp) 839 if (b->flags.documentationp && b->flags.domainp)
840 return (XCAR (XCDR (b->doc_and_interactive))); 840 return XCAR (XCDR (b->doc_and_interactive));
841 else if (b->flags.documentationp) 841 else if (b->flags.documentationp)
842 return (XCDR (b->doc_and_interactive)); 842 return XCDR (b->doc_and_interactive);
843 else if (b->flags.domainp) 843 else if (b->flags.domainp)
844 return (XCAR (b->doc_and_interactive)); 844 return XCAR (b->doc_and_interactive);
845 845
846 /* if all else fails... */ 846 /* if all else fails... */
847 return (b->doc_and_interactive); 847 return b->doc_and_interactive;
848 } 848 }
849 849
850 /* Caller need not check flags.documentationp first */ 850 /* Caller need not check flags.documentationp first */
851 Lisp_Object 851 Lisp_Object
852 compiled_function_documentation (struct Lisp_Compiled_Function *b) 852 compiled_function_documentation (struct Lisp_Compiled_Function *b)
853 { 853 {
854 if (! b->flags.documentationp) 854 if (! b->flags.documentationp)
855 return Qnil; 855 return Qnil;
856 else if (b->flags.interactivep && b->flags.domainp) 856 else if (b->flags.interactivep && b->flags.domainp)
857 return (XCAR (b->doc_and_interactive)); 857 return XCAR (b->doc_and_interactive);
858 else if (b->flags.interactivep) 858 else if (b->flags.interactivep)
859 return (XCAR (b->doc_and_interactive)); 859 return XCAR (b->doc_and_interactive);
860 else if (b->flags.domainp) 860 else if (b->flags.domainp)
861 return (XCAR (b->doc_and_interactive)); 861 return XCAR (b->doc_and_interactive);
862 else 862 else
863 return (b->doc_and_interactive); 863 return b->doc_and_interactive;
864 } 864 }
865 865
866 /* Caller need not check flags.domainp first */ 866 /* Caller need not check flags.domainp first */
867 Lisp_Object 867 Lisp_Object
868 compiled_function_domain (struct Lisp_Compiled_Function *b) 868 compiled_function_domain (struct Lisp_Compiled_Function *b)
869 { 869 {
870 if (! b->flags.domainp) 870 if (! b->flags.domainp)
871 return Qnil; 871 return Qnil;
872 else if (b->flags.documentationp && b->flags.interactivep) 872 else if (b->flags.documentationp && b->flags.interactivep)
873 return (XCDR (XCDR (b->doc_and_interactive))); 873 return XCDR (XCDR (b->doc_and_interactive));
874 else if (b->flags.documentationp) 874 else if (b->flags.documentationp)
875 return (XCDR (b->doc_and_interactive)); 875 return XCDR (b->doc_and_interactive);
876 else if (b->flags.interactivep) 876 else if (b->flags.interactivep)
877 return (XCDR (b->doc_and_interactive)); 877 return XCDR (b->doc_and_interactive);
878 else 878 else
879 return (b->doc_and_interactive); 879 return b->doc_and_interactive;
880 } 880 }
881 881
882 #ifdef COMPILED_FUNCTION_ANNOTATION_HACK 882 #ifdef COMPILED_FUNCTION_ANNOTATION_HACK
883 883
884 Lisp_Object 884 Lisp_Object
911 Return the byte-opcode string of the compiled-function object. 911 Return the byte-opcode string of the compiled-function object.
912 */ 912 */
913 (function)) 913 (function))
914 { 914 {
915 CHECK_COMPILED_FUNCTION (function); 915 CHECK_COMPILED_FUNCTION (function);
916 return (XCOMPILED_FUNCTION (function)->bytecodes); 916 return XCOMPILED_FUNCTION (function)->bytecodes;
917 } 917 }
918 918
919 DEFUN ("compiled-function-constants", Fcompiled_function_constants, 1, 1, 0, /* 919 DEFUN ("compiled-function-constants", Fcompiled_function_constants, 1, 1, 0, /*
920 Return the constants vector of the compiled-function object. 920 Return the constants vector of the compiled-function object.
921 */ 921 */
922 (function)) 922 (function))
923 { 923 {
924 CHECK_COMPILED_FUNCTION (function); 924 CHECK_COMPILED_FUNCTION (function);
925 return (XCOMPILED_FUNCTION (function)->constants); 925 return XCOMPILED_FUNCTION (function)->constants;
926 } 926 }
927 927
928 DEFUN ("compiled-function-stack-depth", Fcompiled_function_stack_depth, 1, 1, 0, /* 928 DEFUN ("compiled-function-stack-depth", Fcompiled_function_stack_depth, 1, 1, 0, /*
929 Return the max stack depth of the compiled-function object. 929 Return the max stack depth of the compiled-function object.
930 */ 930 */
931 (function)) 931 (function))
932 { 932 {
933 CHECK_COMPILED_FUNCTION (function); 933 CHECK_COMPILED_FUNCTION (function);
934 return (make_int (XCOMPILED_FUNCTION (function)->maxdepth)); 934 return make_int (XCOMPILED_FUNCTION (function)->maxdepth);
935 } 935 }
936 936
937 DEFUN ("compiled-function-arglist", Fcompiled_function_arglist, 1, 1, 0, /* 937 DEFUN ("compiled-function-arglist", Fcompiled_function_arglist, 1, 1, 0, /*
938 Return the argument list of the compiled-function object. 938 Return the argument list of the compiled-function object.
939 */ 939 */
940 (function)) 940 (function))
941 { 941 {
942 CHECK_COMPILED_FUNCTION (function); 942 CHECK_COMPILED_FUNCTION (function);
943 return (XCOMPILED_FUNCTION (function)->arglist); 943 return XCOMPILED_FUNCTION (function)->arglist;
944 } 944 }
945 945
946 DEFUN ("compiled-function-interactive", Fcompiled_function_interactive, 1, 1, 0, /* 946 DEFUN ("compiled-function-interactive", Fcompiled_function_interactive, 1, 1, 0, /*
947 Return the interactive spec of the compiled-function object, or nil. 947 Return the interactive spec of the compiled-function object, or nil.
948 If non-nil, the return value will be a list whose first element is 948 If non-nil, the return value will be a list whose first element is
982 a `load'. 982 a `load'.
983 */ 983 */
984 (function)) 984 (function))
985 { 985 {
986 CHECK_COMPILED_FUNCTION (function); 986 CHECK_COMPILED_FUNCTION (function);
987 return (compiled_function_annotation (XCOMPILED_FUNCTION (function))); 987 return compiled_function_annotation (XCOMPILED_FUNCTION (function));
988 } 988 }
989 989
990 #endif /* COMPILED_FUNCTION_ANNOTATION_HACK */ 990 #endif /* COMPILED_FUNCTION_ANNOTATION_HACK */
991 991
992 DEFUN ("compiled-function-domain", Fcompiled_function_domain, 1, 1, 0, /* 992 DEFUN ("compiled-function-domain", Fcompiled_function_domain, 1, 1, 0, /*
996 (function)) 996 (function))
997 { 997 {
998 CHECK_COMPILED_FUNCTION (function); 998 CHECK_COMPILED_FUNCTION (function);
999 if (!XCOMPILED_FUNCTION (function)->flags.domainp) 999 if (!XCOMPILED_FUNCTION (function)->flags.domainp)
1000 return Qnil; 1000 return Qnil;
1001 return (compiled_function_domain (XCOMPILED_FUNCTION (function))); 1001 return compiled_function_domain (XCOMPILED_FUNCTION (function));
1002 } 1002 }
1003 1003
1004 1004
1005 /**********************************************************************/ 1005 /**********************************************************************/
1006 /* Arithmetic functions */ 1006 /* Arithmetic functions */
1029 case grtr: return f1 > f2 ? Qt : Qnil; 1029 case grtr: return f1 > f2 ? Qt : Qnil;
1030 case grtr_or_equal: return f1 >= f2 ? Qt : Qnil; 1030 case grtr_or_equal: return f1 >= f2 ? Qt : Qnil;
1031 } 1031 }
1032 } 1032 }
1033 #endif /* LISP_FLOAT_TYPE */ 1033 #endif /* LISP_FLOAT_TYPE */
1034 1034
1035 switch (comparison) 1035 switch (comparison)
1036 { 1036 {
1037 case equal: return XINT (num1) == XINT (num2) ? Qt : Qnil; 1037 case equal: return XINT (num1) == XINT (num2) ? Qt : Qnil;
1038 case notequal: return XINT (num1) != XINT (num2) ? Qt : Qnil; 1038 case notequal: return XINT (num1) != XINT (num2) ? Qt : Qnil;
1039 case less: return XINT (num1) < XINT (num2) ? Qt : Qnil; 1039 case less: return XINT (num1) < XINT (num2) ? Qt : Qnil;
1176 { 1176 {
1177 CHECK_INT_OR_FLOAT (number); 1177 CHECK_INT_OR_FLOAT (number);
1178 1178
1179 #ifdef LISP_FLOAT_TYPE 1179 #ifdef LISP_FLOAT_TYPE
1180 if (FLOATP (number)) 1180 if (FLOATP (number))
1181 return (float_data (XFLOAT (number)) == 0.0) ? Qt : Qnil; 1181 return float_data (XFLOAT (number)) == 0.0 ? Qt : Qnil;
1182 #endif /* LISP_FLOAT_TYPE */ 1182 #endif /* LISP_FLOAT_TYPE */
1183 1183
1184 return (XINT (number) == 0) ? Qt : Qnil; 1184 return XINT (number) == 0 ? Qt : Qnil;
1185 } 1185 }
1186 1186
1187 /* Convert between a 32-bit value and a cons of two 16-bit values. 1187 /* Convert between a 32-bit value and a cons of two 16-bit values.
1188 This is used to pass 32-bit integers to and from the user. 1188 This is used to pass 32-bit integers to and from the user.
1189 Use time_to_lisp() and lisp_to_time() for time values. 1189 Use time_to_lisp() and lisp_to_time() for time values.
1228 if (FLOATP (num)) 1228 if (FLOATP (num))
1229 { 1229 {
1230 char pigbuf[350]; /* see comments in float_to_string */ 1230 char pigbuf[350]; /* see comments in float_to_string */
1231 1231
1232 float_to_string (pigbuf, float_data (XFLOAT (num))); 1232 float_to_string (pigbuf, float_data (XFLOAT (num)));
1233 return build_string (pigbuf); 1233 return build_string (pigbuf);
1234 } 1234 }
1235 #endif /* LISP_FLOAT_TYPE */ 1235 #endif /* LISP_FLOAT_TYPE */
1236 1236
1237 if (sizeof (int) == sizeof (EMACS_INT)) 1237 sprintf (buffer, "%ld", (long) (XINT (num)));
1238 sprintf (buffer, "%d", XINT (num));
1239 else if (sizeof (long) == sizeof (EMACS_INT))
1240 sprintf (buffer, "%ld", (long) XINT (num));
1241 else
1242 abort ();
1243 return build_string (buffer); 1238 return build_string (buffer);
1244 } 1239 }
1245 1240
1246 static int 1241 static int
1247 digit_to_number (int character, int base) 1242 digit_to_number (int character, int base)
1321 { 1316 {
1322 negative = -1; 1317 negative = -1;
1323 p++; 1318 p++;
1324 } 1319 }
1325 else if (*p == '+') 1320 else if (*p == '+')
1326 p++; 1321 p++;
1327 while (1) 1322 while (1)
1328 { 1323 {
1329 digit = digit_to_number (*p++, b); 1324 digit = digit_to_number (*p++, b);
1330 if (digit < 0) 1325 if (digit < 0)
1331 break; 1326 break;
1332 v = v * b + digit; 1327 v = v * b + digit;
1333 } 1328 }
1334 return make_int (negative * v); 1329 return make_int (negative * v);
1335 } 1330 }
1336 } 1331 }
1337 1332
1338 enum arithop 1333 enum arithop
1339 { Aadd, Asub, Amult, Adiv, Alogand, Alogior, Alogxor, Amax, Amin }; 1334 { Aadd, Asub, Amult, Adiv, Alogand, Alogior, Alogxor, Amax, Amin };
1340 1335
1341 1336
1342 #ifdef LISP_FLOAT_TYPE 1337 #ifdef LISP_FLOAT_TYPE
1344 float_arith_driver (double accum, int argnum, enum arithop code, int nargs, 1339 float_arith_driver (double accum, int argnum, enum arithop code, int nargs,
1345 Lisp_Object *args) 1340 Lisp_Object *args)
1346 { 1341 {
1347 REGISTER Lisp_Object val; 1342 REGISTER Lisp_Object val;
1348 double next; 1343 double next;
1349 1344
1350 for (; argnum < nargs; argnum++) 1345 for (; argnum < nargs; argnum++)
1351 { 1346 {
1352 /* using args[argnum] as argument to CHECK_INT_OR_FLOAT_... */ 1347 /* using args[argnum] as argument to CHECK_INT_OR_FLOAT_... */
1353 val = args[argnum]; 1348 val = args[argnum];
1354 CHECK_INT_OR_FLOAT_COERCE_CHAR_OR_MARKER (val); 1349 CHECK_INT_OR_FLOAT_COERCE_CHAR_OR_MARKER (val);
1437 val = args[argnum]; 1432 val = args[argnum];
1438 CHECK_INT_OR_FLOAT_COERCE_CHAR_OR_MARKER (val); 1433 CHECK_INT_OR_FLOAT_COERCE_CHAR_OR_MARKER (val);
1439 1434
1440 #ifdef LISP_FLOAT_TYPE 1435 #ifdef LISP_FLOAT_TYPE
1441 if (FLOATP (val)) /* time to do serious math */ 1436 if (FLOATP (val)) /* time to do serious math */
1442 return (float_arith_driver ((double) accum, argnum, code, 1437 return float_arith_driver ((double) accum, argnum, code,
1443 nargs, args)); 1438 nargs, args);
1444 #endif /* LISP_FLOAT_TYPE */ 1439 #endif /* LISP_FLOAT_TYPE */
1445 args[argnum] = val; /* runs into a compiler bug. */ 1440 args[argnum] = val; /* runs into a compiler bug. */
1446 next = XINT (args[argnum]); 1441 next = XINT (args[argnum]);
1447 switch (code) 1442 switch (code)
1448 { 1443 {
1521 CHECK_INT_COERCE_CHAR_OR_MARKER (num2); 1516 CHECK_INT_COERCE_CHAR_OR_MARKER (num2);
1522 1517
1523 if (ZEROP (num2)) 1518 if (ZEROP (num2))
1524 Fsignal (Qarith_error, Qnil); 1519 Fsignal (Qarith_error, Qnil);
1525 1520
1526 return (make_int (XINT (num1) % XINT (num2))); 1521 return make_int (XINT (num1) % XINT (num2));
1527 } 1522 }
1528 1523
1529 /* Note, ANSI *requires* the presence of the fmod() library routine. 1524 /* Note, ANSI *requires* the presence of the fmod() library routine.
1530 If your system doesn't have it, complain to your vendor, because 1525 If your system doesn't have it, complain to your vendor, because
1531 that is a bug. */ 1526 that is a bug. */
1534 double 1529 double
1535 fmod (double f1, double f2) 1530 fmod (double f1, double f2)
1536 { 1531 {
1537 if (f2 < 0.0) 1532 if (f2 < 0.0)
1538 f2 = -f2; 1533 f2 = -f2;
1539 return (f1 - f2 * floor (f1/f2)); 1534 return f1 - f2 * floor (f1/f2);
1540 } 1535 }
1541 #endif /* ! HAVE_FMOD */ 1536 #endif /* ! HAVE_FMOD */
1542 1537
1543 1538
1544 DEFUN ("mod", Fmod, 2, 2, 0, /* 1539 DEFUN ("mod", Fmod, 2, 2, 0, /*
1562 f1 = ((FLOATP (x)) ? float_data (XFLOAT (x)) : XINT (x)); 1557 f1 = ((FLOATP (x)) ? float_data (XFLOAT (x)) : XINT (x));
1563 f2 = ((FLOATP (y)) ? float_data (XFLOAT (y)) : XINT (y)); 1558 f2 = ((FLOATP (y)) ? float_data (XFLOAT (y)) : XINT (y));
1564 if (f2 == 0) 1559 if (f2 == 0)
1565 Fsignal (Qarith_error, Qnil); 1560 Fsignal (Qarith_error, Qnil);
1566 1561
1567 f1 = fmod (f1, f2); 1562 f1 = fmod (f1, f2);
1568 1563
1569 /* If the "remainder" comes out with the wrong sign, fix it. */ 1564 /* If the "remainder" comes out with the wrong sign, fix it. */
1570 if (f2 < 0 ? f1 > 0 : f1 < 0) 1565 if (f2 < 0 ? f1 > 0 : f1 < 0)
1571 f1 += f2; 1566 f1 += f2;
1572 return (make_float (f1)); 1567 return make_float (f1);
1573 } 1568 }
1574 #else /* not LISP_FLOAT_TYPE */ 1569 #else /* not LISP_FLOAT_TYPE */
1575 CHECK_INT_OR_FLOAT_COERCE_CHAR_OR_MARKER (x); 1570 CHECK_INT_OR_FLOAT_COERCE_CHAR_OR_MARKER (x);
1576 CHECK_INT_OR_FLOAT_COERCE_CHAR_OR_MARKER (y); 1571 CHECK_INT_OR_FLOAT_COERCE_CHAR_OR_MARKER (y);
1577 #endif /* not LISP_FLOAT_TYPE */ 1572 #endif /* not LISP_FLOAT_TYPE */
1579 i1 = XINT (x); 1574 i1 = XINT (x);
1580 i2 = XINT (y); 1575 i2 = XINT (y);
1581 1576
1582 if (i2 == 0) 1577 if (i2 == 0)
1583 Fsignal (Qarith_error, Qnil); 1578 Fsignal (Qarith_error, Qnil);
1584 1579
1585 i1 %= i2; 1580 i1 %= i2;
1586 1581
1587 /* If the "remainder" comes out with the wrong sign, fix it. */ 1582 /* If the "remainder" comes out with the wrong sign, fix it. */
1588 if (i2 < 0 ? i1 > 0 : i1 < 0) 1583 if (i2 < 0 ? i1 > 0 : i1 < 0)
1589 i1 += i2; 1584 i1 += i2;
1590 1585
1591 return (make_int (i1)); 1586 return make_int (i1);
1592 } 1587 }
1593 1588
1594 1589
1595 DEFUN ("max", Fmax, 1, MANY, 0, /* 1590 DEFUN ("max", Fmax, 1, MANY, 0, /*
1596 Return largest of all the arguments. 1591 Return largest of all the arguments.
1684 { 1679 {
1685 CHECK_INT_OR_FLOAT_COERCE_CHAR_OR_MARKER (number); 1680 CHECK_INT_OR_FLOAT_COERCE_CHAR_OR_MARKER (number);
1686 1681
1687 #ifdef LISP_FLOAT_TYPE 1682 #ifdef LISP_FLOAT_TYPE
1688 if (FLOATP (number)) 1683 if (FLOATP (number))
1689 return (make_float (1.0 + float_data (XFLOAT (number)))); 1684 return make_float (1.0 + float_data (XFLOAT (number)));
1690 #endif /* LISP_FLOAT_TYPE */ 1685 #endif /* LISP_FLOAT_TYPE */
1691 1686
1692 return (make_int (XINT (number) + 1)); 1687 return make_int (XINT (number) + 1);
1693 } 1688 }
1694 1689
1695 DEFUN ("1-", Fsub1, 1, 1, 0, /* 1690 DEFUN ("1-", Fsub1, 1, 1, 0, /*
1696 Return NUMBER minus one. NUMBER may be a number or a marker. 1691 Return NUMBER minus one. NUMBER may be a number or a marker.
1697 Markers and characters are converted to integers. 1692 Markers and characters are converted to integers.
1700 { 1695 {
1701 CHECK_INT_OR_FLOAT_COERCE_CHAR_OR_MARKER (number); 1696 CHECK_INT_OR_FLOAT_COERCE_CHAR_OR_MARKER (number);
1702 1697
1703 #ifdef LISP_FLOAT_TYPE 1698 #ifdef LISP_FLOAT_TYPE
1704 if (FLOATP (number)) 1699 if (FLOATP (number))
1705 return (make_float (-1.0 + (float_data (XFLOAT (number))))); 1700 return make_float (-1.0 + (float_data (XFLOAT (number))));
1706 #endif /* LISP_FLOAT_TYPE */ 1701 #endif /* LISP_FLOAT_TYPE */
1707 1702
1708 return (make_int (XINT (number) - 1)); 1703 return make_int (XINT (number) - 1);
1709 } 1704 }
1710 1705
1711 DEFUN ("lognot", Flognot, 1, 1, 0, /* 1706 DEFUN ("lognot", Flognot, 1, 1, 0, /*
1712 Return the bitwise complement of NUMBER. NUMBER must be an integer. 1707 Return the bitwise complement of NUMBER. NUMBER must be an integer.
1713 */ 1708 */
1714 (number)) 1709 (number))
1715 { 1710 {
1716 CHECK_INT (number); 1711 CHECK_INT (number);
1717 return (make_int (~XINT (number))); 1712 return make_int (~XINT (number));
1718 } 1713 }
1719 1714
1720 1715
1721 /************************************************************************/ 1716 /************************************************************************/
1722 /* weak lists */ 1717 /* weak lists */
1751 static void 1746 static void
1752 print_weak_list (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag) 1747 print_weak_list (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
1753 { 1748 {
1754 if (print_readably) 1749 if (print_readably)
1755 error ("printing unreadable object #<weak-list>"); 1750 error ("printing unreadable object #<weak-list>");
1756 1751
1757 write_c_string ("#<weak-list ", printcharfun); 1752 write_c_string ("#<weak-list ", printcharfun);
1758 print_internal (encode_weak_list_type (XWEAK_LIST (obj)->type), 1753 print_internal (encode_weak_list_type (XWEAK_LIST (obj)->type),
1759 printcharfun, 0); 1754 printcharfun, 0);
1760 write_c_string (" ", printcharfun); 1755 write_c_string (" ", printcharfun);
1761 print_internal (XWEAK_LIST (obj)->list, printcharfun, escapeflag); 1756 print_internal (XWEAK_LIST (obj)->list, printcharfun, escapeflag);
1766 weak_list_equal (Lisp_Object o1, Lisp_Object o2, int depth) 1761 weak_list_equal (Lisp_Object o1, Lisp_Object o2, int depth)
1767 { 1762 {
1768 struct weak_list *w1 = XWEAK_LIST (o1); 1763 struct weak_list *w1 = XWEAK_LIST (o1);
1769 struct weak_list *w2 = XWEAK_LIST (o2); 1764 struct weak_list *w2 = XWEAK_LIST (o2);
1770 1765
1771 return (w1->type == w2->type) && 1766 return ((w1->type == w2->type) &&
1772 internal_equal (w1->list, w2->list, depth + 1); 1767 internal_equal (w1->list, w2->list, depth + 1));
1773 } 1768 }
1774 1769
1775 static unsigned long 1770 static unsigned long
1776 weak_list_hash (Lisp_Object obj, int depth) 1771 weak_list_hash (Lisp_Object obj, int depth)
1777 { 1772 {
2025 we must have already visited the spot, so we exit. 2020 we must have already visited the spot, so we exit.
2026 (If we process with the tortoise, we can fail to 2021 (If we process with the tortoise, we can fail to
2027 process cases where a cons points to itself, or 2022 process cases where a cons points to itself, or
2028 where cons A points to cons B, which points to 2023 where cons A points to cons B, which points to
2029 cons A.) */ 2024 cons A.) */
2030 2025
2031 rest2 = XCDR (rest2); 2026 rest2 = XCDR (rest2);
2032 if (go_tortoise) 2027 if (go_tortoise)
2033 tortoise = XCDR (tortoise); 2028 tortoise = XCDR (tortoise);
2034 go_tortoise = !go_tortoise; 2029 go_tortoise = !go_tortoise;
2035 if (GC_EQ (rest2, tortoise)) 2030 if (GC_EQ (rest2, tortoise))