Port defvar (#1499)

Closes #1475

rust_src/src/eval.rs

@@ -8,17 +8,17 @@ use remacs_macros::lisp_fn;
 
 use crate::{
  alloc::purecopy,
- data::{defalias, fset, indirect_function, indirect_function_lisp, set, set_default},
+ data::{
+ defalias, default_boundp, fset, indirect_function, indirect_function_lisp, set, set_default,
+ },
  lisp::is_autoload,
- lisp::{LispObject, LispSubrRef},
+ lisp::{LispObject, LispSubrRef, SpecbindingRef},
  lists::{assq, car, cdr, get, memq, nth, put},
  lists::{LispCons, LispConsCircularChecks, LispConsEndChecks},
  multibyte::LispStringRef,
  obarray::loadhist_attach,
  objects::equal,
- remacs_sys::specbind_tag::{
- SPECPDL_UNWIND, SPECPDL_UNWIND_INT, SPECPDL_UNWIND_PTR, SPECPDL_UNWIND_VOID,
- },
+ remacs_sys::specbind_tag,
  remacs_sys::{
  backtrace_debug_on_exit, build_string, call_debugger, check_cons_list, do_debug_on_call,
  do_one_unbind, eval_sub, funcall_lambda, funcall_subr, globals, grow_specpdl,
@@ -52,7 +52,7 @@ pub unsafe extern "C" fn record_unwind_protect(
  let unwind = (*ThreadState::current_thread().m_specpdl_ptr)
  .unwind
  .as_mut();
- unwind.set_kind(SPECPDL_UNWIND);
+ unwind.set_kind(specbind_tag::SPECPDL_UNWIND);
  unwind.func = function;
  unwind.arg = arg;
  grow_specpdl();
@@ -66,7 +66,7 @@ pub unsafe extern "C" fn record_unwind_protect_ptr(
  let unwind = (*ThreadState::current_thread().m_specpdl_ptr)
  .unwind_ptr
  .as_mut();
- unwind.set_kind(SPECPDL_UNWIND_PTR);
+ unwind.set_kind(specbind_tag::SPECPDL_UNWIND_PTR);
  unwind.func = function;
  unwind.arg = arg;
  grow_specpdl();
@@ -80,7 +80,7 @@ pub unsafe extern "C" fn record_unwind_protect_int(
  let unwind = (*ThreadState::current_thread().m_specpdl_ptr)
  .unwind_int
  .as_mut();
- unwind.set_kind(SPECPDL_UNWIND_INT);
+ unwind.set_kind(specbind_tag::SPECPDL_UNWIND_INT);
  unwind.func = function;
  unwind.arg = arg;
  grow_specpdl();
@@ -91,7 +91,7 @@ pub unsafe extern "C" fn record_unwind_protect_void(function: Option<unsafe exte
  let unwind = (*ThreadState::current_thread().m_specpdl_ptr)
  .unwind_void
  .as_mut();
- unwind.set_kind(SPECPDL_UNWIND_VOID);
+ unwind.set_kind(specbind_tag::SPECPDL_UNWIND_VOID);
  unwind.func = function;
  grow_specpdl();
 }
@@ -1338,4 +1338,105 @@ pub fn condition_case(args: LispCons) -> LispObject {
  unsafe { internal_lisp_condition_case(var, bodyform, handlers) }
 }
 
+#[no_mangle]
+pub extern "C" fn specpdl_symbol(pdl: SpecbindingRef) -> LispObject {
+ pdl.symbol().into()
+}
+
+#[no_mangle]
+pub extern "C" fn specpdl_old_value(pdl: SpecbindingRef) -> LispObject {
+ pdl.old_value()
+}
+
+#[no_mangle]
+pub extern "C" fn set_specpdl_old_value(mut pdl: SpecbindingRef, val: LispObject) {
+ pdl.set_old_value(val)
+}
+
+#[no_mangle]
+pub extern "C" fn default_toplevel_binding(symbol: LispObject) -> SpecbindingRef {
+ LispSymbolRef::from(symbol).default_toplevel_binding_rust()
+}
+
+/// Define SYMBOL as a variable, and return SYMBOL.
+/// You are not required to define a variable in order to use it, but
+/// defining it lets you supply an initial value and documentation, which
+/// can be referred to by the Emacs help facilities and other programming
+/// tools. The `defvar' form also declares the variable as \"special\",
+/// so that it is always dynamically bound even if `lexical-binding' is t.
+///
+/// If SYMBOL's value is void and the optional argument INITVALUE is
+/// provided, INITVALUE is evaluated and the result used to set SYMBOL's
+/// value. If SYMBOL is buffer-local, its default value is what is set;
+/// buffer-local values are not affected. If INITVALUE is missing,
+/// SYMBOL's value is not set.
+///
+/// If SYMBOL has a local binding, then this form affects the local
+/// binding. This is usually not what you want. Thus, if you need to
+/// load a file defining variables, with this form or with `defconst' or
+/// `defcustom', you should always load that file _outside_ any bindings
+/// for these variables. (`defconst' and `defcustom' behave similarly in
+/// this respect.)
+///
+/// The optional argument DOCSTRING is a documentation string for the
+/// variable.
+///
+/// To define a user option, use `defcustom' instead of `defvar'.
+/// usage: (defvar SYMBOL &optional INITVALUE DOCSTRING)
+#[lisp_fn(min = "1", unevalled = "true")]
+pub fn defvar(args: LispCons) -> LispObject {
+ let (sym_obj, tail) = args.into();
+
+ if let Some(tail) = tail.as_cons() {
+ if tail.length() > 2 {
+ error!("Too many arguments");
+ }
+
+ let sym: LispSymbolRef = sym_obj.into();
+ let has_default = default_boundp(sym);
+
+ // Do it before evaluating the initial value, for self-references.
+ sym.set_declared_special(true);
+
+ if has_default {
+ // Check if there is really a global binding rather than just a let
+ // binding that shadows the global unboundness of the var.
+ let mut binding = sym.default_toplevel_binding_rust();
+ if !binding.is_null() && (binding.old_value() == Qunbound) {
+ binding.set_old_value(unsafe { eval_sub(tail.car()) });
+ }
+ } else {
+ set_default(sym, unsafe { eval_sub(tail.car()) });
+ }
+
+ let mut documentation = car(tail.cdr());
+
+ if documentation.is_not_nil() {
+ if unsafe { globals.Vpurify_flag }.is_not_nil() {
+ documentation = purecopy(documentation);
+ }
+ put(sym, Qvariable_documentation, documentation);
+ }
+ loadhist_attach(sym_obj);
+ } else if unsafe { globals.Vinternal_interpreter_environment }.is_not_nil()
+ && sym_obj
+ .as_symbol()
+ .map_or(false, |x| !x.get_declared_special())
+ {
+ // A simple (defvar foo) with lexical scoping does "nothing" except
+ // declare that var to be dynamically scoped *locally* (i.e. within
+ // the current file or let-block).
+ unsafe {
+ globals.Vinternal_interpreter_environment =
+ LispObject::cons(sym_obj, globals.Vinternal_interpreter_environment);
+ }
+ } else {
+ // Simple (defvar <var>) should not count as a definition at all.
+ // It could get in the way of other definitions, and unloading this
+ // package could try to make the variable unbound.
+ }
+
+ sym_obj
+}
+
 include!(concat!(env!("OUT_DIR"), "/eval_exports.rs"));

rust_src/src/lisp.rs

@@ -20,13 +20,15 @@ use crate::{
  lists::{list, memq, CarIter, LispCons, LispConsCircularChecks, LispConsEndChecks},
  multibyte::LispStringRef,
  process::LispProcessRef,
+ remacs_sys::specbind_tag,
  remacs_sys::{build_string, make_float, Fmake_hash_table},
  remacs_sys::{
  equal_kind, pvec_type, EmacsDouble, EmacsInt, EmacsUint, Lisp_Bits, USE_LSB_TAG, VALMASK,
  },
- remacs_sys::{Lisp_Misc_Any, Lisp_Misc_Type, Lisp_Subr, Lisp_Type},
+ remacs_sys::{specbinding, Lisp_Misc_Any, Lisp_Misc_Type, Lisp_Subr, Lisp_Type},
  remacs_sys::{QCtest, Qautoload, Qeq, Qnil, Qsubrp, Qt},
  remacs_sys::{Vbuffer_alist, Vprocess_alist},
+ symbols::LispSymbolRef,
 };
 
 // TODO: tweak Makefile to rebuild C files if this changes.
@@ -160,6 +162,12 @@ impl<T> PartialEq for ExternalPtr<T> {
  }
 }
 
+impl<T> PartialOrd for ExternalPtr<T> {
+ fn partial_cmp(&self, other: &Self) -> Option<std::cmp::Ordering> {
+ Some(self.as_ptr().cmp(&other.as_ptr()))
+ }
+}
+
 // Misc support (LispType == Lisp_Misc == 1)
 
 // Lisp_Misc is a union. Now we don't really care about its variants except the
@@ -279,6 +287,27 @@ impl From<LispObject> for Option<LispSubrRef> {
  }
 }
 
+pub type SpecbindingRef = ExternalPtr<specbinding>;
+
+impl SpecbindingRef {
+ pub fn symbol(&self) -> LispSymbolRef {
+ debug_assert!(self.kind() >= specbind_tag::SPECPDL_LET);
+ unsafe { self.let_.as_ref().symbol }.into()
+ }
+
+ pub fn old_value(&self) -> LispObject {
+ debug_assert!(self.kind() >= specbind_tag::SPECPDL_LET);
+ unsafe { self.let_.as_ref().old_value }
+ }
+
+ pub fn set_old_value(&mut self, val: LispObject) {
+ debug_assert!(self.kind() >= specbind_tag::SPECPDL_LET);
+ unsafe {
+ self.let_.as_mut().old_value = val;
+ }
+ }
+}
+
 // Other functions
 
 impl From<()> for LispObject {

rust_src/src/symbols.rs

@@ -16,9 +16,10 @@ use crate::{
  },
  frames::selected_frame,
  hashtable::LispHashTableRef,
- lisp::{ExternalPtr, LispObject, LispStructuralEqual},
+ lisp::{ExternalPtr, LispObject, LispStructuralEqual, SpecbindingRef},
  lists::LispCons,
  multibyte::LispStringRef,
+ remacs_sys::specbind_tag,
  remacs_sys::Fframe_terminal,
  remacs_sys::{equal_kind, lispsym, EmacsInt, Lisp_Symbol, Lisp_Type, USE_LSB_TAG},
  remacs_sys::{
@@ -27,6 +28,7 @@ use crate::{
  symbol_interned, symbol_redirect, symbol_trapped_write,
  },
  remacs_sys::{Qcyclic_variable_indirection, Qnil, Qsymbolp, Qunbound},
+ threads::ThreadState,
 };
 
 pub type LispSymbolRef = ExternalPtr<Lisp_Symbol>;
@@ -232,6 +234,36 @@ impl LispSymbolRef {
  blv.where_ = Qnil;
  blv.set_found(false);
  }
+
+ pub fn default_toplevel_binding_rust(&self) -> SpecbindingRef {
+ let current_thread = ThreadState::current_thread();
+ let specpdl = SpecbindingRef::new(current_thread.m_specpdl);
+
+ let mut binding = SpecbindingRef::new(std::ptr::null_mut());
+ let mut pdl = SpecbindingRef::new(current_thread.m_specpdl_ptr);
+
+ while pdl > specpdl {
+ unsafe {
+ pdl.ptr_sub(1);
+ }
+ match pdl.kind() {
+ specbind_tag::SPECPDL_LET_DEFAULT | specbind_tag::SPECPDL_LET => {
+ if pdl.symbol() == *self {
+ binding = pdl.clone()
+ }
+ }
+ specbind_tag::SPECPDL_UNWIND
+ | specbind_tag::SPECPDL_UNWIND_PTR
+ | specbind_tag::SPECPDL_UNWIND_INT
+ | specbind_tag::SPECPDL_UNWIND_VOID
+ | specbind_tag::SPECPDL_BACKTRACE
+ | specbind_tag::SPECPDL_LET_LOCAL => {}
+ _ => panic!("Incorrect specpdl kind"),
+ }
+ }
+
+ binding
+ }
 }
 
 impl LispStructuralEqual for LispSymbolRef {