Mercurial > hg > xemacs-beta
annotate src/lisp-union.h @ 5428:73eef12660cd
Converted gnuserv docs to GPLv3 or later.
| author | Mats Lidell <matsl@xemacs.org> |
|---|---|
| date | Sat, 06 Nov 2010 22:57:08 +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 |