[Pkg-gnupg-commit] [gnupg2] 74/180: gpgscm: Implement tags.
Daniel Kahn Gillmor
dkg at fifthhorseman.net
Sat Dec 24 22:29:10 UTC 2016
This is an automated email from the git hooks/post-receive script.
dkg pushed a commit to branch master
in repository gnupg2.
commit fcf5aea44627def43425d03881e20902e7c0331e
Author: Justus Winter <justus at g10code.com>
Date: Fri Nov 18 13:23:11 2016 +0100
gpgscm: Implement tags.
* tests/gpgscm/opdefines.h: Add opcodes to create and retrieve tags.
* tests/gpgscm/scheme.c (T_TAGGED): New macro.
(mk_tagged_value): New function.
(has_tag): Likewise.
(get_tag): Likewise.
(mark): Mark tag.
(opexe_4): Implement new opcodes.
* tests/gpgscm/scheme.h (USE_TAGS): New macro.
--
Tags are similar to property lists, but property lists can only be
attached to symbols. Tags can not be attached to an existing object,
but a tagged copy can be created. Once done, the tag can be
manipulated in constant time.
Using this during parsing will enable us to produce meaningful error
messages.
Signed-off-by: Justus Winter <justus at g10code.com>
---
tests/gpgscm/opdefines.h | 5 +++
tests/gpgscm/scheme.c | 80 ++++++++++++++++++++++++++++++++++++++++++++++++
tests/gpgscm/scheme.h | 6 ++++
3 files changed, 91 insertions(+)
diff --git a/tests/gpgscm/opdefines.h b/tests/gpgscm/opdefines.h
index c7347fd..a2328fa 100644
--- a/tests/gpgscm/opdefines.h
+++ b/tests/gpgscm/opdefines.h
@@ -149,6 +149,11 @@
_OP_DEF(opexe_4, "set-symbol-property!", 3, 3, TST_SYMBOL TST_SYMBOL TST_ANY, OP_SET_SYMBOL_PROPERTY )
_OP_DEF(opexe_4, "symbol-property", 2, 2, TST_SYMBOL TST_SYMBOL, OP_SYMBOL_PROPERTY )
#endif
+#if USE_TAGS
+ _OP_DEF(opexe_4, NULL, 0, 0, TST_NONE, OP_TAG_VALUE )
+ _OP_DEF(opexe_4, "make-tagged-value", 2, 2, TST_ANY TST_PAIR, OP_MK_TAGGED )
+ _OP_DEF(opexe_4, "get-tag", 1, 1, TST_ANY, OP_GET_TAG )
+#endif
_OP_DEF(opexe_4, "quit", 0, 1, TST_NUMBER, OP_QUIT )
_OP_DEF(opexe_4, "gc", 0, 0, 0, OP_GC )
_OP_DEF(opexe_4, "gc-verbose", 0, 1, TST_NONE, OP_GCVERB )
diff --git a/tests/gpgscm/scheme.c b/tests/gpgscm/scheme.c
index 30b5915..c73a832 100644
--- a/tests/gpgscm/scheme.c
+++ b/tests/gpgscm/scheme.c
@@ -166,6 +166,7 @@ type_to_string (enum scheme_types typ)
#define ADJ 32
#define TYPE_BITS 5
#define T_MASKTYPE 31 /* 0000000000011111 */
+#define T_TAGGED 1024 /* 0000010000000000 */
#define T_FINALIZE 2048 /* 0000100000000000 */
#define T_SYNTAX 4096 /* 0001000000000000 */
#define T_IMMUTABLE 8192 /* 0010000000000000 */
@@ -599,6 +600,59 @@ static long binary_decode(const char *s) {
return x;
}
+
+
+/* Tags are like property lists, but can be attached to arbitrary
+ * values. */
+
+#if USE_TAGS
+
+static pointer
+mk_tagged_value(scheme *sc, pointer v, pointer tag_car, pointer tag_cdr)
+{
+ pointer r, t;
+
+ assert(! is_vector(v));
+
+ r = get_consecutive_cells(sc, 2);
+ if (r == sc->sink)
+ return sc->sink;
+
+ memcpy(r, v, sizeof *v);
+ typeflag(r) |= T_TAGGED;
+
+ t = r + 1;
+ typeflag(t) = T_PAIR;
+ car(t) = tag_car;
+ cdr(t) = tag_cdr;
+
+ return r;
+}
+
+static INLINE int
+has_tag(pointer v)
+{
+ return !! (typeflag(v) & T_TAGGED);
+}
+
+static INLINE pointer
+get_tag(scheme *sc, pointer v)
+{
+ if (has_tag(v))
+ return v + 1;
+ return sc->NIL;
+}
+
+#else
+
+#define mk_tagged_value(SC, X, A, B) (X)
+#define has_tag(V) 0
+#define get_tag(SC, V) (SC)->NIL
+
+#endif
+
+
+
/* Allocate a new cell segment but do not make it available yet. */
static int
_alloc_cellseg(scheme *sc, size_t len, void **alloc, pointer *cells)
@@ -1481,6 +1535,9 @@ E2: setmark(p);
mark(p+1+i);
}
}
+ /* Mark tag if p has one. */
+ if (has_tag(p))
+ mark(p + 1);
if (is_atom(p))
goto E6;
/* E4: down car */
@@ -4183,6 +4240,29 @@ static pointer opexe_4(scheme *sc, enum scheme_opcodes op) {
CASE(OP_SYMBOL_PROPERTY): /* symbol-property */
s_return(sc, get_property(sc, car(sc->args), cadr(sc->args)));
#endif /* USE_PLIST */
+
+#if USE_TAGS
+ CASE(OP_TAG_VALUE): { /* not exposed */
+ /* This tags sc->value with car(sc->args). Useful to tag
+ * results of opcode evaluations. */
+ pointer a, b, c;
+ free_cons(sc, sc->args, &a, &b);
+ free_cons(sc, b, &b, &c);
+ assert(c == sc->NIL);
+ s_return(sc, mk_tagged_value(sc, sc->value, a, b));
+ }
+
+ CASE(OP_MK_TAGGED): /* make-tagged-value */
+ if (is_vector(car(sc->args)))
+ Error_0(sc, "cannot tag vector");
+ s_return(sc, mk_tagged_value(sc, car(sc->args),
+ car(cadr(sc->args)),
+ cdr(cadr(sc->args))));
+
+ CASE(OP_GET_TAG): /* get-tag */
+ s_return(sc, get_tag(sc, car(sc->args)));
+#endif /* USE_TAGS */
+
CASE(OP_QUIT): /* quit */
if(is_pair(sc->args)) {
sc->retcode=ivalue(car(sc->args));
diff --git a/tests/gpgscm/scheme.h b/tests/gpgscm/scheme.h
index 2b5b066..5e7d90d 100644
--- a/tests/gpgscm/scheme.h
+++ b/tests/gpgscm/scheme.h
@@ -44,6 +44,7 @@ extern "C" {
# define USE_DL 0
# define USE_PLIST 0
# define USE_SMALL_INTEGERS 0
+# define USE_TAGS 0
#endif
@@ -76,6 +77,11 @@ extern "C" {
# define USE_PLIST 0
#endif
+/* If set, then every object can be tagged. */
+#ifndef USE_TAGS
+# define USE_TAGS 1
+#endif
+
/* To force system errors through user-defined error handling (see *error-hook*) */
#ifndef USE_ERROR_HOOK
# define USE_ERROR_HOOK 1
--
Alioth's /usr/local/bin/git-commit-notice on /srv/git.debian.org/git/pkg-gnupg/gnupg2.git
More information about the Pkg-gnupg-commit
mailing list