annotate src/symeval.h @ 5353:38e24b8be4ea

Improve the lexical scoping in #'block, #'return-from. lisp/ChangeLog addition: 2011-02-07 Aidan Kehoe <kehoea@parhasard.net> * bytecomp.el: * bytecomp.el (byte-compile-initial-macro-environment): Shadow `block', `return-from' here, we implement them differently when byte-compiling. * bytecomp.el (byte-compile-active-blocks): New. * bytecomp.el (byte-compile-block-1): New. * bytecomp.el (byte-compile-return-from-1): New. * bytecomp.el (return-from-1): New. * bytecomp.el (block-1): New. These are two aliases that exist to have their own associated byte-compile functions, which functions implement `block' and `return-from'. * cl-extra.el (cl-macroexpand-all): Fix a bug here when macros in the environment have been compiled. * cl-macs.el (block): * cl-macs.el (return): * cl-macs.el (return-from): Be more careful about lexical scope in these macros. * cl.el: * cl.el ('cl-block-wrapper): Removed. * cl.el ('cl-block-throw): Removed. These aren't needed in code generated by this XEmacs. They shouldn't be needed in code generated by XEmacs 21.4, but if it turns out the packages do need them, we can put them back. 2011-01-30 Mike Sperber <mike@xemacs.org> * font-lock.el (font-lock-fontify-pending-extents): Don't fail if `font-lock-mode' is unset, which can happen in the middle of `revert-buffer'. 2011-01-23 Aidan Kehoe <kehoea@parhasard.net> * cl-macs.el (delete): * cl-macs.el (delq): * cl-macs.el (remove): * cl-macs.el (remq): Don't use the compiler macro if these functions were given the wrong number of arguments, as happens in lisp-tests.el. * cl-seq.el (remove, remq): Removed. I added these to subr.el, and forgot to remove them from here. 2011-01-22 Aidan Kehoe <kehoea@parhasard.net> * bytecomp.el (byte-compile-setq, byte-compile-set): Remove kludge allowing keywords' values to be set, all the code that does that is gone. * cl-compat.el (elt-satisfies-test-p): * faces.el (set-face-parent): * faces.el (face-doc-string): * gtk-font-menu.el: * gtk-font-menu.el (gtk-reset-device-font-menus): * msw-font-menu.el: * msw-font-menu.el (mswindows-reset-device-font-menus): * package-get.el (package-get-installedp): * select.el (select-convert-from-image-data): * sound.el: * sound.el (load-sound-file): * x-font-menu.el (x-reset-device-font-menus-core): Don't quote keywords, they're self-quoting, and the win from backward-compatibility is sufficiently small now that the style problem overrides it. 2011-01-22 Aidan Kehoe <kehoea@parhasard.net> * cl-macs.el (block, return-from): Require that NAME be a symbol in these macros, as always documented in the #'block docstring and as required by Common Lisp. * descr-text.el (unidata-initialize-unihan-database): Correct the use of non-symbols in #'block and #'return-from in this function. 2011-01-15 Aidan Kehoe <kehoea@parhasard.net> * cl-extra.el (concatenate): Accept more complicated TYPEs in this function, handing the sequences over to #'coerce if we don't understand them here. * cl-macs.el (inline): Don't proclaim #'concatenate as inline, its compiler macro is more useful than doing that. 2011-01-11 Aidan Kehoe <kehoea@parhasard.net> * subr.el (delete, delq, remove, remq): Move #'remove, #'remq here, they don't belong in cl-seq.el; move #'delete, #'delq here from fns.c, implement them in terms of #'delete*, allowing support for sequences generally. * update-elc.el (do-autoload-commands): Use #'delete*, not #'delq here, now the latter's no longer dumped. * cl-macs.el (delete, delq): Add compiler macros transforming #'delete and #'delq to #'delete* calls. 2011-01-10 Aidan Kehoe <kehoea@parhasard.net> * dialog.el (make-dialog-box): Correct a misplaced parenthesis here, thank you Mats Lidell in 87zkr9gqrh.fsf@mail.contactor.se ! 2011-01-02 Aidan Kehoe <kehoea@parhasard.net> * dialog.el (make-dialog-box): * list-mode.el (display-completion-list): These functions used to use cl-parsing-keywords; change them to use defun* instead, fixing the build. (Not sure what led to me not including this change in d1b17a33450b!) 2011-01-02 Aidan Kehoe <kehoea@parhasard.net> * cl-macs.el (define-star-compiler-macros): Make sure the form has ITEM and LIST specified before attempting to change to calls with explicit tests; necessary for some tests in lisp-tests.el to compile correctly. (stable-union, stable-intersection): Add compiler macros for these functions, in the same way we do for most of the other functions in cl-seq.el. 2011-01-01 Aidan Kehoe <kehoea@parhasard.net> * cl-macs.el (dolist, dotimes, do-symbols, macrolet) (symbol-macrolet): Define these macros with defmacro* instead of parsing the argument list by hand, for the sake of style and readability; use backquote where appropriate, instead of calling #'list and and friends, for the same reason. 2010-12-30 Aidan Kehoe <kehoea@parhasard.net> * x-misc.el (device-x-display): Provide this function, documented in the Lispref for years, but not existing previously. Thank you Julian Bradfield, thank you Jeff Mincy. 2010-12-30 Aidan Kehoe <kehoea@parhasard.net> * cl-seq.el: Move the heavy lifting from this file to C. Dump the cl-parsing-keywords macro, but don't use defun* for the functions we define that do take keywords, dynamic scope lossage makes that not practical. * subr.el (sort, fillarray): Move these aliases here. (map-plist): #'nsublis is now built-in, but at this point #'eql isn't necessarily available as a test; use #'eq. * obsolete.el (cl-delete-duplicates): Make this available for old compiler macros and old code. (memql): Document that this is equivalent to #'member*, and worse. * cl.el (adjoin, subst): Removed. These are in C. 2010-12-30 Aidan Kehoe <kehoea@parhasard.net> * simple.el (assoc-ignore-case): Remove a duplicate definition of this function (it's already in subr.el). * iso8859-1.el (char-width): On non-Mule, make this function equivalent to that produced by (constantly 1), but preserve its docstring. * subr.el (subst-char-in-string): Define this in terms of #'substitute, #'nsubstitute. (string-width): Define this using #'reduce and #'char-width. (char-width): Give this a simpler definition, it makes far more sense to check for mule at load time and redefine, as we do in iso8859-1.el. (store-substring): Implement this in terms of #'replace, now #'replace is cheap. 2010-12-30 Aidan Kehoe <kehoea@parhasard.net> * update-elc.el (lisp-files-needed-for-byte-compilation) (lisp-files-needing-early-byte-compilation): cl-macs belongs in the former, not the latter, it is as fundamental as bytecomp.el. 2010-12-30 Aidan Kehoe <kehoea@parhasard.net> * cl.el: Provde the Common Lisp program-error, type-error as error symbols. This doesn't nearly go far enough for anyone using the Common Lisp errors. 2010-12-29 Aidan Kehoe <kehoea@parhasard.net> * cl-macs.el (delete-duplicates): If the form has an incorrect number of arguments, don't attempt a compiler macroexpansion. 2010-12-29 Aidan Kehoe <kehoea@parhasard.net> * cl-macs.el (cl-safe-expr-p): Forms that start with the symbol lambda are also safe. 2010-12-29 Aidan Kehoe <kehoea@parhasard.net> * cl-macs.el (= < > <= >=): For these functions' compiler macros, the optimisation is safe even if the first and the last arguments have side effects, since they're only used the once. 2010-12-29 Aidan Kehoe <kehoea@parhasard.net> * cl-macs.el (inline-side-effect-free-compiler-macros): Unroll a loop here at macro-expansion time, so these compiler macros are compiled. Use #'eql instead of #'eq in a couple of places for better style. 2010-12-29 Aidan Kehoe <kehoea@parhasard.net> * cl-extra.el (notany, notevery): Avoid some dynamic scope stupidity with local variable names in these functions, when they weren't prefixed with cl-; go into some more detail in the doc strings. 2010-12-29 Aidan Kehoe <kehoea@parhasard.net> * byte-optimize.el (side-effect-free-fns): #'remove, #'remq are free of side-effects. (side-effect-and-error-free-fns): Drop dot, dot-marker from the list. 2010-11-17 Aidan Kehoe <kehoea@parhasard.net> * cl-extra.el (coerce): In the argument list, name the first argument OBJECT, not X; the former name was always used in the doc string and is clearer. Handle vector type specifications which include the length of the target sequence, error if there's a mismatch. * cl-macs.el (cl-make-type-test): Handle type specifications starting with the symbol 'eql. 2010-11-14 Aidan Kehoe <kehoea@parhasard.net> * cl-macs.el (eql): Don't remove the byte-compile property of this symbol. That was necessary to override a bug in bytecomp.el where #'eql was confused with #'eq, which bug we no longer have. If neither expression is constant, don't attempt to handle the expression in this compiler macro, leave it to byte-compile-eql, which produces better code anyway. * bytecomp.el (eq): #'eql is not the function associated with the byte-eq byte code. (byte-compile-eql): Add an explicit compile method for this function, for cases where the cl-macs compiler macro hasn't reduced it to #'eq or #'equal. 2010-10-25 Aidan Kehoe <kehoea@parhasard.net> Add compiler macros and compilation sanity-checking for various functions that take keywords. * byte-optimize.el (side-effect-free-fns): #'symbol-value is side-effect free and not error free. * bytecomp.el (byte-compile-normal-call): Check keyword argument lists for sanity; store information about the positions where keyword arguments start using the new byte-compile-keyword-start property. * cl-macs.el (cl-const-expr-val): Take a new optional argument, cl-not-constant, defaulting to nil, in this function; return it if the expression is not constant. (cl-non-fixnum-number-p): Make this into a separate function, we want to pass it to #'every. (eql): Use it. (define-star-compiler-macros): Use the same code to generate the member*, assoc* and rassoc* compiler macros; special-case some code in #'add-to-list in subr.el. (remove, remq): Add compiler macros for these two functions, in preparation for #'remove being in C. (define-foo-if-compiler-macros): Transform (remove-if-not ...) calls to (remove ... :if-not) at compile time, which will be a real win once the latter is in C. (define-substitute-if-compiler-macros) (define-subst-if-compiler-macros): Similarly for these functions. (delete-duplicates): Change this compiler macro to use #'plists-equal; if we don't have information about the type of SEQUENCE at compile time, don't bother attempting to inline the call, the function will be in C soon enough. (equalp): Remove an old commented-out compiler macro for this, if we want to see it it's in version control. (subst-char-in-string): Transform this to a call to nsubstitute or nsubstitute, if that is appropriate. * cl.el (ldiff): Don't call setf here, this makes for a load-time dependency problem in cl-macs.el 2010-06-14 Stephen J. Turnbull <stephen@xemacs.org> * term/vt100.el: Refer to XEmacs, not GNU Emacs, in permissions. * term/bg-mouse.el: * term/sup-mouse.el: Put copyright notice in canonical "Copyright DATE AUTHOR" form. Refer to XEmacs, not GNU Emacs, in permissions. * site-load.el: Add permission boilerplate. * mule/canna-leim.el: * alist.el: Refer to XEmacs, not APEL/this program, in permissions. * mule/canna-leim.el: Remove my copyright, I've assigned it to the FSF. 2010-06-14 Stephen J. Turnbull <stephen@xemacs.org> * gtk.el: * gtk-widget-accessors.el: * gtk-package.el: * gtk-marshal.el: * gtk-compose.el: * gnome.el: Add copyright notice based on internal evidence. 2010-06-14 Stephen J. Turnbull <stephen@xemacs.org> * easymenu.el: Add reference to COPYING to permission notice. * gutter.el: * gutter-items.el: * menubar-items.el: Fix typo "Xmacs" in permissions notice. 2010-06-14 Stephen J. Turnbull <stephen@xemacs.org> * auto-save.el: * font.el: * fontconfig.el: * mule/kinsoku.el: Add "part of XEmacs" text to permission notice. 2010-10-14 Aidan Kehoe <kehoea@parhasard.net> * byte-optimize.el (side-effect-free-fns): * cl-macs.el (remf, getf): * cl-extra.el (tailp, cl-set-getf, cl-do-remf): * cl.el (ldiff, endp): Tighten up Common Lisp compatibility for #'ldiff, #'endp, #'tailp; add circularity checking for the first two. #'cl-set-getf and #'cl-do-remf were Lisp implementations of #'plist-put and #'plist-remprop; change the names to aliases, changes the macros that use them to using #'plist-put and #'plist-remprop directly. 2010-10-12 Aidan Kehoe <kehoea@parhasard.net> * abbrev.el (fundamental-mode-abbrev-table, global-abbrev-table): Create both these abbrev tables using the usual #'define-abbrev-table calls, rather than attempting to special-case them. * cl-extra.el: Force cl-macs to be loaded here, if cl-extra.el is being loaded interpreted. Previously other, later files would redundantly call (load "cl-macs") when interpreted, it's more reasonable to do it here, once. * cmdloop.el (read-quoted-char-radix): Use defcustom here, we don't have any dump-order dependencies that would prevent that. * custom.el (eval-when-compile): Don't load cl-macs when interpreted or when byte-compiling, rely on cl-extra.el in the former case and the appropriate entry in bytecomp-load-hook in the latter. Get rid of custom-declare-variable-list, we have no dump-time dependencies that would require it. * faces.el (eval-when-compile): Don't load cl-macs when interpreted or when byte-compiling. * packages.el: Remove some inaccurate comments. * post-gc.el (cleanup-simple-finalizers): Use #'delete-if-not here, now the order of preloaded-file-list has been changed to make it available. * subr.el (custom-declare-variable-list): Remove. No need for it. Also remove a stub define-abbrev-table from this file, given the current order of preloaded-file-list there's no need for it. 2010-10-10 Aidan Kehoe <kehoea@parhasard.net> * bytecomp.el (byte-compile-constp) Forms quoted with FUNCTION are also constant. (byte-compile-initial-macro-environment): In #'the, if FORM is constant and does not match TYPE, warn at byte-compile time. 2010-10-10 Aidan Kehoe <kehoea@parhasard.net> * backquote.el (bq-vector-contents, bq-list*): Remove; the former is equivalent to (append VECTOR nil), the latter to (list* ...). (bq-process-2): Use (append VECTOR nil) instead of using #'bq-vector-contents to convert to a list. (bq-process-1): Now we use list* instead of bq-list * subr.el (list*): Moved from cl.el, since it is now required to be available the first time a backquoted form is encountered. * cl.el (list*): Move to subr.el. 2010-09-16 Aidan Kehoe <kehoea@parhasard.net> * test-harness.el (Check-Message): Add an omitted comma here, thank you the buildbot. 2010-09-16 Aidan Kehoe <kehoea@parhasard.net> * hash-table.el (hash-table-key-list, hash-table-value-list) (hash-table-key-value-alist, hash-table-key-value-plist): Remove some useless #'nreverse calls in these files; our hash tables have no order, it's not helpful to pretend they do. * behavior.el (read-behavior): Do the same in this file, in some code evidently copied from hash-table.el. 2010-09-16 Aidan Kehoe <kehoea@parhasard.net> * info.el (Info-insert-dir): * format.el (format-deannotate-region): * files.el (cd, save-buffers-kill-emacs): Use #'some, #'every and related functions for applying boolean operations to lists, instead of rolling our own ones that cons and don't short-circuit. 2010-09-16 Aidan Kehoe <kehoea@parhasard.net> * bytecomp.el (byte-compile-initial-macro-environment): * cl-macs.el (the): Rephrase the docstring, make its implementation when compiling files a little nicer. 2010-09-16 Aidan Kehoe <kehoea@parhasard.net> * descr-text.el (unidata-initialize-unicodedata-database) (unidata-initialize-unihan-database, describe-char-unicode-data) (describe-char-unicode-data): Wrap calls to the database functions with (with-fboundp ...), avoiding byte compile warnings on builds without support for the database functions. (describe-char): (reduce #'max ...), not (apply #'max ...), no need to cons needlessly. (describe-char): Remove a redundant lambda wrapping #'extent-properties. (describe-char-unicode-data): Call #'nsubst when replacing "" with nil in the result of #'split-string, instead of consing inside mapcar. 2010-09-16 Aidan Kehoe <kehoea@parhasard.net> * x-faces.el (x-available-font-sizes): * specifier.el (let-specifier): * package-ui.el (pui-add-required-packages): * msw-faces.el (mswindows-available-font-sizes): * modeline.el (modeline-minor-mode-menu): * minibuf.el (minibuf-directory-files): Replace the O2N (delq nil (mapcar (lambda (W) (and X Y)) Z)) with the ON (mapcan (lambda (W) (and X (list Y))) Z) in these files. 2010-09-16 Aidan Kehoe <kehoea@parhasard.net> * cl-macs.el (= < > <= >=): When these functions are handed more than two arguments, and those arguments have no side effects, transform to a series of two argument calls, avoiding funcall in the byte-compiled code. * mule/mule-cmds.el (finish-set-language-environment): Take advantage of this change in a function called 256 times at startup. 2010-09-16 Aidan Kehoe <kehoea@parhasard.net> * bytecomp.el (byte-compile-function-form, byte-compile-quote) (byte-compile-quote-form): Warn at compile time, and error at runtime, if a (quote ...) or a (function ...) form attempts to quote more than one object. 2010-09-16 Aidan Kehoe <kehoea@parhasard.net> * byte-optimize.el (byte-optimize-apply): Transform (apply 'nconc (mapcar ...)) to (mapcan ...); warn about use of the first idiom. * update-elc.el (do-autoload-commands): * packages.el (packages-find-package-library-path): * frame.el (frame-list): * extents.el (extent-descendants): * etags.el (buffer-tag-table-files): * dumped-lisp.el (preloaded-file-list): * device.el (device-list): * bytecomp-runtime.el (proclaim-inline, proclaim-notinline) Use #'mapcan, not (apply #'nconc (mapcar ...) in all these files. * bytecomp-runtime.el (eval-when-compile, eval-and-compile): In passing, mention that these macros also evaluate the body when interpreted. tests/ChangeLog addition: 2011-02-07 Aidan Kehoe <kehoea@parhasard.net> * automated/lisp-tests.el: Test lexical scope for `block', `return-from'; add a Known-Bug-Expect-Failure for a contorted example that fails when byte-compiled.
author Aidan Kehoe <kehoea@parhasard.net>
date Mon, 07 Feb 2011 12:01:24 +0000
parents 59a6419f7504
children 308d34e9f07d
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1 /* Definitions of symbol-value forwarding for XEmacs Lisp interpreter.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2 Copyright (C) 1985, 1986, 1987, 1992, 1993 Free Software Foundation, Inc.
5142
f965e31a35f0 reduce lcrecord headers to 2 words, rename printing_unreadable_object
Ben Wing <ben@xemacs.org>
parents: 5127
diff changeset
3 Copyright (C) 2000, 2001, 2002, 2010 Ben Wing.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5 This file is part of XEmacs.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
6
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
7 XEmacs is free software; you can redistribute it and/or modify it
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
8 under the terms of the GNU General Public License as published by the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
9 Free Software Foundation; either version 2, or (at your option) any
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
10 later version.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
11
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
12 XEmacs is distributed in the hope that it will be useful, but WITHOUT
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
13 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
14 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
15 for more details.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
16
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
17 You should have received a copy of the GNU General Public License
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
18 along with XEmacs; see the file COPYING. If not, write to
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
19 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
20 Boston, MA 02111-1307, USA. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
21
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
22 /* Synched up with: Not in FSF. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
23
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
24 /* Fsymbol_value checks whether XSYMBOL (sym)->value is one of these,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
25 * and does weird magic stuff if so */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
26
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
27 #ifndef INCLUDED_symeval_h_
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
28 #define INCLUDED_symeval_h_
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
29
1743
543769b89fed [xemacs-hg @ 2003-10-14 05:02:57 by james]
james
parents: 1650
diff changeset
30 BEGIN_C_DECLS
1650
34abfb24e891 [xemacs-hg @ 2003-08-28 15:44:04 by james]
james
parents: 1632
diff changeset
31
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
32 enum symbol_value_type
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
33 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
34 /* The following tags use the 'symbol_value_forward' structure
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
35 and are strictly for variables DEFVARed on the C level. */
458
c33ae14dd6d0 Import from CVS: tag r21-2-44
cvs
parents: 452
diff changeset
36 SYMVAL_FIXNUM_FORWARD, /* Forward C "Fixnum", really "EMACS_INT" */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
37 SYMVAL_CONST_FIXNUM_FORWARD, /* Same, but can't be set */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
38 SYMVAL_BOOLEAN_FORWARD, /* Forward C boolean ("int") */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
39 SYMVAL_CONST_BOOLEAN_FORWARD, /* Same, but can't be set */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
40 SYMVAL_OBJECT_FORWARD, /* Forward C Lisp_Object */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
41 SYMVAL_CONST_OBJECT_FORWARD, /* Same, but can't be set */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
42 SYMVAL_CONST_SPECIFIER_FORWARD, /* Same, can't be set, but gives a
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
43 different message when attempting to
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
44 set that says "use set-specifier" */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
45 SYMVAL_DEFAULT_BUFFER_FORWARD, /* Forward Lisp_Object into Vbuffer_defaults */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
46 SYMVAL_CURRENT_BUFFER_FORWARD, /* Forward Lisp_Object into current_buffer */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
47 SYMVAL_CONST_CURRENT_BUFFER_FORWARD, /* Forward Lisp_Object into
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
48 current_buffer, can't be set */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
49 SYMVAL_DEFAULT_CONSOLE_FORWARD, /* Forward Lisp_Object into
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
50 Vconsole_defaults */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
51 SYMVAL_SELECTED_CONSOLE_FORWARD, /* Forward Lisp_Object into
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
52 Vselected_console */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
53 SYMVAL_CONST_SELECTED_CONSOLE_FORWARD, /* Forward Lisp_Object into
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
54 Vselected_console,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
55 can't be set */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
56 SYMVAL_UNBOUND_MARKER, /* Only Qunbound actually has this tag */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
57
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
58 /* The following tags use the 'symbol_value_buffer_local' structure */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
59 SYMVAL_BUFFER_LOCAL, /* make-variable-buffer-local */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
60 SYMVAL_SOME_BUFFER_LOCAL, /* make-local-variable */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
61
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
62 /* The following tag uses the 'symbol_value_lisp_magic' structure */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
63 SYMVAL_LISP_MAGIC, /* Forward to lisp callbacks */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
64
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
65 /* The following tag uses the 'symbol_value_varalias' structure */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
66 SYMVAL_VARALIAS /* defvaralias */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
67
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
68 #if 0
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
69 /* NYI */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
70 SYMVAL_CONSTANT_SYMBOL, /* Self-evaluating symbol */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
71 /* NYI */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
72 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
73 };
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
74
458
c33ae14dd6d0 Import from CVS: tag r21-2-44
cvs
parents: 452
diff changeset
75 /* Underlying C type used to implement DEFVAR_INT */
c33ae14dd6d0 Import from CVS: tag r21-2-44
cvs
parents: 452
diff changeset
76 typedef EMACS_INT Fixnum;
c33ae14dd6d0 Import from CVS: tag r21-2-44
cvs
parents: 452
diff changeset
77
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
78 struct symbol_value_magic
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
79 {
5127
a9c41067dd88 more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents: 5125
diff changeset
80 NORMAL_LISP_OBJECT_HEADER header;
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
81 void *value;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
82 enum symbol_value_type type;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
83 };
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
84 #define SYMBOL_VALUE_MAGIC_P(x) \
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
85 (LRECORDP (x) && \
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
86 XRECORD_LHEADER (x)->type <= lrecord_type_max_symbol_value_magic)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
87 #define XSYMBOL_VALUE_MAGIC_TYPE(v) \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
88 (((struct symbol_value_magic *) XPNTR (v))->type)
793
e38acbeb1cae [xemacs-hg @ 2002-03-29 04:46:17 by ben]
ben
parents: 771
diff changeset
89 #define wrap_symbol_value_magic(p) wrap_pointer_1 (p)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
90 void print_symbol_value_magic (Lisp_Object, Lisp_Object, int);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
91
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
92 /********** The various different symbol-value-magic types ***********/
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
93
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
94 /* 1. symbol-value-forward */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
95
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
96 /* This type of symbol-value-magic is used for variables declared
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
97 DEFVAR_LISP, DEFVAR_INT, DEFVAR_BOOL, DEFVAR_BUFFER_LOCAL,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
98 DEFVAR_BUFFER_DEFAULTS, DEFVAR_SPECIFIER, and for Qunbound.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
99
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
100 Note that some of these types of variables can be made buffer-local.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
101 Then, the symbol's value field contains a symbol-value-buffer-local,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
102 whose CURRENT-VALUE field then contains a symbol-value-forward.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
103 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
104
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
105 struct symbol_value_forward
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
106 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
107 struct symbol_value_magic magic;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
108
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
109 /* `magicfun' is a function controlling the magic behavior of this
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
110 forward variable.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
111
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
112 SYM is the symbol being operated on (read, set, etc.);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
113
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
114 VAL is either the value to set or the value to be returned.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
115
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
116 IN_OBJECT is the buffer or console that the value is read in
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
117 or set in. A value of Qnil means that the current buffer
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
118 and possibly other buffers are being set. (This value will
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
119 never be passed for built-in buffer-local or console-local
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
120 variables such as `truncate-lines'.) (Currently, a value of
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
121 Qnil is always passed for DEFVAR_INT, DEFVAR_LISP, and
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
122 DEFVAR_BOOL variables; the code isn't smart enough to figure
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
123 out what buffers besides the current buffer are being
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
124 affected. Because the magic function is called
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
125 before the value is changed, it's not that easy
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
126 to determine which buffers are getting changed.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
127 #### If this information is important, let me know
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
128 and I will look into providing it.) (Remember also
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
129 that the only console-local variables currently existing
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
130 are built-in ones, because others can't be created.)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
131
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
132 FLAGS gives more information about the operation being performed.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
133
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
134 The return value indicates what the magic function actually did.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
135
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
136 Currently FLAGS and the return value are not used. This
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
137 function is only called when the value of a forward variable
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
138 is about to be changed. Note that this can occur explicitly
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
139 through a call to `set', `setq', `set-default', or `setq-default',
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
140 or implicitly by the current buffer being changed. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
141 int (*magicfun) (Lisp_Object sym, Lisp_Object *val, Lisp_Object in_object,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
142 int flags);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
143 };
5118
e0db3c197671 merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
parents: 4677
diff changeset
144 DECLARE_LISP_OBJECT (symbol_value_forward, struct symbol_value_forward);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
145 #define XSYMBOL_VALUE_FORWARD(x) \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
146 XRECORD (x, symbol_value_forward, struct symbol_value_forward)
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
147 #define symbol_value_forward_forward(m) ((void *)((m)->magic.value))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
148 #define symbol_value_forward_magicfun(m) ((m)->magicfun)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
149
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
150 /* 2. symbol-value-buffer-local */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
151
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
152 struct symbol_value_buffer_local
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
153 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
154 struct symbol_value_magic magic;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
155 /* Used in a symbol value cell when the symbol's value is per-buffer.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
156
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
157 The type of the symbol-value-magic will be either
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
158 SYMVAL_BUFFER_LOCAL (i.e. `make-variable-buffer-local' was called)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
159 or SYMVAL_SOME_BUFFER_LOCAL (i.e. `make-local-variable' was called).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
160 The only difference between the two is that when setting the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
161 former kind of variable, an implicit `make-local-variable' is
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
162 called.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
163
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
164 A buffer-local variable logically has
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
165
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
166 -- a default value
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
167 -- local values in some buffers
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
168
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
169 The primary place where the local values are stored is in each
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
170 buffer's local_var_alist slot.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
171
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
172 In the simplest implementation, all that this structure needs to
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
173 keep track of is the default value; to retrieve the value in
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
174 a buffer, look in that buffer's local_var_alist, and use the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
175 default value if there is no local value. To implement
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
176 `make-local-variable' in a buffer, look in the buffer's
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
177 local_var_alist, and if no element exists for this symbol,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
178 add one, copying the value from the default value. When setting
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
179 the value in a buffer, look in the buffer's local_var_alist, and set
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
180 the value in that list if an element exists for this symbol;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
181 otherwise, set the default. (Remember that SYMVAL_BUFFER_LOCAL
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
182 variables implicitly call `make-local-variable' first, so when
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
183 setting a value, there will always be an entry in the buffer's
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
184 local_var_alist to set.)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
185
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
186 However, this operation is potentially slow. To speed it up,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
187 we cache the value in one buffer in this structure.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
188
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
189 NOTE: This is *not* a write-through cache. I.e. when setting
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
190 the value in the buffer that is cached, we *only* change the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
191 cache and don't write the value through to either the buffer's
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
192 local_var_alist or the default value. Therefore, when retrieving
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
193 a value in a buffer, you must *always* look in the cache to see if
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
194 it refers to that buffer.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
195
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
196 The cache consists of
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
197
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
198 -- a buffer, or nil if the cache has not been set up
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
199 -- the value in that buffer
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
200 -- the element (a cons) from the buffer's local_var_alist, or
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
201 nil if there is no local value in the buffer
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
202
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
203 These slots are called CURRENT-BUFFER, CURRENT-VALUE, and
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
204 CURRENT-ALIST-ELEMENT, respectively.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
205
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
206 If we want to examine or set the value in BUFFER and CURRENT-BUFFER
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
207 equals BUFFER, we just examine or set CURRENT-VALUE. Otherwise,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
208 we store CURRENT-VALUE value into CURRENT-ALIST-ELEMENT (or maybe
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
209 into DEFAULT-VALUE), then find the appropriate alist element for
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
210 BUFFER and set up CURRENT-ALIST-ELEMENT. Then we set CURRENT-VALUE
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
211 out of that element (or maybe out of DEFAULT-VALUE), and store
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
212 BUFFER into CURRENT-BUFFER.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
213
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
214 If we are setting the variable and the current buffer does not have
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
215 an alist entry for this variable, an alist entry is created.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
216
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
217 Note that CURRENT-BUFFER's local_var_alist value for this variable
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
218 might be out-of-date (the correct value is stored in CURRENT-VALUE).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
219 Similarly, if CURRENT-BUFFER sees the default value, then
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
220 DEFAULT-VALUE might be out-of-date.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
221
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
222 Note that CURRENT-VALUE (but not DEFAULT-VALUE) can be a
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
223 forwarding pointer. Each time it is examined or set,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
224 forwarding must be done.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
225 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
226 Lisp_Object default_value;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
227 Lisp_Object current_value;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
228 Lisp_Object current_buffer;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
229 Lisp_Object current_alist_element;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
230 };
5118
e0db3c197671 merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
parents: 4677
diff changeset
231 DECLARE_LISP_OBJECT (symbol_value_buffer_local, struct symbol_value_buffer_local);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
232 #define XSYMBOL_VALUE_BUFFER_LOCAL(x) \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
233 XRECORD (x, symbol_value_buffer_local, struct symbol_value_buffer_local)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
234 #define SYMBOL_VALUE_BUFFER_LOCAL_P(x) RECORDP (x, symbol_value_buffer_local)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
235
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
236 /* 3. symbol-value-lisp-magic */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
237
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
238 enum lisp_magic_handler
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
239 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
240 MAGIC_HANDLER_GET_VALUE,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
241 MAGIC_HANDLER_SET_VALUE,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
242 MAGIC_HANDLER_BOUND_PREDICATE,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
243 MAGIC_HANDLER_MAKE_UNBOUND,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
244 MAGIC_HANDLER_LOCAL_PREDICATE,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
245 MAGIC_HANDLER_MAKE_LOCAL,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
246 MAGIC_HANDLER_MAX
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
247 };
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
248
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
249 struct symbol_value_lisp_magic
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
250 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
251 struct symbol_value_magic magic;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
252 Lisp_Object handler[MAGIC_HANDLER_MAX];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
253 Lisp_Object harg[MAGIC_HANDLER_MAX];
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
254 Lisp_Object shadowed;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
255 };
5118
e0db3c197671 merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
parents: 4677
diff changeset
256 DECLARE_LISP_OBJECT (symbol_value_lisp_magic, struct symbol_value_lisp_magic);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
257 #define XSYMBOL_VALUE_LISP_MAGIC(x) \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
258 XRECORD (x, symbol_value_lisp_magic, struct symbol_value_lisp_magic)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
259 #define SYMBOL_VALUE_LISP_MAGIC_P(x) RECORDP (x, symbol_value_lisp_magic)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
260
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
261 /* 4. symbol-value-varalias */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
262
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
263 struct symbol_value_varalias
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
264 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
265 struct symbol_value_magic magic;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
266 Lisp_Object aliasee;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
267 Lisp_Object shadowed;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
268 };
5118
e0db3c197671 merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
parents: 4677
diff changeset
269 DECLARE_LISP_OBJECT (symbol_value_varalias, struct symbol_value_varalias);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
270 #define XSYMBOL_VALUE_VARALIAS(x) \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
271 XRECORD (x, symbol_value_varalias, struct symbol_value_varalias)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
272 #define SYMBOL_VALUE_VARALIAS_P(x) RECORDP (x, symbol_value_varalias)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
273 #define symbol_value_varalias_aliasee(m) ((m)->aliasee)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
274 #define symbol_value_varalias_shadowed(m) ((m)->shadowed)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
275
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
276 /* To define a Lisp primitive function using a C function `Fname', do this:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
277 DEFUN ("name, Fname, ...); // at top level in foo.c
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
278 DEFSUBR (Fname); // in syms_of_foo();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
279 */
3263
d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani]
crestani
parents: 3024
diff changeset
280 #ifdef NEW_GC
2720
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 1743
diff changeset
281 MODULE_API void defsubr (Lisp_Subr *);
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 1743
diff changeset
282 #define DEFSUBR_MC_ALLOC(Fname) \
2814
520c08f04735 [xemacs-hg @ 2005-06-16 19:59:33 by crestani]
crestani
parents: 2720
diff changeset
283 S##Fname= (struct Lisp_Subr *) mc_alloc (sizeof (struct Lisp_Subr)); \
2720
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 1743
diff changeset
284 set_lheader_implementation (&S##Fname->lheader, &lrecord_subr); \
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 1743
diff changeset
285 \
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 1743
diff changeset
286 S##Fname->min_args = MC_ALLOC_S##Fname.min_args; \
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 1743
diff changeset
287 S##Fname->max_args = MC_ALLOC_S##Fname.max_args; \
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 1743
diff changeset
288 S##Fname->prompt = MC_ALLOC_S##Fname.prompt; \
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 1743
diff changeset
289 S##Fname->doc = MC_ALLOC_S##Fname.doc; \
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 1743
diff changeset
290 S##Fname->name = MC_ALLOC_S##Fname.name; \
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 1743
diff changeset
291 S##Fname->subr_fn = MC_ALLOC_S##Fname.subr_fn; \
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 1743
diff changeset
292 MARK_LRECORD_AS_LISP_READONLY (S##Fname);
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 1743
diff changeset
293
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 1743
diff changeset
294
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 1743
diff changeset
295 #define DEFSUBR(Fname) \
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 1743
diff changeset
296 do { \
5280
59a6419f7504 Use GET_DEFUN_LISP_OBJECT() in PARSE_KEYWORDS(), fix former under NEW_GC.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5142
diff changeset
297 /* #### As far as I can see, this has no upside compared to the non-NEW_GC \
59a6419f7504 Use GET_DEFUN_LISP_OBJECT() in PARSE_KEYWORDS(), fix former under NEW_GC.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5142
diff changeset
298 code. The MC_ALLOC_S##Fname structure is also in the dumped \
59a6419f7504 Use GET_DEFUN_LISP_OBJECT() in PARSE_KEYWORDS(), fix former under NEW_GC.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5142
diff changeset
299 XEmacs. Aidan Kehoe, Mon Sep 20 23:14:01 IST 2010 */ \
2720
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 1743
diff changeset
300 DEFSUBR_MC_ALLOC (Fname); \
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 1743
diff changeset
301 defsubr (S##Fname); \
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 1743
diff changeset
302 } while (0)
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 1743
diff changeset
303
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 1743
diff changeset
304 /* To define a Lisp primitive macro using a C function `Fname', do this:
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 1743
diff changeset
305 DEFUN ("name, Fname, ...); // at top level in foo.c
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 1743
diff changeset
306 DEFSUBR_MACRO (Fname); // in syms_of_foo();
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 1743
diff changeset
307 */
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 1743
diff changeset
308 MODULE_API void defsubr_macro (Lisp_Subr *);
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 1743
diff changeset
309 #define DEFSUBR_MACRO(Fname) \
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 1743
diff changeset
310 do { \
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 1743
diff changeset
311 DEFSUBR_MC_ALLOC (Fname); \
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 1743
diff changeset
312 defsubr_macro (S##Fname); \
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 1743
diff changeset
313 } while (0)
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 1743
diff changeset
314
3263
d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani]
crestani
parents: 3024
diff changeset
315 #else /* not NEW_GC */
2720
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 1743
diff changeset
316 /* To define a Lisp primitive function using a C function `Fname', do this:
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 1743
diff changeset
317 DEFUN ("name, Fname, ...); // at top level in foo.c
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 1743
diff changeset
318 DEFSUBR (Fname); // in syms_of_foo();
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 1743
diff changeset
319 */
1632
64eaceca611d [xemacs-hg @ 2003-08-19 02:07:03 by james]
james
parents: 1111
diff changeset
320 MODULE_API void defsubr (Lisp_Subr *);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
321 #define DEFSUBR(Fname) defsubr (&S##Fname)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
322
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
323 /* To define a Lisp primitive macro using a C function `Fname', do this:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
324 DEFUN ("name, Fname, ...); // at top level in foo.c
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
325 DEFSUBR_MACRO (Fname); // in syms_of_foo();
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
326 */
1632
64eaceca611d [xemacs-hg @ 2003-08-19 02:07:03 by james]
james
parents: 1111
diff changeset
327 MODULE_API void defsubr_macro (Lisp_Subr *);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
328 #define DEFSUBR_MACRO(Fname) defsubr_macro (&S##Fname)
3263
d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani]
crestani
parents: 3024
diff changeset
329 #endif /* not NEW_GC */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
330
1632
64eaceca611d [xemacs-hg @ 2003-08-19 02:07:03 by james]
james
parents: 1111
diff changeset
331 MODULE_API void defsymbol_massage_name (Lisp_Object *location,
4952
19a72041c5ed Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents: 4677
diff changeset
332 const Ascbyte *name);
1632
64eaceca611d [xemacs-hg @ 2003-08-19 02:07:03 by james]
james
parents: 1111
diff changeset
333 MODULE_API void defsymbol_massage_name_nodump (Lisp_Object *location,
4952
19a72041c5ed Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents: 4677
diff changeset
334 const Ascbyte *name);
1632
64eaceca611d [xemacs-hg @ 2003-08-19 02:07:03 by james]
james
parents: 1111
diff changeset
335 MODULE_API void defsymbol_massage_multiword_predicate (Lisp_Object *location,
4952
19a72041c5ed Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents: 4677
diff changeset
336 const Ascbyte *name);
1632
64eaceca611d [xemacs-hg @ 2003-08-19 02:07:03 by james]
james
parents: 1111
diff changeset
337 MODULE_API void
64eaceca611d [xemacs-hg @ 2003-08-19 02:07:03 by james]
james
parents: 1111
diff changeset
338 defsymbol_massage_multiword_predicate_nodump (Lisp_Object *location,
4952
19a72041c5ed Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents: 4677
diff changeset
339 const Ascbyte *name);
19a72041c5ed Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents: 4677
diff changeset
340 MODULE_API void defsymbol (Lisp_Object *location, const Ascbyte *name);
19a72041c5ed Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents: 4677
diff changeset
341 MODULE_API void defsymbol_nodump (Lisp_Object *location, const Ascbyte *name);
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
342
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 458
diff changeset
343 /* Defining symbols:
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 458
diff changeset
344
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 458
diff changeset
345 (1) A standard symbol is defined with DEFSYMBOL. That means that
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 458
diff changeset
346 the symbol's print name can be derived from the symbol's variable
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 458
diff changeset
347 name by removing the initial Q and replacing underscores with hyphens.
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 458
diff changeset
348 (2) A keyword symbol is defined with DEFKEYWORD. That means that
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 458
diff changeset
349 the symbol's print name can be derived from the symbol's variable
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 458
diff changeset
350 name by removing the initial Q and replacing underscores with hyphens,
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 458
diff changeset
351 except that the initial underscore, which comes directly after the Q,
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 458
diff changeset
352 is replaced by a colon.
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 458
diff changeset
353 (3) DEFSYMBOL_MULTIWORD_PREDICATE is used for the predicates that are
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 458
diff changeset
354 associated with a particular type of Lisp Object. Because of the
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 458
diff changeset
355 limitations of C macros, they're always given a predicate symbol
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 458
diff changeset
356 whose C name simply appends `p' to the type name, modulo hyphen/
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 458
diff changeset
357 underscore conversion. Properly, however, the Lisp name should have
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 458
diff changeset
358 `-p' if there is more than one word in the type name.
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 458
diff changeset
359 DEFSYMBOL_MULTIWORD_PREDICATE is for these weird symbols -- the
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 458
diff changeset
360 C name as supplied to the macro should end with a `p' with no
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 458
diff changeset
361 underscore before it, and the macro will insert a hyphen there in
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 458
diff changeset
362 the Lisp name.
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 458
diff changeset
363 (4) In case you have some weird symbol where the equivalence between
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 458
diff changeset
364 the C and Lisp names is more complicated (e.g. the Lisp symbol has
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 458
diff changeset
365 non-alphabetic, non-numeric characters in it), you can just call
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 458
diff changeset
366 defsymbol() (the lowercase version) directly.
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 458
diff changeset
367 */
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 458
diff changeset
368
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
369 #define DEFSYMBOL(name) defsymbol_massage_name (&name, #name)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
370 #define DEFSYMBOL_NO_DUMP(name) defsymbol_massage_name_nodump (&name, #name)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
371 #define DEFSYMBOL_MULTIWORD_PREDICATE(name) \
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
372 defsymbol_massage_multiword_predicate (&name, #name)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
373 #define DEFSYMBOL_MULTIWORD_PREDICATE_NO_DUMP(name) \
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
374 defsymbol_massage_multiword_predicate_nodump (&name, #name)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
375
4952
19a72041c5ed Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents: 4677
diff changeset
376 MODULE_API void defkeyword (Lisp_Object *location, const Ascbyte *name);
1632
64eaceca611d [xemacs-hg @ 2003-08-19 02:07:03 by james]
james
parents: 1111
diff changeset
377 MODULE_API void defkeyword_massage_name (Lisp_Object *location,
4952
19a72041c5ed Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents: 4677
diff changeset
378 const Ascbyte *name);
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
379 #define DEFKEYWORD(name) defkeyword_massage_name (&name, #name)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
380
4952
19a72041c5ed Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents: 4677
diff changeset
381 MODULE_API void deferror (Lisp_Object *symbol, const Ascbyte *name,
19a72041c5ed Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents: 4677
diff changeset
382 const Ascbyte *message, Lisp_Object inherits_from);
19a72041c5ed Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents: 4677
diff changeset
383 MODULE_API void deferror_massage_name (Lisp_Object *symbol, const Ascbyte *name,
19a72041c5ed Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents: 4677
diff changeset
384 const Ascbyte *message,
1632
64eaceca611d [xemacs-hg @ 2003-08-19 02:07:03 by james]
james
parents: 1111
diff changeset
385 Lisp_Object inherits_from);
64eaceca611d [xemacs-hg @ 2003-08-19 02:07:03 by james]
james
parents: 1111
diff changeset
386 MODULE_API void deferror_massage_name_and_message (Lisp_Object *symbol,
4952
19a72041c5ed Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents: 4677
diff changeset
387 const Ascbyte *name,
1632
64eaceca611d [xemacs-hg @ 2003-08-19 02:07:03 by james]
james
parents: 1111
diff changeset
388 Lisp_Object inherits_from);
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
389 #define DEFERROR(name, message, inherits_from) \
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
390 deferror_massage_name (&name, #name, message, inherits_from)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
391 /* In this case, the error message is the same as the name, modulo some
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
392 prettifying */
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
393 #define DEFERROR_STANDARD(name, inherits_from) \
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
394 deferror_massage_name_and_message (&name, #name, inherits_from)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
395
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
396 /* Macros we use to define forwarded Lisp variables.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
397 These are used in the syms_of_FILENAME functions. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
398
4952
19a72041c5ed Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents: 4677
diff changeset
399 MODULE_API void defvar_magic (const Ascbyte *symbol_name,
1632
64eaceca611d [xemacs-hg @ 2003-08-19 02:07:03 by james]
james
parents: 1111
diff changeset
400 const struct symbol_value_forward *magic);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
401
3263
d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani]
crestani
parents: 3024
diff changeset
402 #ifdef NEW_GC
2720
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 1743
diff changeset
403 #define DEFVAR_SYMVAL_FWD(lname, c_location, forward_type, magic_fun) \
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 1743
diff changeset
404 do \
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 1743
diff changeset
405 { \
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 1743
diff changeset
406 struct symbol_value_forward *I_hate_C = \
5127
a9c41067dd88 more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents: 5125
diff changeset
407 XSYMBOL_VALUE_FORWARD (ALLOC_NORMAL_LISP_OBJECT (symbol_value_forward)); \
2720
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 1743
diff changeset
408 /* mcpro ((Lisp_Object) I_hate_C);*/ \
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 1743
diff changeset
409 \
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 1743
diff changeset
410 MARK_LRECORD_AS_LISP_READONLY (I_hate_C); \
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 1743
diff changeset
411 \
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 1743
diff changeset
412 I_hate_C->magic.value = c_location; \
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 1743
diff changeset
413 I_hate_C->magic.type = forward_type; \
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 1743
diff changeset
414 I_hate_C->magicfun = magic_fun; \
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 1743
diff changeset
415 \
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 1743
diff changeset
416 defvar_magic ((lname), I_hate_C); \
6fa9919a9a0b [xemacs-hg @ 2005-04-08 23:10:01 by crestani]
crestani
parents: 1743
diff changeset
417 } while (0)
3263
d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani]
crestani
parents: 3024
diff changeset
418 #else /* not NEW_GC */
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 563
diff changeset
419 #define DEFVAR_SYMVAL_FWD(lname, c_location, forward_type, magicfun) \
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 563
diff changeset
420 do \
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 563
diff changeset
421 { \
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 563
diff changeset
422 static const struct symbol_value_forward I_hate_C = \
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 563
diff changeset
423 { /* struct symbol_value_forward */ \
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 563
diff changeset
424 { /* struct symbol_value_magic */ \
3024
b7f26b2f78bd [xemacs-hg @ 2005-10-25 08:32:40 by ben]
ben
parents: 3017
diff changeset
425 { /* struct old_lcrecord_header */ \
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 563
diff changeset
426 { /* struct lrecord_header */ \
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 563
diff changeset
427 lrecord_type_symbol_value_forward, /* lrecord_type_index */ \
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 563
diff changeset
428 1, /* mark bit */ \
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 563
diff changeset
429 1, /* c_readonly bit */ \
1111
184461bc8de4 [xemacs-hg @ 2002-11-18 06:52:23 by ben]
ben
parents: 793
diff changeset
430 1, /* lisp_readonly bit */ \
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 563
diff changeset
431 }, \
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 563
diff changeset
432 0, /* next */ \
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 563
diff changeset
433 }, \
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 563
diff changeset
434 c_location, \
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 563
diff changeset
435 forward_type \
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 563
diff changeset
436 }, \
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 563
diff changeset
437 magicfun \
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 563
diff changeset
438 }; \
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 563
diff changeset
439 defvar_magic ((lname), &I_hate_C); \
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
440 } while (0)
3263
d674024a8674 [xemacs-hg @ 2006-02-27 16:29:00 by crestani]
crestani
parents: 3024
diff changeset
441 #endif /* not NEW_GC */
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 563
diff changeset
442 #define DEFVAR_SYMVAL_FWD_INT(lname, c_location, forward_type, magicfun) \
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 563
diff changeset
443 do \
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 563
diff changeset
444 { \
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 563
diff changeset
445 DEFVAR_SYMVAL_FWD (lname, c_location, forward_type, magicfun); \
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 563
diff changeset
446 dump_add_opaque_int (c_location); \
458
c33ae14dd6d0 Import from CVS: tag r21-2-44
cvs
parents: 452
diff changeset
447 } while (0)
c33ae14dd6d0 Import from CVS: tag r21-2-44
cvs
parents: 452
diff changeset
448
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 563
diff changeset
449 #define DEFVAR_SYMVAL_FWD_FIXNUM(lname, c_location, forward_type, magicfun) \
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 563
diff changeset
450 do \
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 563
diff changeset
451 { \
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 563
diff changeset
452 DEFVAR_SYMVAL_FWD (lname, c_location, forward_type, magicfun); \
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 563
diff changeset
453 dump_add_opaque_fixnum (c_location); \
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
454 } while (0)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
455
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 563
diff changeset
456 #define DEFVAR_SYMVAL_FWD_OBJECT(lname, c_location, forward_type, magicfun) \
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 563
diff changeset
457 do \
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 563
diff changeset
458 { \
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 563
diff changeset
459 DEFVAR_SYMVAL_FWD (lname, c_location, forward_type, magicfun); \
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 563
diff changeset
460 { \
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 563
diff changeset
461 Lisp_Object *DSF_location = c_location; /* Type check */ \
4971
bcdf496e49d0 put back patch to get more informative staticpro debugging
Ben Wing <ben@xemacs.org>
parents: 4969
diff changeset
462 staticpro_1 (DSF_location, lname); \
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 563
diff changeset
463 if (EQ (*DSF_location, Qnull_pointer)) *DSF_location = Qnil; \
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 563
diff changeset
464 } \
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
465 } while (0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
466
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
467 #define DEFVAR_LISP(lname, c_location) \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
468 DEFVAR_SYMVAL_FWD_OBJECT (lname, c_location, SYMVAL_OBJECT_FORWARD, 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
469 #define DEFVAR_CONST_LISP(lname, c_location) \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
470 DEFVAR_SYMVAL_FWD_OBJECT (lname, c_location, SYMVAL_CONST_OBJECT_FORWARD, 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
471 #define DEFVAR_SPECIFIER(lname, c_location) \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
472 DEFVAR_SYMVAL_FWD_OBJECT (lname, c_location, SYMVAL_CONST_SPECIFIER_FORWARD, 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
473 #define DEFVAR_INT(lname, c_location) \
458
c33ae14dd6d0 Import from CVS: tag r21-2-44
cvs
parents: 452
diff changeset
474 DEFVAR_SYMVAL_FWD_FIXNUM (lname, c_location, SYMVAL_FIXNUM_FORWARD, 0)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
475 #define DEFVAR_CONST_INT(lname, c_location) \
458
c33ae14dd6d0 Import from CVS: tag r21-2-44
cvs
parents: 452
diff changeset
476 DEFVAR_SYMVAL_FWD_FIXNUM (lname, c_location, SYMVAL_CONST_FIXNUM_FORWARD, 0)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
477 #define DEFVAR_BOOL(lname, c_location) \
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
478 DEFVAR_SYMVAL_FWD_INT (lname, c_location, SYMVAL_BOOLEAN_FORWARD, 0)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
479 #define DEFVAR_CONST_BOOL(lname, c_location) \
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
480 DEFVAR_SYMVAL_FWD_INT (lname, c_location, SYMVAL_CONST_BOOLEAN_FORWARD, 0)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
481 #define DEFVAR_LISP_MAGIC(lname, c_location, magicfun) \
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
482 DEFVAR_SYMVAL_FWD_OBJECT (lname, c_location, SYMVAL_OBJECT_FORWARD, magicfun)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
483 #define DEFVAR_INT_MAGIC(lname, c_location, magicfun) \
458
c33ae14dd6d0 Import from CVS: tag r21-2-44
cvs
parents: 452
diff changeset
484 DEFVAR_SYMVAL_FWD_FIXNUM (lname, c_location, SYMVAL_FIXNUM_FORWARD, magicfun)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
485 #define DEFVAR_BOOL_MAGIC(lname, c_location, magicfun) \
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
486 DEFVAR_SYMVAL_FWD_INT (lname, c_location, SYMVAL_BOOLEAN_FORWARD, magicfun)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
487
446
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 442
diff changeset
488 void flush_all_buffer_local_cache (void);
1ccc32a20af4 Import from CVS: tag r21-2-38
cvs
parents: 442
diff changeset
489
4677
8f1ee2d15784 Support full Common Lisp multiple values in C.
Aidan Kehoe <kehoea@parhasard.net>
parents: 3263
diff changeset
490 struct multiple_value {
5127
a9c41067dd88 more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents: 5125
diff changeset
491 NORMAL_LISP_OBJECT_HEADER header;
4677
8f1ee2d15784 Support full Common Lisp multiple values in C.
Aidan Kehoe <kehoea@parhasard.net>
parents: 3263
diff changeset
492 Elemcount count;
8f1ee2d15784 Support full Common Lisp multiple values in C.
Aidan Kehoe <kehoea@parhasard.net>
parents: 3263
diff changeset
493 Elemcount allocated_count;
8f1ee2d15784 Support full Common Lisp multiple values in C.
Aidan Kehoe <kehoea@parhasard.net>
parents: 3263
diff changeset
494 Elemcount first_desired;
8f1ee2d15784 Support full Common Lisp multiple values in C.
Aidan Kehoe <kehoea@parhasard.net>
parents: 3263
diff changeset
495 Lisp_Object contents[1];
8f1ee2d15784 Support full Common Lisp multiple values in C.
Aidan Kehoe <kehoea@parhasard.net>
parents: 3263
diff changeset
496 };
8f1ee2d15784 Support full Common Lisp multiple values in C.
Aidan Kehoe <kehoea@parhasard.net>
parents: 3263
diff changeset
497 typedef struct multiple_value multiple_value;
8f1ee2d15784 Support full Common Lisp multiple values in C.
Aidan Kehoe <kehoea@parhasard.net>
parents: 3263
diff changeset
498
5118
e0db3c197671 merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
parents: 4677
diff changeset
499 DECLARE_LISP_OBJECT (multiple_value, multiple_value);
4677
8f1ee2d15784 Support full Common Lisp multiple values in C.
Aidan Kehoe <kehoea@parhasard.net>
parents: 3263
diff changeset
500 #define MULTIPLE_VALUEP(x) RECORDP (x, multiple_value)
8f1ee2d15784 Support full Common Lisp multiple values in C.
Aidan Kehoe <kehoea@parhasard.net>
parents: 3263
diff changeset
501
8f1ee2d15784 Support full Common Lisp multiple values in C.
Aidan Kehoe <kehoea@parhasard.net>
parents: 3263
diff changeset
502 #define XMULTIPLE_VALUE(x) XRECORD (x, multiple_value, multiple_value)
8f1ee2d15784 Support full Common Lisp multiple values in C.
Aidan Kehoe <kehoea@parhasard.net>
parents: 3263
diff changeset
503 #define wrap_multiple_value(p) wrap_record (p, multiple_value)
8f1ee2d15784 Support full Common Lisp multiple values in C.
Aidan Kehoe <kehoea@parhasard.net>
parents: 3263
diff changeset
504
8f1ee2d15784 Support full Common Lisp multiple values in C.
Aidan Kehoe <kehoea@parhasard.net>
parents: 3263
diff changeset
505 #define CHECK_MULTIPLE_VALUE(x) CHECK_RECORD (x, multiple_value)
8f1ee2d15784 Support full Common Lisp multiple values in C.
Aidan Kehoe <kehoea@parhasard.net>
parents: 3263
diff changeset
506 #define CONCHECK_MULTIPLE_VALUE(x) CONCHECK_RECORD (x, multiple_value)
8f1ee2d15784 Support full Common Lisp multiple values in C.
Aidan Kehoe <kehoea@parhasard.net>
parents: 3263
diff changeset
507
8f1ee2d15784 Support full Common Lisp multiple values in C.
Aidan Kehoe <kehoea@parhasard.net>
parents: 3263
diff changeset
508 #define multiple_value_count(x) ((x)->count)
8f1ee2d15784 Support full Common Lisp multiple values in C.
Aidan Kehoe <kehoea@parhasard.net>
parents: 3263
diff changeset
509 #define multiple_value_allocated_count(x) ((x)->allocated_count)
8f1ee2d15784 Support full Common Lisp multiple values in C.
Aidan Kehoe <kehoea@parhasard.net>
parents: 3263
diff changeset
510 #define multiple_value_first_desired(x) ((x)->first_desired)
8f1ee2d15784 Support full Common Lisp multiple values in C.
Aidan Kehoe <kehoea@parhasard.net>
parents: 3263
diff changeset
511 #define multiple_value_contents(x) ((x)->contents)
8f1ee2d15784 Support full Common Lisp multiple values in C.
Aidan Kehoe <kehoea@parhasard.net>
parents: 3263
diff changeset
512
8f1ee2d15784 Support full Common Lisp multiple values in C.
Aidan Kehoe <kehoea@parhasard.net>
parents: 3263
diff changeset
513 #define XMULTIPLE_VALUE_COUNT(x) multiple_value_count (XMULTIPLE_VALUE (x))
8f1ee2d15784 Support full Common Lisp multiple values in C.
Aidan Kehoe <kehoea@parhasard.net>
parents: 3263
diff changeset
514 #define XMULTIPLE_VALUE_ALLOCATED_COUNT(x) \
8f1ee2d15784 Support full Common Lisp multiple values in C.
Aidan Kehoe <kehoea@parhasard.net>
parents: 3263
diff changeset
515 multiple_value_allocated_count (XMULTIPLE_VALUE (x))
8f1ee2d15784 Support full Common Lisp multiple values in C.
Aidan Kehoe <kehoea@parhasard.net>
parents: 3263
diff changeset
516 #define XMULTIPLE_VALUE_FIRST_DESIRED(x) \
8f1ee2d15784 Support full Common Lisp multiple values in C.
Aidan Kehoe <kehoea@parhasard.net>
parents: 3263
diff changeset
517 multiple_value_first_desired (XMULTIPLE_VALUE(x))
8f1ee2d15784 Support full Common Lisp multiple values in C.
Aidan Kehoe <kehoea@parhasard.net>
parents: 3263
diff changeset
518 #define XMULTIPLE_VALUE_CONTENTS(x) multiple_value_contents (XMULTIPLE_VALUE(x))
8f1ee2d15784 Support full Common Lisp multiple values in C.
Aidan Kehoe <kehoea@parhasard.net>
parents: 3263
diff changeset
519
8f1ee2d15784 Support full Common Lisp multiple values in C.
Aidan Kehoe <kehoea@parhasard.net>
parents: 3263
diff changeset
520 Lisp_Object multiple_value_call (int nargs, Lisp_Object *args);
8f1ee2d15784 Support full Common Lisp multiple values in C.
Aidan Kehoe <kehoea@parhasard.net>
parents: 3263
diff changeset
521 Lisp_Object multiple_value_list_internal (int nargs, Lisp_Object *args);
8f1ee2d15784 Support full Common Lisp multiple values in C.
Aidan Kehoe <kehoea@parhasard.net>
parents: 3263
diff changeset
522
8f1ee2d15784 Support full Common Lisp multiple values in C.
Aidan Kehoe <kehoea@parhasard.net>
parents: 3263
diff changeset
523 /* It's slightly ugly to expose this here, but it does cut down the amount
8f1ee2d15784 Support full Common Lisp multiple values in C.
Aidan Kehoe <kehoea@parhasard.net>
parents: 3263
diff changeset
524 of work the bytecode interpreter has to do substantially. */
8f1ee2d15784 Support full Common Lisp multiple values in C.
Aidan Kehoe <kehoea@parhasard.net>
parents: 3263
diff changeset
525 extern int multiple_value_current_limit;
8f1ee2d15784 Support full Common Lisp multiple values in C.
Aidan Kehoe <kehoea@parhasard.net>
parents: 3263
diff changeset
526
8f1ee2d15784 Support full Common Lisp multiple values in C.
Aidan Kehoe <kehoea@parhasard.net>
parents: 3263
diff changeset
527 /* Bind the multiple value limits that #'values and #'values-list pay
8f1ee2d15784 Support full Common Lisp multiple values in C.
Aidan Kehoe <kehoea@parhasard.net>
parents: 3263
diff changeset
528 attention to. Used by bytecode and interpreted code. */
8f1ee2d15784 Support full Common Lisp multiple values in C.
Aidan Kehoe <kehoea@parhasard.net>
parents: 3263
diff changeset
529 int bind_multiple_value_limits (int first, int upper);
8f1ee2d15784 Support full Common Lisp multiple values in C.
Aidan Kehoe <kehoea@parhasard.net>
parents: 3263
diff changeset
530
8f1ee2d15784 Support full Common Lisp multiple values in C.
Aidan Kehoe <kehoea@parhasard.net>
parents: 3263
diff changeset
531 Lisp_Object multiple_value_aref (Lisp_Object, Elemcount);
8f1ee2d15784 Support full Common Lisp multiple values in C.
Aidan Kehoe <kehoea@parhasard.net>
parents: 3263
diff changeset
532 void multiple_value_aset (Lisp_Object, Elemcount, Lisp_Object);
8f1ee2d15784 Support full Common Lisp multiple values in C.
Aidan Kehoe <kehoea@parhasard.net>
parents: 3263
diff changeset
533
8f1ee2d15784 Support full Common Lisp multiple values in C.
Aidan Kehoe <kehoea@parhasard.net>
parents: 3263
diff changeset
534 Lisp_Object values2 (Lisp_Object first, Lisp_Object second);
8f1ee2d15784 Support full Common Lisp multiple values in C.
Aidan Kehoe <kehoea@parhasard.net>
parents: 3263
diff changeset
535
8f1ee2d15784 Support full Common Lisp multiple values in C.
Aidan Kehoe <kehoea@parhasard.net>
parents: 3263
diff changeset
536 DECLARE_INLINE_HEADER (
8f1ee2d15784 Support full Common Lisp multiple values in C.
Aidan Kehoe <kehoea@parhasard.net>
parents: 3263
diff changeset
537 Lisp_Object
8f1ee2d15784 Support full Common Lisp multiple values in C.
Aidan Kehoe <kehoea@parhasard.net>
parents: 3263
diff changeset
538 ignore_multiple_values (Lisp_Object obj)
8f1ee2d15784 Support full Common Lisp multiple values in C.
Aidan Kehoe <kehoea@parhasard.net>
parents: 3263
diff changeset
539 )
8f1ee2d15784 Support full Common Lisp multiple values in C.
Aidan Kehoe <kehoea@parhasard.net>
parents: 3263
diff changeset
540 {
8f1ee2d15784 Support full Common Lisp multiple values in C.
Aidan Kehoe <kehoea@parhasard.net>
parents: 3263
diff changeset
541 return MULTIPLE_VALUEP (obj) ? multiple_value_aref (obj, 0) : obj;
8f1ee2d15784 Support full Common Lisp multiple values in C.
Aidan Kehoe <kehoea@parhasard.net>
parents: 3263
diff changeset
542 }
8f1ee2d15784 Support full Common Lisp multiple values in C.
Aidan Kehoe <kehoea@parhasard.net>
parents: 3263
diff changeset
543
8f1ee2d15784 Support full Common Lisp multiple values in C.
Aidan Kehoe <kehoea@parhasard.net>
parents: 3263
diff changeset
544 #ifdef ERROR_CHECK_MULTIPLE_VALUES
8f1ee2d15784 Support full Common Lisp multiple values in C.
Aidan Kehoe <kehoea@parhasard.net>
parents: 3263
diff changeset
545
8f1ee2d15784 Support full Common Lisp multiple values in C.
Aidan Kehoe <kehoea@parhasard.net>
parents: 3263
diff changeset
546 DECLARE_INLINE_HEADER (
8f1ee2d15784 Support full Common Lisp multiple values in C.
Aidan Kehoe <kehoea@parhasard.net>
parents: 3263
diff changeset
547 Lisp_Object
8f1ee2d15784 Support full Common Lisp multiple values in C.
Aidan Kehoe <kehoea@parhasard.net>
parents: 3263
diff changeset
548 ignore_multiple_values_1 (Lisp_Object obj)
8f1ee2d15784 Support full Common Lisp multiple values in C.
Aidan Kehoe <kehoea@parhasard.net>
parents: 3263
diff changeset
549 )
8f1ee2d15784 Support full Common Lisp multiple values in C.
Aidan Kehoe <kehoea@parhasard.net>
parents: 3263
diff changeset
550 {
8f1ee2d15784 Support full Common Lisp multiple values in C.
Aidan Kehoe <kehoea@parhasard.net>
parents: 3263
diff changeset
551 if (1 == multiple_value_current_limit)
8f1ee2d15784 Support full Common Lisp multiple values in C.
Aidan Kehoe <kehoea@parhasard.net>
parents: 3263
diff changeset
552 {
8f1ee2d15784 Support full Common Lisp multiple values in C.
Aidan Kehoe <kehoea@parhasard.net>
parents: 3263
diff changeset
553 assert (!MULTIPLE_VALUEP (obj));
8f1ee2d15784 Support full Common Lisp multiple values in C.
Aidan Kehoe <kehoea@parhasard.net>
parents: 3263
diff changeset
554 return obj;
8f1ee2d15784 Support full Common Lisp multiple values in C.
Aidan Kehoe <kehoea@parhasard.net>
parents: 3263
diff changeset
555 }
8f1ee2d15784 Support full Common Lisp multiple values in C.
Aidan Kehoe <kehoea@parhasard.net>
parents: 3263
diff changeset
556
8f1ee2d15784 Support full Common Lisp multiple values in C.
Aidan Kehoe <kehoea@parhasard.net>
parents: 3263
diff changeset
557 return ignore_multiple_values (obj);
8f1ee2d15784 Support full Common Lisp multiple values in C.
Aidan Kehoe <kehoea@parhasard.net>
parents: 3263
diff changeset
558 }
8f1ee2d15784 Support full Common Lisp multiple values in C.
Aidan Kehoe <kehoea@parhasard.net>
parents: 3263
diff changeset
559
8f1ee2d15784 Support full Common Lisp multiple values in C.
Aidan Kehoe <kehoea@parhasard.net>
parents: 3263
diff changeset
560 #define IGNORE_MULTIPLE_VALUES(X) ignore_multiple_values_1 (X)
8f1ee2d15784 Support full Common Lisp multiple values in C.
Aidan Kehoe <kehoea@parhasard.net>
parents: 3263
diff changeset
561
8f1ee2d15784 Support full Common Lisp multiple values in C.
Aidan Kehoe <kehoea@parhasard.net>
parents: 3263
diff changeset
562 #else
8f1ee2d15784 Support full Common Lisp multiple values in C.
Aidan Kehoe <kehoea@parhasard.net>
parents: 3263
diff changeset
563 #define IGNORE_MULTIPLE_VALUES(X) (multiple_value_current_limit == 1 ? (X) \
8f1ee2d15784 Support full Common Lisp multiple values in C.
Aidan Kehoe <kehoea@parhasard.net>
parents: 3263
diff changeset
564 : ignore_multiple_values (X))
8f1ee2d15784 Support full Common Lisp multiple values in C.
Aidan Kehoe <kehoea@parhasard.net>
parents: 3263
diff changeset
565 #endif
8f1ee2d15784 Support full Common Lisp multiple values in C.
Aidan Kehoe <kehoea@parhasard.net>
parents: 3263
diff changeset
566
1743
543769b89fed [xemacs-hg @ 2003-10-14 05:02:57 by james]
james
parents: 1650
diff changeset
567 END_C_DECLS
1650
34abfb24e891 [xemacs-hg @ 2003-08-28 15:44:04 by james]
james
parents: 1632
diff changeset
568
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 428
diff changeset
569 #endif /* INCLUDED_symeval_h_ */