comparison src/buffer.c @ 107984:bef5d1738c0b

Make variable forwarding explicit rather the using special values. Basically, this makes the structure of buffer-local values and object forwarding explicit in the type of Lisp_Symbols rather than use special Lisp_Objects for that. This tends to lead to slightly more verbose code, but is more C-like, simpler, and makes it easier to make sure we handled all cases, among other things by letting the compiler help us check it. * lisp.h (enum Lisp_Misc_Type, union Lisp_Misc): Removing forwarding objects. (enum Lisp_Fwd_Type, enum symbol_redirect, union Lisp_Fwd): New types. (struct Lisp_Symbol): Make the various forms of variable-forwarding explicit rather than hiding them inside Lisp_Object "values". (XFWDTYPE): New macro. (XINTFWD, XBOOLFWD, XOBJFWD, XKBOARD_OBJFWD): Redefine. (XBUFFER_LOCAL_VALUE): Remove. (SYMBOL_VAL, SYMBOL_ALIAS, SYMBOL_BLV, SYMBOL_FWD, SET_SYMBOL_VAL) (SET_SYMBOL_ALIAS, SET_SYMBOL_BLV, SET_SYMBOL_FWD): New macros. (SYMBOL_VALUE, SET_SYMBOL_VALUE): Remove. (struct Lisp_Intfwd, struct Lisp_Boolfwd, struct Lisp_Objfwd) (struct Lisp_Buffer_Objfwd, struct Lisp_Kboard_Objfwd): Remove the Lisp_Misc_* header. (struct Lisp_Buffer_Local_Value): Redefine. (BLV_FOUND, SET_BLV_FOUND, BLV_VALUE, SET_BLV_VALUE): New macros. (struct Lisp_Misc_Any): Add filler to get the right size. (struct Lisp_Free): Use struct Lisp_Misc_Any rather than struct Lisp_Intfwd. (DEFVAR_LISP, DEFVAR_LISP_NOPRO, DEFVAR_BOOL, DEFVAR_INT) (DEFVAR_KBOARD): Allocate a forwarding object. * data.c (do_blv_forwarding, store_blv_forwarding): New macros. (let_shadows_global_binding_p): New function. (union Lisp_Val_Fwd): New type. (make_blv): New function. (swap_in_symval_forwarding, indirect_variable, do_symval_forwarding) (store_symval_forwarding, swap_in_global_binding, Fboundp) (swap_in_symval_forwarding, find_symbol_value, Fset) (let_shadows_buffer_binding_p, set_internal, default_value) (Fset_default, Fmake_variable_buffer_local, Fmake_local_variable) (Fkill_local_variable, Fmake_variable_frame_local) (Flocal_variable_p, Flocal_variable_if_set_p) (Fvariable_binding_locus): * xdisp.c (select_frame_for_redisplay): * lread.c (Fintern, Funintern, init_obarray, defvar_int) (defvar_bool, defvar_lisp_nopro, defvar_lisp, defvar_kboard): * frame.c (store_frame_param): * eval.c (Fdefvaralias, Fuser_variable_p, specbind, unbind_to): * bytecode.c (Fbyte_code) <varref, varset>: Adapt to the new symbol value structure. * buffer.c (PER_BUFFER_SYMBOL): Move from buffer.h. (clone_per_buffer_values): Only adjust markers into the current buffer. (reset_buffer_local_variables): PER_BUFFER_IDX is never -2. (Fbuffer_local_value, set_buffer_internal_1) (swap_out_buffer_local_variables): Adapt to the new symbol value structure. (DEFVAR_PER_BUFFER): Allocate a Lisp_Buffer_Objfwd object. (defvar_per_buffer): Take a new arg for the fwd object. (buffer_lisp_local_variables): Return a proper alist (different fix for bug#4138). * alloc.c (Fmake_symbol): Use SET_SYMBOL_VAL. (Fgarbage_collect): Don't handle buffer_defaults specially. (mark_object): Handle new symbol value structure rather than the old special Lisp_Misc_* objects. (gc_sweep) <symbols>: Free also the buffer-local-value objects. * term.c (set_tty_color_mode): * bidi.c (bidi_initialize): Don't access the ->value field directly. * buffer.h (PER_BUFFER_VAR_OFFSET): Don't bother with a buffer_local_flags. * print.c (print_object): Get rid of impossible forwarding objects.

107983:781bff25a517

   If a slot in this structure is -1, then even though there may
   be a DEFVAR_PER_BUFFER for the slot, there is no default value for it;
   and the corresponding slot in buffer_defaults is not used.

   If a slot is -2, then there is no DEFVAR_PER_BUFFER for it,
   but there is a default value which is copied into each buffer.

   If a slot in this structure corresponding to a DEFVAR_PER_BUFFER is
   zero, that is a bug */

struct buffer buffer_local_flags;

DECL_ALIGN (struct buffer, buffer_local_symbols);

/* A Lisp_Object pointer to the above, used for staticpro */
static Lisp_Object Vbuffer_local_symbols;

/* Flags indicating which built-in buffer-local variables
   are permanent locals.  */
static char buffer_permanent_local_flags[MAX_PER_BUFFER_VARS];

      /* Don't touch the `name' which should be unique for every buffer.  */
      if (offset == PER_BUFFER_VAR_OFFSET (name))
	continue;

      obj = PER_BUFFER_VALUE (from, offset);
      if (MARKERP (obj))
	{
	  struct Lisp_Marker *m = XMARKER (obj);
	  obj = Fmake_marker ();
	  XMARKER (obj)->insertion_type = m->insertion_type;
	  set_marker_both (obj, to_buffer, m->charpos, m->bytepos);

    b->local_var_alist = Qnil;
  else
    {
      Lisp_Object tmp, prop, last = Qnil;
      for (tmp = b->local_var_alist; CONSP (tmp); tmp = XCDR (tmp))
	if (CONSP (XCAR (tmp))
	    && SYMBOLP (XCAR (XCAR (tmp)))
	    && !NILP (prop = Fget (XCAR (XCAR (tmp)), Qpermanent_local)))
	  {
	    /* If permanent-local, keep it.  */
	    last = tmp;
	    if (EQ (prop, Qpermanent_local_hook))
	      {

       offset += sizeof (Lisp_Object))
    {
      int idx = PER_BUFFER_IDX (offset);
      if ((idx > 0
	   && (permanent_too
	       || buffer_permanent_local_flags[idx] == 0))
	  /* Is -2 used anywhere?  */
	  || idx == -2)
	PER_BUFFER_VALUE (b, offset) = PER_BUFFER_DEFAULT (offset);
    }
}

/* We split this away from generate-new-buffer, because rename-buffer

  struct Lisp_Symbol *sym;

  CHECK_SYMBOL (variable);
  CHECK_BUFFER (buffer);
  buf = XBUFFER (buffer);

  sym = indirect_variable (XSYMBOL (variable));
  XSETSYMBOL (variable, sym);

  /* Look in local_var_list */
  result = Fassoc (variable, buf->local_var_alist);
  if (NILP (result))
    {
      int offset, idx;
      int found = 0;

      /* Look in special slots */
      /* buffer-local Lisp variables start at `undo_list',
	 tho only the ones from `name' on are GC'd normally.  */
      for (offset = PER_BUFFER_VAR_OFFSET (undo_list);
	   offset < sizeof (struct buffer);
	   /* sizeof EMACS_INT == sizeof Lisp_Object */
	   offset += (sizeof (EMACS_INT)))
	{
	  idx = PER_BUFFER_IDX (offset);
	  if ((idx == -1 || PER_BUFFER_VALUE_P (buf, idx))
	      && SYMBOLP (PER_BUFFER_SYMBOL (offset))
	      && EQ (PER_BUFFER_SYMBOL (offset), variable))
	    {
	      result = PER_BUFFER_VALUE (buf, offset);
	      found = 1;
	      break;
	    }
	}

      if (!found)
	result = Fdefault_value (variable);
    }
  else
    {
      Lisp_Object valcontents;
      Lisp_Object current_alist_element;

      /* What binding is loaded right now?  */
      valcontents = sym->value;
      current_alist_element
	= XCAR (XBUFFER_LOCAL_VALUE (valcontents)->cdr);

      /* The value of the currently loaded binding is not
	 stored in it, but rather in the realvalue slot.
	 Store that value into the binding it belongs to
	 in case that is the one we are about to use.  */

      Fsetcdr (current_alist_element,
	       do_symval_forwarding (XBUFFER_LOCAL_VALUE (valcontents)->realvalue));

      /* Now get the (perhaps updated) value out of the binding.  */
      result = XCDR (result);
    }

  if (!EQ (result, Qunbound))
    return result;

      val = find_symbol_value (XCAR (elt));
      /* Use the current buffer value only if buf is the current buffer.  */
      if (buf != current_buffer)
	val = XCDR (elt);

      /* If symbol is unbound, put just the symbol in the list.  */
      if (EQ (val, Qunbound))
	result = Fcons (XCAR (elt), result);
      /* Otherwise, put (symbol . value) in the list.  */
      else
	result = Fcons (Fcons (XCAR (elt), val), result);
    }

  return result;
}

void
set_buffer_internal_1 (b)
     register struct buffer *b;
{
  register struct buffer *old_buf;
  register Lisp_Object tail, valcontents;
  Lisp_Object tem;

#ifdef USE_MMAP_FOR_BUFFERS
  if (b->text->beg == NULL)
    enlarge_buffer_text (b, 0);
#endif /* USE_MMAP_FOR_BUFFERS */

    }

  /* Look down buffer's list of local Lisp variables
     to find and update any that forward into C variables. */

  for (tail = b->local_var_alist; CONSP (tail); tail = XCDR (tail))
    {
      if (CONSP (XCAR (tail))
	  && SYMBOLP (XCAR (XCAR (tail)))
	  && (valcontents = SYMBOL_VALUE (XCAR (XCAR (tail))),
	      (BUFFER_LOCAL_VALUEP (valcontents)))
	  && (tem = XBUFFER_LOCAL_VALUE (valcontents)->realvalue,
	      (BOOLFWDP (tem) || INTFWDP (tem) || OBJFWDP (tem))))
	/* Just reference the variable to cause it to become set for
	   this buffer.  */
	Fsymbol_value (XCAR (XCAR (tail)));
    }

  /* Do the same with any others that were local to the previous buffer */

  if (old_buf)
    for (tail = old_buf->local_var_alist; CONSP (tail); tail = XCDR (tail))
      {
	if (CONSP (tail)
	    && SYMBOLP (XCAR (XCAR (tail)))
	    && (valcontents = SYMBOL_VALUE (XCAR (XCAR (tail))),
		(BUFFER_LOCAL_VALUEP (valcontents)))
	    && (tem = XBUFFER_LOCAL_VALUE (valcontents)->realvalue,
		(BOOLFWDP (tem) || INTFWDP (tem) || OBJFWDP (tem))))
	  /* Just reference the variable to cause it to become set for
	     this buffer.  */
	  Fsymbol_value (XCAR (XCAR (tail)));
      }
}

