gpgscm: Add flags to the interpreter.

* tests/gpgscm/scheme-private.h (struct scheme): Add field 'flags'.
* tests/gpgscm/scheme.c (S_OP_MASK): New macro.
(S_FLAG_MASK, s_set_flag, s_clear_flag, s_get_flag): Likewise.
(_s_return): Unpack the encoded opcode and flags.
(s_save): Encode the flags along with the opcode.  Use normal
integers to encode the result.
(scheme_init_custom_alloc): Initialize 'op' and 'flags'.

Signed-off-by: Justus Winter <justus@g10code.com>

2 files changed, 44 insertions, 5 deletions

diff --git a/tests/gpgscm/scheme-private.h b/tests/gpgscm/scheme-private.h
index 2c5c749e9..40a421160 100644
--- a/tests/gpgscm/scheme-private.h
+++ b/tests/gpgscm/scheme-private.h
@@ -163,6 +163,7 @@ int tok;
 int print_flag;
 pointer value;
 int op;
+unsigned int flags;
 
 void *ext_data;     /* For the benefit of foreign functions */
 long gensym_cnt;
diff --git a/tests/gpgscm/scheme.c b/tests/gpgscm/scheme.c
index c73a832f0..ab3491b69 100644
--- a/tests/gpgscm/scheme.c
+++ b/tests/gpgscm/scheme.c
@@ -2705,6 +2705,34 @@ static pointer _Error_1(scheme *sc, const char *s, pointer a) {
 # define  BEGIN     do {
 # define  END  } while (0)
 
+
+
+/* Flags.  The interpreter has a flags field.  When the interpreter
+ * pushes a frame to the dump stack, it is encoded with the opcode.
+ * Therefore, we do not use the least significant byte.  */
+
+/* Masks used to encode and decode opcode and flags.  */
+#define S_OP_MASK	0x000000ff
+#define S_FLAG_MASK	0xffffff00
+
+/* Set flag F.  */
+#define s_set_flag(sc, f)			\
+	   BEGIN				\
+	   (sc)->flags |= S_FLAG_ ## f;		\
+	   END
+
+/* Clear flag F.  */
+#define s_clear_flag(sc, f)			\
+	   BEGIN				\
+	   (sc)->flags &= ~ S_FLAG_ ## f;	\
+	   END
+
+/* Check if flag F is set.  */
+#define s_get_flag(sc, f)			\
+	   !!((sc)->flags & S_FLAG_ ## f)
+
+
+
 /* Bounce back to Eval_Cycle and execute A.  */
 #define s_goto(sc,a) BEGIN                                  \
     sc->op = (int)(a);                                      \
@@ -2757,16 +2785,23 @@ static void dump_stack_free(scheme *sc)
 static pointer _s_return(scheme *sc, pointer a, int enable_gc) {
   pointer dump = sc->dump;
   pointer op;
+  unsigned long v;
   sc->value = (a);
   if (enable_gc)
        gc_enable(sc);
   if (dump == sc->NIL)
     return sc->NIL;
   free_cons(sc, dump, &op, &dump);
-  sc->op = ivalue(op);
-#ifndef USE_SMALL_INTEGERS
-  free_cell(sc, op);
+  v = (unsigned long) ivalue_unchecked(op);
+  sc->op = (int) (v & S_OP_MASK);
+  sc->flags = v & S_FLAG_MASK;
+#ifdef USE_SMALL_INTEGERS
+  if (v < MAX_SMALL_INTEGER) {
+    /* This is a small integer, we must not free it.  */
+  } else
+    /* Normal integer.  Recover the cell.  */
 #endif
+    free_cell(sc, op);
   free_cons(sc, dump, &sc->args, &dump);
   free_cons(sc, dump, &sc->envir, &dump);
   free_cons(sc, dump, &sc->code, &sc->dump);
@@ -2774,12 +2809,13 @@ static pointer _s_return(scheme *sc, pointer a, int enable_gc) {
 }
 
 static void s_save(scheme *sc, enum scheme_opcodes op, pointer args, pointer code) {
-#define s_save_allocates	(4 + mk_small_integer_allocates)
+#define s_save_allocates	5
     pointer dump;
+    unsigned long v = sc->flags | ((unsigned long) op);
     gc_disable(sc, gc_reservations (s_save));
     dump = cons(sc, sc->envir, cons(sc, (code), sc->dump));
     dump = cons(sc, (args), dump);
-    sc->dump = cons(sc, mk_small_integer(sc, (long)(op)), dump);
+    sc->dump = cons(sc, mk_integer(sc, (long) v), dump);
     gc_enable(sc);
 }
 
@@ -5111,6 +5147,8 @@ int scheme_init_custom_alloc(scheme *sc, func_alloc malloc, func_dealloc free) {
   dump_stack_initialize(sc);
   sc->code = sc->NIL;
   sc->tracing=0;
+  sc->op = -1;
+  sc->flags = 0;
 
   /* init sc->NIL */
   typeflag(sc->NIL) = (T_NIL | T_ATOM | MARK);