[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
scratch/lexspaces 7fecbf5 08/17: Add lexspace redirection
From: |
Andrea Corallo |
Subject: |
scratch/lexspaces 7fecbf5 08/17: Add lexspace redirection |
Date: |
Fri, 8 May 2020 16:43:08 -0400 (EDT) |
branch: scratch/lexspaces
commit 7fecbf57e2946c5541c4c707cf9b8f68f5716034
Author: Andrea Corallo <address@hidden>
Commit: Andrea Corallo <address@hidden>
Add lexspace redirection
---
src/lexspaces.c | 6 ++++--
src/lisp.h | 22 +++++++++++++++++-----
src/pdumper.c | 19 +++++++++++++++++--
3 files changed, 38 insertions(+), 9 deletions(-)
diff --git a/src/lexspaces.c b/src/lexspaces.c
index 587ca94..6e6a7a3 100644
--- a/src/lexspaces.c
+++ b/src/lexspaces.c
@@ -39,12 +39,14 @@ lexspace_copy (EMACS_INT dst, EMACS_INT src)
&& !EQ (sym->u.s.val.value, Qunbound))
{
struct Lisp_Binding *binding = XBINDING (sym->u.s.val.value);
- binding->b[dst] = binding->b[src];
+ binding->r[dst] = true;
+ binding->b[dst] = make_fixnum (src);
}
if (!NILP (sym->u.s._function))
{
struct Lisp_Binding *binding = XBINDING (sym->u.s._function);
- binding->b[dst] = binding->b[src];
+ binding->r[dst] = true;
+ binding->b[dst] = make_fixnum (src);
}
if (sym->u.s.next == 0)
break;
diff --git a/src/lisp.h b/src/lisp.h
index 29df243..a24e5f2 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -2177,6 +2177,8 @@ struct Lisp_Binding
{
union vectorlike_header header;
Lisp_Object b[MAX_LEXSPACES];
+ /* true if redirect. */
+ bool r[MAX_LEXSPACES];
};
INLINE bool
@@ -2212,16 +2214,25 @@ SYMBOL_VAL (struct Lisp_Symbol *sym)
if (EQ (sym->u.s.val.value, Qunbound))
return Qunbound;
eassert (BINDINGP (sym->u.s.val.value));
- /* FIXME: add loop to follow indirection. */
- return XBINDING (sym->u.s.val.value)->b[curr_lexspace];
+ EMACS_INT lexspace = curr_lexspace;
+ struct Lisp_Binding *binding = XBINDING (sym->u.s.val.value);
+ /* Follow redirections. */
+ while (binding->r[lexspace])
+ lexspace = XFIXNUM (binding->b[lexspace]);
+ return binding->b[lexspace];
}
INLINE Lisp_Object
SYMBOL_FUNCTION (struct Lisp_Symbol *sym)
{
- if (!NILP (sym->u.s._function))
- return XBINDING (sym->u.s._function)->b[curr_lexspace];
- return Qnil;
+ if (NILP (sym->u.s._function))
+ return Qnil;
+ EMACS_INT lexspace = curr_lexspace;
+ struct Lisp_Binding *binding = XBINDING (sym->u.s._function);
+ /* Follow redirections. */
+ while (binding->r[lexspace])
+ lexspace = XFIXNUM (binding->b[lexspace]);
+ return binding->b[lexspace];
}
INLINE struct Lisp_Symbol *
@@ -2251,6 +2262,7 @@ SET_SYMBOL_VAL (struct Lisp_Symbol *sym, Lisp_Object v)
if (EQ (sym->u.s.val.value, Qunbound))
sym->u.s.val.value = make_binding (Qunbound);
struct Lisp_Binding *binding = XBINDING (sym->u.s.val.value);
+ binding->r[curr_lexspace] = false;
binding->b[curr_lexspace] = v;
}
diff --git a/src/pdumper.c b/src/pdumper.c
index 20dd2ff..9be6d56 100644
--- a/src/pdumper.c
+++ b/src/pdumper.c
@@ -1758,7 +1758,7 @@ dump_roots (struct dump_context *ctx)
visit_static_gc_roots (visitor);
}
-enum { PDUMPER_MAX_OBJECT_SIZE = 2048 };
+enum { PDUMPER_MAX_OBJECT_SIZE = 4096 };
static dump_off
field_relpos (const void *in_start, const void *in_field)
@@ -2935,6 +2935,19 @@ dump_subr (struct dump_context *ctx, const struct
Lisp_Subr *subr)
return dump_object_finish (ctx, &out, sizeof (out));
}
+static dump_off
+dump_binding (struct dump_context *ctx, const struct Lisp_Binding *binding)
+{
+#if CHECK_STRUCTS && !defined (HASH_Lisp_Binding_A2586197DB)
+# error "Lisp_Binding changed. See CHECK_STRUCTS comment in config.h."
+#endif
+ START_DUMP_PVEC (ctx, &binding->header, struct Lisp_Binding, out);
+ dump_pseudovector_lisp_fields (ctx, &out->header, &binding->header);
+ for (ptrdiff_t i = 0; i < MAX_LEXSPACES; ++i)
+ DUMP_FIELD_COPY (out, binding, r[i]);
+ return finish_dump_pvec (ctx, &out->header);
+}
+
static void
fill_pseudovec (union vectorlike_header *header, Lisp_Object item)
{
@@ -2980,7 +2993,6 @@ dump_vectorlike (struct dump_context *ctx,
case PVEC_CHAR_TABLE:
case PVEC_SUB_CHAR_TABLE:
case PVEC_RECORD:
- case PVEC_BINDING:
offset = dump_vectorlike_generic (ctx, &v->header);
break;
case PVEC_BOOL_VECTOR:
@@ -2995,6 +3007,9 @@ dump_vectorlike (struct dump_context *ctx,
case PVEC_SUBR:
offset = dump_subr (ctx, XSUBR (lv));
break;
+ case PVEC_BINDING:
+ offset = dump_binding (ctx, XBINDING (lv));
+ break;
case PVEC_FRAME:
case PVEC_WINDOW:
case PVEC_PROCESS:
- branch scratch/lexspaces created (now e2f183c), Andrea Corallo, 2020/05/08
- scratch/lexspaces 67e28d9 02/17: Adding binding pseudovector, Andrea Corallo, 2020/05/08
- scratch/lexspaces 2d1e916 01/17: Add lexspaces.c, Andrea Corallo, 2020/05/08
- scratch/lexspaces 64e442b 04/17: Add SYMBOL_FUNCTION accessor function, Andrea Corallo, 2020/05/08
- scratch/lexspaces 02d8ef2 05/17: Move symbol value into separate binding, Andrea Corallo, 2020/05/08
- scratch/lexspaces 3a57250 06/17: Add lexspace-make-from, Andrea Corallo, 2020/05/08
- scratch/lexspaces 7fecbf5 08/17: Add lexspace redirection,
Andrea Corallo <=
- scratch/lexspaces 09821e3 03/17: Store symbol value into the binding, Andrea Corallo, 2020/05/08
- scratch/lexspaces 04ac507 14/17: Remove unnecessary assertion, Andrea Corallo, 2020/05/08
- scratch/lexspaces 00108a5 15/17: Fix sweep_symbols, Andrea Corallo, 2020/05/08
- scratch/lexspaces 295ac3d 07/17: Make in-lexspace do something, Andrea Corallo, 2020/05/08
- scratch/lexspaces 610552d 10/17: Add SYMBOL_FUNC_LEXSPACE, Andrea Corallo, 2020/05/08
- scratch/lexspaces 9091913 13/17: Rename lexspace-make-from -> lexspace-make, Andrea Corallo, 2020/05/08
- scratch/lexspaces e2f183c 17/17: Shallow setters by default are not a good idea, Andrea Corallo, 2020/05/08
- scratch/lexspaces 73363e9 09/17: Store lexspace in closures, Andrea Corallo, 2020/05/08
- scratch/lexspaces b46c504 12/17: Add lexspace-import-symbol, Andrea Corallo, 2020/05/08
- scratch/lexspaces c578c72 11/17: Add function lexspace contex mechanism, Andrea Corallo, 2020/05/08