/* Switch to buffer B temporarily for redisplay purposes.
   This avoids certain things that don't need to be done within redisplay.  */

static void
swap_out_buffer_local_variables (b)
     struct buffer *b;
{
  Lisp_Object oalist, alist, sym, buffer;

  XSETBUFFER (buffer, b);
  oalist = b->local_var_alist;

  for (alist = oalist; CONSP (alist); alist = XCDR (alist))
    {
      if (CONSP (XCAR (alist))
	  && (sym = XCAR (XCAR (alist)), SYMBOLP (sym))
	  /* Need not do anything if some other buffer's binding is
	     now encached.  */
	  && EQ (XBUFFER_LOCAL_VALUE (SYMBOL_VALUE (sym))->buffer,
		 buffer))
	{
	  /* Symbol is set up for this buffer's old local value:
	     swap it out!  */
	  swap_in_global_binding (sym);
	}
    }
}

/* Find all the overlays in the current buffer that contain position POS.

  bzero (buffer_permanent_local_flags, sizeof buffer_permanent_local_flags);

  /* Make sure all markable slots in buffer_defaults
     are initialized reasonably, so mark_buffer won't choke.  */
  reset_buffer (&buffer_defaults);
  reset_buffer_local_variables (&buffer_defaults, 1);
  reset_buffer (&buffer_local_symbols);
  reset_buffer_local_variables (&buffer_local_symbols, 1);
  /* Prevent GC from getting confused.  */
  buffer_defaults.text = &buffer_defaults.own_text;
  buffer_local_symbols.text = &buffer_local_symbols.own_text;

