Mercurial > emacs
comparison src/fns.c @ 10411:b3c03881e6f6
(internal_equal): Delete redundant tests.
Mask size field when comparing pseudovectors.
(Frandom): Use VALBITS instead of hardcoded constants.
author | Karl Heuer <kwzh@gnu.org> |
---|---|
date | Thu, 12 Jan 1995 23:18:19 +0000 |
parents | 609f34c0c7bc |
children | 40c59e55775a |
comparison
equal
deleted
inserted
replaced
10410:562c360a3f6c | 10411:b3c03881e6f6 |
---|---|
47 return arg; | 47 return arg; |
48 } | 48 } |
49 | 49 |
50 DEFUN ("random", Frandom, Srandom, 0, 1, 0, | 50 DEFUN ("random", Frandom, Srandom, 0, 1, 0, |
51 "Return a pseudo-random number.\n\ | 51 "Return a pseudo-random number.\n\ |
52 On most systems all integers representable in Lisp are equally likely.\n\ | 52 All integers representable in Lisp are equally likely.\n\ |
53 This is 24 bits' worth.\n\ | 53 On most systems, this is 28 bits' worth.\n\ |
54 With argument N, return random number in interval [0,N).\n\ | 54 With argument N, return random number in interval [0,N).\n\ |
55 With argument t, set the random number seed from the current time and pid.") | 55 With argument t, set the random number seed from the current time and pid.") |
56 (limit) | 56 (limit) |
57 Lisp_Object limit; | 57 Lisp_Object limit; |
58 { | 58 { |
62 extern srandom (); | 62 extern srandom (); |
63 extern long time (); | 63 extern long time (); |
64 | 64 |
65 if (EQ (limit, Qt)) | 65 if (EQ (limit, Qt)) |
66 srandom (getpid () + time (0)); | 66 srandom (getpid () + time (0)); |
67 if (INTEGERP (limit) && XINT (limit) > 0) | 67 if (NATNUMP (limit) && XFASTINT (limit) != 0) |
68 { | 68 { |
69 if (XFASTINT (limit) >= 0x40000000) | 69 /* Try to take our random number from the higher bits of VAL, |
70 /* This case may occur on 64-bit machines. */ | 70 not the lower, since (says Gentzel) the low bits of `random' |
71 val = random () % XFASTINT (limit); | 71 are less random than the higher ones. We do this by using the |
72 else | 72 quotient rather than the remainder. At the high end of the RNG |
73 { | 73 it's possible to get a quotient larger than limit; discarding |
74 /* Try to take our random number from the higher bits of VAL, | 74 these values eliminates the bias that would otherwise appear |
75 not the lower, since (says Gentzel) the low bits of `random' | 75 when using a large limit. */ |
76 are less random than the higher ones. We do this by using the | 76 denominator = ((unsigned long)1 << VALBITS) / XFASTINT (limit); |
77 quotient rather than the remainder. At the high end of the RNG | 77 do |
78 it's possible to get a quotient larger than limit; discarding | 78 val = (random () & (((unsigned long)1 << VALBITS) - 1)) / denominator; |
79 these values eliminates the bias that would otherwise appear | 79 while (val >= XFASTINT (limit)); |
80 when using a large limit. */ | |
81 denominator = (unsigned long)0x40000000 / XFASTINT (limit); | |
82 do | |
83 val = (random () & 0x3fffffff) / denominator; | |
84 while (val >= XFASTINT (limit)); | |
85 } | |
86 } | 80 } |
87 else | 81 else |
88 val = random (); | 82 val = random (); |
89 return make_number (val); | 83 return make_number (val); |
90 } | 84 } |
893 case Lisp_Float: | 887 case Lisp_Float: |
894 return (extract_float (o1) == extract_float (o2)); | 888 return (extract_float (o1) == extract_float (o2)); |
895 #endif | 889 #endif |
896 | 890 |
897 case Lisp_Cons: | 891 case Lisp_Cons: |
898 { | 892 if (!internal_equal (XCONS (o1)->car, XCONS (o2)->car, depth + 1)) |
899 if (!internal_equal (XCONS (o1)->car, XCONS (o2)->car, depth + 1)) | 893 return 0; |
900 return 0; | 894 o1 = XCONS (o1)->cdr; |
901 o1 = XCONS (o1)->cdr; | 895 o2 = XCONS (o2)->cdr; |
902 o2 = XCONS (o2)->cdr; | 896 goto tail_recurse; |
903 goto tail_recurse; | |
904 } | |
905 | 897 |
906 case Lisp_Misc: | 898 case Lisp_Misc: |
907 if (MISCP (o1) && XMISC (o1)->type != XMISC (o2)->type) | 899 if (XMISC (o1)->type != XMISC (o2)->type) |
908 return 0; | 900 return 0; |
909 if (OVERLAYP (o1)) | 901 if (OVERLAYP (o1)) |
910 { | 902 { |
911 if (!internal_equal (OVERLAY_START (o1), OVERLAY_START (o1), | 903 if (!internal_equal (OVERLAY_START (o1), OVERLAY_START (o1), |
912 depth + 1) | 904 depth + 1) |
924 || XMARKER (o1)->bufpos == XMARKER (o2)->bufpos)); | 916 || XMARKER (o1)->bufpos == XMARKER (o2)->bufpos)); |
925 } | 917 } |
926 break; | 918 break; |
927 | 919 |
928 case Lisp_Vectorlike: | 920 case Lisp_Vectorlike: |
929 if ((VECTORP (o1) && VECTORP (o2)) | 921 { |
930 || | 922 register int i, size; |
931 (COMPILEDP (o1) && COMPILEDP (o2))) | 923 size = XVECTOR (o1)->size; |
932 { | 924 /* Pseudovectors have the type encoded in the size field, so this test |
933 register int index; | 925 actually checks that the objects have the same type as well as the |
934 if (XVECTOR (o1)->size != XVECTOR (o2)->size) | 926 same size. */ |
935 return 0; | 927 if (XVECTOR (o2)->size != size) |
936 for (index = 0; index < XVECTOR (o1)->size; index++) | 928 return 0; |
937 { | 929 /* But only true vectors and compiled functions are actually sensible |
938 Lisp_Object v1, v2; | 930 to compare, so eliminate the others now. */ |
939 v1 = XVECTOR (o1)->contents [index]; | 931 if (size & PSEUDOVECTOR_FLAG) |
940 v2 = XVECTOR (o2)->contents [index]; | 932 { |
941 if (!internal_equal (v1, v2, depth + 1)) | 933 if (!(size & PVEC_COMPILED)) |
942 return 0; | 934 return 0; |
943 } | 935 size &= PSEUDOVECTOR_SIZE_MASK; |
944 return 1; | 936 } |
945 } | 937 for (i = 0; i < size; i++) |
938 { | |
939 Lisp_Object v1, v2; | |
940 v1 = XVECTOR (o1)->contents [i]; | |
941 v2 = XVECTOR (o2)->contents [i]; | |
942 if (!internal_equal (v1, v2, depth + 1)) | |
943 return 0; | |
944 } | |
945 return 1; | |
946 } | |
946 break; | 947 break; |
947 | 948 |
948 case Lisp_String: | 949 case Lisp_String: |
949 if (STRINGP (o1)) | 950 if (XSTRING (o1)->size != XSTRING (o2)->size) |
950 { | 951 return 0; |
951 if (XSTRING (o1)->size != XSTRING (o2)->size) | 952 if (bcmp (XSTRING (o1)->data, XSTRING (o2)->data, |
952 return 0; | 953 XSTRING (o1)->size)) |
953 if (bcmp (XSTRING (o1)->data, XSTRING (o2)->data, | 954 return 0; |
954 XSTRING (o1)->size)) | |
955 return 0; | |
956 #ifdef USE_TEXT_PROPERTIES | 955 #ifdef USE_TEXT_PROPERTIES |
957 /* If the strings have intervals, verify they match; | 956 /* If the strings have intervals, verify they match; |
958 if not, they are unequal. */ | 957 if not, they are unequal. */ |
959 if ((XSTRING (o1)->intervals != 0 || XSTRING (o2)->intervals != 0) | 958 if ((XSTRING (o1)->intervals != 0 || XSTRING (o2)->intervals != 0) |
960 && ! compare_string_intervals (o1, o2)) | 959 && ! compare_string_intervals (o1, o2)) |
961 return 0; | 960 return 0; |
962 #endif | 961 #endif |
963 return 1; | 962 return 1; |
964 } | |
965 } | 963 } |
966 return 0; | 964 return 0; |
967 } | 965 } |
968 | 966 |
969 DEFUN ("fillarray", Ffillarray, Sfillarray, 2, 2, 0, | 967 DEFUN ("fillarray", Ffillarray, Sfillarray, 2, 2, 0, |