Mercurial > hg > xemacs-beta
annotate src/lisp-union.h @ 5569:d19b6e3bdf91
#'cl-defsubst-expand; avoid mutually-recursive symbol macros.
lisp/ChangeLog addition:
2011-09-10 Aidan Kehoe <kehoea@parhasard.net>
* cl-macs.el (cl-defsubst-expand):
Change set 2a6a8da4dd7c of
http://mid.gmane.org/19966.17522.332164.615228@parhasard.net
wasn't sufficiently comprehensive, symbol macros can be mutually
rather than simply recursive, and they can equally hang. Thanks
for the bug report, Michael Sperber, and for the test case,
Stephen Turnbull.
| author | Aidan Kehoe <kehoea@parhasard.net> |
|---|---|
| date | Sat, 10 Sep 2011 13:17:29 +0100 |
| parents | 308d34e9f07d |
| children | 56144c8593a8 |
| rev | line source |
|---|---|
| 428 | 1 /* Fundamental definitions for XEmacs Lisp interpreter -- union objects. |
| 2 Copyright (C) 1985, 1986, 1987, 1992, 1993, 1994 | |
| 3 Free Software Foundation, Inc. | |
| 5013 | 4 Copyright (C) 2002, 2005, 2010 Ben Wing. |
| 428 | 5 |
| 6 This file is part of XEmacs. | |
| 7 | |
|
5402
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
5013
diff
changeset
|
8 XEmacs is free software: you can redistribute it and/or modify it |
| 428 | 9 under the terms of the GNU General Public License as published by the |
|
5402
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
5013
diff
changeset
|
10 Free Software Foundation, either version 3 of the License, or (at your |
|
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
5013
diff
changeset
|
11 option) any later version. |
| 428 | 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 | |
|
5402
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
5013
diff
changeset
|
19 along with XEmacs. If not, see <http://www.gnu.org/licenses/>. */ |
| 428 | 20 |
| 21 /* Divergent from FSF. */ | |
| 22 | |
| 23 /* Definition of Lisp_Object type as a union. | |
| 24 The declaration order of the objects within the struct members | |
| 25 of the union is dependent on ENDIAN-ness. | |
| 26 See lisp-disunion.h for more details. */ | |
| 27 | |
| 28 typedef | |
| 29 union Lisp_Object | |
| 30 { | |
| 31 /* if non-valbits are at lower addresses */ | |
| 442 | 32 #ifdef WORDS_BIGENDIAN |
| 428 | 33 struct |
| 34 { | |
| 35 EMACS_UINT val : VALBITS; | |
| 36 enum_field (Lisp_Type) type : GCTYPEBITS; | |
| 37 } gu; | |
| 38 | |
| 39 struct | |
| 40 { | |
| 41 signed EMACS_INT val : INT_VALBITS; | |
| 42 unsigned int bits : INT_GCBITS; | |
| 43 } s; | |
| 44 | |
| 45 struct | |
| 46 { | |
| 47 EMACS_UINT val : INT_VALBITS; | |
| 48 unsigned int bits : INT_GCBITS; | |
| 49 } u; | |
| 50 #else /* non-valbits are at higher addresses */ | |
| 51 struct | |
| 52 { | |
| 53 enum_field (Lisp_Type) type : GCTYPEBITS; | |
| 54 EMACS_UINT val : VALBITS; | |
| 55 } gu; | |
| 56 | |
| 57 struct | |
| 58 { | |
| 59 unsigned int bits : INT_GCBITS; | |
| 60 signed EMACS_INT val : INT_VALBITS; | |
| 61 } s; | |
| 62 | |
| 63 struct | |
| 64 { | |
| 65 unsigned int bits : INT_GCBITS; | |
| 66 EMACS_UINT val : INT_VALBITS; | |
| 67 } u; | |
| 68 | |
| 69 #endif /* non-valbits are at higher addresses */ | |
| 70 | |
| 71 EMACS_UINT ui; | |
| 72 signed EMACS_INT i; | |
| 73 | |
| 3025 | 74 /* This was formerly declared `void *v' etc. but that causes |
| 428 | 75 GCC to accept any (yes, any) pointer as the argument of |
| 76 a function declared to accept a Lisp_Object. */ | |
| 77 struct nosuchstruct *v; | |
| 78 } | |
| 79 Lisp_Object; | |
| 80 | |
| 3455 | 81 #define XCHARVAL(x) ((EMACS_INT)(x).gu.val) |
| 826 | 82 #define XPNTRVAL(x) ((x).ui) |
| 83 | |
| 3455 | 84 #define XREALINT(x) ((EMACS_INT)(x).s.val) |
| 85 #define XUINT(x) ((EMACS_UINT)(x).u.val) | |
| 826 | 86 #define XTYPE(x) ((x).gu.type) |
| 87 #define EQ(x,y) ((x).v == (y).v) | |
| 428 | 88 |
| 826 | 89 DECLARE_INLINE_HEADER ( |
| 90 Lisp_Object | |
| 91 make_int_verify (EMACS_INT val) | |
| 92 ) | |
| 93 { | |
| 94 Lisp_Object obj; | |
| 95 obj.s.bits = 1; | |
| 96 obj.s.val = val; | |
| 97 type_checking_assert (XREALINT (obj) == val); | |
| 98 return obj; | |
| 99 } | |
| 100 | |
| 101 DECLARE_INLINE_HEADER ( | |
| 102 Lisp_Object | |
| 428 | 103 make_int (EMACS_INT val) |
| 826 | 104 ) |
| 428 | 105 { |
| 106 Lisp_Object obj; | |
| 793 | 107 obj.s.bits = 1; |
| 108 obj.s.val = val; | |
| 428 | 109 return obj; |
| 110 } | |
| 111 | |
| 826 | 112 DECLARE_INLINE_HEADER ( |
| 113 Lisp_Object | |
| 867 | 114 make_char_1 (Ichar val) |
| 826 | 115 ) |
| 428 | 116 { |
| 117 Lisp_Object obj; | |
| 793 | 118 obj.gu.type = Lisp_Type_Char; |
| 119 obj.gu.val = val; | |
| 442 | 120 return obj; |
| 121 } | |
| 122 | |
| 826 | 123 DECLARE_INLINE_HEADER ( |
| 124 Lisp_Object | |
| 800 | 125 wrap_pointer_1 (const void *ptr) |
| 826 | 126 ) |
| 442 | 127 { |
| 128 Lisp_Object obj; | |
| 793 | 129 obj.ui = (EMACS_UINT) ptr; |
| 428 | 130 return obj; |
| 131 } | |
| 132 | |
| 1632 | 133 extern MODULE_API Lisp_Object Qnull_pointer, Qzero; |
| 428 | 134 |
| 135 #define INTP(x) ((x).s.bits) | |
| 136 #define INT_PLUS(x,y) make_int (XINT (x) + XINT (y)) | |
| 137 #define INT_MINUS(x,y) make_int (XINT (x) - XINT (y)) | |
| 138 #define INT_PLUS1(x) make_int (XINT (x) + 1) | |
| 139 #define INT_MINUS1(x) make_int (XINT (x) - 1) | |
| 140 | |
| 853 | 141 /* WARNING!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! |
| 142 | |
| 5013 | 143 You can only GET_LISP_FROM_VOID something that had previously been |
| 144 STORE_LISP_IN_VOID'd. If you want to go the other way, use | |
| 145 STORE_VOID_IN_LISP and GET_VOID_FROM_LISP, or use make_opaque_ptr(). */ | |
| 853 | 146 |
| 5013 | 147 /* Convert a Lisp object to a void * pointer, as when it needs to be passed |
| 148 to a toolkit callback function */ | |
| 149 #define STORE_LISP_IN_VOID(larg) ((void *) ((larg).v)) | |
| 150 | |
| 151 /* Convert a void * pointer back into a Lisp object, assuming that the | |
| 152 pointer was generated by STORE_LISP_IN_VOID. */ | |
| 826 | 153 DECLARE_INLINE_HEADER ( |
| 154 Lisp_Object | |
| 5013 | 155 GET_LISP_FROM_VOID (const void *arg) |
| 826 | 156 ) |
| 157 { | |
| 158 Lisp_Object larg; | |
| 159 larg.v = (struct nosuchstruct *) arg; | |
| 160 return larg; | |
| 161 } | |
| 162 | |
| 428 | 163 /* Convert a Lisp_Object into something that can't be used as an |
| 164 lvalue. Useful for type-checking. */ | |
| 165 #if (__GNUC__ > 1) | |
| 166 #define NON_LVALUE(larg) ({ (larg); }) | |
| 167 #else | |
| 168 /* Well, you can't really do it without using a function call, and | |
| 169 there's no real point in that; no-union-type is the rule, and that | |
| 170 will catch errors. */ | |
| 171 #define NON_LVALUE(larg) (larg) | |
| 172 #endif |