/* Similar to defvar_lisp but define a variable whose value is the Lisp
   Object stored in the current buffer.  address is the address of the slot
   in the buffer that is current now. */

/* TYPE is nil for a general Lisp variable.
   An integer specifies a type; then only LIsp values
   with that type code are allowed (except that nil is allowed too).
   LNAME is the LIsp-level variable name.
   VNAME is the name of the buffer slot.
   DOC is a dummy where you write the doc string as a comment.  */
#define DEFVAR_PER_BUFFER(lname, vname, type, doc)  \
 defvar_per_buffer (lname, vname, type, 0)

static void
defvar_per_buffer (namestring, address, type, doc)
     char *namestring;
     Lisp_Object *address;
     Lisp_Object type;
     char *doc;
{
  Lisp_Object sym, val;
  int offset;

  sym = intern (namestring);
  val = allocate_misc ();
  offset = (char *)address - (char *)current_buffer;

  XMISCTYPE (val) = Lisp_Misc_Buffer_Objfwd;
  XBUFFER_OBJFWD (val)->offset = offset;
  XBUFFER_OBJFWD (val)->slottype = type;
  SET_SYMBOL_VALUE (sym, val);
  PER_BUFFER_SYMBOL (offset) = sym;

  if (PER_BUFFER_IDX (offset) == 0)
    /* Did a DEFVAR_PER_BUFFER without initializing the corresponding
       slot of buffer_local_flags */
    abort ();

107984:bef5d1738c0b

   If a slot in this structure is -1, then even though there may
   be a DEFVAR_PER_BUFFER for the slot, there is no default value for it;
   and the corresponding slot in buffer_defaults is not used.

   If a slot in this structure corresponding to a DEFVAR_PER_BUFFER is
   zero, that is a bug */

struct buffer buffer_local_flags;

DECL_ALIGN (struct buffer, buffer_local_symbols);

/* A Lisp_Object pointer to the above, used for staticpro */
static Lisp_Object Vbuffer_local_symbols;

/* Return the symbol of the per-buffer variable at offset OFFSET in
   the buffer structure.  */

#define PER_BUFFER_SYMBOL(OFFSET) \
      (*(Lisp_Object *)((OFFSET) + (char *) &buffer_local_symbols))

/* Flags indicating which built-in buffer-local variables
   are permanent locals.  */
static char buffer_permanent_local_flags[MAX_PER_BUFFER_VARS];

      /* Don't touch the `name' which should be unique for every buffer.  */
      if (offset == PER_BUFFER_VAR_OFFSET (name))
	continue;

      obj = PER_BUFFER_VALUE (from, offset);
      if (MARKERP (obj) && XMARKER (obj)->buffer == from)
	{
	  struct Lisp_Marker *m = XMARKER (obj);
	  obj = Fmake_marker ();
	  XMARKER (obj)->insertion_type = m->insertion_type;
	  set_marker_both (obj, to_buffer, m->charpos, m->bytepos);

    b->local_var_alist = Qnil;
  else
    {
      Lisp_Object tmp, prop, last = Qnil;
      for (tmp = b->local_var_alist; CONSP (tmp); tmp = XCDR (tmp))
	if (!NILP (prop = Fget (XCAR (XCAR (tmp)), Qpermanent_local)))
	  {
	    /* If permanent-local, keep it.  */
	    last = tmp;
	    if (EQ (prop, Qpermanent_local_hook))
	      {

       offset += sizeof (Lisp_Object))
    {
      int idx = PER_BUFFER_IDX (offset);
      if ((idx > 0
	   && (permanent_too
	       || buffer_permanent_local_flags[idx] == 0)))
	PER_BUFFER_VALUE (b, offset) = PER_BUFFER_DEFAULT (offset);
    }
}

/* We split this away from generate-new-buffer, because rename-buffer

  struct Lisp_Symbol *sym;

  CHECK_SYMBOL (variable);
  CHECK_BUFFER (buffer);
  buf = XBUFFER (buffer);
  sym = XSYMBOL (variable);

 start:
  switch (sym->redirect)
    {
    case SYMBOL_VARALIAS: sym = indirect_variable (sym); goto start;
    case SYMBOL_PLAINVAL: result = SYMBOL_VAL (sym); break;
    case SYMBOL_LOCALIZED:
      { /* Look in local_var_alist.  */
	struct Lisp_Buffer_Local_Value *blv = SYMBOL_BLV (sym);
	XSETSYMBOL (variable, sym); /* Update In case of aliasing.  */
	result = Fassoc (variable, buf->local_var_alist);
	if (!NILP (result))
	  {
	    if (blv->fwd)
	      { /* What binding is loaded right now?  */
		Lisp_Object current_alist_element = blv->valcell;

		/* The value of the currently loaded binding is not
		   stored in it, but rather in the realvalue slot.
		   Store that value into the binding it belongs to
		   in case that is the one we are about to use.  */

		XSETCDR (current_alist_element,
			 do_symval_forwarding (blv->fwd));
	      }
	    /* Now get the (perhaps updated) value out of the binding.  */
	    result = XCDR (result);
	  }
	else
	  result = Fdefault_value (variable);
	break;
      }
    case SYMBOL_FORWARDED:
      {
	union Lisp_Fwd *fwd = SYMBOL_FWD (sym);
	if (BUFFER_OBJFWDP (fwd))
	  result = PER_BUFFER_VALUE (buf, XBUFFER_OBJFWD (fwd)->offset);
	else
	  result = Fdefault_value (variable);
	break;
      }
    default: abort ();
    }

  if (!EQ (result, Qunbound))
    return result;

      val = find_symbol_value (XCAR (elt));
      /* Use the current buffer value only if buf is the current buffer.  */
      if (buf != current_buffer)
	val = XCDR (elt);

      result = Fcons (Fcons (XCAR (elt), val), result);
    }

  return result;
}

