+/* Make a multibyte string from NCHARS characters occupying NBYTES
+ bytes at CONTENTS. */
+
+Lisp_Object
+make_multibyte_string (contents, nchars, nbytes)
+ char *contents;
+ int nchars, nbytes;
+{
+ register Lisp_Object val;
+ val = make_uninit_multibyte_string (nchars, nbytes);
+ bcopy (contents, XSTRING (val)->data, nbytes);
+ return val;
+}
+
+
+/* Make a string from NCHARS characters occupying NBYTES bytes at
+ CONTENTS. It is a multibyte string if NBYTES != NCHARS. */
+
+Lisp_Object
+make_string_from_bytes (contents, nchars, nbytes)
+ char *contents;
+ int nchars, nbytes;
+{
+ register Lisp_Object val;
+ val = make_uninit_multibyte_string (nchars, nbytes);
+ bcopy (contents, XSTRING (val)->data, nbytes);
+ if (STRING_BYTES (XSTRING (val)) == XSTRING (val)->size)
+ SET_STRING_BYTES (XSTRING (val), -1);
+ return val;
+}
+
+
+/* Make a string from NCHARS characters occupying NBYTES bytes at
+ CONTENTS. The argument MULTIBYTE controls whether to label the
+ string as multibyte. */
+
+Lisp_Object
+make_specified_string (contents, nchars, nbytes, multibyte)
+ char *contents;
+ int nchars, nbytes;
+ int multibyte;
+{
+ register Lisp_Object val;
+ val = make_uninit_multibyte_string (nchars, nbytes);
+ bcopy (contents, XSTRING (val)->data, nbytes);
+ if (!multibyte)
+ SET_STRING_BYTES (XSTRING (val), -1);
+ return val;
+}
+
+
+/* Make a string from the data at STR, treating it as multibyte if the
+ data warrants. */
+
+Lisp_Object
+build_string (str)
+ char *str;
+{
+ return make_string (str, strlen (str));
+}
+
+
+/* Return an unibyte Lisp_String set up to hold LENGTH characters
+ occupying LENGTH bytes. */
+
+Lisp_Object
+make_uninit_string (length)
+ int length;
+{
+ Lisp_Object val;
+ val = make_uninit_multibyte_string (length, length);
+ SET_STRING_BYTES (XSTRING (val), -1);
+ return val;
+}
+
+
+/* Return a multibyte Lisp_String set up to hold NCHARS characters
+ which occupy NBYTES bytes. */
+
+Lisp_Object
+make_uninit_multibyte_string (nchars, nbytes)
+ int nchars, nbytes;
+{
+ Lisp_Object string;
+ struct Lisp_String *s;
+
+ if (nchars < 0)
+ abort ();
+
+ s = allocate_string ();
+ allocate_string_data (s, nchars, nbytes);
+ XSETSTRING (string, s);
+ string_chars_consed += nbytes;
+ return string;
+}
+
+
+\f
+/***********************************************************************
+ Float Allocation
+ ***********************************************************************/
+
+/* We store float cells inside of float_blocks, allocating a new
+ float_block with malloc whenever necessary. Float cells reclaimed
+ by GC are put on a free list to be reallocated before allocating
+ any new float cells from the latest float_block.
+
+ Each float_block is just under 1020 bytes long, since malloc really
+ allocates in units of powers of two and uses 4 bytes for its own
+ overhead. */
+
+#define FLOAT_BLOCK_SIZE \
+ ((1020 - sizeof (struct float_block *)) / sizeof (struct Lisp_Float))
+
+struct float_block
+{
+ struct float_block *next;
+ struct Lisp_Float floats[FLOAT_BLOCK_SIZE];
+};
+
+/* Current float_block. */
+
+struct float_block *float_block;
+
+/* Index of first unused Lisp_Float in the current float_block. */
+
+int float_block_index;
+
+/* Total number of float blocks now in use. */
+
+int n_float_blocks;
+
+/* Free-list of Lisp_Floats. */
+
+struct Lisp_Float *float_free_list;
+
+
+/* Initialze float allocation. */
+
+void
+init_float ()
+{
+ float_block = (struct float_block *) lisp_malloc (sizeof *float_block,
+ MEM_TYPE_FLOAT);
+ float_block->next = 0;
+ bzero ((char *) float_block->floats, sizeof float_block->floats);
+ float_block_index = 0;
+ float_free_list = 0;
+ n_float_blocks = 1;
+}
+
+
+/* Explicitly free a float cell by putting it on the free-list. */
+
+void
+free_float (ptr)
+ struct Lisp_Float *ptr;
+{
+ *(struct Lisp_Float **)&ptr->data = float_free_list;
+#if GC_MARK_STACK
+ ptr->type = Vdead;
+#endif
+ float_free_list = ptr;
+}
+
+
+/* Return a new float object with value FLOAT_VALUE. */
+
+Lisp_Object
+make_float (float_value)
+ double float_value;
+{
+ register Lisp_Object val;
+
+ if (float_free_list)
+ {
+ /* We use the data field for chaining the free list
+ so that we won't use the same field that has the mark bit. */
+ XSETFLOAT (val, float_free_list);
+ float_free_list = *(struct Lisp_Float **)&float_free_list->data;
+ }
+ else
+ {
+ if (float_block_index == FLOAT_BLOCK_SIZE)
+ {
+ register struct float_block *new;
+
+ new = (struct float_block *) lisp_malloc (sizeof *new,
+ MEM_TYPE_FLOAT);
+ VALIDATE_LISP_STORAGE (new, sizeof *new);
+ new->next = float_block;
+ float_block = new;
+ float_block_index = 0;
+ n_float_blocks++;
+ }
+ XSETFLOAT (val, &float_block->floats[float_block_index++]);
+ }
+
+ XFLOAT_DATA (val) = float_value;
+ XSETFASTINT (XFLOAT (val)->type, 0); /* bug chasing -wsr */
+ consing_since_gc += sizeof (struct Lisp_Float);
+ floats_consed++;
+ return val;
+}
+
+
+\f
+/***********************************************************************
+ Cons Allocation
+ ***********************************************************************/
+
+/* We store cons cells inside of cons_blocks, allocating a new
+ cons_block with malloc whenever necessary. Cons cells reclaimed by
+ GC are put on a free list to be reallocated before allocating
+ any new cons cells from the latest cons_block.
+
+ Each cons_block is just under 1020 bytes long,
+ since malloc really allocates in units of powers of two
+ and uses 4 bytes for its own overhead. */
+
+#define CONS_BLOCK_SIZE \
+ ((1020 - sizeof (struct cons_block *)) / sizeof (struct Lisp_Cons))
+
+struct cons_block
+{
+ struct cons_block *next;
+ struct Lisp_Cons conses[CONS_BLOCK_SIZE];
+};
+
+/* Current cons_block. */
+
+struct cons_block *cons_block;
+
+/* Index of first unused Lisp_Cons in the current block. */
+
+int cons_block_index;
+
+/* Free-list of Lisp_Cons structures. */
+
+struct Lisp_Cons *cons_free_list;
+
+/* Total number of cons blocks now in use. */
+
+int n_cons_blocks;
+
+
+/* Initialize cons allocation. */
+
+void
+init_cons ()
+{
+ cons_block = (struct cons_block *) lisp_malloc (sizeof *cons_block,
+ MEM_TYPE_CONS);
+ cons_block->next = 0;
+ bzero ((char *) cons_block->conses, sizeof cons_block->conses);
+ cons_block_index = 0;
+ cons_free_list = 0;
+ n_cons_blocks = 1;
+}
+
+
+/* Explicitly free a cons cell by putting it on the free-list. */
+
+void
+free_cons (ptr)
+ struct Lisp_Cons *ptr;
+{
+ *(struct Lisp_Cons **)&ptr->cdr = cons_free_list;
+#if GC_MARK_STACK
+ ptr->car = Vdead;
+#endif
+ cons_free_list = ptr;
+}
+
+
+DEFUN ("cons", Fcons, Scons, 2, 2, 0,
+ "Create a new cons, give it CAR and CDR as components, and return it.")
+ (car, cdr)
+ Lisp_Object car, cdr;
+{
+ register Lisp_Object val;
+
+ if (cons_free_list)
+ {
+ /* We use the cdr for chaining the free list
+ so that we won't use the same field that has the mark bit. */
+ XSETCONS (val, cons_free_list);
+ cons_free_list = *(struct Lisp_Cons **)&cons_free_list->cdr;
+ }
+ else
+ {
+ if (cons_block_index == CONS_BLOCK_SIZE)
+ {
+ register struct cons_block *new;
+ new = (struct cons_block *) lisp_malloc (sizeof *new,
+ MEM_TYPE_CONS);
+ VALIDATE_LISP_STORAGE (new, sizeof *new);
+ new->next = cons_block;
+ cons_block = new;
+ cons_block_index = 0;
+ n_cons_blocks++;
+ }
+ XSETCONS (val, &cons_block->conses[cons_block_index++]);
+ }
+
+ XCAR (val) = car;
+ XCDR (val) = cdr;
+ consing_since_gc += sizeof (struct Lisp_Cons);
+ cons_cells_consed++;
+ return val;
+}
+
+
+/* Make a list of 2, 3, 4 or 5 specified objects. */
+
+Lisp_Object
+list2 (arg1, arg2)
+ Lisp_Object arg1, arg2;
+{
+ return Fcons (arg1, Fcons (arg2, Qnil));
+}
+
+
+Lisp_Object
+list3 (arg1, arg2, arg3)
+ Lisp_Object arg1, arg2, arg3;
+{
+ return Fcons (arg1, Fcons (arg2, Fcons (arg3, Qnil)));
+}
+
+
+Lisp_Object
+list4 (arg1, arg2, arg3, arg4)
+ Lisp_Object arg1, arg2, arg3, arg4;
+{
+ return Fcons (arg1, Fcons (arg2, Fcons (arg3, Fcons (arg4, Qnil))));
+}
+
+
+Lisp_Object
+list5 (arg1, arg2, arg3, arg4, arg5)
+ Lisp_Object arg1, arg2, arg3, arg4, arg5;
+{
+ return Fcons (arg1, Fcons (arg2, Fcons (arg3, Fcons (arg4,
+ Fcons (arg5, Qnil)))));
+}
+
+
+DEFUN ("list", Flist, Slist, 0, MANY, 0,
+ "Return a newly created list with specified arguments as elements.\n\
+Any number of arguments, even zero arguments, are allowed.")
+ (nargs, args)
+ int nargs;
+ register Lisp_Object *args;
+{
+ register Lisp_Object val;
+ val = Qnil;
+
+ while (nargs > 0)
+ {
+ nargs--;
+ val = Fcons (args[nargs], val);
+ }
+ return val;
+}
+
+
+DEFUN ("make-list", Fmake_list, Smake_list, 2, 2, 0,
+ "Return a newly created list of length LENGTH, with each element being INIT.")
+ (length, init)
+ register Lisp_Object length, init;
+{
+ register Lisp_Object val;
+ register int size;
+
+ CHECK_NATNUM (length, 0);
+ size = XFASTINT (length);
+
+ val = Qnil;
+ while (size-- > 0)
+ val = Fcons (init, val);
+ return val;
+}
+
+
+\f
+/***********************************************************************
+ Vector Allocation
+ ***********************************************************************/
+
+/* Singly-linked list of all vectors. */
+
+struct Lisp_Vector *all_vectors;
+
+/* Total number of vector-like objects now in use. */
+
+int n_vectors;
+
+
+/* Value is a pointer to a newly allocated Lisp_Vector structure
+ with room for LEN Lisp_Objects. */
+
+struct Lisp_Vector *
+allocate_vectorlike (len)
+ EMACS_INT len;
+{
+ struct Lisp_Vector *p;
+ size_t nbytes;
+
+#ifdef DOUG_LEA_MALLOC
+ /* Prevent mmap'ing the chunk. Lisp data may not be mmap'ed
+ because mapped region contents are not preserved in
+ a dumped Emacs. */
+ mallopt (M_MMAP_MAX, 0);
+#endif
+
+ nbytes = sizeof *p + (len - 1) * sizeof p->contents[0];
+ p = (struct Lisp_Vector *) lisp_malloc (nbytes, MEM_TYPE_VECTOR);
+
+#ifdef DOUG_LEA_MALLOC
+ /* Back to a reasonable maximum of mmap'ed areas. */
+ mallopt (M_MMAP_MAX, MMAP_MAX_AREAS);
+#endif
+
+ VALIDATE_LISP_STORAGE (p, 0);
+ consing_since_gc += nbytes;
+ vector_cells_consed += len;
+
+ p->next = all_vectors;
+ all_vectors = p;
+ ++n_vectors;
+ return p;
+}
+
+
+DEFUN ("make-vector", Fmake_vector, Smake_vector, 2, 2, 0,
+ "Return a newly created vector of length LENGTH, with each element being INIT.\n\
+See also the function `vector'.")
+ (length, init)
+ register Lisp_Object length, init;
+{
+ Lisp_Object vector;
+ register EMACS_INT sizei;
+ register int index;
+ register struct Lisp_Vector *p;
+
+ CHECK_NATNUM (length, 0);
+ sizei = XFASTINT (length);
+
+ p = allocate_vectorlike (sizei);
+ p->size = sizei;