along with GNU Emacs; see the file COPYING. If not, write to
the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */
+/* Note that this declares bzero on OSF/1. How dumb. */
#include <signal.h>
#include <config.h>
/* Define DONT_COPY_FLAG to be some bit which will always be zero in a
pointer to a Lisp_Object, when that pointer is viewed as an integer.
(On most machines, pointers are even, so we can use the low bit.
- Word-addressible architectures may need to override this in the m-file.)
+ Word-addressable architectures may need to override this in the m-file.)
When linking references to small strings through the size field, we
use this slot to hold the bit that would otherwise be interpreted as
the GC mark bit. */
/* Non-zero means ignore malloc warnings. Set during initialization. */
int ignore_warnings;
-Lisp_Object Qgc_cons_threshold;
+Lisp_Object Qgc_cons_threshold, Qchar_table_extra_slots;
static void mark_object (), mark_buffer (), mark_kboards ();
static void clear_marks (), gc_sweep ();
= (struct interval_block *) malloc (sizeof (struct interval_block));
allocating_for_lisp = 0;
interval_block->next = 0;
- bzero (interval_block->intervals, sizeof interval_block->intervals);
+ bzero ((char *) interval_block->intervals, sizeof interval_block->intervals);
interval_block_index = 0;
interval_free_list = 0;
}
float_block = (struct float_block *) malloc (sizeof (struct float_block));
allocating_for_lisp = 0;
float_block->next = 0;
- bzero (float_block->floats, sizeof float_block->floats);
+ bzero ((char *) float_block->floats, sizeof float_block->floats);
float_block_index = 0;
float_free_list = 0;
}
cons_block = (struct cons_block *) malloc (sizeof (struct cons_block));
allocating_for_lisp = 0;
cons_block->next = 0;
- bzero (cons_block->conses, sizeof cons_block->conses);
+ bzero ((char *) cons_block->conses, sizeof cons_block->conses);
cons_block_index = 0;
cons_free_list = 0;
}
int nargs;
register Lisp_Object *args;
{
- register Lisp_Object val = Qnil;
+ register Lisp_Object val;
+ val = Qnil;
- while (nargs--)
- val = Fcons (args[nargs], val);
+ while (nargs > 0)
+ {
+ nargs--;
+ val = Fcons (args[nargs], val);
+ }
return val;
}
return vector;
}
-DEFUN ("make-char-table", Fmake_char_table, Smake_char_table, 0, 2, 0,
- "Return a newly created char-table, with N \"extra\" slots.\n\
+DEFUN ("make-char-table", Fmake_char_table, Smake_char_table, 1, 2, 0,
+ "Return a newly created char-table, with purpose PURPOSE.\n\
Each element is initialized to INIT, which defaults to nil.\n\
-N may not be more than ten.\n\
-See `char-table-extra-slot' and `set-char-table-extra-slot'.")
- (n, init)
- register Lisp_Object n, init;
+PURPOSE should be a symbol which has a `char-table-extra-slot' property.\n\
+The property's value should be an integer between 0 and 10.")
+ (purpose, init)
+ register Lisp_Object purpose, init;
{
Lisp_Object vector;
- CHECK_NUMBER (n, 1);
+ Lisp_Object n;
+ CHECK_SYMBOL (purpose, 1);
+ n = Fget (purpose, Qchar_table_extra_slots);
+ CHECK_NUMBER (n, 0);
if (XINT (n) < 0 || XINT (n) > 10)
args_out_of_range (n, Qnil);
/* Add 2 to the size for the defalt and parent slots. */
vector = Fmake_vector (make_number (CHAR_TABLE_STANDARD_SLOTS + XINT (n)),
init);
XCHAR_TABLE (vector)->parent = Qnil;
+ XCHAR_TABLE (vector)->purpose = purpose;
XSETCHAR_TABLE (vector, XCHAR_TABLE (vector));
return vector;
}
symbol_block = (struct symbol_block *) malloc (sizeof (struct symbol_block));
allocating_for_lisp = 0;
symbol_block->next = 0;
- bzero (symbol_block->symbols, sizeof symbol_block->symbols);
+ bzero ((char *) symbol_block->symbols, sizeof symbol_block->symbols);
symbol_block_index = 0;
symbol_free_list = 0;
}
DEFUN ("make-symbol", Fmake_symbol, Smake_symbol, 1, 1, 0,
"Return a newly allocated uninterned symbol whose name is NAME.\n\
Its value and function definition are void, and its property list is nil.")
- (str)
- Lisp_Object str;
+ (name)
+ Lisp_Object name;
{
register Lisp_Object val;
register struct Lisp_Symbol *p;
- CHECK_STRING (str, 0);
+ CHECK_STRING (name, 0);
if (symbol_free_list)
{
XSETSYMBOL (val, &symbol_block->symbols[symbol_block_index++]);
}
p = XSYMBOL (val);
- p->name = XSTRING (str);
+ p->name = XSTRING (name);
p->plist = Qnil;
p->value = Qunbound;
p->function = Qunbound;
marker_block = (struct marker_block *) malloc (sizeof (struct marker_block));
allocating_for_lisp = 0;
marker_block->next = 0;
- bzero (marker_block->markers, sizeof marker_block->markers);
+ bzero ((char *) marker_block->markers, sizeof marker_block->markers);
marker_block_index = 0;
marker_free_list = 0;
}
CHECK_NATNUM (length, 0);
- bits_per_value = sizeof (EMACS_INT) * INTBITS / sizeof (int);
+ bits_per_value = sizeof (EMACS_INT) * BITS_PER_CHAR;
length_in_elts = (XFASTINT (length) + bits_per_value - 1) / bits_per_value;
length_in_chars = length_in_elts * sizeof (EMACS_INT);
{
int count = specpdl_ptr - specpdl;
Lisp_Object number;
- int nbits = min (VALBITS, INTBITS);
+ int nbits = min (VALBITS, BITS_PER_INT);
XSETINT (number, ((EMACS_INT) 1 << (nbits - 1)) - 1);
int last_marked_index;
static void
-mark_object (objptr)
- Lisp_Object *objptr;
+mark_object (argptr)
+ Lisp_Object *argptr;
{
+ Lisp_Object *objptr = argptr;
register Lisp_Object obj;
loop:
#ifndef standalone
/* Put all unmarked markers on free list.
- Dechain each one first from the buffer it points into,
+ Unchain each one first from the buffer it points into,
but only if it's a real marker. */
{
register struct marker_block *mblk;
Lisp_Object lisp_intervals_consed;
XSETINT (lisp_cons_cells_consed,
- cons_cells_consed & ~(1 << (VALBITS - 1)));
+ cons_cells_consed & ~(((EMACS_INT) 1) << (VALBITS - 1)));
XSETINT (lisp_floats_consed,
- floats_consed & ~(1 << (VALBITS - 1)));
+ floats_consed & ~(((EMACS_INT) 1) << (VALBITS - 1)));
XSETINT (lisp_vector_cells_consed,
- vector_cells_consed & ~(1 << (VALBITS - 1)));
+ vector_cells_consed & ~(((EMACS_INT) 1) << (VALBITS - 1)));
XSETINT (lisp_symbols_consed,
- symbols_consed & ~(1 << (VALBITS - 1)));
+ symbols_consed & ~(((EMACS_INT) 1) << (VALBITS - 1)));
XSETINT (lisp_string_chars_consed,
- string_chars_consed & ~(1 << (VALBITS - 1)));
+ string_chars_consed & ~(((EMACS_INT) 1) << (VALBITS - 1)));
XSETINT (lisp_misc_objects_consed,
- misc_objects_consed & ~(1 << (VALBITS - 1)));
+ misc_objects_consed & ~(((EMACS_INT) 1) << (VALBITS - 1)));
XSETINT (lisp_intervals_consed,
- intervals_consed & ~(1 << (VALBITS - 1)));
+ intervals_consed & ~(((EMACS_INT) 1) << (VALBITS - 1)));
return Fcons (lisp_cons_cells_consed,
Fcons (lisp_floats_consed,
staticpro (&Qgc_cons_threshold);
Qgc_cons_threshold = intern ("gc-cons-threshold");
+ staticpro (&Qchar_table_extra_slots);
+ Qchar_table_extra_slots = intern ("char-table-extra-slots");
+
defsubr (&Scons);
defsubr (&Slist);
defsubr (&Svector);