void
set_buffer_internal_1 (b)
     register struct buffer *b;
{
  register struct buffer *old_buf;
  register Lisp_Object tail;

#ifdef USE_MMAP_FOR_BUFFERS
  if (b->text->beg == NULL)
    enlarge_buffer_text (b, 0);
#endif /* USE_MMAP_FOR_BUFFERS */

    }

  /* Look down buffer's list of local Lisp variables
     to find and update any that forward into C variables. */

  do
    {
      for (tail = b->local_var_alist; CONSP (tail); tail = XCDR (tail))
	{
	  Lisp_Object var = XCAR (XCAR (tail));
	  struct Lisp_Symbol *sym = XSYMBOL (var);
	  if (sym->redirect == SYMBOL_LOCALIZED /* Just to be sure.  */
	      && SYMBOL_BLV (sym)->fwd)
	    /* Just reference the variable
	       to cause it to become set for this buffer.  */
	    Fsymbol_value (var);
	}
    }
  /* Do the same with any others that were local to the previous buffer */
  while (b != old_buf && (b = old_buf, b));
}

/* Switch to buffer B temporarily for redisplay purposes.
   This avoids certain things that don't need to be done within redisplay.  */

static void
swap_out_buffer_local_variables (b)
     struct buffer *b;
{
  Lisp_Object oalist, alist, buffer;

