#ifndef NO_UNION_TYPE
-#ifndef BIG_ENDIAN
+#ifndef WORDS_BIG_ENDIAN
/* Definition of Lisp_Object for little-endian machines. */
}
Lisp_Object;
-#else /* If BIG_ENDIAN */
+#else /* If WORDS_BIG_ENDIAN */
typedef
union Lisp_Object
}
Lisp_Object;
-#endif /* BIG_ENDIAN */
+#endif /* WORDS_BIG_ENDIAN */
#endif /* NO_UNION_TYPE */
#define VALMASK ((1<<VALBITS) - 1)
#endif
#define GCTYPEMASK ((1<<GCTYPEBITS) - 1)
+
+/* Two flags that are set during GC. On some machines, these flags
+ are defined differently by the m- file. */
+
+/* This is set in the car of a cons and in the plist slot of a symbol
+ to indicate it is marked. Likewise in the plist slot of an interval,
+ the chain slot of a marker, the type slot of a float, and the name
+ slot of a buffer.
+
+ In strings, this bit in the size field indicates that the string
+ is a "large" one, one which was separately malloc'd
+ rather than being part of a string block. */
+
#define MARKBIT (1 << (VALBITS + GCTYPEBITS))
+/* In the size word of a vector, this bit means the vector has been marked.
+ In the size word of a large string, likewise. */
+
+#ifndef ARRAY_MARK_FLAG
+#define ARRAY_MARK_FLAG ((MARKBIT >> 1) & ~MARKBIT)
+#endif /* no ARRAY_MARK_FLAG */
+
+#if ARRAY_MARK_FLAG == MARKBIT
+you lose
+#endif
+
#endif /* NO_UNION_TYPE */
\f
/* These macros extract various sorts of values from a Lisp_Object.
unsigned int position; /* Cache of interval's character position */
struct interval *left; /* Intervals which precede me. */
struct interval *right; /* Intervals which succeed me. */
- struct interval *parent; /* Parent in the tree, or the Lisp_Object
- containing this interval tree. */
+
+ /* Parent in the tree, or the Lisp_Object containing this interval tree.
+
+ The mark bit on the root interval of an interval tree says
+ whether we have started (and possibly finished) marking the
+ tree. If GC comes across an interval tree whose root's parent
+ field has its markbit set, it leaves the tree alone.
+
+ You'd think we could store this information in the parent object
+ somewhere (after all, that should be visited once and then
+ ignored too, right?), but strings are GC'd strangely. */
+ struct interval *parent;
/* The remaining components are `properties' of the interval.
The first four are duplicates for things which can be on the list,
before this interval goes into it. */
unsigned char rear_sticky; /* Likewise for just after it. */
- Lisp_Object plist; /* Properties of this interval. */
+ /* Properties of this interval.
+ The mark bit on this field says whether this particular interval
+ tree node has been visited. Since intervals should never be
+ shared, GC aborts if it seems to have visited an interval twice. */
+ Lisp_Object plist;
};
typedef struct interval *INTERVAL;
#define CHAR_CTL (0x400000)
#define CHAR_META (0x800000)
+#ifdef USE_X_TOOLKIT
+#ifdef NO_UNION_TYPE
+/* Use this for turning a (void *) into a Lisp_Object, as when the
+ Lisp_Object is passed into a toolkit callback function. */
+#define VOID_TO_LISP(larg,varg) \
+ do { ((larg) = ((Lisp_Object) (varg))); } while (0)
+#define CVOID_TO_LISP VOID_TO_LISP
+
+/* Use this for turning a Lisp_Object into a (void *), as when the
+ Lisp_Object is passed into a toolkit callback function. */
+#define LISP_TO_VOID(larg) ((void *) (larg))
+#define LISP_TO_CVOID(varg) ((const void *) (larg))
+
+#else /* not NO_UNION_TYPE */
+/* Use this for turning a (void *) into a Lisp_Object, as when the
+ Lisp_Object is passed into a toolkit callback function. */
+#define VOID_TO_LISP(larg,varg) \
+ do { ((larg).v = (void *) (varg)); } while (0)
+#define CVOID_TO_LISP(larg,varg) \
+ do { ((larg).cv = (const void *) (varg)); } while (0)
+
+/* Use this for turning a Lisp_Object into a (void *), as when the
+ Lisp_Object is passed into a toolkit callback function. */
+#define LISP_TO_VOID(larg) ((larg).v)
+#define LISP_TO_CVOID(larg) ((larg).cv)
+#endif /* not NO_UNION_TYPE */
+#endif /* USE_X_TOOLKIT */
+
\f
/* The glyph datatype, used to represent characters on the display. */
/* Return a glyph's face ID. */
#define GLYPH_FACE(glyph) (((glyph) >> 8) & ((1 << 24) - 1))
+/* The ID of the mode line highlighting face. */
+#define GLYPH_MODE_LINE_FACE 1
\f
/* Data type checking */
#define GC_EQ(x, y) (XGCTYPE (x) == XGCTYPE (y) && XPNTR (x) == XPNTR (y))
#define CHECK_LIST(x, i) \
- { if ((XTYPE ((x)) != Lisp_Cons) && !NILP (x)) x = wrong_type_argument (Qlistp, (x)); }
+ do { if ((XTYPE ((x)) != Lisp_Cons) && !NILP (x)) x = wrong_type_argument (Qlistp, (x)); } while (0)
#define CHECK_STRING(x, i) \
- { if (XTYPE ((x)) != Lisp_String) x = wrong_type_argument (Qstringp, (x)); }
+ do { if (XTYPE ((x)) != Lisp_String) x = wrong_type_argument (Qstringp, (x)); } while (0)
#define CHECK_CONS(x, i) \
- { if (XTYPE ((x)) != Lisp_Cons) x = wrong_type_argument (Qconsp, (x)); }
+ do { if (XTYPE ((x)) != Lisp_Cons) x = wrong_type_argument (Qconsp, (x)); } while (0)
#define CHECK_SYMBOL(x, i) \
- { if (XTYPE ((x)) != Lisp_Symbol) x = wrong_type_argument (Qsymbolp, (x)); }
+ do { if (XTYPE ((x)) != Lisp_Symbol) x = wrong_type_argument (Qsymbolp, (x)); } while (0)
#define CHECK_VECTOR(x, i) \
- { if (XTYPE ((x)) != Lisp_Vector) x = wrong_type_argument (Qvectorp, (x)); }
+ do { if (XTYPE ((x)) != Lisp_Vector) x = wrong_type_argument (Qvectorp, (x)); } while (0)
#define CHECK_BUFFER(x, i) \
- { if (XTYPE ((x)) != Lisp_Buffer) x = wrong_type_argument (Qbufferp, (x)); }
+ do { if (XTYPE ((x)) != Lisp_Buffer) x = wrong_type_argument (Qbufferp, (x)); } while (0)
#define CHECK_WINDOW(x, i) \
- { if (XTYPE ((x)) != Lisp_Window) x = wrong_type_argument (Qwindowp, (x)); }
+ do { if (XTYPE ((x)) != Lisp_Window) x = wrong_type_argument (Qwindowp, (x)); } while (0)
/* This macro rejects windows on the interior of the window tree as
"dead", which is what we want; this is an argument-checking macro, and
vchild, and hchild members are all nil. */
#define CHECK_LIVE_WINDOW(x, i) \
- { \
+ do { \
if (XTYPE ((x)) != Lisp_Window \
|| NILP (XWINDOW ((x))->buffer)) \
x = wrong_type_argument (Qwindow_live_p, (x)); \
- }
+ } while (0)
#define CHECK_PROCESS(x, i) \
- { if (XTYPE ((x)) != Lisp_Process) x = wrong_type_argument (Qprocessp, (x)); }
+ do { if (XTYPE ((x)) != Lisp_Process) x = wrong_type_argument (Qprocessp, (x)); } while (0)
#define CHECK_NUMBER(x, i) \
- { if (XTYPE ((x)) != Lisp_Int) x = wrong_type_argument (Qintegerp, (x)); }
+ do { if (XTYPE ((x)) != Lisp_Int) x = wrong_type_argument (Qintegerp, (x)); } while (0)
#define CHECK_NATNUM(x, i) \
- { if (XTYPE ((x)) != Lisp_Int || XINT ((x)) < 0) \
- x = wrong_type_argument (Qnatnump, (x)); }
+ do { if (XTYPE ((x)) != Lisp_Int || XINT ((x)) < 0) \
+ x = wrong_type_argument (Qnatnump, (x)); } while (0)
#define CHECK_MARKER(x, i) \
- { if (XTYPE ((x)) != Lisp_Marker) x = wrong_type_argument (Qmarkerp, (x)); }
+ do { if (XTYPE ((x)) != Lisp_Marker) x = wrong_type_argument (Qmarkerp, (x)); } while (0)
#define CHECK_NUMBER_COERCE_MARKER(x, i) \
- { if (XTYPE ((x)) == Lisp_Marker) XFASTINT (x) = marker_position (x); \
- else if (XTYPE ((x)) != Lisp_Int) x = wrong_type_argument (Qinteger_or_marker_p, (x)); }
+ do { if (XTYPE ((x)) == Lisp_Marker) XFASTINT (x) = marker_position (x); \
+ else if (XTYPE ((x)) != Lisp_Int) x = wrong_type_argument (Qinteger_or_marker_p, (x)); } while (0)
#ifdef LISP_FLOAT_TYPE
#define XFLOATINT(n) extract_float((n))
#define CHECK_FLOAT(x, i) \
-{ if (XTYPE (x) != Lisp_Float) \
- x = wrong_type_argument (Qfloatp, (x)); }
+ do { if (XTYPE (x) != Lisp_Float) \
+ x = wrong_type_argument (Qfloatp, (x)); } while (0)
#define CHECK_NUMBER_OR_FLOAT(x, i) \
-{ if (XTYPE (x) != Lisp_Float && XTYPE (x) != Lisp_Int) \
- x = wrong_type_argument (Qnumberp, (x)); }
+ do { if (XTYPE (x) != Lisp_Float && XTYPE (x) != Lisp_Int) \
+ x = wrong_type_argument (Qnumberp, (x)); } while (0)
#define CHECK_NUMBER_OR_FLOAT_COERCE_MARKER(x, i) \
-{ if (XTYPE (x) == Lisp_Marker) XFASTINT (x) = marker_position (x); \
+ do { if (XTYPE (x) == Lisp_Marker) XFASTINT (x) = marker_position (x); \
else if (XTYPE (x) != Lisp_Int && XTYPE (x) != Lisp_Float) \
- x = wrong_type_argument (Qnumber_or_marker_p, (x)); }
+ x = wrong_type_argument (Qnumber_or_marker_p, (x)); } while (0)
#else /* Not LISP_FLOAT_TYPE */
#endif /* LISP_FLOAT_TYPE */
#define CHECK_OVERLAY(x, i) \
- { if (XTYPE ((x)) != Lisp_Overlay) x = wrong_type_argument (Qoverlayp, (x));}
+ do { if (XTYPE ((x)) != Lisp_Overlay) x = wrong_type_argument (Qoverlayp, (x));} while (0)
/* Cast pointers to this type to compare them. Some machines want int. */
#ifndef PNTR_COMPARISON_TYPE
`doc' is documentation for the user.
*/
+#ifndef __STDC__
#define DEFUN(lname, fnname, sname, minargs, maxargs, prompt, doc) \
Lisp_Object fnname (); \
struct Lisp_Subr sname = {fnname, minargs, maxargs, lname, prompt, 0}; \
Lisp_Object fnname
+#else
+
+/* This version of DEFUN declares a function prototype with the right
+ arguments, so we can catch errors with maxargs at compile-time. */
+#define DEFUN(lname, fnname, sname, minargs, maxargs, prompt, doc) \
+ Lisp_Object fnname DEFUN_ARGS_ ## maxargs ; \
+ struct Lisp_Subr sname = {fnname, minargs, maxargs, lname, prompt, 0}; \
+ Lisp_Object fnname
+
+/* Note that the weird token-substitution semantics of ANSI C makes
+ this work for MANY and UNEVALLED. */
+#define DEFUN_ARGS_MANY (int, Lisp_Object *)
+#define DEFUN_ARGS_UNEVALLED (Lisp_Object)
+#define DEFUN_ARGS_0 (void)
+#define DEFUN_ARGS_1 (Lisp_Object)
+#define DEFUN_ARGS_2 (Lisp_Object, Lisp_Object)
+#define DEFUN_ARGS_3 (Lisp_Object, Lisp_Object, Lisp_Object)
+#define DEFUN_ARGS_4 (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object)
+#define DEFUN_ARGS_5 (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, \
+ Lisp_Object)
+#define DEFUN_ARGS_6 (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, \
+ Lisp_Object, Lisp_Object)
+#define DEFUN_ARGS_7 (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, \
+ Lisp_Object, Lisp_Object, Lisp_Object)
+#endif
+
/* defsubr (Sname);
is how we define the symbol for function `name' at start-up time. */
extern void defsubr ();
/* The handler clauses and variable from the condition-case form. */
Lisp_Object handler;
Lisp_Object var;
+ /* Fsignal stores here the condition-case clause that applies,
+ and Fcondition_case thus knows which clause to run. */
+ Lisp_Object chosen_clause;
/* Used to effect the longjump out to the handler. */
struct catchtag *tag;
extern struct catchtag *catchlist;
extern struct backtrace *backtrace_list;
+extern Lisp_Object memory_signal_data;
+
/* An address near the bottom of the stack.
Tells GC how to save a copy of the stack. */
extern char *stack_bottom;
Normally every link of the chain is an automatic variable of a function,
and its `val' points to some argument or local variable of the function.
On exit to the function, the chain is set back to the value it had on entry.
- This way, no link remains in the chain when the stack frame containing the link disappears.
+ This way, no link remains in the chain when the stack frame containing the
+ link disappears.
Every function that can call Feval must protect in this fashion all
Lisp_Object variables whose contents will be used again. */
ret_ungc_val = (expr); \
UNGCPRO; \
return ret_ungc_val; \
- } \
+ }
\f
/* Defined in data.c */
extern Lisp_Object Qnil, Qt, Qquote, Qlambda, Qsubr, Qunbound;
extern Lisp_Object Qinvalid_function, Qwrong_number_of_arguments, Qno_catch;
extern Lisp_Object Qend_of_file, Qarith_error;
extern Lisp_Object Qbeginning_of_buffer, Qend_of_buffer, Qbuffer_read_only;
+extern Lisp_Object Qmark_inactive;
extern Lisp_Object Qrange_error, Qdomain_error, Qsingularity_error;
extern Lisp_Object Qoverflow_error, Qunderflow_error;
extern Lisp_Object Vinhibit_quit, Qinhibit_quit, Vquit_flag;
extern Lisp_Object Vmocklisp_arguments, Qmocklisp, Qmocklisp_arguments;
extern Lisp_Object Vautoload_queue;
+/* To run a normal hook, do
+ if (!NILP (Vrun_hooks))
+ call1 (Vrun_hooks, Qmy_funny_hook); */
extern Lisp_Object Vrun_hooks;
extern Lisp_Object Fand (), For (), Fif (), Fprogn (), Fprog1 (), Fprog2 ();
extern Lisp_Object Fsetq (), Fquote ();
extern Lisp_Object apply_lambda ();
extern Lisp_Object internal_catch ();
extern Lisp_Object internal_condition_case ();
+extern Lisp_Object internal_condition_case_1 ();
extern Lisp_Object unbind_to ();
extern void error ();
extern Lisp_Object un_autoload ();
/* defined in keymap.c */
-extern Lisp_Object Qkeymap;
+extern Lisp_Object Qkeymap, Qmenu_bar;
extern Lisp_Object current_global_map;
extern Lisp_Object Fkey_description (), Fsingle_key_description ();
extern Lisp_Object Fwhere_is_internal ();
extern Lisp_Object Fvertical_motion (), Findent_to (), Fcurrent_column ();
/* defined in window.c */
-extern Lisp_Object Qwindowp, Qwindow_live_p, Qvisible;
+extern Lisp_Object Qwindowp, Qwindow_live_p;
extern Lisp_Object Fget_buffer_window ();
extern Lisp_Object Fsave_window_excursion ();
extern Lisp_Object Fset_window_configuration (), Fcurrent_window_configuration ();
extern int window_internal_height (), window_internal_width ();
/* defined in frame.c */
+extern Lisp_Object Qvisible;
extern Lisp_Object Fframep ();
extern Lisp_Object Fselect_frame ();
extern Lisp_Object Ffocus_frame ();
/* defined in emacs.c */
extern Lisp_Object decode_env_path ();
-extern Lisp_Object Vinvocation_name;
-void shut_down_emacs ( /* int signal, int no_x */ );
+extern Lisp_Object Vinvocation_name, Vinvocation_directory;
+extern Lisp_Object Vinstallation_directory;
+void shut_down_emacs ( /* int signal, int no_x, Lisp_Object stuff */ );
/* Nonzero means don't do interactive redisplay and don't change tty modes */
extern int noninteractive;
/* Nonzero means don't do use window-system-specific display code */
/* defined in callproc.c */
extern Lisp_Object Vexec_path, Vexec_directory, Vdata_directory;
+extern Lisp_Object Vdoc_directory;
/* defined in doc.c */
extern Lisp_Object Vdoc_file_name;
extern Lisp_Object Fundo_boundary ();
extern Lisp_Object truncate_undo_list ();
+/* defined in textprop.c */
+extern Lisp_Object Qmodification_hooks;
+extern Lisp_Object Qinsert_in_front_hooks, Qinsert_behind_hooks;
+extern Lisp_Object Fnext_property_change ();
+extern Lisp_Object Fnext_single_property_change ();
+
/* Nonzero means Emacs has already been initialized.
Used during startup to detect startup of dumped Emacs. */
extern int initialized;
extern char *egetenv ();
+/* Return the name of the machine we're running on. */
+extern char *get_system_name ();
HCoop / bpt / emacs.git / blobdiff