Mercurial > hg > xemacs-beta

comparison src/alloc.c @ 5607:1a507c4c6c42

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Refactor out sequence-oriented builtins from fns.c to the new sequence.c. src/ChangeLog addition: 2011-12-04 Aidan Kehoe <kehoea@parhasard.net> * Makefile.in.in (objs): * depend: Add sequence.o to the list of objects and dependencies. * alloc.c: * alloc.c (mark_bit_vector): * alloc.c (print_bit_vector): * alloc.c (bit_vector_equal): * alloc.c (internal_bit_vector_equalp_hash): * alloc.c (bit_vector_hash): * alloc.c (init_alloc_once_early): Move the implementation of the bit vector type here from fns.c. * emacs.c (main_1): Call syms_of_sequence() here, now sequence.c is included. * fns.c (Fold_rassq): Move this together with the rest of the Fold_* functions. * fns.c: * fns.c (syms_of_fns): Move most functions dealing with sequences generally, and especially those taking key arguments, to a separate file, sequence.c. * general-slots.h: Qyes_or_no_p belong here, not fns.c. * lisp.h: Make Flist_length available here, it's used by sequence.c * sequence.c: * sequence.c (check_sequence_range): * sequence.c (Flength): * sequence.c (check_other_nokey): * sequence.c (check_other_key): * sequence.c (check_if_key): * sequence.c (check_match_eq_key): * sequence.c (check_match_eql_key): * sequence.c (check_match_equal_key): * sequence.c (check_match_equalp_key): * sequence.c (check_match_other_key): * sequence.c (check_lss_key): * sequence.c (check_lss_key_car): * sequence.c (check_string_lessp_key): * sequence.c (check_string_lessp_key_car): * sequence.c (get_check_match_function_1): * sequence.c (get_merge_predicate): * sequence.c (count_with_tail): * sequence.c (list_count_from_end): * sequence.c (string_count_from_end): * sequence.c (Fcount): * sequence.c (Fsubseq): * sequence.c (list_position_cons_before): * sequence.c (FmemberX): * sequence.c (Fadjoin): * sequence.c (FassocX): * sequence.c (FrassocX): * sequence.c (position): * sequence.c (Fposition): * sequence.c (Ffind): * sequence.c (delq_no_quit_and_free_cons): * sequence.c (FdeleteX): * sequence.c (FremoveX): * sequence.c (list_delete_duplicates_from_end): * sequence.c (Fdelete_duplicates): * sequence.c (Fremove_duplicates): * sequence.c (Fnreverse): * sequence.c (Freverse): * sequence.c (list_merge): * sequence.c (array_merge): * sequence.c (list_array_merge_into_list): * sequence.c (list_list_merge_into_array): * sequence.c (list_array_merge_into_array): * sequence.c (Fmerge): * sequence.c (list_sort): * sequence.c (array_sort): * sequence.c (FsortX): * sequence.c (Ffill): * sequence.c (mapcarX): * sequence.c (shortest_length_among_sequences): * sequence.c (Fmapconcat): * sequence.c (FmapcarX): * sequence.c (Fmapvector): * sequence.c (Fmapcan): * sequence.c (Fmap): * sequence.c (Fmap_into): * sequence.c (Fsome): * sequence.c (Fevery): * sequence.c (Freduce): * sequence.c (replace_string_range_1): * sequence.c (Freplace): * sequence.c (Fnsubstitute): * sequence.c (Fsubstitute): * sequence.c (subst): * sequence.c (sublis): * sequence.c (Fsublis): * sequence.c (nsublis): * sequence.c (Fnsublis): * sequence.c (Fsubst): * sequence.c (Fnsubst): * sequence.c (tree_equal): * sequence.c (Ftree_equal): * sequence.c (mismatch_from_end): * sequence.c (mismatch_list_list): * sequence.c (mismatch_list_string): * sequence.c (mismatch_list_array): * sequence.c (mismatch_string_array): * sequence.c (mismatch_string_string): * sequence.c (mismatch_array_array): * sequence.c (get_mismatch_func): * sequence.c (Fmismatch): * sequence.c (Fsearch): * sequence.c (venn): * sequence.c (nvenn): * sequence.c (Funion): * sequence.c (Fset_exclusive_or): * sequence.c (Fnset_exclusive_or): * sequence.c (syms_of_sequence): Add this file, containing those general functions that dealt with sequences that were in fns.c. * symsinit.h: Make syms_of_sequence() available here. man/ChangeLog addition: 2011-12-04 Aidan Kehoe <kehoea@parhasard.net> * internals/internals.texi (Basic Lisp Modules): Document sequence.c here too.
author Aidan Kehoe <kehoea@parhasard.net>
date Sun, 04 Dec 2011 18:42:50 +0000
parents 56144c8593a8
children 3192994c49ca
comparison
equal deleted inserted replaced
5606:7c383c5784ed 5607:1a507c4c6c42
1984 #endif /* unused */ 1984 #endif /* unused */
1985 1985
1986 /************************************************************************/ 1986 /************************************************************************/
1987 /* Bit Vector allocation */ 1987 /* Bit Vector allocation */
1988 /************************************************************************/ 1988 /************************************************************************/
1989
1990 static Lisp_Object
1991 mark_bit_vector (Lisp_Object UNUSED (obj))
1992 {
1993 return Qnil;
1994 }
1995
1996 static void
1997 print_bit_vector (Lisp_Object obj, Lisp_Object printcharfun,
1998 int UNUSED (escapeflag))
1999 {
2000 Elemcount i;
2001 Lisp_Bit_Vector *v = XBIT_VECTOR (obj);
2002 Elemcount len = bit_vector_length (v);
2003 Elemcount last = len;
2004
2005 if (FIXNUMP (Vprint_length))
2006 last = min (len, XFIXNUM (Vprint_length));
2007 write_ascstring (printcharfun, "#*");
2008 for (i = 0; i < last; i++)
2009 {
2010 if (bit_vector_bit (v, i))
2011 write_ascstring (printcharfun, "1");
2012 else
2013 write_ascstring (printcharfun, "0");
2014 }
2015
2016 if (last != len)
2017 write_ascstring (printcharfun, "...");
2018 }
2019
2020 static int
2021 bit_vector_equal (Lisp_Object obj1, Lisp_Object obj2, int UNUSED (depth),
2022 int UNUSED (foldcase))
2023 {
2024 Lisp_Bit_Vector *v1 = XBIT_VECTOR (obj1);
2025 Lisp_Bit_Vector *v2 = XBIT_VECTOR (obj2);
2026
2027 return ((bit_vector_length (v1) == bit_vector_length (v2)) &&
2028 !memcmp (v1->bits, v2->bits,
2029 BIT_VECTOR_LONG_STORAGE (bit_vector_length (v1)) *
2030 sizeof (long)));
2031 }
2032
2033 /* This needs to be algorithmically identical to internal_array_hash in
2034 elhash.c when equalp is one, so arrays and bit vectors with the same
2035 contents hash the same. It would be possible to enforce this by giving
2036 internal_ARRAYLIKE_hash its own file and including it twice, but right
2037 now that doesn't seem worth it. */
2038 static Hashcode
2039 internal_bit_vector_equalp_hash (Lisp_Bit_Vector *v)
2040 {
2041 int ii, size = bit_vector_length (v);
2042 Hashcode hash = 0;
2043
2044 if (size <= 5)
2045 {
2046 for (ii = 0; ii < size; ii++)
2047 {
2048 hash = HASH2
2049 (hash,
2050 FLOAT_HASHCODE_FROM_DOUBLE ((double) (bit_vector_bit (v, ii))));
2051 }
2052 return hash;
2053 }
2054
2055 /* just pick five elements scattered throughout the array.
2056 A slightly better approach would be to offset by some
2057 noise factor from the points chosen below. */
2058 for (ii = 0; ii < 5; ii++)
2059 hash = HASH2 (hash,
2060 FLOAT_HASHCODE_FROM_DOUBLE
2061 ((double) (bit_vector_bit (v, ii * size / 5))));
2062
2063 return hash;
2064 }
2065
2066 static Hashcode
2067 bit_vector_hash (Lisp_Object obj, int UNUSED (depth), Boolint equalp)
2068 {
2069 Lisp_Bit_Vector *v = XBIT_VECTOR (obj);
2070 if (equalp)
2071 {
2072 return HASH2 (bit_vector_length (v),
2073 internal_bit_vector_equalp_hash (v));
2074 }
2075
2076 return HASH2 (bit_vector_length (v),
2077 memory_hash (v->bits,
2078 BIT_VECTOR_LONG_STORAGE (bit_vector_length (v)) *
2079 sizeof (long)));
2080 }
2081
2082 static Bytecount
2083 size_bit_vector (Lisp_Object obj)
2084 {
2085 Lisp_Bit_Vector *v = XBIT_VECTOR (obj);
2086 return FLEXIBLE_ARRAY_STRUCT_SIZEOF (Lisp_Bit_Vector, unsigned long, bits,
2087 BIT_VECTOR_LONG_STORAGE (bit_vector_length (v)));
2088 }
2089
2090 static const struct memory_description bit_vector_description[] = {
2091 { XD_END }
2092 };
2093
2094
2095 DEFINE_DUMPABLE_SIZABLE_LISP_OBJECT ("bit-vector", bit_vector,
2096 mark_bit_vector,
2097 print_bit_vector, 0,
2098 bit_vector_equal,
2099 bit_vector_hash,
2100 bit_vector_description,
2101 size_bit_vector,
2102 Lisp_Bit_Vector);
1989 2103
1990 /* #### should allocate `small' bit vectors from a frob-block */ 2104 /* #### should allocate `small' bit vectors from a frob-block */
1991 static Lisp_Bit_Vector * 2105 static Lisp_Bit_Vector *
1992 make_bit_vector_internal (Elemcount sizei) 2106 make_bit_vector_internal (Elemcount sizei)
1993 { 2107 {
5794 init_lcrecord_lists (); 5908 init_lcrecord_lists ();
5795 #endif /* not NEW_GC */ 5909 #endif /* not NEW_GC */
5796 5910
5797 INIT_LISP_OBJECT (cons); 5911 INIT_LISP_OBJECT (cons);
5798 INIT_LISP_OBJECT (vector); 5912 INIT_LISP_OBJECT (vector);
5913 INIT_LISP_OBJECT (bit_vector);
5799 INIT_LISP_OBJECT (string); 5914 INIT_LISP_OBJECT (string);
5800 5915
5801 #ifdef NEW_GC 5916 #ifdef NEW_GC
5802 INIT_LISP_OBJECT (string_indirect_data); 5917 INIT_LISP_OBJECT (string_indirect_data);
5803 INIT_LISP_OBJECT (string_direct_data); 5918 INIT_LISP_OBJECT (string_direct_data);