  XSETBUFFER (buffer, b);
  oalist = b->local_var_alist;

  for (alist = oalist; CONSP (alist); alist = XCDR (alist))
    {
      Lisp_Object sym = XCAR (XCAR (alist));
      eassert (XSYMBOL (sym)->redirect == SYMBOL_LOCALIZED);
      /* Need not do anything if some other buffer's binding is
	 now encached.  */
      if (EQ (SYMBOL_BLV (XSYMBOL (sym))->where, buffer))
	{
	  /* Symbol is set up for this buffer's old local value:
	     swap it out!  */
	  swap_in_global_binding (XSYMBOL (sym));
	}
    }
}

/* Find all the overlays in the current buffer that contain position POS.

  bzero (buffer_permanent_local_flags, sizeof buffer_permanent_local_flags);

  /* Make sure all markable slots in buffer_defaults
     are initialized reasonably, so mark_buffer won't choke.  */
  reset_buffer (&buffer_defaults);
  eassert (EQ (buffer_defaults.name, make_number (0)));
  reset_buffer_local_variables (&buffer_defaults, 1);
  eassert (EQ (buffer_local_symbols.name, make_number (0)));
  reset_buffer (&buffer_local_symbols);
  reset_buffer_local_variables (&buffer_local_symbols, 1);
  /* Prevent GC from getting confused.  */
  buffer_defaults.text = &buffer_defaults.own_text;
  buffer_local_symbols.text = &buffer_local_symbols.own_text;

