FFI struct types no longer use global variables (with improved type-inference as a bonus)

eval.c

@@ -1702,13 +1702,11 @@ sexp sexp_make_foreign (sexp ctx, const char *name, int num_args,
 
 sexp sexp_define_foreign_aux (sexp ctx, sexp env, const char *name, int num_args,
                               int flags, sexp_proc1 f, sexp data) {
-  sexp_gc_var2(op, res);
+  sexp_gc_var2(sym, res);
-  sexp_gc_preserve2(ctx, op, res);
+  sexp_gc_preserve2(ctx, sym, res);
-  op = sexp_make_foreign(ctx, name, num_args, flags, f, data);
+  res = sexp_make_foreign(ctx, name, num_args, flags, f, data);
-  if (sexp_exceptionp(op))
+  if (!sexp_exceptionp(res))
-    res = op;
+    sexp_env_define(ctx, env, sym = sexp_intern(ctx, name, -1), res);
-  else
-    sexp_env_define(ctx, env, res = sexp_intern(ctx, name, -1), op);
   sexp_gc_release2(ctx);
   return res;
 }

include/chibi/sexp.h

@@ -246,7 +246,8 @@ struct sexp_type_struct {
 
 struct sexp_opcode_struct {
   unsigned char op_class, code, num_args, flags, inverse;
-  sexp name, data, data2, proc, ret_type, arg1_type, arg2_type, arg3_type, dl;
+  sexp name, data, data2, proc, ret_type, arg1_type, arg2_type, arg3_type,
+    argn_type, dl;
   sexp_proc1 func;
 };
 
@@ -871,6 +872,7 @@ SEXP_API sexp sexp_make_unsigned_integer(sexp ctx, sexp_luint_t x);
 #define sexp_opcode_arg1_type(x)   (sexp_field(x, opcode, SEXP_OPCODE, arg1_type))
 #define sexp_opcode_arg2_type(x)   (sexp_field(x, opcode, SEXP_OPCODE, arg2_type))
 #define sexp_opcode_arg3_type(x)   (sexp_field(x, opcode, SEXP_OPCODE, arg3_type))
+#define sexp_opcode_argn_type(x)   (sexp_field(x, opcode, SEXP_OPCODE, argn_type))
 #define sexp_opcode_func(x)        (sexp_field(x, opcode, SEXP_OPCODE, func))
 
 #define sexp_opcode_variadic_p(x)  (sexp_opcode_flags(x) & 1)

lib/chibi/accept.c

@@ -4,23 +4,15 @@
 /* EWOULDBLOCK and block on the socket, and listen should automatically make */
 /* sockets non-blocking. */
 
-sexp sexp_accept (sexp ctx, sexp self, sexp arg0, sexp arg1, sexp arg2) {
+sexp sexp_accept (sexp ctx, sexp self, int sock, struct sockaddr* addr, socklen_t len) {
   sexp f;
-  socklen_t tmp;
   int res;
-  if (! sexp_exact_integerp(arg0))
+  res = accept(sock, addr, &len);
-    return sexp_type_exception(ctx, self, SEXP_FIXNUM, arg0);
-  if (! (sexp_pointerp(arg1) && (sexp_pointer_tag(arg1) == sexp_type_tag(sexp_sockaddr_type_t))))
-    return sexp_type_exception(ctx, self, sexp_type_tag(sexp_sockaddr_type_t), arg1);
-  if (! sexp_exact_integerp(arg2))
-    return sexp_type_exception(ctx, self, SEXP_FIXNUM, arg2);
-  tmp = sexp_sint_value(arg2);
-  res = accept(sexp_sint_value(arg0), (struct sockaddr*)sexp_cpointer_value(arg1), &tmp);
 #if SEXP_USE_GREEN_THREADS
   if (res < 0 && errno == EWOULDBLOCK) {
     f = sexp_global(ctx, SEXP_G_THREADS_BLOCKER);
     if (sexp_opcodep(f)) {
-      ((sexp_proc2)sexp_opcode_func(f))(ctx, f, 1, arg0);
+      ((sexp_proc2)sexp_opcode_func(f))(ctx, f, 1, sexp_make_fixnum(sock));
       return sexp_global(ctx, SEXP_G_IO_BLOCK_ERROR);
     }
   }

lib/chibi/net.stub

@@ -38,7 +38,7 @@
 ;;> Accept a connection on a socket.
 
 (define-c sexp (accept "sexp_accept")
-  ((value ctx sexp) (value self sexp) sexp sexp sexp))
+  ((value ctx sexp) (value self sexp) int sockaddr int))
 
 ;;> Create an endpoint for communication.
 

opcodes.c

@@ -1,8 +1,8 @@
 
 #define _I(n) sexp_make_fixnum(n)
-#define _OP(c,o,n,m,rt,a1,a2,a3,i,s,d,f) {c, o, n, m, i, (sexp)s, d, NULL, NULL, rt, a1, a2, a3, SEXP_FALSE, f}
+#define _OP(c,o,n,m,rt,a1,a2,a3,i,s,d,f) {c, o, n, m, i, (sexp)s, d, NULL, NULL, rt, a1, a2, a3, NULL, SEXP_FALSE, f}
 #if SEXP_USE_IMAGE_LOADING
-#define _FN(o,n,m,rt,a1,a2,a3,s,d,f) {SEXP_OPC_FOREIGN, o, n, m, 0, (sexp)s, d, (sexp)#f, NULL, rt, a1, a2, a3, SEXP_FALSE, (sexp_proc1)f}
+#define _FN(o,n,m,rt,a1,a2,a3,s,d,f) {SEXP_OPC_FOREIGN, o, n, m, 0, (sexp)s, d, (sexp)#f, NULL, rt, a1, a2, a3, NULL, SEXP_FALSE, (sexp_proc1)f}
 #else
 #define _FN(o,n,m,rt,a1,a2,a3,s,d,f) _OP(SEXP_OPC_FOREIGN, o, n, m, rt, a1, a2, a3, 0, s, d, (sexp_proc1)f)
 #endif

sexp.c

@@ -176,7 +176,7 @@ static struct sexp_type_struct _sexp_type_specs[] = {
 #if SEXP_USE_DL
   {SEXP_DL, sexp_offsetof(dl, file), 1, 1, 0, 0, sexp_sizeof(dl), 0, 0, 0, 0, 0, 0, 0, 0, (sexp)"Dynamic-Library", SEXP_FALSE, SEXP_FALSE, NULL, SEXP_FALSE, NULL, SEXP_FINALIZE_DL},
 #endif
-  {SEXP_OPCODE, sexp_offsetof(opcode, name), 8+SEXP_USE_DL, 8+SEXP_USE_DL, 0, 0, sexp_sizeof(opcode), 0, 0, 0, 0, 0, 0, 0, 0, (sexp)"Opcode", SEXP_FALSE, SEXP_FALSE, NULL, SEXP_FALSE, NULL, NULL},
+  {SEXP_OPCODE, sexp_offsetof(opcode, name), 10, 10, 0, 0, sexp_sizeof(opcode), 0, 0, 0, 0, 0, 0, 0, 0, (sexp)"Opcode", SEXP_FALSE, SEXP_FALSE, NULL, SEXP_FALSE, NULL, NULL},
   {SEXP_LAMBDA, sexp_offsetof(lambda, name), 11, 11, 0, 0, sexp_sizeof(lambda), 0, 0, 0, 0, 0, 0, 0, 0, (sexp)"Lambda", SEXP_FALSE, SEXP_FALSE, NULL, SEXP_FALSE, (sexp)sexp_write_simple_object, NULL},
   {SEXP_CND, sexp_offsetof(cnd, test), 4, 4, 0, 0, sexp_sizeof(cnd), 0, 0, 0, 0, 0, 0, 0, 0, (sexp)"Conditional", SEXP_FALSE, SEXP_FALSE, NULL, SEXP_FALSE, (sexp)sexp_write_simple_object, NULL},
   {SEXP_REF, sexp_offsetof(ref, name), 3, 3, 0, 0, sexp_sizeof(ref), 0, 0, 0, 0, 0, 0, 0, 0, (sexp)"Reference", SEXP_FALSE, SEXP_FALSE, NULL, SEXP_FALSE, (sexp)sexp_write_simple_object, NULL},

tests/foreign/typeid.c

@@ -0,0 +1,44 @@
+
+#include "chibi/eval.h"
+
+#define sexp_safe_pointer_tag(x) (sexp_pointerp(x) ? sexp_pointer_tag(x) : -1)
+
+#define CHECK(expr) res = expr; check_exception(res, #expr)
+
+void check_exception (sexp x, const char* expr) {
+  if (sexp_exceptionp(x))
+    fprintf(stderr, "Exception: %s => %s\n", expr,
+            sexp_string_data(sexp_exception_message(x)));
+}
+
+int main (int argc, char **argv) {
+  sexp ctx1, ctx2, res;
+
+  /* Create a context and load two modules with C types. */
+  ctx1 = sexp_make_eval_context(NULL, NULL, NULL, 0, 0);
+  sexp_load_standard_env(ctx1, NULL, SEXP_SEVEN);
+  CHECK(sexp_eval_string(ctx1, "(import (chibi net))", -1, NULL));
+  CHECK(sexp_eval_string(ctx1, "(import (chibi time))", -1, NULL));
+
+  /* Create another context and load the same modules in a different order. */
+  ctx2 = sexp_make_eval_context(NULL, NULL, NULL, 0, 0);
+  sexp_load_standard_env(ctx2, NULL, SEXP_SEVEN);
+  CHECK(sexp_eval_string(ctx2, "(import (chibi time))", -1, NULL));
+  CHECK(sexp_eval_string(ctx2, "(import (chibi net))", -1, NULL));
+
+  /* Both instances of seconds->time should return the same type, */
+  /* but with different tags. */
+  CHECK(sexp_eval_string(ctx1, "(seconds->time 0)", -1, NULL));
+  fprintf(stderr, "ctx1: %p (%d): %s\n", res, sexp_safe_pointer_tag(res),
+          sexp_string_data(sexp_object_type_name(ctx1, res)));
+
+  CHECK(sexp_eval_string(ctx2, "(seconds->time 0)", -1, NULL));
+  fprintf(stderr, "ctx2: %p (%d): %s\n", res, sexp_safe_pointer_tag(res),
+          sexp_string_data(sexp_object_type_name(ctx2, res)));
+
+  /* Cleanup. */
+  sexp_destroy_context(ctx1);
+  sexp_destroy_context(ctx2);
+
+  return 0;
+}

tools/chibi-ffi

@@ -32,6 +32,7 @@
 (define *funcs* '())
 (define *consts* '())
 (define *inits* '())
+(define *tags* '())
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; type objects
@@ -100,6 +101,18 @@
           ((symbol? (car ls)) (lp (cddr ls) res))
           (else (lp (cdr ls) (cons (car ls) res))))))
 
+(define (type-field-type type field)
+  (cond
+   ((assq (type-base (parse-type type)) *types*)
+    => (lambda (x)
+         (let lp ((ls (struct-fields (cdr x))))
+           (cond
+            ((null? ls) #f)
+            ((eq? field (caar ls)) (cadar ls))
+            (else (lp (cdr ls)))))))
+   (else
+    #f)))
+
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; type predicates
 
@@ -266,6 +279,14 @@
         (thunk)
         (current-output-port old-out)))))
 
+(define (warn msg . args)
+  (let ((err (current-error-port)))
+    (display "WARNING: " err)
+    (display msg err)
+    (if (pair? args) (display ":" err))
+    (for-each (lambda (x) (display " " err) (write x err)) args)
+    (newline err)))
+
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; naming
 
@@ -290,7 +311,7 @@
   (string-append "sexp_" (mangle sym) "_stub"))
 
 (define (type-id-name sym)
-  (string-append "sexp_" (mangle sym) "_type_t"))
+  (string-append "sexp_" (mangle sym) "_type_tag"))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; .stub file interface
@@ -327,7 +348,8 @@
            `((,(cadr expr)
               ,@(parse-struct-like (cddr expr)))
              ,@*types*))
-     `(cat "\nstatic sexp " ,(type-id-name (cadr expr)) ";\n"))))
+     (set! *tags* `(,(type-id-name (cadr expr)) ,@*tags*))
+     #f)))
 
 (define-syntax define-c-struct
   (er-macro-transformer
@@ -365,6 +387,75 @@
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; C code generation
 
+(define (type-predicate type)
+  (let ((base (type-base (parse-type type))))
+    (cond
+     ((int-type? base) "sexp_exact_integerp")
+     ((float-type? base) "sexp_flonump")
+     ((string-type? base) "sexp_stringp")
+     ((eq? base 'char) "sexp_charp")
+     ((eq? base 'boolean) "sexp_booleanp")
+     ((eq? base 'port) "sexp_portp")
+     ((eq? base 'input-port) "sexp_iportp")
+     ((eq? base 'output-port) "sexp_oportp")
+     (else #f))))
+
+(define (type-name type)
+  (let ((base (type-base (parse-type type))))
+    (cond
+     ((int-type? base) "integer")
+     ((float-type? base) "flonum")
+     ((eq? 'boolean base) "int")
+     (else base))))
+
+(define (type-id-number type . o)
+  (let ((base (type-base type)))
+    (cond
+     ((int-type? base) "SEXP_FIXNUM")
+     ((float-type? base) "SEXP_FLONUM")
+     ((string-type? base) "SEXP_STRING")
+     ((eq? base 'char) "SEXP_CHAR")
+     ((eq? base 'boolean) "SEXP_BOOLEAN")
+     ((eq? base 'string) "SEXP_STRING")
+     ((eq? base 'symbol) "SEXP_SYMBOL")
+     ((eq? base 'pair) "SEXP_PAIR")
+     ((eq? base 'port) "SEXP_IPORT")
+     ((eq? base 'input-port) "SEXP_IPORT")
+     ((eq? base 'output-port) "SEXP_OPORT")
+     ((void-pointer-type? type) "SEXP_CPOINTER")
+     ((assq base *types*)
+      ;; (string-append "sexp_type_tag(" (type-id-name base) ")")
+      (let ((i (type-index type)))
+        (cond
+         ((not i)
+          ;;(warn "type-id-number on unknown arg" type)
+          (if (and (pair? o) (car o))
+              "sexp_unbox_fixnum(sexp_opcode_return_type(self))"
+              (string-append "sexp_type_tag(" (type-id-name base) ")")))
+         ((< i 3)
+          (string-append
+           "sexp_unbox_fixnum(sexp_opcode_arg"
+           (number->string (+ i 1)) "_type(self))"))
+         (else
+          (string-append
+           "sexp_unbox_fixnum(sexp_vector_ref(sexp_opcode_argn_type(self), "
+           (number->string (- i 3)) "))")))))
+     (else "SEXP_OBJECT"))))
+
+(define (type-id-value type . o)
+  (cond
+   ((eq? 'void (type-base type))
+    "SEXP_VOID")
+   (else
+    (string-append "sexp_make_fixnum(" (apply type-id-number type o) ")"))))
+
+(define (type-id-init-value type)
+  (cond
+   ((assq (type-base type) *types*)
+    (string-append "sexp_make_fixnum(sexp_type_tag(" (type-id-name (type-base type)) "))"))
+   (else
+    (type-id-value type))))
+
 (define (c->scheme-converter type val . o)
   (let ((base (type-base type)))
     (cond
@@ -404,7 +495,8 @@
           (cat "sexp_make_cpointer(ctx, "
                (if void*?
                    "SEXP_CPOINTER"
-                   (string-append "sexp_type_tag(" (type-id-name base) ")"))
+                   ;;(string-append "sexp_type_tag(" (type-id-name base) ")")
+                   (type-id-number type #t))
                ", "
                val ", " (or (and (pair? o) (car o)) "SEXP_FALSE") ", "
                (if (or (type-free? type)
@@ -455,27 +547,6 @@
          (else
           (error "unknown type" base))))))))
 
-(define (type-predicate type)
-  (let ((base (type-base (parse-type type))))
-    (cond
-     ((int-type? base) "sexp_exact_integerp")
-     ((float-type? base) "sexp_flonump")
-     ((string-type? base) "sexp_stringp")
-     ((eq? base 'char) "sexp_charp")
-     ((eq? base 'boolean) "sexp_booleanp")
-     ((eq? base 'port) "sexp_portp")
-     ((eq? base 'input-port) "sexp_iportp")
-     ((eq? base 'output-port) "sexp_oportp")
-     (else #f))))
-
-(define (type-name type)
-  (let ((base (type-base (parse-type type))))
-   (cond
-    ((int-type? base) "integer")
-    ((float-type? base) "flonum")
-    ((eq? 'boolean base) "int")
-    (else base))))
-
 (define (base-type-c-name base)
   (case base
     ((string env-string non-null-string) "char*")
@@ -515,29 +586,13 @@
        " && (sexp_pointer_tag(" arg  ") == "
        (if (void-pointer-type? type)
            "SEXP_CPOINTER"
-           (string-append "sexp_type_tag(" (type-id-name base) ")"))
+           (type-id-number type))
        "))"
        (lambda () (if (type-null? type) (cat " || sexp_not(" arg "))")))))
      (else
-      (display "WARNING: don't know how to check: " (current-error-port))
+      (warn "don't know how to check" type)
-      (write type (current-error-port))
-      (newline (current-error-port))
       (cat "1")))))
 
-(define (type-id-number type)
-  (let ((base (type-base type)))
-    (cond
-     ((int-type? base) "SEXP_FIXNUM")
-     ((float-type? base) "SEXP_FLONUM")
-     ((string-type? base) "SEXP_STRING")
-     ((eq? base 'char) "SEXP_CHAR")
-     ((eq? base 'boolean) "SEXP_BOOLEAN")
-     ((eq? base 'port) "SEXP_IPORT")
-     ((eq? base 'input-port) "SEXP_IPORT")
-     ((eq? base 'output-port) "SEXP_OPORT")
-     ((void-pointer-type? type) "SEXP_CPOINTER")
-     (else (string-append "sexp_type_tag(" (type-id-name base) ")")))))
-
 (define (write-validator arg type)
   (let* ((type (parse-type type))
          (array (type-array type))
@@ -577,9 +632,7 @@
      ((string-type? type)
       (write-validator arg 'string))
      (else
-      (display "WARNING: don't know how to validate: " (current-error-port))
+      (warn "don't know how to validate" type)))))
-      (write type (current-error-port))
-      (newline (current-error-port))))))
 
 (define (write-parameters args)
   (lambda () (for-each (lambda (a) (cat ", sexp arg" (type-index a))) args)))
@@ -982,6 +1035,8 @@
         (cat "\"current-output-port\""))
        ((equal? value '(current-error-port))
         (cat "\"current-error-port\""))
+       ((equal? value 'NULL)
+        (cat "SEXP_FALSE"))
        (else
         (c->scheme-converter x value))))))
 
@@ -989,7 +1044,8 @@
   (let ((default (and (pair? (func-scheme-args func))
                       (type-default? (car (reverse (func-scheme-args func))))
                       (car (reverse (func-scheme-args func))))))
-    (cat (if default
+    (cat "  op = "
+         (if default
              (if (parameter-default? (type-value default))
                  "sexp_define_foreign_param(ctx, env, "
                  "sexp_define_foreign_opt(ctx, env, ")
@@ -1000,7 +1056,36 @@
          (func-stub-name func)
          (if default ", " "")
          (if default (write-default default) "")
-         ");\n")))
+         ");\n"
+         (cond
+          ((and (pair? (func-c-args func))
+                (any (lambda (a) (not (eq? 'sexp (type-base a))))
+                     (func-c-args func)))
+           (lambda ()
+             (cat
+              "  if (sexp_opcodep(op)) {\n"
+              "    sexp_opcode_return_type(op) = "
+              (type-id-init-value (func-ret-type func)) ";\n"
+              (lambda ()
+                (do ((ls (func-c-args func) (cdr ls))
+                     (i 1 (+ i 1)))
+                    ((null? ls))
+                  (cond
+                   ((<= i 3)
+                    (cat "    sexp_opcode_arg" i "_type(op) = "
+                         (type-id-init-value (car ls)) ";\n"))
+                   (else
+                    (if (= i 4)
+                        (cat "    sexp_opcode_argn_type(op) = "
+                             "sexp_make_vector(ctx, sexp_make_fixnum("
+                             (- i 3) "),"
+                             " sexp_make_fixnum(SEXP_OBJECT));\n"))
+                    (cat "    sexp_vector_set(sexp_opcode_argn_type(op), "
+                         "sexp_make_fixnum(" (- i 4) "), "
+                         (type-id-init-value (car ls)) ");\n")))))
+              "  }\n")))
+          (else
+           "")))))
 
 (define (write-type type)
   (let ((name (car type))
@@ -1029,7 +1114,7 @@
 (define (write-type-getter type name field)
   (cat "static sexp " (type-getter-name type name field)
        " (sexp ctx, sexp self, sexp_sint_t n, sexp x) {\n"
-       (lambda () (write-validator "x" name))
+       (lambda () (write-validator "x" (parse-type name 0)))
        "  return "
        (lambda ()
          (c->scheme-converter
@@ -1075,8 +1160,8 @@
 (define (write-type-setter type name field)
   (cat "static sexp " (type-setter-name type name field)
        " (sexp ctx, sexp self, sexp_sint_t n, sexp x, sexp v) {\n"
-       (lambda () (write-validator "x" name))
+       (lambda () (write-validator "x" (parse-type name 0)))
-       (lambda () (write-validator "v" (car field)))
+       (lambda () (write-validator "v" (parse-type (car field) 1)))
        (write-type-setter-assignment
         type name field
         (string-append "((" (x->string (or (type-struct-type name) ""))
@@ -1113,16 +1198,22 @@
                              (cat ", sexp arg" i)
                              (lp (cdr ls) (+ i 1))))))
                   ") {\n"
-                  "  " (or (type-struct-type name) "") " " (type-name name) " *r;\n"
+                  "  " (or (type-struct-type name) "")
+                  " " (type-name name) " *r;\n"
                   "  sexp_gc_var1(res);\n"
                   "  sexp_gc_preserve1(ctx, res);\n"
-                  ;; "  res = sexp_alloc_tagged(ctx, sexp_sizeof(cpointer) + sizeof(struct " (type-name name) "), "
+                  ;; TODO: support heap-managed allocations
+                  ;; "  res = sexp_alloc_tagged(ctx, sexp_sizeof(cpointer)"
+                  ;; " + sizeof(struct " (type-name name) "), "
                   ;; (type-id-name name)
                   ;; ");\n"
-                  ;; "  r = sexp_cpointer_value(res) = sexp_cpointer_body(res);\n"
+                  ;; "  r = sexp_cpointer_value(res) = "
-                  "  res = sexp_alloc_tagged(ctx, sexp_sizeof(cpointer), sexp_type_tag("
+                  ;; "sexp_cpointer_body(res);\n"
-                  (type-id-name name)
+                  ;; "  res = sexp_alloc_tagged(ctx, sexp_sizeof(cpointer), sexp_type_tag("
-                  "));\n"
+                  ;; (type-id-name name)
+                  ;; "));\n"
+                  "  res = sexp_alloc_tagged(ctx, sexp_sizeof(cpointer), "
+                  "sexp_unbox_fixnum(sexp_opcode_return_type(self)));\n"
                   "  r = sexp_cpointer_value(res) = calloc(1, sizeof("
                   (or (type-struct-type name) "") " " (type-name name) "));\n"
                   "  memset(r, 0, sizeof("
@@ -1149,7 +1240,16 @@
                   "  return res;\n"
                   "}\n\n")
              (set! *funcs*
-                   (cons (parse-func `(void ,make ,args)) *funcs*))))))
+                   (cons (parse-func
+                          `(,name ,make
+                                  ,(map (lambda (a)
+                                          (cond
+                                           ((find (lambda (x) (eq? a (cadr x)))
+                                                  (struct-fields type))
+                                            => car)
+                                           (else 'sexp)))
+                                        args)))
+                         *funcs*))))))
     ;; write field accessors
     (for-each
      (lambda (field)
@@ -1213,16 +1313,20 @@
   (for-each write-func *funcs*)
   (for-each write-type-funcs *types*)
   (cat "sexp sexp_init_library (sexp ctx, sexp self, sexp_sint_t n, sexp env, const char* version, sexp_abi_identifier_t abi) {\n"
-       "  sexp_gc_var2(name, tmp);\n"
+       (lambda ()
+         (for-each
+          (lambda (t) (cat "  sexp " t ";\n"))
+          *tags*))
+       "  sexp_gc_var3(name, tmp, op);\n"
        "  if (!(sexp_version_compatible(ctx, version, sexp_version)\n"
        "        && sexp_abi_compatible(ctx, abi, SEXP_ABI_IDENTIFIER)))\n"
-       "    return sexp_global(ctx, SEXP_G_ABI_ERROR);"
+       "    return sexp_global(ctx, SEXP_G_ABI_ERROR);\n"
-       "  sexp_gc_preserve2(ctx, name, tmp);\n")
+       "  sexp_gc_preserve3(ctx, name, tmp, op);\n")
   (for-each write-const *consts*)
   (for-each write-type *types*)
   (for-each write-func-binding *funcs*)
   (for-each (lambda (x) (cat "  " x "\n")) (reverse *inits*))
-  (cat "  sexp_gc_release2(ctx);\n"
+  (cat "  sexp_gc_release3(ctx);\n"
        "  return SEXP_VOID;\n"
        "}\n\n"))