Mercurial > hg > xemacs-beta

comparison src/lisp.h @ 0:376386a54a3c r19-14

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r19-14
author cvs
date Mon, 13 Aug 2007 08:45:50 +0200
parents
children ac2d302a0011
comparison
equal deleted inserted replaced
-1:000000000000 0:376386a54a3c
1 /* Fundamental definitions for XEmacs Lisp interpreter.
2 Copyright (C) 1985-1987, 1992-1995 Free Software Foundation, Inc.
3 Copyright (C) 1993-1996 Richard Mlynarik.
4 Copyright (C) 1995, 1996 Ben Wing.
5
6 This file is part of XEmacs.
7
8 XEmacs is free software; you can redistribute it and/or modify it
9 under the terms of the GNU General Public License as published by the
10 Free Software Foundation; either version 2, or (at your option) any
11 later version.
12
13 XEmacs is distributed in the hope that it will be useful, but WITHOUT
14 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
15 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
16 for more details.
17
18 You should have received a copy of the GNU General Public License
19 along with XEmacs; see the file COPYING. If not, write to
20 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
21 Boston, MA 02111-1307, USA. */
22
23 /* Synched up with: FSF 19.30. */
24
25 #ifndef _XEMACS_LISP_H_
26 #define _XEMACS_LISP_H_
27
28 /************************************************************************/
29 /* general definitions */
30 /************************************************************************/
31
32 /* We include the following generally useful header files so that you
33 don't have to worry about prototypes when using the standard C
34 library functions and macros. These files shouldn't be excessively
35 large so they shouldn't cause that much of a slowdown. */
36
37 #include <stdlib.h>
38 #include <string.h> /* primarily for memcpy, etc. */
39 #include <stdio.h> /* NULL, etc. */
40 #include <ctype.h>
41 #include <stdarg.h>
42 #ifdef HAVE_UNISTD_H
43 #include <unistd.h>
44 #endif
45 #ifndef INCLUDED_FCNTL
46 # define INCLUDED_FCNTL
47 # include <fcntl.h>
48 #endif /* INCLUDED_FCNTL */
49
50 #ifdef __lucid
51 # include <sysent.h>
52 #endif
53
54 #include "blocktype.h" /* A generally useful include */
55 #include "dynarr.h" /* A generally useful include */
56 #include "symsinit.h" /* compiler warning suppression */
57
58 /* Also define min() and max(). (Some compilers put them in strange
59 places that won't be referenced by the above include files, such
60 as 'macros.h' under Solaris.) */
61
62 #ifndef min
63 #define min(a,b) ((a) <= (b) ? (a) : (b))
64 #endif
65 #ifndef max
66 #define max(a,b) ((a) > (b) ? (a) : (b))
67 #endif
68
69 /* Emacs needs to use its own definitions of certain system calls on
70 some systems (like SunOS 4.1 and USG systems, where the read system
71 call is interruptible but Emacs expects it not to be; and under
72 MULE, where all filenames need to be converted to external format).
73 To do this, we #define read to be sys_read, which is defined in
74 sysdep.c. We first #undef read, in case some system file defines
75 read as a macro. sysdep.c doesn't encapsulate read, so the call to
76 read inside of sys_read will do the right thing.
77
78 DONT_ENCAPSULATE is used in files such as sysdep.c that want to
79 call the actual system calls rather than the encapsulated versions.
80 Those files can call sys_read to get the (possibly) encapsulated
81 versions.
82
83 IMPORTANT: the redefinition of the system call must occur *after* the
84 inclusion of any header files that declare or define the system call;
85 otherwise lots of unfriendly things can happen. This goes for all
86 encapsulated system calls.
87
88 We encapsulate the most common system calls here; we assume their
89 declarations are in one of the standard header files included above.
90 Other encapsulations are declared in the appropriate sys*.h file. */
91
92 #if defined (ENCAPSULATE_READ) && !defined (DONT_ENCAPSULATE)
93 # undef read
94 # define read sys_read
95 #endif
96 #if !defined (ENCAPSULATE_READ) && defined (DONT_ENCAPSULATE)
97 # define sys_read read
98 #endif
99
100 #if defined (ENCAPSULATE_WRITE) && !defined (DONT_ENCAPSULATE)
101 # undef write
102 # define write sys_write
103 #endif
104 #if !defined (ENCAPSULATE_WRITE) && defined (DONT_ENCAPSULATE)
105 # define sys_write write
106 #endif
107
108 #if defined (ENCAPSULATE_OPEN) && !defined (DONT_ENCAPSULATE)
109 # undef open
110 # define open sys_open
111 #endif
112 #if !defined (ENCAPSULATE_OPEN) && defined (DONT_ENCAPSULATE)
113 # define sys_open open
114 #endif
115
116 #if defined (ENCAPSULATE_CLOSE) && !defined (DONT_ENCAPSULATE)
117 # undef close
118 # define close sys_close
119 #endif
120 #if !defined (ENCAPSULATE_CLOSE) && defined (DONT_ENCAPSULATE)
121 # define sys_close close
122 #endif
123
124 /* Now the stdio versions ... */
125
126 #if defined (ENCAPSULATE_FREAD) && !defined (DONT_ENCAPSULATE)
127 # undef fread
128 # define fread sys_fread
129 #endif
130 #if !defined (ENCAPSULATE_FREAD) && defined (DONT_ENCAPSULATE)
131 # define sys_fread fread
132 #endif
133
134 #if defined (ENCAPSULATE_FWRITE) && !defined (DONT_ENCAPSULATE)
135 # undef fwrite
136 # define fwrite sys_fwrite
137 #endif
138 #if !defined (ENCAPSULATE_FWRITE) && defined (DONT_ENCAPSULATE)
139 # define sys_fwrite fwrite
140 #endif
141
142 #if defined (ENCAPSULATE_FOPEN) && !defined (DONT_ENCAPSULATE)
143 # undef fopen
144 # define fopen sys_fopen
145 #endif
146 #if !defined (ENCAPSULATE_FOPEN) && defined (DONT_ENCAPSULATE)
147 # define sys_fopen fopen
148 #endif
149
150 #if defined (ENCAPSULATE_FCLOSE) && !defined (DONT_ENCAPSULATE)
151 # undef fclose
152 # define fclose sys_fclose
153 #endif
154 #if !defined (ENCAPSULATE_FCLOSE) && defined (DONT_ENCAPSULATE)
155 # define sys_fclose fclose
156 #endif
157
158 /* generally useful */
159 #define countof(x) (sizeof(x)/sizeof(x[0]))
160 #define slot_offset(type, slot_name) \
161 ((unsigned) (((char *) (&(((type *)0)->slot_name))) - ((char *)0)))
162 #define malloc_type(type) ((type *) xmalloc (sizeof (type)))
163 #define malloc_type_and_zero(type) ((type *) xmalloc_and_zero (sizeof (type)))
164
165 /* also generally useful if you want to avoid arbitrary size limits
166 but don't need a full dynamic array. Assumes that BASEVAR points
167 to a malloced array of TYPE objects (or possibly a NULL pointer,
168 if SIZEVAR is 0), with the total size stored in SIZEVAR. This
169 macro will realloc BASEVAR as necessary so that it can hold at
170 least NEEDED_SIZE objects. The reallocing is done by doubling,
171 which ensures constant amortized time per element. */
172 #define DO_REALLOC(basevar, sizevar, needed_size, type) do \
173 { \
174 /* Avoid side-effectualness. */ \
175 /* Dammit! Macros suffer from dynamic scope! */ \
176 /* We demand inline functions! */ \
177 int do_realloc_needed_size = (needed_size); \
178 int newsize = 0; \
179 while ((sizevar) < (do_realloc_needed_size)) { \
180 newsize = 2*(sizevar); \
181 if (newsize < 32) \
182 newsize = 32; \
183 (sizevar) = newsize; \
184 } \
185 if (newsize) \
186 (basevar) = (type *) xrealloc (basevar, (newsize)*sizeof(type)); \
187 } while (0)
188
189 #ifdef ERROR_CHECK_MALLOC
190 #define xfree(lvalue) do \
191 { \
192 void **ptr = (void **) &(lvalue); \
193 xfree_1 (*ptr); \
194 *ptr = (void *) 0xDEADBEEF; \
195 } while (0)
196 #else
197 #define xfree_1 xfree
198 #endif
199
200 /* We assume an ANSI C compiler and libraries and memcpy, memset, memcmp */
201 /* (This definition is here because system header file macros may want
202 * to call bzero (eg FD_ZERO) */
203 #ifndef bzero
204 # define bzero(m, l) memset ((m), 0, (l))
205 #endif
206
207 #ifndef PRINTF_ARGS
208 # if defined (__GNUC__) && (__GNUC__ >= 2)
209 # define PRINTF_ARGS(string_index,first_to_check) \
210 __attribute__ ((format (printf, string_index, first_to_check)))
211 # else
212 # define PRINTF_ARGS(string_index,first_to_check)
213 # endif /* GNUC */
214 #endif
215
216 #ifndef DOESNT_RETURN
217 # if defined __GNUC__
218 # if ((__GNUC__ > 2) || (__GNUC__ == 2) && (__GNUC_MINOR__ >= 5))
219 # define DOESNT_RETURN void volatile
220 # define DECLARE_DOESNT_RETURN(decl) \
221 extern void volatile decl __attribute__ ((noreturn))
222 # define DECLARE_DOESNT_RETURN_GCC__ATTRIBUTE__SYNTAX_SUCKS(decl,str,idx) \
223 /* Should be able to state multiple independent __attribute__s, but \
224 the losing syntax doesn't work that way, and screws losing cpp */ \
225 extern void volatile decl \
226 __attribute__ ((noreturn, format (printf, str, idx)))
227 # else
228 # define DOESNT_RETURN void volatile
229 # define DECLARE_DOESNT_RETURN(decl) extern void volatile decl
230 # define DECLARE_DOESNT_RETURN_GCC__ATTRIBUTE__SYNTAX_SUCKS(decl,str,idx) \
231 extern void volatile decl PRINTF_ARGS(str,idx)
232 # endif /* GNUC 2.5 */
233 # else
234 # define DOESNT_RETURN void
235 # define DECLARE_DOESNT_RETURN(decl) extern void decl
236 # define DECLARE_DOESNT_RETURN_GCC__ATTRIBUTE__SYNTAX_SUCKS(decl,str,idx) \
237 extern void decl PRINTF_ARGS(str,idx)
238 # endif /* GNUC */
239 #endif
240
241 #ifndef ALIGNOF
242 # if defined (__GNUC__) && (__GNUC__ >= 2)
243 # define ALIGNOF(x) __alignof (x)
244 # else
245 # define ALIGNOF(x) sizeof (x)
246 # endif
247 #endif
248
249 #define ALIGN_SIZE(len, unit) \
250 ((((len) + (unit) - 1) / (unit)) * (unit))
251
252 /* #### Yuck, this is kind of evil */
253 #define ALIGN_PTR(ptr, unit) \
254 ((void *) ALIGN_SIZE ((long) (ptr), unit))
255
256 #ifdef QUANTIFY
257 #include "quantify.h"
258 #define QUANTIFY_START_RECORDING \
259 do { quantify_start_recording_data (); } while (0)
260 #define QUANTIFY_STOP_RECORDING \
261 do { quantify_stop_recording_data (); } while (0)
262 #else /* !QUANTIFY */
263 #define QUANTIFY_START_RECORDING
264 #define QUANTIFY_STOP_RECORDING
265 #endif /* !QUANTIFY */
266
267
268 #ifndef DO_NOTHING
269 #define DO_NOTHING do {} while (0)
270 #endif
271
272 /* We define assert iff USE_ASSERTIONS or DEBUG_XEMACS is defined.
273 Otherwise we it to NULL. Quantify has shown that the time the
274 assert checks take is measurable so let's not include them in
275 production binaries. */
276
277 #ifdef USE_ASSERTIONS
278 /* Highly dubious kludge */
279 /* (thanks, Jamie, I feel better now -- ben) */
280 DECLARE_DOESNT_RETURN (assert_failed (CONST char *, int, CONST char *));
281 # define abort() (assert_failed (__FILE__, __LINE__, "abort()"))
282 # define assert(x) ((x) ? (void) 0 : assert_failed (__FILE__, __LINE__, #x))
283 #else
284 # ifdef DEBUG_XEMACS
285 # define assert(x) ((x) ? (void) 0 : (void) abort ())
286 # else
287 # define assert(x)
288 # endif
289 #endif
290
291 #ifdef DEBUG_XEMACS
292 #define REGISTER
293 #else
294 #define REGISTER register
295 #endif
296
297 #ifndef INT_MAX
298 #define INT_MAX ((int) ((1U << (INTBITS - 1)) - 1))
299 #endif
300
301 #if defined (__GNUC__) && (__GNUC__ >= 2)
302 /* Entomological studies have revealed that the following junk is
303 necessary under GCC. GCC has a compiler bug where incorrect
304 code will be generated if you use a global temporary variable
305 in a macro and the macro occurs twice in the same expression.
306 As it happens, we can avoid this problem using a GCC language
307 extension. Thus we play weird games with syntax to avoid having
308 to provide two definitions for lots of macros.
309
310 The approximate way this works is as follows:
311
312 1. Use these macros whenever you want to avoid evaluating an
313 argument more than once in a macro. (It's almost always a
314 good idea to make your macros safe like this.)
315 2. Choose a name for the temporary variable you will store
316 the parameter in. It should begin with `MT' and
317 be distinguishing, since it will (or may) be a global
318 variable.
319 3. In the same header file as the macro, put in a
320 MAC_DECLARE_EXTERN for the temporary variable. This
321 resolves to an external variable declaration for some
322 compilers.
323 4. Put a MAC_DEFINE for the variable in a C file somewhere.
324 This resolves to a variable definition for some compilers.
325 5. Write your macro with no semicolons or commas in it.
326 Remember to use parentheses to surround macro arguments,
327 but you do not need to surround each separate statement
328 or the temporary variable with parentheses.
329 6. Write your macro like this:
330
331 #define foo(bar,baz) \
332 MAC_BEGIN \
333 MAC_DECLARE (struct frobozz *, MTfoobar, bar) \
334 SOME_EXPRESSION \
335 MAC_SEP \
336 SOME OTHER EXPRESSION \
337 MAC_END
338
339 7. You only need to use MAC_SEP if you have more than one
340 expression in the macro, not counting any MAC_DECLARE
341 statements.
342
343 DONT_DECLARE_MAC_VARS is used in signal.c, for asynchronous signals.
344 All functions that may be called from within an asynchronous signal
345 handler must declare local variables (with MAC_DECLARE_LOCAL) for
346 the (normally global) variables used in these sorts of macros.
347 Otherwise, a signal could occur in the middle of processing one
348 of these macros and the signal handler could use the same macro,
349 resulting in the global variable getting overwritten and yielding
350 nasty evil crashes that are very difficult to track down.
351 */
352 # define MAC_BEGIN ({
353 # define MAC_DECLARE(type, var, value) type var = (value);
354 # define MAC_SEP ;
355 # define MAC_END ; })
356 # define MAC_DECLARE_EXTERN(type, var)
357 # define MAC_DECLARE_LOCAL(type, var)
358 # define MAC_DEFINE(type, var)
359 #else
360 # define MAC_BEGIN (
361 # define MAC_DECLARE(type, var, value) var = (value),
362 # define MAC_SEP ,
363 # define MAC_END )
364 # ifdef DONT_DECLARE_MAC_VARS
365 # define MAC_DECLARE_EXTERN(type, var)
366 # else
367 # define MAC_DECLARE_EXTERN(type, var) extern type var;
368 # endif
369 # define MAC_DECLARE_LOCAL(type, var) type var;
370 # define MAC_DEFINE(type, var) type var;
371 #endif
372
373 /* For Lo, the Lord didst appear and look upon the face of the code,
374 and the Lord was unhappy with the strange syntax that had come
375 into vogue with the cryptic name of "C". And so the Lord didst
376 decree, that from now on all programmers shall use Pascal syntax,
377 a syntax truly and in sooth ordained in heaven. Amen. */
378
379
380 /************************************************************************/
381 /* typedefs */
382 /************************************************************************/
383
384 /* We put typedefs here so that prototype declarations don't choke.
385 Note that we don't actually declare the structures here (except
386 maybe for simple structures like Dynarrs); that keeps them private
387 to the routines that actually use them. */
388
389 /* The data representing the text in a buffer is logically a set
390 of Bufbytes, declared as follows. */
391
392 typedef unsigned char Bufbyte;
393
394 /* The data representing a string in "external" format (simple
395 binary format) is logically a set of Extbytes, declared as follows. */
396
397 typedef unsigned char Extbyte;
398
399 /* To the user, a buffer is made up of characters, declared as follows.
400 In the non-Mule world, characters and Bufbytes are equivalent.
401 In the Mule world, a characters requires (typically) 1 to 4
402 Bufbytes for its representation in a buffer. */
403
404 typedef int Emchar;
405
406 /* Different ways of referring to a position in a buffer. We use
407 the typedefs in preference to 'int' to make it clearer what
408 sort of position is being used. See extents.c for a description
409 of the different positions. We put them here instead of in
410 buffer.h (where they rightfully belong) to avoid syntax errors
411 in function prototypes. */
412
413 typedef int Bufpos;
414 typedef int Bytind;
415 typedef int Memind;
416
417 /* Counts of bytes or chars */
418
419 typedef int Bytecount;
420 typedef int Charcount;
421
422 /* Length in bytes of a string in external format */
423 typedef int Extcount;
424
425 typedef struct lstream Lstream;
426
427 typedef unsigned int face_index;
428 typedef struct face_cachel_dynarr_type
429 {
430 Dynarr_declare (struct face_cachel);
431 } face_cachel_dynarr;
432
433 typedef unsigned int glyph_index;
434 typedef struct glyph_cachel_dynarr_type
435 {
436 Dynarr_declare (struct glyph_cachel);
437 } glyph_cachel_dynarr;
438
439 struct buffer; /* "buffer.h" */
440 struct console; /* "console.h" */
441 struct device; /* "device.h" */
442 struct extent_fragment;
443 struct extent;
444 struct frame; /* "frame.h" */
445 struct window; /* "window.h" */
446 struct Lisp_Event; /* "events.h" */
447 struct Lisp_Face;
448 struct Lisp_Process; /* "process.c" */
449 struct stat; /* <sys/stat.h> */
450 struct Lisp_Color_Instance;
451 struct Lisp_Font_Instance;
452 struct Lisp_Image_Instance;
453 struct display_line;
454 struct redisplay_info;
455 struct window_mirror;
456 struct scrollbar_instance;
457 struct font_metric_info;
458 struct face_cachel;
459 struct console_type_entry;
460
461 typedef struct bufbyte_dynarr_type
462 {
463 Dynarr_declare (Bufbyte);
464 } bufbyte_dynarr;
465
466 typedef struct extbyte_dynarr_type
467 {
468 Dynarr_declare (Extbyte);
469 } extbyte_dynarr;
470
471 typedef struct emchar_dynarr_type
472 {
473 Dynarr_declare (Emchar);
474 } emchar_dynarr;
475
476 typedef struct unsigned_char_dynarr_type
477 {
478 Dynarr_declare (unsigned char);
479 } unsigned_char_dynarr;
480
481 typedef struct int_dynarr_type
482 {
483 Dynarr_declare (int);
484 } int_dynarr;
485
486 typedef struct bufpos_dynarr_type
487 {
488 Dynarr_declare (Bufpos);
489 } bufpos_dynarr;
490
491 typedef struct bytind_dynarr_type
492 {
493 Dynarr_declare (Bytind);
494 } bytind_dynarr;
495
496 typedef struct charcount_dynarr_type
497 {
498 Dynarr_declare (Charcount);
499 } charcount_dynarr;
500
501 typedef struct bytecount_dynarr_type
502 {
503 Dynarr_declare (Bytecount);
504 } bytecount_dynarr;
505
506 typedef struct console_type_entry_dynarr_type
507 {
508 Dynarr_declare (struct console_type_entry);
509 } console_type_entry_dynarr;
510
511 /* Need to declare this here. */
512 enum external_data_format
513 {
514 /* Binary format. This is the simplest format and is what we
515 use in the absence of a more appropriate format. This converts
516 according to the `binary' coding system:
517
518 a) On input, bytes 0 - 255 are converted into characters 0 - 255.
519 b) On output, characters 0 - 255 are converted into bytes 0 - 255
520 and other characters are converted into `X'.
521 */
522 FORMAT_BINARY,
523
524 /* Format used for filenames. In the original Mule, this is
525 user-definable with the `pathname-coding-system' variable.
526 For the moment, we just use the `binary' coding system. */
527 FORMAT_FILENAME,
528
529 /* Format used for output to the terminal. This should be controlled
530 by the `display-coding-system' variable. Under kterm, this will
531 be some ISO2022 system. On some DOS machines, this is Shift-JIS. */
532 FORMAT_DISPLAY,
533
534 /* Format used for input from the terminal. This should be controlled
535 by the `keyboard-coding-system' variable. */
536 FORMAT_KEYBOARD,
537
538 /* Format used for the external Unix environment -- argv[], stuff
539 from getenv(), stuff from the /etc/passwd file, etc.
540
541 Perhaps should be the same as FORMAT_FILENAME. */
542 FORMAT_OS,
543
544 /* Compound-text format. This is the standard X format used for
545 data stored in properties, selections, and the like. This is
546 an 8-bit no-lock-shift ISO2022 coding system. */
547 FORMAT_CTEXT
548 };
549
550 enum run_hooks_condition
551 {
552 RUN_HOOKS_TO_COMPLETION,
553 RUN_HOOKS_UNTIL_SUCCESS,
554 RUN_HOOKS_UNTIL_FAILURE
555 };
556
557 #ifdef HAVE_TOOLBARS
558 enum toolbar_pos
559 {
560 TOP_TOOLBAR,
561 BOTTOM_TOOLBAR,
562 LEFT_TOOLBAR,
563 RIGHT_TOOLBAR
564 };
565 #endif
566
567 #ifndef ERROR_CHECK_TYPECHECK
568
569 typedef enum error_behavior
570 {
571 ERROR_ME,
572 ERROR_ME_NOT,
573 ERROR_ME_WARN
574 } Error_behavior;
575
576 #define ERRB_EQ(a, b) ((a) == (b))
577
578 #else
579
580 /* By defining it like this, we provide strict type-checking
581 for code that lazily uses ints. */
582
583 typedef struct _error_behavior_struct_
584 {
585 int really_unlikely_name_to_have_accidentally_in_a_non_errb_structure;
586 } Error_behavior;
587
588 extern Error_behavior ERROR_ME;
589 extern Error_behavior ERROR_ME_NOT;
590 extern Error_behavior ERROR_ME_WARN;
591
592 #define ERRB_EQ(a, b) \
593 ((a).really_unlikely_name_to_have_accidentally_in_a_non_errb_structure == \
594 (b).really_unlikely_name_to_have_accidentally_in_a_non_errb_structure)
595
596 #endif
597
598 enum munge_me_out_the_door
599 {
600 MUNGE_ME_FUNCTION_KEY,
601 MUNGE_ME_KEY_TRANSLATION
602 };
603
604
605 /************************************************************************/
606 /* Definition of Lisp_Object data type */
607 /************************************************************************/
608
609 /* There's not any particular reason not to use lrecords for these; some
610 objects get slightly larger, but we get 3 bit tags instead of 4.
611 */
612 #define LRECORD_SYMBOL
613
614
615 /* Define the fundamental Lisp data structures */
616
617 /* This is the set of Lisp data types */
618
619 enum Lisp_Type
620 {
621 /* Integer. XINT(obj) is the integer value. */
622 Lisp_Int /* 0 DTP-FIXNUM */
623
624 /* XRECORD_LHEADER (object) points to a struct lrecord_header
625 lheader->implementation determines the type (and GC behaviour)
626 of the object. */
627 ,Lisp_Record /* 1 DTP-OTHER-POINTER */
628
629 /* Cons. XCONS (object) points to a struct Lisp_Cons. */
630 ,Lisp_Cons /* 2 DTP-LIST */
631
632 /* LRECORD_STRING is NYI */
633 /* String. XSTRING (object) points to a struct Lisp_String.
634 The length of the string, and its contents, are stored therein. */
635 ,Lisp_String /* 3 DTP-STRING */
636
637 #ifndef LRECORD_VECTOR
638 /* Vector of Lisp objects. XVECTOR(object) points to a struct Lisp_Vector.
639 The length of the vector, and its contents, are stored therein. */
640 ,Lisp_Vector /* 4 DTP-SIMPLE-ARRAY */
641 #endif
642
643 #ifndef LRECORD_SYMBOL
644 /* Symbol. XSYMBOL (object) points to a struct Lisp_Symbol. */
645 ,Lisp_Symbol
646 #endif /* !LRECORD_SYMBOL */
647 };
648
649 /* unsafe! */
650 #define POINTER_TYPE_P(type) ((type) != Lisp_Int)
651
652 /* This should be the underlying type intowhich a Lisp_Object must fit.
653 In a strict ANSI world, this must be `int', since ANSI says you can't
654 use bitfields on any type other than `int'. However, on a machine
655 where `int' and `long' are not the same size, this should be the
656 longer of the two. (This also must be something into which a pointer
657 to an arbitrary object will fit, modulo any DATA_SEG_BITS cruft.)
658 */
659 #if (LONGBITS > INTBITS)
660 # define EMACS_INT long
661 # define EMACS_UINT unsigned long
662 #else
663 # define EMACS_INT int
664 # define EMACS_UINT unsigned int
665 #endif
666
667 /* Cast pointers to this type to compare them. Some machines want int. */
668 #ifndef PNTR_COMPARISON_TYPE
669 # define PNTR_COMPARISON_TYPE unsigned int
670 #endif
671
672 /* Overridden by m/next.h */
673 #ifndef ASSERT_VALID_POINTER
674 # define ASSERT_VALID_POINTER(pnt) (assert ((((EMACS_UINT) pnt) & 3) == 0))
675 #endif
676
677 /* These values are overridden by the m- file on some machines. */
678 #ifndef GCTYPEBITS
679 # define GCTYPEBITS 3L
680 #endif
681
682 #ifndef VALBITS
683 # define VALBITS ((LONGBITS)-((GCTYPEBITS)+1L))
684 #endif
685
686 #ifdef NO_UNION_TYPE
687 # include "lisp-disunion.h"
688 #else /* !NO_UNION_TYPE */
689 # include "lisp-union.h"
690 #endif /* !NO_UNION_TYPE */
691
692 /* WARNING WARNING WARNING. You must ensure on your own that proper
693 GC protection is provided for the elements in this array. */
694 typedef struct lisp_dynarr_type
695 {
696 Dynarr_declare (Lisp_Object);
697 } lisp_dynarr;
698
699 /* Close your eyes now lest you vomit or spontaneously combust ... */
700
701 #define HACKEQ_UNSAFE(obj1, obj2) \
702 (EQ (obj1, obj2) || (!POINTER_TYPE_P (XGCTYPE (obj1)) \
703 && !POINTER_TYPE_P (XGCTYPE (obj2)) \
704 && XREALINT (obj1) == XREALINT (obj2)))
705
706 INLINE int HACKEQ (Lisp_Object obj1, Lisp_Object obj2);
707 INLINE int
708 HACKEQ (Lisp_Object obj1, Lisp_Object obj2)
709 {
710 return HACKEQ_UNSAFE (obj1, obj2);
711 }
712
713 /* OK, you can open them again */
714
715 /************************************************************************/
716 /* Definitions of basic Lisp objects */
717 /************************************************************************/
718
719 #include "lrecord.h"
720
721 /********** unbound ***********/
722
723 /* Qunbound is a special Lisp_Object (actually of type
724 symbol-value-forward), that can never be visible to
725 the Lisp caller and thus can be used in the C code
726 to mean "no such value". */
727
728 #define UNBOUNDP(val) EQ (val, Qunbound)
729 #define GC_UNBOUNDP(val) GC_EQ (val, Qunbound)
730
731 /*********** cons ***********/
732
733 /* In a cons, the markbit of the car is the gc mark bit */
734
735 struct Lisp_Cons
736 {
737 Lisp_Object car, cdr;
738 };
739
740 #if 0 /* FSFmacs */
741 /* Like a cons, but records info on where the text lives that it was read from */
742 /* This is not really in use now */
743
744 struct Lisp_Buffer_Cons
745 {
746 Lisp_Object car, cdr;
747 struct buffer *buffer;
748 int bufpos;
749 };
750 #endif
751
752 DECLARE_NONRECORD (cons, Lisp_Cons, struct Lisp_Cons);
753 #define XCONS(a) XNONRECORD (a, cons, Lisp_Cons, struct Lisp_Cons)
754 #define XSETCONS(c, p) XSETOBJ (c, Lisp_Cons, p)
755 #define CONSP(x) (XTYPE (x) == Lisp_Cons)
756 #define GC_CONSP(x) (XGCTYPE (x) == Lisp_Cons)
757 #define CHECK_CONS(x) CHECK_NONRECORD (x, Lisp_Cons, Qconsp)
758 #define CONCHECK_CONS(x) CONCHECK_NONRECORD (x, Lisp_Cons, Qconsp)
759
760 /* Define these because they're used in a few places, inside and
761 out of alloc.c */
762 #define CONS_MARKED_P(c) XMARKBIT (c->car)
763 #define MARK_CONS(c) XMARK (c->car)
764
765 #define NILP(x) EQ (x, Qnil)
766 #define GC_NILP(x) GC_EQ (x, Qnil)
767 #define CHECK_LIST(x) \
768 do { if ((!CONSP (x)) && !NILP (x)) dead_wrong_type_argument (Qlistp, x); } while (0)
769 #define CONCHECK_LIST(x) \
770 do { if ((!CONSP (x)) && !NILP (x)) x = wrong_type_argument (Qlistp, x); } while (0)
771 #define XCAR(a) (XCONS (a)->car)
772 #define XCDR(a) (XCONS (a)->cdr)
773
774 /* For a list that's known to be in valid list format --
775 will abort() if the list is not in valid format */
776 #define LIST_LOOP(consvar, list) \
777 for (consvar = list; !NILP (consvar); consvar = XCDR (consvar))
778
779 /* For a list that's known to be in valid list format, where we may
780 be deleting the current element out of the list --
781 will abort() if the list is not in valid format */
782 #define LIST_LOOP_DELETING(consvar, nextconsvar, list) \
783 for (consvar = list; \
784 !NILP (consvar) ? (nextconsvar = XCDR (consvar), 1) : 0; \
785 consvar = nextconsvar)
786
787 /* For a list that may not be in valid list format --
788 will signal an error if the list is not in valid format */
789 #define EXTERNAL_LIST_LOOP(consvar, listp) \
790 for (consvar = listp; !NILP (consvar); consvar = XCDR (consvar)) \
791 if (!CONSP (consvar)) \
792 signal_simple_error ("Invalid list format", listp); \
793 else
794
795 /* For a property list (alternating keywords/values) that may not be
796 in valid list format -- will signal an error if the list is not in
797 valid format. CONSVAR is used to keep track of the iterations
798 without modifying LISTP.
799
800 We have to be tricky to still keep the same C format.*/
801 #define EXTERNAL_PROPERTY_LIST_LOOP(consvar, keyword, value, listp) \
802 for (consvar = listp; \
803 (CONSP (consvar) && CONSP (XCDR (consvar)) ? \
804 (keyword = XCAR (consvar), value = XCAR (XCDR (consvar))) : \
805 (keyword = Qunbound, value = Qunbound)), \
806 !NILP (consvar); \
807 consvar = XCDR (XCDR (consvar))) \
808 if (UNBOUNDP (keyword)) \
809 signal_simple_error ("Invalid property list format", listp); \
810 else
811
812 /*********** string ***********/
813
814 /* In a string or vector, the sign bit of the `size' is the gc mark bit */
815
816 /* (The size and data fields have underscores prepended to catch old
817 code that attempts to reference the fields directly) */
818 struct Lisp_String
819 {
820 #ifdef LRECORD_STRING
821 struct lrecord_header lheader;
822 #endif
823 long _size;
824 Bufbyte *_data;
825 Lisp_Object plist;
826 };
827
828 #ifdef LRECORD_STRING
829
830 DECLARE_LRECORD (string, struct Lisp_String);
831 #define XSTRING(x) XRECORD (x, string, struct Lisp_String)
832 #define XSETSTRING(x, p) XSETRECORD (x, p, string)
833 #define STRINGP(x) RECORDP (x, string)
834 #define GC_STRINGP(x) GC_RECORDP (x, string)
835 #define CHECK_STRING(x) CHECK_RECORD (x, string)
836 #define CONCHECK_STRING(x) CONCHECK_RECORD (x, string)
837
838 #else
839
840 DECLARE_NONRECORD (string, Lisp_String, struct Lisp_String);
841 #define XSTRING(x) XNONRECORD (x, string, Lisp_String, struct Lisp_String)
842 #define XSETSTRING(x, p) XSETOBJ (x, Lisp_String, p)
843 #define STRINGP(x) (XTYPE (x) == Lisp_String)
844 #define GC_STRINGP(x) (XGCTYPE (x) == Lisp_String)
845 #define CHECK_STRING(x) CHECK_NONRECORD (x, Lisp_String, Qstringp)
846 #define CONCHECK_STRING(x) CONCHECK_NONRECORD (x, Lisp_String, Qstringp)
847
848 #endif
849
850
851 # define bytecount_to_charcount(ptr, len) (len)
852 # define charcount_to_bytecount(ptr, len) (len)
853
854 #define string_length(s) ((s)->_size)
855 #define string_data(s) ((s)->_data + 0)
856 #define string_byte(s, i) ((s)->_data[i] + 0)
857 #define string_byte_addr(s, i) (&((s)->_data[i]))
858 #define set_string_length(s, len) do { (s)->_size = (len); } while (0)
859 #define set_string_data(s, ptr) do { (s)->_data = (ptr); } while (0)
860 #define set_string_byte(s, i, c) do { (s)->_data[i] = (c); } while (0)
861
862 void resize_string (struct Lisp_String *s, Bytecount pos, Bytecount delta);
863
864 # define string_char_length(s) string_length (s)
865 # define string_char(s, i) ((Emchar) string_byte (s, i))
866 # define string_char_addr(s, i) string_byte_addr (s, i)
867 # define set_string_char(s, i, c) set_string_byte (s, i, c)
868
869
870 /*********** vector ***********/
871
872 struct Lisp_Vector
873 {
874 #ifdef LRECORD_VECTOR
875 struct lrecord_header lheader;
876 #endif
877 long size;
878 /* next is now chained through v->contents[size], terminated by Qzero.
879 * This means that pure vectors don't need a "next" */
880 /* struct Lisp_Vector *next; */
881 Lisp_Object contents[1];
882 };
883
884 #ifdef LRECORD_VECTOR
885
886 DECLARE_LRECORD (vector, struct Lisp_Vector);
887 #define XVECTOR(x) XRECORD (x, vector, struct Lisp_Vector)
888 #define XSETVECTOR(x, p) XSETRECORD (x, p, vector)
889 #define VECTORP(x) RECORDP (x, vector)
890 #define GC_VECTORP(x) GC_RECORDP (x, vector)
891 #define CHECK_VECTOR(x) CHECK_RECORD (x, vector)
892 #define CONCHECK_VECTOR(x) CONCHECK_RECORD (x, vector)
893
894 #else
895
896 DECLARE_NONRECORD (vector, Lisp_Vector, struct Lisp_Vector);
897 #define XVECTOR(x) XNONRECORD (x, vector, Lisp_Vector, struct Lisp_Vector)
898 #define XSETVECTOR(x, p) XSETOBJ (x, Lisp_Vector, p)
899 #define VECTORP(x) (XTYPE (x) == Lisp_Vector)
900 #define GC_VECTORP(x) (XGCTYPE (x) == Lisp_Vector)
901 #define CHECK_VECTOR(x) CHECK_NONRECORD (x, Lisp_Vector, Qvectorp)
902 #define CONCHECK_VECTOR(x) CONCHECK_NONRECORD (x, Lisp_Vector, Qvectorp)
903
904 #endif
905
906 #define vector_length(v) ((v)->size)
907 #define vector_data(v) ((v)->contents)
908 #define vector_next(v) ((v)->contents[(v)->size])
909
910 /*********** bit vector ***********/
911
912 #if (LONGBITS < 16)
913 What the hell?!
914 #elif (LONGBITS < 32)
915 # define LONGBITS_LOG2 4
916 # define LONGBITS_POWER_OF_2 16
917 #elif (LONGBITS < 64)
918 # define LONGBITS_LOG2 5
919 # define LONGBITS_POWER_OF_2 32
920 #elif (LONGBITS < 128)
921 # define LONGBITS_LOG2 6
922 # define LONGBITS_POWER_OF_2 64
923 #else
924 #error You really have 128-bit integers?!
925 #endif
926
927 struct Lisp_Bit_Vector
928 {
929 struct lrecord_header lheader;
930 Lisp_Object next;
931 long size;
932 unsigned int bits[1];
933 };
934
935 DECLARE_LRECORD (bit_vector, struct Lisp_Bit_Vector);
936 #define XBIT_VECTOR(x) XRECORD (x, bit_vector, struct Lisp_Bit_Vector)
937 #define XSETBIT_VECTOR(x, p) XSETRECORD (x, p, bit_vector)
938 #define BIT_VECTORP(x) RECORDP (x, bit_vector)
939 #define GC_BIT_VECTORP(x) GC_RECORDP (x, bit_vector)
940 #define CHECK_BIT_VECTOR(x) CHECK_RECORD (x, bit_vector)
941 #define CONCHECK_BIT_VECTOR(x) CONCHECK_RECORD (x, bit_vector)
942
943 #define BITP(x) (INTP (x) && (XINT (x) == 0 || XINT (x) == 1))
944 #define GC_BITP(x) (GC_INTP (x) && (XINT (x) == 0 || XINT (x) == 1))
945
946 #define CHECK_BIT(x) \
947 do { if (!BITP (x)) dead_wrong_type_argument (Qbitp, x); } while (0)
948 #define CONCHECK_BIT(x) \
949 do { if (!BITP (x)) x = wrong_type_argument (Qbitp, x); } while (0)
950
951 #define bit_vector_length(v) ((v)->size)
952 #define bit_vector_next(v) ((v)->next)
953
954 INLINE int bit_vector_bit (struct Lisp_Bit_Vector *v, int i);
955 INLINE int
956 bit_vector_bit (struct Lisp_Bit_Vector *v, int i)
957 {
958 unsigned int ui = (unsigned int) i;
959
960 return (((v)->bits[ui >> LONGBITS_LOG2] >> (ui & (LONGBITS_POWER_OF_2 - 1)))
961 & 1);
962 }
963
964 INLINE void set_bit_vector_bit (struct Lisp_Bit_Vector *v, int i, int value);
965 INLINE void
966 set_bit_vector_bit (struct Lisp_Bit_Vector *v, int i, int value)
967 {
968 unsigned int ui = (unsigned int) i;
969 if (value)
970 (v)->bits[ui >> LONGBITS_LOG2] |= (1 << (ui & (LONGBITS_POWER_OF_2 - 1)));
971 else
972 (v)->bits[ui >> LONGBITS_LOG2] &= ~(1 << (ui & (LONGBITS_POWER_OF_2 - 1)));
973 }
974
975 /* Number of longs required to hold LEN bits */
976 #define BIT_VECTOR_LONG_STORAGE(len) \
977 ((len + LONGBITS_POWER_OF_2 - 1) >> LONGBITS_LOG2)
978
979
980 /*********** symbol ***********/
981
982 /* In a symbol, the markbit of the plist is used as the gc mark bit */
983
984 struct Lisp_Symbol
985 {
986 #ifdef LRECORD_SYMBOL
987 struct lrecord_header lheader;
988 #endif
989 /* next symbol in this obarray bucket */
990 struct Lisp_Symbol *next;
991 struct Lisp_String *name;
992 Lisp_Object value;
993 Lisp_Object function;
994 Lisp_Object plist;
995 };
996
997 #define SYMBOL_IS_KEYWORD(sym) (string_byte (XSYMBOL(sym)->name, 0) == ':')
998 #define KEYWORDP(obj) (SYMBOLP (obj) && SYMBOL_IS_KEYWORD (obj))
999
1000 #ifdef LRECORD_SYMBOL
1001
1002 DECLARE_LRECORD (symbol, struct Lisp_Symbol);
1003 #define XSYMBOL(x) XRECORD (x, symbol, struct Lisp_Symbol)
1004 #define XSETSYMBOL(x, p) XSETRECORD (x, p, symbol)
1005 #define SYMBOLP(x) RECORDP (x, symbol)
1006 #define GC_SYMBOLP(x) GC_RECORDP (x, symbol)
1007 #define CHECK_SYMBOL(x) CHECK_RECORD (x, symbol)
1008 #define CONCHECK_SYMBOL(x) CONCHECK_RECORD (x, symbol)
1009
1010 #else
1011
1012 DECLARE_NONRECORD (symbol, Lisp_Symbol, struct Lisp_Symbol);
1013 #define XSYMBOL(x) XNONRECORD (x, symbol, Lisp_Symbol, struct Lisp_Symbol)
1014 #define XSETSYMBOL(s, p) XSETOBJ ((s), Lisp_Symbol, (p))
1015 #define SYMBOLP(x) (XTYPE (x) == Lisp_Symbol)
1016 #define GC_SYMBOLP(x) (XGCTYPE (x) == Lisp_Symbol)
1017 #define CHECK_SYMBOL(x) CHECK_NONRECORD (x, Lisp_Symbol, Qsymbolp)
1018 #define CONCHECK_SYMBOL(x) CONCHECK_NONRECORD (x, Lisp_Symbol, Qsymbolp)
1019
1020 #endif
1021
1022 #define symbol_next(s) ((s)->next)
1023 #define symbol_name(s) ((s)->name)
1024 #define symbol_value(s) ((s)->value)
1025 #define symbol_function(s) ((s)->function)
1026 #define symbol_plist(s) ((s)->plist)
1027
1028 /*********** subr ***********/
1029
1030 struct Lisp_Subr
1031 {
1032 struct lrecord_header lheader;
1033 short min_args, max_args;
1034 CONST char *prompt;
1035 CONST char *doc;
1036 CONST char *name;
1037 Lisp_Object (*subr_fn) ();
1038 };
1039
1040 DECLARE_LRECORD (subr, struct Lisp_Subr);
1041 #define XSUBR(x) XRECORD (x, subr, struct Lisp_Subr)
1042 #define XSETSUBR(x, p) XSETRECORD (x, p, subr)
1043 #define SUBRP(x) RECORDP (x, subr)
1044 #define GC_SUBRP(x) GC_RECORDP (x, subr)
1045 #define CHECK_SUBR(x) CHECK_RECORD (x, subr)
1046 #define CONCHECK_SUBR(x) CONCHECK_RECORD (x, subr)
1047
1048 #define subr_function(subr) (subr)->subr_fn
1049 #define subr_name(subr) (subr)->name
1050
1051 /*********** marker ***********/
1052
1053 struct Lisp_Marker
1054 {
1055 struct lrecord_header lheader;
1056 struct Lisp_Marker *next, *prev;
1057 struct buffer *buffer;
1058 Memind memind;
1059 char insertion_type;
1060 };
1061
1062 DECLARE_LRECORD (marker, struct Lisp_Marker);
1063 #define XMARKER(x) XRECORD (x, marker, struct Lisp_Marker)
1064 #define XSETMARKER(x, p) XSETRECORD (x, p, marker)
1065 #define MARKERP(x) RECORDP (x, marker)
1066 #define GC_MARKERP(x) GC_RECORDP (x, marker)
1067 #define CHECK_MARKER(x) CHECK_RECORD (x, marker)
1068 #define CONCHECK_MARKER(x) CONCHECK_RECORD (x, marker)
1069
1070 /* The second check was looking for GCed markers still in use */
1071 /* if (INTP (XMARKER (x)->lheader.next.v)) abort (); */
1072
1073 #define marker_next(m) ((m)->next)
1074 #define marker_prev(m) ((m)->prev)
1075
1076 /*********** char ***********/
1077
1078 #define CHARP(x) (INTP (x))
1079 #define GC_CHARP(x) (GC_INTP (x))
1080
1081 #ifdef ERROR_CHECK_TYPECHECK
1082
1083 INLINE Emchar XCHAR (Lisp_Object obj);
1084 INLINE Emchar
1085 XCHAR (Lisp_Object obj)
1086 {
1087 return XREALINT (obj);
1088 }
1089
1090 #else
1091
1092 #define XCHAR(x) (XINT (x))
1093
1094 #endif
1095
1096 #define CHECK_CHAR(x) (CHECK_INT (x))
1097 #define CONCHECK_CHAR(x) (CONCHECK_INT (x))
1098
1099
1100 /*********** float ***********/
1101
1102 #ifdef LISP_FLOAT_TYPE
1103
1104 struct Lisp_Float
1105 {
1106 struct lrecord_header lheader;
1107 union { double d; struct Lisp_Float *next; } data;
1108 };
1109
1110 DECLARE_LRECORD (float, struct Lisp_Float);
1111 #define XFLOAT(x) XRECORD (x, float, struct Lisp_Float)
1112 #define XSETFLOAT(x, p) XSETRECORD (x, p, float)
1113 #define FLOATP(x) RECORDP (x, float)
1114 #define GC_FLOATP(x) GC_RECORDP (x, float)
1115 #define CHECK_FLOAT(x) CHECK_RECORD (x, float)
1116 #define CONCHECK_FLOAT(x) CONCHECK_RECORD (x, float)
1117
1118 #define float_next(f) ((f)->data.next)
1119 #define float_data(f) ((f)->data.d)
1120
1121 #ifndef DBL_DIG
1122 # define DBL_DIG 16
1123 #endif
1124
1125 #define XFLOATINT(n) extract_float (n)
1126
1127 #define CHECK_INT_OR_FLOAT(x) \
1128 do { if ( !INTP (x) && !FLOATP (x)) \
1129 dead_wrong_type_argument (Qnumberp, (x)); } while (0)
1130 #define CONCHECK_INT_OR_FLOAT(x) \
1131 do { if ( !INTP (x) && !FLOATP (x)) \
1132 x = wrong_type_argument (Qnumberp, (x)); } while (0)
1133
1134 /* These are always continuable because they change their arguments
1135 even when no error is signalled. */
1136
1137 #define CHECK_INT_OR_FLOAT_COERCE_MARKER(x) \
1138 do { if (INTP (x) || FLOATP (x)) \
1139 ; \
1140 else if (MARKERP (x)) \
1141 x = make_int (marker_position (x)); \
1142 else \
1143 x = wrong_type_argument (Qnumber_or_marker_p, x); } while (0)
1144
1145 #define CHECK_INT_OR_FLOAT_COERCE_CHAR_OR_MARKER(x) \
1146 do { if (INTP (x) || FLOATP (x)) \
1147 ; \
1148 else if (CHARP (x)) \
1149 x = make_int (XCHAR (x)); \
1150 else if (MARKERP (x)) \
1151 x = make_int (marker_position (x)); \
1152 else \
1153 x = wrong_type_argument (Qnumber_char_or_marker_p, x); \
1154 } while (0)
1155
1156 # define INT_OR_FLOATP(x) (INTP (x) || FLOATP (x))
1157 # define GC_INT_OR_FLOATP(x) (GC_INTP (x) || GC_FLOATP (x))
1158
1159 #else /* not LISP_FLOAT_TYPE */
1160
1161 #define XFLOAT(x) --- error! No float support. ---
1162 #define XSETFLOAT(x, p) --- error! No float support. ---
1163 #define FLOATP(x) 0
1164 #define GC_FLOATP(x) 0
1165 #define CHECK_FLOAT(x) --- error! No float support. ---
1166 #define CONCHECK_FLOAT(x) --- error! No float support. ---
1167
1168 #define XFLOATINT(n) XINT(n)
1169 #define CHECK_INT_OR_FLOAT CHECK_INT
1170 #define CONCHECK_INT_OR_FLOAT CONCHECK_INT
1171 #define CHECK_INT_OR_FLOAT_COERCE_MARKER CHECK_INT_COERCE_MARKER
1172 #define CHECK_INT_OR_FLOAT_COERCE_CHAR_OR_MARKER \
1173 CHECK_INT_COERCE_CHAR_OR_MARKER
1174 #define INT_OR_FLOATP(x) (INTP (x))
1175 # define GC_INT_OR_FLOATP(x) (GC_INTP (x))
1176
1177 #endif /* not LISP_FLOAT_TYPE */
1178
1179 #define INTP(x) (XTYPE (x) == Lisp_Int)
1180 #define GC_INTP(x) (XGCTYPE (x) == Lisp_Int)
1181
1182 #define ZEROP(x) EQ (x, Qzero)
1183 #define GC_ZEROP(x) GC_EQ (x, Qzero)
1184
1185 #ifdef ERROR_CHECK_TYPECHECK
1186
1187 INLINE EMACS_INT XINT (Lisp_Object obj);
1188 INLINE EMACS_INT
1189 XINT (Lisp_Object obj)
1190 {
1191 assert (INTP (obj));
1192 return XREALINT (obj);
1193 }
1194
1195 #else
1196
1197 #define XINT(obj) XREALINT (obj)
1198
1199 #endif
1200
1201 #define CHECK_INT(x) CHECK_NONRECORD (x, Lisp_Int, Qintegerp)
1202 #define CONCHECK_INT(x) CONCHECK_NONRECORD (x, Lisp_Int, Qintegerp)
1203
1204 #define NATNUMP(x) (INTP (x) && XINT (x) >= 0)
1205 #define GC_NATNUMP(x) (GC_INTP (x) && XINT (x) >= 0)
1206
1207 #define CHECK_NATNUM(x) \
1208 do { if (!NATNUMP (x)) dead_wrong_type_argument (Qnatnump, x); } while (0)
1209 #define CONCHECK_NATNUM(x) \
1210 do { if (!NATNUMP (x)) x = wrong_type_argument (Qnatnump, x); } while (0)
1211
1212 /* next three always continuable because they coerce their arguments. */
1213 #define CHECK_INT_COERCE_CHAR(x) \
1214 do { if (INTP (x)) \
1215 ; \
1216 else if (CHARP (x)) \
1217 x = make_int (XCHAR (x)); \
1218 else \
1219 x = wrong_type_argument (Qinteger_or_char_p, x); } while (0)
1220
1221 #define CHECK_INT_COERCE_MARKER(x) \
1222 do { if (INTP (x)) \
1223 ; \
1224 else if (MARKERP (x)) \
1225 x = make_int (marker_position (x)); \
1226 else \
1227 x = wrong_type_argument (Qinteger_or_marker_p, x); } while (0)
1228
1229 #define CHECK_INT_COERCE_CHAR_OR_MARKER(x) \
1230 do { if (INTP (x)) \
1231 ; \
1232 else if (CHARP (x)) \
1233 x = make_int (XCHAR (x)); \
1234 else if (MARKERP (x)) \
1235 x = make_int (marker_position (x)); \
1236 else \
1237 x = wrong_type_argument (Qinteger_char_or_marker_p, x); \
1238 } while (0)
1239
1240 /*********** pure space ***********/
1241
1242 #define CHECK_IMPURE(obj) \
1243 do { if (purified (obj)) pure_write_error (); } while (0)
1244
1245 /*********** structures ***********/
1246
1247 struct structure_keyword_entry
1248 {
1249 Lisp_Object keyword;
1250 int (*validate) (Lisp_Object keyword, Lisp_Object value,
1251 Error_behavior errb);
1252 };
1253
1254 typedef struct structure_keyword_entry_dynarr_type
1255 {
1256 Dynarr_declare (struct structure_keyword_entry);
1257 } Structure_keyword_entry_dynarr;
1258
1259 struct structure_type
1260 {
1261 Lisp_Object type;
1262 Structure_keyword_entry_dynarr *keywords;
1263 int (*validate) (Lisp_Object data, Error_behavior errb);
1264 Lisp_Object (*instantiate) (Lisp_Object data);
1265 };
1266
1267 typedef struct structure_type_dynarr_type
1268 {
1269 Dynarr_declare (struct structure_type);
1270 } Structure_type_dynarr;
1271
1272 struct structure_type *define_structure_type (Lisp_Object type,
1273 int (*validate)
1274 (Lisp_Object data,
1275 Error_behavior errb),
1276 Lisp_Object (*instantiate)
1277 (Lisp_Object data));
1278 void define_structure_type_keyword (struct structure_type *st,
1279 Lisp_Object keyword,
1280 int (*validate) (Lisp_Object keyword,
1281 Lisp_Object value,
1282 Error_behavior errb));
1283
1284 /*********** weak lists ***********/
1285
1286 enum weak_list_type
1287 {
1288 /* element disappears if it's unmarked. */
1289 WEAK_LIST_SIMPLE,
1290 /* element disappears if it's a cons and either its car or
1291 cdr is unmarked. */
1292 WEAK_LIST_ASSOC,
1293 /* element disappears if it's a cons and its car is unmarked. */
1294 WEAK_LIST_KEY_ASSOC,
1295 /* element disappears if it's a cons and its cdr is unmarked. */
1296 WEAK_LIST_VALUE_ASSOC
1297 };
1298
1299 struct weak_list
1300 {
1301 struct lcrecord_header header;
1302 Lisp_Object list; /* don't mark through this! */
1303 enum weak_list_type type;
1304 Lisp_Object next_weak; /* don't mark through this! */
1305 };
1306
1307 DECLARE_LRECORD (weak_list, struct weak_list);
1308 #define XWEAK_LIST(x) XRECORD (x, weak_list, struct weak_list)
1309 #define XSETWEAK_LIST(x, p) XSETRECORD (x, p, weak_list)
1310 #define WEAK_LISTP(x) RECORDP (x, weak_list)
1311 #define GC_WEAK_LISTP(x) GC_RECORDP (x, weak_list)
1312 #define CHECK_WEAK_LIST(x) CHECK_RECORD (x, weak_list)
1313 #define CONCHECK_WEAK_LIST(x) CONCHECK_RECORD (x, weak_list)
1314
1315 #define weak_list_list(w) ((w)->list)
1316 #define XWEAK_LIST_LIST(w) (XWEAK_LIST (w)->list)
1317
1318 Lisp_Object make_weak_list (enum weak_list_type type);
1319 /* The following two are only called by the garbage collector */
1320 int finish_marking_weak_lists (int (*obj_marked_p) (Lisp_Object),
1321 void (*markobj) (Lisp_Object));
1322 void prune_weak_lists (int (*obj_marked_p) (Lisp_Object));
1323
1324 /*********** lcrecord lists ***********/
1325
1326 struct lcrecord_list
1327 {
1328 struct lcrecord_header header;
1329 Lisp_Object free;
1330 int size;
1331 CONST struct lrecord_implementation *implementation;
1332 };
1333
1334 DECLARE_LRECORD (lcrecord_list, struct lcrecord_list);
1335 #define XLCRECORD_LIST(x) XRECORD (x, lcrecord_list, struct lcrecord_list)
1336 #define XSETLCRECORD_LIST(x, p) XSETRECORD (x, p, lcrecord_list)
1337 #define LCRECORD_LISTP(x) RECORDP (x, lcrecord_list)
1338 #define GC_LCRECORD_LISTP(x) GC_RECORDP (x, lcrecord_list)
1339 /* #define CHECK_LCRECORD_LIST(x) CHECK_RECORD (x, lcrecord_list)
1340 Lcrecord lists should never escape to the Lisp level, so
1341 functions should not be doing this. */
1342
1343 Lisp_Object make_lcrecord_list (int size,
1344 CONST struct lrecord_implementation
1345 *implementation);
1346 Lisp_Object allocate_managed_lcrecord (Lisp_Object lcrecord_list);
1347 void free_managed_lcrecord (Lisp_Object lcrecord_list, Lisp_Object lcrecord);
1348
1349
1350 /************************************************************************/
1351 /* Definitions of primitive Lisp functions and variables */
1352 /************************************************************************/
1353
1354 /* Define a built-in function for calling from Lisp.
1355 `lname' should be the name to give the function in Lisp,
1356 as a null-terminated C string.
1357 `fnname' should be the name of the function in C.
1358 By convention, it starts with F.
1359 `sname' should be the name for the C constant structure
1360 that records information on this function for internal use.
1361 By convention, it should be the same as `fnname' but with S instead of F.
1362 It's too bad that C macros can't compute this from `fnname'.
1363 `minargs' should be a number, the minimum number of arguments allowed.
1364 `maxargs' should be a number, the maximum number of arguments allowed,
1365 or else MANY or UNEVALLED.
1366 MANY means pass a vector of evaluated arguments,
1367 in the form of an integer number-of-arguments
1368 followed by the address of a vector of Lisp_Objects
1369 which contains the argument values.
1370 UNEVALLED means pass the list of unevaluated arguments
1371 `prompt' says how to read arguments for an interactive call.
1372 See the doc string for `interactive'.
1373 A null string means call interactively with no arguments.
1374 `doc' is documentation for the user.
1375 */
1376
1377 #define SUBR_MAX_ARGS 8
1378 #define MANY -2
1379 #define UNEVALLED -1
1380
1381 /* Can't be const, because then subr->doc is read-only and
1382 * FSnarf_documentation chokes */
1383 #define DEFUN(lname, fnname, sname, minargs, maxargs, prompt) \
1384 Lisp_Object fnname DEFUN_ARGS_ ## maxargs ; /* See below */ \
1385 static struct Lisp_Subr sname \
1386 = { { lrecord_subr }, minargs, maxargs, prompt, 0, lname, fnname }; \
1387 Lisp_Object fnname
1388
1389 /* Scary ANSI C preprocessor hackery by Felix Lee <flee@guardian.cse.psu.edu>
1390 to get DEFUN to declare a prototype that matches maxargs, so that the
1391 compiler can complain if the "real" arglist doesn't match. Clever hack
1392 or repulsive kludge? You be the judge.
1393 */
1394
1395 /* WARNING: If you add defines below for higher values of maxargs,
1396 make sure to also fix the clauses in primitive_funcall(). */
1397
1398 #define DEFUN_ARGS_MANY (int, Lisp_Object *)
1399 #define DEFUN_ARGS_UNEVALLED (Lisp_Object)
1400 #define DEFUN_ARGS_0 (void)
1401 #define DEFUN_ARGS_1 (Lisp_Object)
1402 #define DEFUN_ARGS_2 (Lisp_Object, Lisp_Object)
1403 #define DEFUN_ARGS_3 (Lisp_Object, Lisp_Object, Lisp_Object)
1404 #define DEFUN_ARGS_4 (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object)
1405 #define DEFUN_ARGS_5 (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, \
1406 Lisp_Object)
1407 #define DEFUN_ARGS_6 (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, \
1408 Lisp_Object, Lisp_Object)
1409 #define DEFUN_ARGS_7 (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, \
1410 Lisp_Object, Lisp_Object, Lisp_Object)
1411 #define DEFUN_ARGS_8 (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, \
1412 Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object)
1413 #define DEFUN_ARGS_9 (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, \
1414 Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, \
1415 Lisp_Object)
1416 #define DEFUN_ARGS_10 (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, \
1417 Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, \
1418 Lisp_Object, Lisp_Object)
1419 #define DEFUN_ARGS_11 (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, \
1420 Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, \
1421 Lisp_Object, Lisp_Object, Lisp_Object)
1422 #define DEFUN_ARGS_12 (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, \
1423 Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, \
1424 Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object)
1425
1426 #include "symeval.h"
1427
1428 /* Depth of special binding/unwind-protect stack. Use as arg to unbind_to */
1429 int specpdl_depth (void);
1430
1431
1432 /************************************************************************/
1433 /* Checking for QUIT */
1434 /************************************************************************/
1435
1436 /* Asynchronous events set something_happened, and then are processed
1437 within the QUIT macro. At this point, we are guaranteed to not be in
1438 any sensitive code. */
1439
1440 extern volatile int something_happened;
1441 int check_what_happened (void);
1442
1443 extern volatile int quit_check_signal_happened;
1444 extern volatile int quit_check_signal_tick_count;
1445 int check_quit (void);
1446
1447 void signal_quit (void);
1448
1449 /* Nonzero if ought to quit now. */
1450 #define QUITP ((quit_check_signal_happened ? check_quit () : 0), \
1451 (!NILP (Vquit_flag) && (NILP (Vinhibit_quit) \
1452 || EQ (Vquit_flag, Qcritical))))
1453
1454 /* QUIT used to call QUITP, but there are some places where QUITP
1455 is called directly, and check_what_happened() should only be called
1456 when Emacs is actually ready to quit because it could do things
1457 like switch threads. */
1458 #define INTERNAL_QUITP \
1459 ((something_happened ? check_what_happened () : 0), \
1460 (!NILP (Vquit_flag) && \
1461 (NILP (Vinhibit_quit) || EQ (Vquit_flag, Qcritical))))
1462
1463 #define INTERNAL_REALLY_QUITP \
1464 (check_what_happened (), \
1465 (!NILP (Vquit_flag) && \
1466 (NILP (Vinhibit_quit) || EQ (Vquit_flag, Qcritical))))
1467
1468 /* Check quit-flag and quit if it is non-nil. Also do any other things
1469 that might have gotten queued until it was safe. */
1470 #define QUIT \
1471 do { if (INTERNAL_QUITP) signal_quit (); } while (0)
1472
1473 #define REALLY_QUIT \
1474 do { if (INTERNAL_REALLY_QUITP) signal_quit (); } while (0)
1475
1476
1477 /************************************************************************/
1478 /* hashing */
1479 /************************************************************************/
1480
1481 /* #### for a 64-bit machine, we should substitute a prime just over
1482 2^32 */
1483 #define GOOD_HASH_VALUE 65599 /* prime number just over 2^16;
1484 Dragon book, p. 435 */
1485 #define HASH2(a, b) ((a) * GOOD_HASH_VALUE + (b))
1486 #define HASH3(a, b, c) (HASH2 (a, b) * GOOD_HASH_VALUE + (c))
1487 #define HASH4(a, b, c, d) (HASH3 (a, b, c) * GOOD_HASH_VALUE + (d))
1488 #define HASH5(a, b, c, d, e) (HASH4 (a, b, c, d) * GOOD_HASH_VALUE + (e))
1489 #define HASH6(a, b, c, d, e, f) (HASH5 (a, b, c, d, e) * GOOD_HASH_VALUE + (f))
1490 #define HASH7(a, b, c, d, e, f, g) \
1491 (HASH6 (a, b, c, d, e, f) * GOOD_HASH_VALUE + (g))
1492 #define HASH8(a, b, c, d, e, f, g, h) \
1493 (HASH7 (a, b, c, d, e, f, g) * GOOD_HASH_VALUE + (h))
1494 #define HASH9(a, b, c, d, e, f, g, h, i) \
1495 (HASH8 (a, b, c, d, e, f, g, h) * GOOD_HASH_VALUE + (i))
1496
1497 /* Enough already! */
1498
1499 #define LISP_HASH(obj) ((unsigned long) LISP_TO_VOID (obj))
1500 unsigned long string_hash (CONST void *xv);
1501 unsigned long memory_hash (CONST void *xv, int size);
1502 unsigned long internal_hash (Lisp_Object obj, int depth);
1503 unsigned long internal_array_hash (Lisp_Object *arr, int size, int depth);
1504
1505
1506 /************************************************************************/
1507 /* String translation */
1508 /************************************************************************/
1509
1510 #ifdef I18N3
1511 #ifdef HAVE_LIBINTL_H
1512 #include <libintl.h>
1513 #else
1514 char *dgettext (CONST char *, CONST char *);
1515 char *gettext (CONST char *);
1516 char *textdomain (CONST char *);
1517 char *bindtextdomain (CONST char *, CONST char *);
1518 #endif /* HAVE_LIBINTL_H */
1519
1520 #define GETTEXT(x) gettext(x)
1521 #define LISP_GETTEXT(x) Fgettext (x)
1522 #else /* !I18N3 */
1523 #define GETTEXT(x) (x)
1524 #define LISP_GETTEXT(x) (x)
1525 #endif /* !I18N3 */
1526
1527 /* DEFER_GETTEXT is used to identify strings which are translated when
1528 they are referenced instead of when they are defined.
1529 These include Qerror_messages and initialized arrays of strings.
1530 */
1531 #define DEFER_GETTEXT(x) (x)
1532
1533
1534 /************************************************************************/
1535 /* Garbage collection / GC-protection */
1536 /************************************************************************/
1537
1538 /* number of bytes of structure consed since last GC */
1539
1540 extern EMACS_INT consing_since_gc;
1541
1542 /* threshold for doing another gc */
1543
1544 extern EMACS_INT gc_cons_threshold;
1545
1546 /* Structure for recording stack slots that need marking */
1547
1548 /* This is a chain of structures, each of which points at a Lisp_Object
1549 variable whose value should be marked in garbage collection.
1550 Normally every link of the chain is an automatic variable of a function,
1551 and its `val' points to some argument or local variable of the function.
1552 On exit to the function, the chain is set back to the value it had on
1553 entry. This way, no link remains in the chain when the stack frame
1554 containing the link disappears.
1555
1556 Every function that can call Feval must protect in this fashion all
1557 Lisp_Object variables whose contents will be used again. */
1558
1559 extern struct gcpro *gcprolist;
1560
1561 struct gcpro
1562 {
1563 struct gcpro *next;
1564 Lisp_Object *var; /* Address of first protected variable */
1565 int nvars; /* Number of consecutive protected variables */
1566 };
1567
1568 /* Normally, you declare variables gcpro1, gcpro2, ... and use the
1569 GCPROn() macros. However, if you need to have nested gcpro's,
1570 declare ngcpro1, ngcpro2, ... and use NGCPROn(). If you need
1571 to nest another level, use nngcpro1, nngcpro2, ... and use
1572 NNGCPROn(). If you need to nest yet another level, create
1573 the appropriate macros. */
1574
1575 #ifdef DEBUG_GCPRO
1576
1577 void debug_gcpro1 (), debug_gcpro2 (), debug_gcpro3 (), debug_gcpro4 ();
1578 void debug_gcpro_5 (), debug_ungcpro ();
1579
1580 #define GCPRO1(v) \
1581 debug_gcpro1 (__FILE__, __LINE__,&gcpro1,&v)
1582 #define GCPRO2(v1,v2) \
1583 debug_gcpro2 (__FILE__, __LINE__,&gcpro1,&gcpro2,&v1,&v2)
1584 #define GCPRO3(v1,v2,v3) \
1585 debug_gcpro3 (__FILE__, __LINE__,&gcpro1,&gcpro2,&gcpro3,&v1,&v2,&v3)
1586 #define GCPRO4(v1,v2,v3,v4) \
1587 debug_gcpro4 (__FILE__, __LINE__,&gcpro1,&gcpro2,&gcpro3,&gcpro4,\
1588 &v1,&v2,&v3,&v4)
1589 #define GCPRO5(v1,v2,v3,v4,v5) \
1590 debug_gcpro5 (__FILE__, __LINE__,&gcpro1,&gcpro2,&gcpro3,&gcpro4,&gcpro5,\
1591 &v1,&v2,&v3,&v4,&v5)
1592 #define UNGCPRO \
1593 debug_ungcpro(__FILE__, __LINE__,&gcpro1)
1594
1595 #define NGCPRO1(v) \
1596 debug_gcpro1 (__FILE__, __LINE__,&ngcpro1,&v)
1597 #define NGCPRO2(v1,v2) \
1598 debug_gcpro2 (__FILE__, __LINE__,&ngcpro1,&ngcpro2,&v1,&v2)
1599 #define NGCPRO3(v1,v2,v3) \
1600 debug_gcpro3 (__FILE__, __LINE__,&ngcpro1,&ngcpro2,&ngcpro3,&v1,&v2,&v3)
1601 #define NGCPRO4(v1,v2,v3,v4) \
1602 debug_gcpro4 (__FILE__, __LINE__,&ngcpro1,&ngcpro2,&ngcpro3,&ngcpro4,\
1603 &v1,&v2,&v3,&v4)
1604 #define NGCPRO5(v1,v2,v3,v4,v5) \
1605 debug_gcpro5 (__FILE__, __LINE__,&ngcpro1,&ngcpro2,&ngcpro3,&ngcpro4,\
1606 &ngcpro5,&v1,&v2,&v3,&v4,&v5)
1607 #define NUNGCPRO \
1608 debug_ungcpro(__FILE__, __LINE__,&ngcpro1)
1609
1610 #define NNGCPRO1(v) \
1611 debug_gcpro1 (__FILE__, __LINE__,&nngcpro1,&v)
1612 #define NNGCPRO2(v1,v2) \
1613 debug_gcpro2 (__FILE__, __LINE__,&nngcpro1,&nngcpro2,&v1,&v2)
1614 #define NNGCPRO3(v1,v2,v3) \
1615 debug_gcpro3 (__FILE__, __LINE__,&nngcpro1,&nngcpro2,&nngcpro3,&v1,&v2,&v3)
1616 #define NNGCPRO4(v1,v2,v3,v4) \
1617 debug_gcpro4 (__FILE__, __LINE__,&nngcpro1,&nngcpro2,&nngcpro3,&nngcpro4,\
1618 &v1,&v2,&v3,&v4)
1619 #define NNGCPRO5(v1,v2,v3,v4,v5) \
1620 debug_gcpro5 (__FILE__, __LINE__,&nngcpro1,&nngcpro2,&nngcpro3,&nngcpro4,\
1621 &nngcpro5,&v1,&v2,&v3,&v4,&v5)
1622 #define NUNNGCPRO \
1623 debug_ungcpro(__FILE__, __LINE__,&nngcpro1)
1624
1625 #else /* ! DEBUG_GCPRO */
1626
1627 #define GCPRO1(varname) \
1628 {gcpro1.next = gcprolist; gcpro1.var = &varname; gcpro1.nvars = 1; \
1629 gcprolist = &gcpro1; }
1630
1631 #define GCPRO2(varname1, varname2) \
1632 {gcpro1.next = gcprolist; gcpro1.var = &varname1; gcpro1.nvars = 1; \
1633 gcpro2.next = &gcpro1; gcpro2.var = &varname2; gcpro2.nvars = 1; \
1634 gcprolist = &gcpro2; }
1635
1636 #define GCPRO3(varname1, varname2, varname3) \
1637 {gcpro1.next = gcprolist; gcpro1.var = &varname1; gcpro1.nvars = 1; \
1638 gcpro2.next = &gcpro1; gcpro2.var = &varname2; gcpro2.nvars = 1; \
1639 gcpro3.next = &gcpro2; gcpro3.var = &varname3; gcpro3.nvars = 1; \
1640 gcprolist = &gcpro3; }
1641
1642 #define GCPRO4(varname1, varname2, varname3, varname4) \
1643 {gcpro1.next = gcprolist; gcpro1.var = &varname1; gcpro1.nvars = 1; \
1644 gcpro2.next = &gcpro1; gcpro2.var = &varname2; gcpro2.nvars = 1; \
1645 gcpro3.next = &gcpro2; gcpro3.var = &varname3; gcpro3.nvars = 1; \
1646 gcpro4.next = &gcpro3; gcpro4.var = &varname4; gcpro4.nvars = 1; \
1647 gcprolist = &gcpro4; }
1648
1649 #define GCPRO5(varname1, varname2, varname3, varname4, varname5) \
1650 {gcpro1.next = gcprolist; gcpro1.var = &varname1; gcpro1.nvars = 1; \
1651 gcpro2.next = &gcpro1; gcpro2.var = &varname2; gcpro2.nvars = 1; \
1652 gcpro3.next = &gcpro2; gcpro3.var = &varname3; gcpro3.nvars = 1; \
1653 gcpro4.next = &gcpro3; gcpro4.var = &varname4; gcpro4.nvars = 1; \
1654 gcpro5.next = &gcpro4; gcpro5.var = &varname5; gcpro5.nvars = 1; \
1655 gcprolist = &gcpro5; }
1656
1657 #define UNGCPRO (gcprolist = gcpro1.next)
1658
1659 #define NGCPRO1(varname) \
1660 {ngcpro1.next = gcprolist; ngcpro1.var = &varname; ngcpro1.nvars = 1; \
1661 gcprolist = &ngcpro1; }
1662
1663 #define NGCPRO2(varname1, varname2) \
1664 {ngcpro1.next = gcprolist; ngcpro1.var = &varname1; ngcpro1.nvars = 1; \
1665 ngcpro2.next = &ngcpro1; ngcpro2.var = &varname2; ngcpro2.nvars = 1; \
1666 gcprolist = &ngcpro2; }
1667
1668 #define NGCPRO3(varname1, varname2, varname3) \
1669 {ngcpro1.next = gcprolist; ngcpro1.var = &varname1; ngcpro1.nvars = 1; \
1670 ngcpro2.next = &ngcpro1; ngcpro2.var = &varname2; ngcpro2.nvars = 1; \
1671 ngcpro3.next = &ngcpro2; ngcpro3.var = &varname3; ngcpro3.nvars = 1; \
1672 gcprolist = &ngcpro3; }
1673
1674 #define NGCPRO4(varname1, varname2, varname3, varname4) \
1675 {ngcpro1.next = gcprolist; ngcpro1.var = &varname1; ngcpro1.nvars = 1; \
1676 ngcpro2.next = &ngcpro1; ngcpro2.var = &varname2; ngcpro2.nvars = 1; \
1677 ngcpro3.next = &ngcpro2; ngcpro3.var = &varname3; ngcpro3.nvars = 1; \
1678 ngcpro4.next = &ngcpro3; ngcpro4.var = &varname4; ngcpro4.nvars = 1; \
1679 gcprolist = &ngcpro4; }
1680
1681 #define NGCPRO5(varname1, varname2, varname3, varname4, varname5) \
1682 {ngcpro1.next = gcprolist; ngcpro1.var = &varname1; ngcpro1.nvars = 1; \
1683 ngcpro2.next = &ngcpro1; ngcpro2.var = &varname2; ngcpro2.nvars = 1; \
1684 ngcpro3.next = &ngcpro2; ngcpro3.var = &varname3; ngcpro3.nvars = 1; \
1685 ngcpro4.next = &ngcpro3; ngcpro4.var = &varname4; ngcpro4.nvars = 1; \
1686 ngcpro5.next = &ngcpro4; ngcpro5.var = &varname5; ngcpro5.nvars = 1; \
1687 gcprolist = &ngcpro5; }
1688
1689 #define NUNGCPRO (gcprolist = ngcpro1.next)
1690
1691 #define NNGCPRO1(varname) \
1692 {nngcpro1.next = gcprolist; nngcpro1.var = &varname; nngcpro1.nvars = 1; \
1693 gcprolist = &nngcpro1; }
1694
1695 #define NNGCPRO2(varname1, varname2) \
1696 {nngcpro1.next = gcprolist; nngcpro1.var = &varname1; nngcpro1.nvars = 1; \
1697 nngcpro2.next = &nngcpro1; nngcpro2.var = &varname2; nngcpro2.nvars = 1; \
1698 gcprolist = &nngcpro2; }
1699
1700 #define NNGCPRO3(varname1, varname2, varname3) \
1701 {nngcpro1.next = gcprolist; nngcpro1.var = &varname1; nngcpro1.nvars = 1; \
1702 nngcpro2.next = &nngcpro1; nngcpro2.var = &varname2; nngcpro2.nvars = 1; \
1703 nngcpro3.next = &nngcpro2; nngcpro3.var = &varname3; nngcpro3.nvars = 1; \
1704 gcprolist = &nngcpro3; }
1705
1706 #define NNGCPRO4(varname1, varname2, varname3, varname4) \
1707 {nngcpro1.next = gcprolist; nngcpro1.var = &varname1; nngcpro1.nvars = 1; \
1708 nngcpro2.next = &nngcpro1; nngcpro2.var = &varname2; nngcpro2.nvars = 1; \
1709 nngcpro3.next = &nngcpro2; nngcpro3.var = &varname3; nngcpro3.nvars = 1; \
1710 nngcpro4.next = &nngcpro3; nngcpro4.var = &varname4; nngcpro4.nvars = 1; \
1711 gcprolist = &nngcpro4; }
1712
1713 #define NNGCPRO5(varname1, varname2, varname3, varname4, varname5) \
1714 {nngcpro1.next = gcprolist; nngcpro1.var = &varname1; nngcpro1.nvars = 1; \
1715 nngcpro2.next = &nngcpro1; nngcpro2.var = &varname2; nngcpro2.nvars = 1; \
1716 nngcpro3.next = &nngcpro2; nngcpro3.var = &varname3; nngcpro3.nvars = 1; \
1717 nngcpro4.next = &nngcpro3; nngcpro4.var = &varname4; nngcpro4.nvars = 1; \
1718 nngcpro5.next = &nngcpro4; nngcpro5.var = &varname5; nngcpro5.nvars = 1; \
1719 gcprolist = &nngcpro5; }
1720
1721 #define NNUNGCPRO (gcprolist = nngcpro1.next)
1722
1723 #endif /* ! DEBUG_GCPRO */
1724
1725 /* Another try to fix SunPro C compiler warnings */
1726 /* "end-of-loop code not reached" */
1727 #ifdef __SUNPRO_C
1728 #define RETURN__ if (1) return
1729 #else
1730 #define RETURN__ return
1731 #endif
1732
1733 /* Another try to fix SunPro C compiler warnings */
1734 /* "end-of-loop code not reached" */
1735 /* "statement not reached */
1736 #ifdef __SUNPRO_C
1737 #define RETURN__ if (1) return
1738 #define RETURN_NOT_REACHED(value)
1739 #else
1740 #define RETURN__ return
1741 #define RETURN_NOT_REACHED(value) return value;
1742 #endif
1743
1744 /* Evaluate expr, UNGCPRO, and then return the value of expr. */
1745 #define RETURN_UNGCPRO(expr) do \
1746 { \
1747 Lisp_Object ret_ungc_val = (expr); \
1748 UNGCPRO; \
1749 RETURN__ ret_ungc_val; \
1750 } while (0)
1751
1752 /* Evaluate expr, NUNGCPRO, UNGCPRO, and then return the value of expr. */
1753 #define RETURN_NUNGCPRO(expr) do \
1754 { \
1755 Lisp_Object ret_ungc_val = (expr); \
1756 NUNGCPRO; \
1757 UNGCPRO; \
1758 RETURN__ ret_ungc_val; \
1759 } while (0)
1760
1761 /* Evaluate expr, NNUNGCPRO, NUNGCPRO, UNGCPRO, and then return the
1762 value of expr. */
1763 #define RETURN_NNUNGCPRO(expr) do \
1764 { \
1765 Lisp_Object ret_ungc_val = (expr); \
1766 NNUNGCPRO; \
1767 NUNGCPRO; \
1768 UNGCPRO; \
1769 RETURN__ ret_ungc_val; \
1770 } while (0)
1771
1772 /* Evaluate expr, return it if it's not Qunbound. */
1773 #define RETURN_IF_NOT_UNBOUND(expr) do \
1774 { \
1775 Lisp_Object ret_nunb_val = (expr); \
1776 if (!UNBOUNDP (ret_nunb_val)) \
1777 RETURN__ ret_nunb_val; \
1778 } while (0)
1779
1780 /* Call staticpro (&var) to protect static variable `var'. */
1781 void staticpro (Lisp_Object *);
1782
1783 /* Nonzero means Emacs has already been initialized.
1784 Used during startup to detect startup of dumped Emacs. */
1785 extern int initialized;
1786
1787 #ifdef MEMORY_USAGE_STATS
1788
1789 /* This structure is used to keep statistics on the amount of memory
1790 in use.
1791
1792 WAS_REQUESTED stores the actual amount of memory that was requested
1793 of the allocation function. The *_OVERHEAD fields store the
1794 additional amount of memory that was grabbed by the functions to
1795 facilitate allocation, reallocation, etc. MALLOC_OVERHEAD is for
1796 memory allocated with malloc(); DYNARR_OVERHEAD is for dynamic
1797 arrays; GAP_OVERHEAD is for gap arrays. Note that for (e.g.)
1798 dynamic arrays, there is both MALLOC_OVERHEAD and DYNARR_OVERHEAD
1799 memory: The dynamic array allocates memory above and beyond what
1800 was asked of it, and when it in turns allocates memory using
1801 malloc(), malloc() allocates memory beyond what it was asked
1802 to allocate.
1803
1804 Functions that accept a structure of this sort do not initialize
1805 the fields to 0, and add any existing values to whatever was there
1806 before; this way, you can get a cumulative effect. */
1807
1808 struct overhead_stats
1809 {
1810 int was_requested;
1811 int malloc_overhead;
1812 int dynarr_overhead;
1813 int gap_overhead;
1814 };
1815
1816 #endif /* MEMORY_USAGE_STATS */
1817
1818 /* Some systems (e.g., NT) use a different path separator than Unix,
1819 in addition to a device separator. Default the path separator
1820 to '/', and don't test for a device separator in IS_ANY_SEP. */
1821
1822 #ifndef DIRECTORY_SEP
1823 #define DIRECTORY_SEP '/'
1824 #endif
1825 #ifndef IS_DIRECTORY_SEP
1826 #define IS_DIRECTORY_SEP(_c_) ((_c_) == DIRECTORY_SEP)
1827 #endif
1828 #ifndef IS_DEVICE_SEP
1829 #ifndef DEVICE_SEP
1830 #define IS_DEVICE_SEP(_c_) 0
1831 #else
1832 #define IS_DEVICE_SEP(_c_) ((_c_) == DEVICE_SEP)
1833 #endif
1834 #endif
1835 #ifndef IS_ANY_SEP
1836 #define IS_ANY_SEP(_c_) (IS_DIRECTORY_SEP (_c_))
1837 #endif
1838
1839 #include "emacsfns.h"
1840
1841 #endif /* _XEMACS_LISP_H_ */