/* Similar to defvar_lisp but define a variable whose value is the Lisp
   Object stored in the current buffer.  address is the address of the slot
   in the buffer that is current now. */

/* TYPE is nil for a general Lisp variable.
   An integer specifies a type; then only Lisp values
   with that type code are allowed (except that nil is allowed too).
   LNAME is the Lisp-level variable name.
   VNAME is the name of the buffer slot.
   DOC is a dummy where you write the doc string as a comment.  */
#define DEFVAR_PER_BUFFER(lname, vname, type, doc)			\
  do {									\
    static struct Lisp_Buffer_Objfwd bo_fwd;				\
    defvar_per_buffer (&bo_fwd, lname, vname, type, 0);			\
  } while (0)

static void
defvar_per_buffer (bo_fwd, namestring, address, type, doc)
     struct Lisp_Buffer_Objfwd *bo_fwd;
     char *namestring;
     Lisp_Object *address;
     Lisp_Object type;
     char *doc;
{
  struct Lisp_Symbol *sym;
  int offset;

  sym = XSYMBOL (intern (namestring));
  offset = (char *)address - (char *)current_buffer;

  bo_fwd->type = Lisp_Fwd_Buffer_Obj;
  bo_fwd->offset = offset;
  bo_fwd->slottype = type;
  sym->redirect = SYMBOL_FORWARDED;
  {
    /* I tried to do the job without a cast, but it seems impossible.
       union Lisp_Fwd *fwd; &(fwd->u_buffer_objfwd) = bo_fwd;  */
    SET_SYMBOL_FWD (sym, (union Lisp_Fwd *)bo_fwd);
  }
  XSETSYMBOL (PER_BUFFER_SYMBOL (offset), sym);

  if (PER_BUFFER_IDX (offset) == 0)
    /* Did a DEFVAR_PER_BUFFER without initializing the corresponding
       slot of buffer_local_flags */
    abort ();