de-nargs struct scm_objcode; procedure-property refactor

* libguile/objcodes.h (struct scm_objcode): Remove nargs, nrest, and
  nlocs, as they are no longer needed. Also obviates the need for a
  padding word.

* libguile/procs.c (scm_thunk_p): Use scm_i_program_arity for programs.

* libguile/procprop.c (scm_i_procedure_arity): Use scm_i_program_arity
  for programs.
  (scm_procedure_properties, scm_set_procedure_properties_x)
  (scm_procedure_property, scm_set_procedure_property_x): Rework so that
  non-closure properties are stored directly in a weak hash, instead of
  needing a weak hash of "stand-in" closures to hold the properties. Fix
  docstrings also.

* libguile/root.h (scm_stand_in_procs): Remove from the scm_sys_protects
  set. Actually with libGC, we should be able to store the elements of
  scm_sys_protects directly as global variables.
* libguile/gc.c (scm_init_storage): Remove scm_stand_in_procs
  initialization.

* libguile/programs.c (scm_i_program_arity): New private accessor, tries
  to determine the "minimum arity" of a program.

* libguile/vm.c (really_make_boot_program): Adapt to changes in
  struct scm_objcode.

* module/language/assembly.scm (*program-header-len*, byte-length):
* module/language/assembly/compile-bytecode.scm (write-bytecode):
* module/language/assembly/decompile-bytecode.scm (decode-load-program):
* module/language/assembly/disassemble.scm (disassemble-load-program):
  Adapt to changes in objcode.

* module/system/xref.scm (program-callee-rev-vars): Adapt to changes in
  assembly.

* module/language/glil.scm: Remove nargs, nrest, and nlocs from
  glil-program.

* module/language/glil/compile-assembly.scm (make-meta, glil->assembly):
* module/language/glil/decompile-assembly.scm (decompile-toplevel):
  (decompile-load-program): Adapt to changes in GLIL and assembly.

* module/language/tree-il/compile-glil.scm (flatten-lambda): Adapt to
  changes in GLIL.

* test-suite/tests/asm-to-bytecode.test: Adapt to assembly and bytecode
  changes.
* test-suite/tests/tree-il.test: Adapt to GLIL changes.

21 files changed, 210 insertions, 205 deletions

diff --git a/libguile/_scm.h b/libguile/_scm.h
index f506f55b8..53b698e98 100644
--- a/libguile/_scm.h
+++ b/libguile/_scm.h
@@ -172,7 +172,7 @@
 
 /* Major and minor versions must be single characters. */
 #define SCM_OBJCODE_MAJOR_VERSION 0
-#define SCM_OBJCODE_MINOR_VERSION G
+#define SCM_OBJCODE_MINOR_VERSION H
 #define SCM_OBJCODE_MAJOR_VERSION_STRING        \
   SCM_CPP_STRINGIFY(SCM_OBJCODE_MAJOR_VERSION)
 #define SCM_OBJCODE_MINOR_VERSION_STRING        \
diff --git a/libguile/gc.c b/libguile/gc.c
index 7c508affd..9c56d0412 100644
--- a/libguile/gc.c
+++ b/libguile/gc.c
@@ -680,7 +680,6 @@ scm_init_storage ()
 
 #endif
 
-  scm_stand_in_procs = scm_make_weak_key_hash_table (scm_from_int (257));
   scm_protects = scm_c_make_hash_table (31);
 
   return 0;
diff --git a/libguile/objcodes.h b/libguile/objcodes.h
index 2bb4e6040..ab4db3dab 100644
--- a/libguile/objcodes.h
+++ b/libguile/objcodes.h
@@ -23,13 +23,9 @@
 
 /* objcode data should be directly mappable to this C structure. */
 struct scm_objcode {
-  scm_t_uint8 nargs;
-  scm_t_uint8 nrest;
-  scm_t_uint16 nlocs;
   scm_t_uint32 len;             /* the maximum index of base[] */
   scm_t_uint32 metalen;         /* well, i lie. this many bytes at the end of
                                    base[] for metadata */
-  scm_t_uint32 unused;          /* pad so that `base' is 8-byte aligned */
   scm_t_uint8 base[0];
 };
 
@@ -46,9 +42,6 @@ SCM_API scm_t_bits scm_tc16_objcode;
 #define SCM_OBJCODE_LEN(x)	(SCM_OBJCODE_DATA (x)->len)
 #define SCM_OBJCODE_META_LEN(x)	(SCM_OBJCODE_DATA (x)->metalen)
 #define SCM_OBJCODE_TOTAL_LEN(x) (SCM_OBJCODE_LEN (x) + SCM_OBJCODE_META_LEN (x))
-#define SCM_OBJCODE_NARGS(x)	(SCM_OBJCODE_DATA (x)->nargs)
-#define SCM_OBJCODE_NREST(x)	(SCM_OBJCODE_DATA (x)->nrest)
-#define SCM_OBJCODE_NLOCS(x)	(SCM_OBJCODE_DATA (x)->nlocs)
 #define SCM_OBJCODE_BASE(x)	(SCM_OBJCODE_DATA (x)->base)
 
 #define SCM_OBJCODE_IS_MMAP(x)	(SCM_SMOB_FLAGS (x) & SCM_F_OBJCODE_IS_MMAP)
diff --git a/libguile/procprop.c b/libguile/procprop.c
index 5054291b1..4f18dff75 100644
--- a/libguile/procprop.c
+++ b/libguile/procprop.c
@@ -42,6 +42,9 @@
 SCM_GLOBAL_SYMBOL (scm_sym_system_procedure, "system-procedure");
 SCM_GLOBAL_SYMBOL (scm_sym_arity, "arity");
 
+static SCM non_closure_props;
+static scm_i_pthread_mutex_t non_closure_props_lock = SCM_I_PTHREAD_MUTEX_INITIALIZER;
+
 SCM
 scm_i_procedure_arity (SCM proc)
 {
@@ -74,10 +77,10 @@ scm_i_procedure_arity (SCM proc)
       r = 1;
       break;
     case scm_tc7_program:
-      a += SCM_PROGRAM_DATA (proc)->nargs;
-      r = SCM_PROGRAM_DATA (proc)->nrest;
-      a -= r;
-      break;
+      if (scm_i_program_arity (proc, &a, &o, &r))
+        break;
+      else
+        return SCM_BOOL_F;
     case scm_tc7_lsubr_2:
       a += 2;
       r = 1;
@@ -137,92 +140,77 @@ scm_i_procedure_arity (SCM proc)
   return scm_list_3 (scm_from_int (a), scm_from_int (o), scm_from_bool(r));
 }
 
-/* XXX - instead of using a stand-in value for everything except
-   closures, we should find other ways to store the procedure
-   properties for those other kinds of procedures.  For example, subrs
-   have their own property slot, which is unused at present.
-*/
-
-static SCM
-scm_stand_in_scm_proc(SCM proc)
-{
-  SCM handle, answer;
-  handle = scm_hashq_get_handle (scm_stand_in_procs, proc);
-  if (scm_is_false (handle))
-    {
-      answer = scm_closure (scm_list_2 (SCM_EOL, SCM_BOOL_F), SCM_EOL);
-      scm_hashq_set_x (scm_stand_in_procs, proc, answer);
-    }
-  else
-    answer = SCM_CDR (handle);
-  return answer;
-}
+/* FIXME: instead of the weak hash, perhaps for some kinds of procedures, use
+   other means; for example subrs have their own property slot, which is unused
+   at present. */
 
 SCM_DEFINE (scm_procedure_properties, "procedure-properties", 1, 0, 0, 
            (SCM proc),
 	    "Return @var{obj}'s property list.")
 #define FUNC_NAME s_scm_procedure_properties
 {
+  SCM props;
+  
   SCM_VALIDATE_PROC (1, proc);
-  return scm_acons (scm_sym_arity, scm_i_procedure_arity (proc),
-		    SCM_PROCPROPS (SCM_CLOSUREP (proc)
-				   ? proc
-				   : scm_stand_in_scm_proc (proc)));
+  if (SCM_CLOSUREP (proc))
+    props = SCM_PROCPROPS (proc);
+  else
+    {
+      scm_i_pthread_mutex_lock (&non_closure_props_lock);
+      props = scm_hashq_ref (non_closure_props, proc, SCM_EOL);
+      scm_i_pthread_mutex_unlock (&non_closure_props_lock);
+    }
+  return scm_acons (scm_sym_arity, scm_i_procedure_arity (proc), props);
 }
 #undef FUNC_NAME
 
 SCM_DEFINE (scm_set_procedure_properties_x, "set-procedure-properties!", 2, 0, 0,
-           (SCM proc, SCM new_val),
-	    "Set @var{obj}'s property list to @var{alist}.")
+           (SCM proc, SCM alist),
+	    "Set @var{proc}'s property list to @var{alist}.")
 #define FUNC_NAME s_scm_set_procedure_properties_x
 {
-  if (!SCM_CLOSUREP (proc))
-    proc = scm_stand_in_scm_proc(proc);
-  SCM_VALIDATE_CLOSURE (1, proc);
-  SCM_SETPROCPROPS (proc, new_val);
+  SCM_VALIDATE_PROC (1, proc);
+
+  if (SCM_CLOSUREP (proc))
+    SCM_SETPROCPROPS (proc, alist);
+  else
+    {
+      scm_i_pthread_mutex_lock (&non_closure_props_lock);
+      scm_hashq_set_x (non_closure_props, proc, alist);
+      scm_i_pthread_mutex_unlock (&non_closure_props_lock);
+    }
   return SCM_UNSPECIFIED;
 }
 #undef FUNC_NAME
 
 SCM_DEFINE (scm_procedure_property, "procedure-property", 2, 0, 0,
-           (SCM p, SCM k),
-	    "Return the property of @var{obj} with name @var{key}.")
+           (SCM proc, SCM key),
+	    "Return the property of @var{proc} with name @var{key}.")
 #define FUNC_NAME s_scm_procedure_property
 {
-  SCM assoc;
-  if (scm_is_eq (k, scm_sym_arity))
-    {
-      SCM arity;
-      SCM_ASSERT (scm_is_true (arity = scm_i_procedure_arity (p)),
-		  p, SCM_ARG1, FUNC_NAME);
-      return arity;
-    }
-  SCM_VALIDATE_PROC (1, p);
-  assoc = scm_sloppy_assq (k,
-			   SCM_PROCPROPS (SCM_CLOSUREP (p)
-					  ? p
-					  : scm_stand_in_scm_proc (p)));
-  return (SCM_NIMP (assoc) ? SCM_CDR (assoc) : SCM_BOOL_F);
+  SCM_VALIDATE_PROC (1, proc);
+
+  if (scm_is_eq (key, scm_sym_arity))
+    /* avoid a cons in this case */
+    return scm_i_procedure_arity (proc);
+  else
+    return scm_assq_ref (scm_procedure_properties (proc), key);
 }
 #undef FUNC_NAME
 
 SCM_DEFINE (scm_set_procedure_property_x, "set-procedure-property!", 3, 0, 0,
-           (SCM p, SCM k, SCM v),
-	    "In @var{obj}'s property list, set the property named @var{key} to\n"
-	    "@var{value}.")
+           (SCM proc, SCM key, SCM val),
+	    "In @var{proc}'s property list, set the property named @var{key} to\n"
+	    "@var{val}.")
 #define FUNC_NAME s_scm_set_procedure_property_x
 {
-  SCM assoc;
-  if (!SCM_CLOSUREP (p))
-    p = scm_stand_in_scm_proc(p);
-  SCM_VALIDATE_CLOSURE (1, p);
-  if (scm_is_eq (k, scm_sym_arity))
+  SCM_VALIDATE_PROC (1, proc);
+
+  if (scm_is_eq (key, scm_sym_arity))
     SCM_MISC_ERROR ("arity is a read-only property", SCM_EOL);
-  assoc = scm_sloppy_assq (k, SCM_PROCPROPS (p));
-  if (SCM_NIMP (assoc))
-    SCM_SETCDR (assoc, v);
-  else
-    SCM_SETPROCPROPS (p, scm_acons (k, v, SCM_PROCPROPS (p)));
+  scm_set_procedure_properties_x
+    (proc,
+     scm_assq_set_x (scm_procedure_properties (proc), key, val));
   return SCM_UNSPECIFIED;
 }
 #undef FUNC_NAME
@@ -233,6 +221,7 @@ SCM_DEFINE (scm_set_procedure_property_x, "set-procedure-property!", 3, 0, 0,
 void
 scm_init_procprop ()
 {
+  non_closure_props = scm_make_doubly_weak_hash_table (SCM_UNDEFINED);
 #include "libguile/procprop.x"
 }
 
diff --git a/libguile/procprop.h b/libguile/procprop.h
index 04cd38442..7a1131489 100644
--- a/libguile/procprop.h
+++ b/libguile/procprop.h
@@ -3,7 +3,7 @@
 #ifndef SCM_PROCPROP_H
 #define SCM_PROCPROP_H
 
-/* Copyright (C) 1995,1996,1998,2000, 2006, 2008 Free Software Foundation, Inc.
+/* Copyright (C) 1995,1996,1998,2000, 2006, 2008, 2009 Free Software Foundation, Inc.
  *
  * This library is free software; you can redistribute it and/or
  * modify it under the terms of the GNU Lesser General Public License
@@ -35,9 +35,9 @@ SCM_API SCM scm_sym_system_procedure;
 
 SCM_INTERNAL SCM scm_i_procedure_arity (SCM proc);
 SCM_API SCM scm_procedure_properties (SCM proc);
-SCM_API SCM scm_set_procedure_properties_x (SCM proc, SCM new_val);
-SCM_API SCM scm_procedure_property (SCM p, SCM k);
-SCM_API SCM scm_set_procedure_property_x (SCM p, SCM k, SCM v);
+SCM_API SCM scm_set_procedure_properties_x (SCM proc, SCM alist);
+SCM_API SCM scm_procedure_property (SCM proc, SCM key);
+SCM_API SCM scm_set_procedure_property_x (SCM proc, SCM key, SCM val);
 SCM_INTERNAL void scm_init_procprop (void);
 
 #endif  /* SCM_PROCPROP_H */
diff --git a/libguile/procs.c b/libguile/procs.c
index 40d6231bb..5de2f33f1 100644
--- a/libguile/procs.c
+++ b/libguile/procs.c
@@ -144,16 +144,18 @@ SCM_DEFINE (scm_thunk_p, "thunk?", 1, 0, 0,
 	case scm_tc7_gsubr:
 	  return scm_from_bool (SCM_GSUBR_REQ (SCM_GSUBR_TYPE (obj)) == 0);
 	case scm_tc7_program:
-	  return scm_from_bool (SCM_PROGRAM_DATA (obj)->nargs == 0
-                                || (SCM_PROGRAM_DATA (obj)->nargs == 1
-                                    && SCM_PROGRAM_DATA (obj)->nrest));
+          {
+            int a, o, r;
+            if (scm_i_program_arity (obj, &a, &o, &r))
+              return scm_from_bool (a == 0);
+            else
+              return SCM_BOOL_F;
+          }
 	case scm_tc7_pws:
 	  obj = SCM_PROCEDURE (obj);
 	  goto again;
 	default:
-          if (SCM_PROGRAM_P (obj) && SCM_PROGRAM_DATA (obj)->nargs == 0)
-            return SCM_BOOL_T;
-          /* otherwise fall through */
+          return SCM_BOOL_F;
 	}
     }
   return SCM_BOOL_F;
diff --git a/libguile/programs.c b/libguile/programs.c
index 773dc991a..61a0f11e7 100644
--- a/libguile/programs.c
+++ b/libguile/programs.c
@@ -282,11 +282,51 @@ SCM_DEFINE (scm_program_objcode, "program-objcode", 1, 0, 0,
 }
 #undef FUNC_NAME
 
+/* This one is a shim to pre-case-lambda internal interfaces. Avoid it if you
+   can -- use program-arguments or the like. */
+static SCM sym_arglist;
+int
+scm_i_program_arity (SCM program, int *req, int *opt, int *rest)
+{
+  SCM arities, x;
+  
+  arities = scm_program_arities (program);
+  if (!scm_is_pair (arities))
+    return 0;
+  /* take the last arglist, it will be least specific */
+  while (scm_is_pair (scm_cdr (arities)))
+    arities = scm_cdr (arities);
+  x = scm_cdar (arities);
+  if (scm_is_pair (x))
+    {
+      *req = scm_to_int (scm_car (x));
+      x = scm_cdr (x);
+      if (scm_is_pair (x))
+        {
+          *opt = scm_to_int (scm_car (x));
+          x = scm_cdr (x);
+          if (scm_is_pair (x))
+            *rest = scm_is_true (scm_car (x));
+          else
+            *rest = 0;
+        }
+      else
+        *opt = *rest = 0;
+    }
+  else
+    *req = *opt = *rest = 0;
+          
+  return 1;
+}
 
 
+
 void
 scm_bootstrap_programs (void)
 {
+  /* arglist can't be snarfed, because snarfage is only loaded when (system vm
+     program) is loaded. perhaps static-alloc will fix this. */
+  sym_arglist = scm_from_locale_symbol ("arglist");
   scm_c_register_extension ("libguile", "scm_init_programs",
                             (scm_t_extension_init_func)scm_init_programs, NULL);
 }
diff --git a/libguile/programs.h b/libguile/programs.h
index b114ad942..836f1ff0d 100644
--- a/libguile/programs.h
+++ b/libguile/programs.h
@@ -54,6 +54,7 @@ SCM_API SCM scm_program_objcode (SCM program);
 
 SCM_API SCM scm_c_program_source (SCM program, size_t ip);
 
+SCM_INTERNAL int scm_i_program_arity (SCM program, int *req, int *opt, int *rest);
 SCM_INTERNAL void scm_i_program_print (SCM program, SCM port,
                                        scm_print_state *pstate);
 SCM_INTERNAL void scm_bootstrap_programs (void);
diff --git a/libguile/root.h b/libguile/root.h
index 676a7b44c..46b9be013 100644
--- a/libguile/root.h
+++ b/libguile/root.h
@@ -3,7 +3,7 @@
 #ifndef SCM_ROOT_H
 #define SCM_ROOT_H
 
-/* Copyright (C) 1996,1998,2000,2001, 2002, 2006, 2008 Free Software Foundation, Inc.
+/* Copyright (C) 1996,1998,2000,2001, 2002, 2006, 2008, 2009 Free Software Foundation, Inc.
  *
  * This library is free software; you can redistribute it and/or
  * modify it under the terms of the GNU Lesser General Public License
@@ -34,13 +34,12 @@
 #define scm_nullvect scm_sys_protects[2]
 #define scm_nullstr scm_sys_protects[3]
 #define scm_keyword_obarray scm_sys_protects[4]
-#define scm_stand_in_procs scm_sys_protects[5]
-#define scm_object_whash scm_sys_protects[6]
-#define scm_asyncs scm_sys_protects[7]
-#define scm_protects scm_sys_protects[8]
-#define scm_properties_whash scm_sys_protects[9]
-#define scm_source_whash scm_sys_protects[10]
-#define SCM_NUM_PROTECTS 11
+#define scm_object_whash scm_sys_protects[5]
+#define scm_asyncs scm_sys_protects[6]
+#define scm_protects scm_sys_protects[7]
+#define scm_properties_whash scm_sys_protects[8]
+#define scm_source_whash scm_sys_protects[9]
+#define SCM_NUM_PROTECTS 10
 
 SCM_API SCM scm_sys_protects[];
 
diff --git a/libguile/vm.c b/libguile/vm.c
index cd730511f..df02f0595 100644
--- a/libguile/vm.c
+++ b/libguile/vm.c
@@ -191,12 +191,8 @@ really_make_boot_program (long nargs)
 
   bp = scm_malloc (sizeof (struct scm_objcode) + sizeof (text));
   memcpy (bp->base, text, sizeof (text));
-  bp->nargs = 0;
-  bp->nrest = 0;
-  bp->nlocs = 0;
   bp->len = sizeof(text);
   bp->metalen = 0;
-  bp->unused = 0;
 
   u8vec = scm_take_u8vector ((scm_t_uint8*)bp,
                              sizeof (struct scm_objcode) + sizeof (text));
diff --git a/module/language/assembly.scm b/module/language/assembly.scm
index 2b22fd834..a7c47492e 100644
--- a/module/language/assembly.scm
+++ b/module/language/assembly.scm
@@ -28,8 +28,8 @@
             assembly-pack assembly-unpack
             object->assembly assembly->object))
 
-;; nargs, nrest, nlocs, len, metalen, padding
-(define *program-header-len* (+ 1 1 2 4 4 4))
+;; len, metalen
+(define *program-header-len* (+ 4 4))
 
 ;; lengths are encoded in 3 bytes
 (define *len-len* 3)
@@ -49,7 +49,7 @@
      (+ 1 *len-len* (string-length str)))
     ((load-array ,bv)
      (+ 1 *len-len* (bytevector-length bv)))
-    ((load-program ,nargs ,nrest ,nlocs ,labels ,len ,meta . ,code)
+    ((load-program ,labels ,len ,meta . ,code)
      (+ 1 *program-header-len* len (if meta (1- (byte-length meta)) 0)))
     ((,inst . _) (guard (>= (instruction-length inst) 0))
      (+ 1 (instruction-length inst)))
diff --git a/module/language/assembly/compile-bytecode.scm b/module/language/assembly/compile-bytecode.scm
index 5a8098112..d92821cc9 100644
--- a/module/language/assembly/compile-bytecode.scm
+++ b/module/language/assembly/compile-bytecode.scm
@@ -104,13 +104,9 @@
           (len (instruction-length inst)))
       (write-byte opcode)
       (pmatch asm
-        ((load-program ,nargs ,nrest ,nlocs ,labels ,length ,meta . ,code)
-         (write-byte nargs)
-         (write-byte nrest)
-         (write-uint16 nlocs)
+        ((load-program ,labels ,length ,meta . ,code)
          (write-uint32 length)
          (write-uint32 (if meta (1- (byte-length meta)) 0))
-         (write-uint32 0) ; padding
          (letrec ((i 0)
                   (write (lambda (x) (set! i (1+ i)) (write-byte x)))
                   (get-addr (lambda () i)))
diff --git a/module/language/assembly/decompile-bytecode.scm b/module/language/assembly/decompile-bytecode.scm
index 559abeab7..6c929cb33 100644
--- a/module/language/assembly/decompile-bytecode.scm
+++ b/module/language/assembly/decompile-bytecode.scm
@@ -51,13 +51,10 @@
 
 ;; FIXME: this is a little-endian disassembly!!!
 (define (decode-load-program pop)
-  (let* ((nargs (pop)) (nrest (pop)) (nlocs0 (pop)) (nlocs1 (pop))
-         (nlocs (+ nlocs0 (ash nlocs1 8)))
-         (a (pop)) (b (pop)) (c (pop)) (d (pop))
+  (let* ((a (pop)) (b (pop)) (c (pop)) (d (pop))
          (e (pop)) (f (pop)) (g (pop)) (h (pop))
          (len (+ a (ash b 8) (ash c 16) (ash d 24)))
          (metalen (+ e (ash f 8) (ash g 16) (ash h 24)))
-         (%unused-pad (begin (pop) (pop) (pop) (pop)))
          (labels '())
          (i 0))
     (define (ensure-label rel1 rel2 rel3)
@@ -77,8 +74,7 @@
       (cond ((> i len)
              (error "error decoding program -- read too many bytes" out))
             ((= i len)
-             `(load-program ,nargs ,nrest ,nlocs 
-                            ,(map (lambda (x) (cons (cdr x) (car x)))
+             `(load-program ,(map (lambda (x) (cons (cdr x) (car x)))
                                   (reverse labels))
                             ,len
                             ,(if (zero? metalen) #f (decode-load-program pop))
diff --git a/module/language/assembly/disassemble.scm b/module/language/assembly/disassemble.scm
index c7b9df96d..ae2d32787 100644
--- a/module/language/assembly/disassemble.scm
+++ b/module/language/assembly/disassemble.scm
@@ -35,7 +35,7 @@
 
 (define (disassemble-load-program asm env)
   (pmatch asm
-    ((load-program ,nargs ,nrest ,nlocs ,labels ,len ,meta . ,code)
+    ((load-program ,labels ,len ,meta . ,code)
      (let ((objs  (and env (assq-ref env 'objects)))
            (free-vars (and env (assq-ref env 'free-vars)))
            (meta  (and env (assq-ref env 'meta)))
@@ -64,7 +64,9 @@
                 (lp (+ pos (byte-length asm)) (cdr code) programs))
                (else
                 (print-info pos asm
-                            (code-annotation end asm objs nargs blocs
+                            ;; FIXME: code-annotation for whether it's
+                            ;; an arg or not, currently passing nargs=-1
+                            (code-annotation end asm objs -1 blocs
                                              labels)
                             (and=> (and srcs (assq end srcs)) source->string))
                 (lp (+ pos (byte-length asm)) (cdr code) programs)))))))
diff --git a/module/language/glil.scm b/module/language/glil.scm
index 7f326efc1..7e8d73d94 100644
--- a/module/language/glil.scm
+++ b/module/language/glil.scm
@@ -24,7 +24,6 @@
   #:use-module ((srfi srfi-1) #:select (fold))
   #:export
   (<glil-program> make-glil-program glil-program?
-   glil-program-nargs glil-program-nrest glil-program-nlocs
    glil-program-meta glil-program-body
    
    <glil-arity> make-glil-arity glil-arity?
@@ -74,7 +73,7 @@
 
 (define-type (<glil> #:printer print-glil)
   ;; Meta operations
-  (<glil-program> nargs nrest nlocs meta body)
+  (<glil-program> meta body)
   (<glil-arity> nargs nrest label)
   (<glil-bind> vars)
   (<glil-mv-bind> vars rest)
@@ -97,8 +96,8 @@
 
 (define (parse-glil x)
   (pmatch x
-    ((program ,nargs ,nrest ,nlocs ,meta . ,body)
-     (make-glil-program nargs nrest nlocs meta (map parse-glil body)))
+    ((program ,meta . ,body)
+     (make-glil-program meta (map parse-glil body)))
     ((arity ,nargs ,nrest ,label) (make-glil-arity nargs nrest label))
     ((bind . ,vars) (make-glil-bind vars))
     ((mv-bind ,vars ,rest) (make-glil-mv-bind vars rest))
@@ -119,8 +118,8 @@
 (define (unparse-glil glil)
   (record-case glil
     ;; meta
-    ((<glil-program> nargs nrest nlocs meta body)
-     `(program ,nargs ,nrest ,nlocs ,meta ,@(map unparse-glil body)))
+    ((<glil-program> meta body)
+     `(program ,meta ,@(map unparse-glil body)))
     ((<glil-arity> nargs nrest label) `(arity ,nargs ,nrest ,label))
     ((<glil-bind> vars) `(bind ,@vars))
     ((<glil-mv-bind> vars rest) `(mv-bind ,vars ,rest))
diff --git a/module/language/glil/compile-assembly.scm b/module/language/glil/compile-assembly.scm
index 8ff35ca7b..48d747453 100644
--- a/module/language/glil/compile-assembly.scm
+++ b/module/language/glil/compile-assembly.scm
@@ -72,7 +72,7 @@
   (if (and (null? bindings) (null? sources) (null? tail))
       #f
       (compile-assembly
-       (make-glil-program 0 0 0 '()
+       (make-glil-program '()
                           (list
                            (make-glil-const `(,bindings ,sources ,arities ,@tail))
                            (make-glil-call 'return 1))))))
@@ -156,7 +156,7 @@
             (begin-arity (addr+ addr x) nreq nopt rest? kw arities)))
 
   (record-case glil
-    ((<glil-program> nargs nrest nlocs meta body)
+    ((<glil-program> meta body)
      (define (process-body)
        (let lp ((body body) (code '()) (bindings '(())) (source-alist '())
                 (label-alist '()) (object-alist (if toplevel? #f '()))
@@ -184,7 +184,7 @@
          (process-body)
        (let* ((meta (make-meta bindings sources arities meta))
               (meta-pad (if meta (modulo (- 8 (modulo len 8)) 8) 0))
-              (prog `(load-program ,nargs ,nrest ,nlocs ,labels
+              (prog `(load-program ,labels
                                   ,(+ len meta-pad)
                                   ,meta
                                   ,@code
diff --git a/module/language/glil/decompile-assembly.scm b/module/language/glil/decompile-assembly.scm
index 3cb887d44..937a67858 100644
--- a/module/language/glil/decompile-assembly.scm
+++ b/module/language/glil/decompile-assembly.scm
@@ -31,9 +31,8 @@
 
 (define (decompile-toplevel x)
   (pmatch x
-    ((load-program ,nargs ,nrest ,nlocs ,labels ,len ,meta . ,body)
-     (decompile-load-program nargs nrest nlocs
-                             (decompile-meta meta)
+    ((load-program ,labels ,len ,meta . ,body)
+     (decompile-load-program (decompile-meta meta)
                              body labels #f))
     (else
      (error "invalid assembly" x))))
@@ -56,7 +55,7 @@
           ((glil-program? (car in)) (lp (cdr in) (cons (car in) out)))
           (else (lp (cdr in) (cons (make-glil-const (car l)) out))))))
 
-(define (decompile-load-program nargs nrest nlocs meta body labels
+(define (decompile-load-program meta body labels
                                 objects)
   (let ((glil-labels (sort (map (lambda (x)
                                   (cons (cdr x) (make-glil-label (car x))))
@@ -100,7 +99,7 @@
       (cond
        ((null? in)
         (or (null? stack) (error "leftover stack insts" stack body))
-        (make-glil-program nargs nrest nlocs props (reverse out) #f))
+        (make-glil-program props (reverse out)))
        ((pop-bindings! pos)
         => (lambda (bindings)
              (lp in stack
@@ -123,9 +122,9 @@
            (lp (cdr in) stack out (1+ pos)))
           ((make-false)
            (lp (cdr in) (cons #f stack) out (1+ pos)))
-          ((load-program ,a ,b ,c ,d ,labels ,sublen ,meta . ,body)
+          ((load-program ,labels ,sublen ,meta . ,body)
            (lp (cdr in)
-               (cons (decompile-load-program a b c d (decompile-meta meta)
+               (cons (decompile-load-program (decompile-meta meta)
                                              body labels (car stack))
                      (cdr stack))
                out
diff --git a/module/language/tree-il/compile-glil.scm b/module/language/tree-il/compile-glil.scm
index fa10d2003..f80ff0378 100644
--- a/module/language/tree-il/compile-glil.scm
+++ b/module/language/tree-il/compile-glil.scm
@@ -186,7 +186,7 @@
     (let ((nlocs (car (hashq-ref allocation x)))
           (labels (cadr (hashq-ref allocation x))))
       (make-glil-program
-       nargs nrest nlocs (lambda-meta x)
+       (lambda-meta x)
        (with-output-to-code
         (lambda (emit-code)
           ;; write source info for proc
diff --git a/module/system/xref.scm b/module/system/xref.scm
index 906ec8e4a..94ecb5bbf 100644
--- a/module/system/xref.scm
+++ b/module/system/xref.scm
@@ -35,7 +35,7 @@
                 (progv (make-vector (vector-length objects) #f))
                 (asm (decompile (program-objcode prog) #:to 'assembly)))
             (pmatch asm
-              ((load-program ,nargs ,nrest ,nlocs ,labels ,len . ,body)
+              ((load-program ,labels ,len . ,body)
                (for-each
                 (lambda (x)
                   (pmatch x
diff --git a/test-suite/tests/asm-to-bytecode.test b/test-suite/tests/asm-to-bytecode.test
index a8e251b83..304a84da9 100644
--- a/test-suite/tests/asm-to-bytecode.test
+++ b/test-suite/tests/asm-to-bytecode.test
@@ -77,34 +77,28 @@
                (vector 'load-symbol 0 0 3 (char->integer #\f) (char->integer #\o)
                        (char->integer #\o)))
     
-    (comp-test '(load-program 3 2 1 () 3 #f (make-int8 3) (return))
+    (comp-test '(load-program () 3 #f (make-int8 3) (return))
                #(load-program
-                 3 2 (uint16 1) ;; nargs, nrest, nlocs
                  (uint32 3)     ;; len
                  (uint32 0)     ;; metalen
-                 (uint32 0)     ;; padding
                  make-int8 3
                  return))
 
     ;; the nops are to pad meta to an 8-byte alignment. not strictly
     ;; necessary for this test, but representative of the common case.
-    (comp-test '(load-program 3 2 1 () 8
-                              (load-program 3 2 1 () 3
+    (comp-test '(load-program () 8
+                              (load-program () 3
                                             #f
                                             (make-int8 3) (return))
                               (make-int8 3) (return)
                               (nop) (nop) (nop) (nop) (nop))
                #(load-program
-                 3 2 (uint16 1) ;; nargs, nrest, nlocs
                  (uint32 8)     ;; len
-                 (uint32 19)    ;; metalen
-                 (uint32 0)     ;; padding
+                 (uint32 11)    ;; metalen
                  make-int8 3
                  return
                  nop nop nop nop nop
-                 3 2 (uint16 1) ;; nargs, nrest, nlocs
                  (uint32 3)     ;; len
                  (uint32 0)     ;; metalen
-                 (uint32 0)     ;; padding
                  make-int8 3
                  return))))
diff --git a/test-suite/tests/tree-il.test b/test-suite/tests/tree-il.test
index 41b5d56ba..06e2a3e27 100644
--- a/test-suite/tests/tree-il.test
+++ b/test-suite/tests/tree-il.test
@@ -69,21 +69,21 @@
 (with-test-prefix "void"
   (assert-tree-il->glil
    (void)
-   (program 0 0 0 () (arity 0 0 #f) (void) (call return 1)))
+   (program () (arity 0 0 #f) (void) (call return 1)))
   (assert-tree-il->glil
    (begin (void) (const 1))
-   (program 0 0 0 () (arity 0 0 #f) (const 1) (call return 1)))
+   (program () (arity 0 0 #f) (const 1) (call return 1)))
   (assert-tree-il->glil
    (apply (primitive +) (void) (const 1))
-   (program 0 0 0 () (arity 0 0 #f) (void) (call add1 1) (call return 1))))
+   (program () (arity 0 0 #f) (void) (call add1 1) (call return 1))))
 
 (with-test-prefix "application"
   (assert-tree-il->glil
    (apply (toplevel foo) (const 1))
-   (program 0 0 0 () (arity 0 0 #f) (toplevel ref foo) (const 1) (call goto/args 1)))
+   (program () (arity 0 0 #f) (toplevel ref foo) (const 1) (call goto/args 1)))
   (assert-tree-il->glil/pmatch
    (begin (apply (toplevel foo) (const 1)) (void))
-   (program 0 0 0 () (arity 0 0 #f) (call new-frame 0) (toplevel ref foo) (const 1) (mv-call 1 ,l1)
+   (program () (arity 0 0 #f) (call new-frame 0) (toplevel ref foo) (const 1) (mv-call 1 ,l1)
             (call drop 1) (branch br ,l2)
             (label ,l3) (mv-bind () #f) (unbind)
             (label ,l4)
@@ -91,26 +91,26 @@
    (and (eq? l1 l3) (eq? l2 l4)))
   (assert-tree-il->glil
    (apply (toplevel foo) (apply (toplevel bar)))
-   (program 0 0 0 ()  (arity 0 0 #f)(toplevel ref foo) (call new-frame 0) (toplevel ref bar) (call call 0)
+   (program ()  (arity 0 0 #f)(toplevel ref foo) (call new-frame 0) (toplevel ref bar) (call call 0)
             (call goto/args 1))))
 
 (with-test-prefix "conditional"
   (assert-tree-il->glil/pmatch
    (if (const #t) (const 1) (const 2))
-   (program 0 0 0 () (arity 0 0 #f) (const #t) (branch br-if-not ,l1)
+   (program () (arity 0 0 #f) (const #t) (branch br-if-not ,l1)
             (const 1) (call return 1)
             (label ,l2) (const 2) (call return 1))
    (eq? l1 l2))
   
   (assert-tree-il->glil/pmatch
    (begin (if (const #t) (const 1) (const 2)) (const #f))
-   (program 0 0 0 () (arity 0 0 #f) (const #t) (branch br-if-not ,l1) (branch br ,l2)
+   (program () (arity 0 0 #f) (const #t) (branch br-if-not ,l1) (branch br ,l2)
             (label ,l3) (label ,l4) (const #f) (call return 1))
    (eq? l1 l3) (eq? l2 l4))
 
   (assert-tree-il->glil/pmatch
    (apply (primitive null?) (if (const #t) (const 1) (const 2)))
-   (program 0 0 0 () (arity 0 0 #f) (const #t) (branch br-if-not ,l1)
+   (program () (arity 0 0 #f) (const #t) (branch br-if-not ,l1)
             (const 1) (branch br ,l2)
                     (label ,l3) (const 2) (label ,l4)
                     (call null? 1) (call return 1))
@@ -119,35 +119,35 @@
 (with-test-prefix "primitive-ref"
   (assert-tree-il->glil
    (primitive +)
-   (program 0 0 0 () (arity 0 0 #f) (toplevel ref +) (call return 1)))
+   (program () (arity 0 0 #f) (toplevel ref +) (call return 1)))
 
   (assert-tree-il->glil
    (begin (primitive +) (const #f))
-   (program 0 0 0 () (arity 0 0 #f) (const #f) (call return 1)))
+   (program () (arity 0 0 #f) (const #f) (call return 1)))
 
   (assert-tree-il->glil
    (apply (primitive null?) (primitive +))
-   (program 0 0 0 () (arity 0 0 #f) (toplevel ref +) (call null? 1)
+   (program () (arity 0 0 #f) (toplevel ref +) (call null? 1)
             (call return 1))))
 
 (with-test-prefix "lexical refs"
   (assert-tree-il->glil
    (let (x) (y) ((const 1)) (lexical x y))
-   (program 0 0 1 () (arity 0 0 #f) (call reserve-locals 1)
+   (program () (arity 0 0 #f) (call reserve-locals 1)
             (const 1) (bind (x #f 0)) (lexical #t #f set 0)
             (lexical #t #f ref 0) (call return 1)
             (unbind)))
 
   (assert-tree-il->glil
    (let (x) (y) ((const 1)) (begin (lexical x y) (const #f)))
-   (program 0 0 1 () (arity 0 0 #f) (call reserve-locals 1)
+   (program () (arity 0 0 #f) (call reserve-locals 1)
             (const 1) (bind (x #f 0)) (lexical #t #f set 0)
             (const #f) (call return 1)
             (unbind)))
 
   (assert-tree-il->glil
    (let (x) (y) ((const 1)) (apply (primitive null?) (lexical x y)))
-   (program 0 0 1 () (arity 0 0 #f) (call reserve-locals 1)
+   (program () (arity 0 0 #f) (call reserve-locals 1)
             (const 1) (bind (x #f 0)) (lexical #t #f set 0)
             (lexical #t #f ref 0) (call null? 1) (call return 1)
             (unbind))))
@@ -157,7 +157,7 @@
    ;; unreferenced sets may be optimized away -- make sure they are ref'd
    (let (x) (y) ((const 1))
         (set! (lexical x y) (apply (primitive 1+) (lexical x y))))
-   (program 0 0 1 () (arity 0 0 #f) (call reserve-locals 1)
+   (program () (arity 0 0 #f) (call reserve-locals 1)
             (const 1) (bind (x #t 0)) (lexical #t #t box 0)
             (lexical #t #t ref 0) (call add1 1) (lexical #t #t set 0)
             (void) (call return 1)
@@ -167,7 +167,7 @@
    (let (x) (y) ((const 1))
         (begin (set! (lexical x y) (apply (primitive 1+) (lexical x y)))
                (lexical x y)))
-   (program 0 0 1 () (arity 0 0 #f) (call reserve-locals 1)
+   (program () (arity 0 0 #f) (call reserve-locals 1)
             (const 1) (bind (x #t 0)) (lexical #t #t box 0)
             (lexical #t #t ref 0) (call add1 1) (lexical #t #t set 0)
             (lexical #t #t ref 0) (call return 1)
@@ -177,7 +177,7 @@
    (let (x) (y) ((const 1))
      (apply (primitive null?)
             (set! (lexical x y) (apply (primitive 1+) (lexical x y)))))
-   (program 0 0 1 () (arity 0 0 #f) (call reserve-locals 1)
+   (program () (arity 0 0 #f) (call reserve-locals 1)
             (const 1) (bind (x #t 0)) (lexical #t #t box 0)
             (lexical #t #t ref 0) (call add1 1) (lexical #t #t set 0) (void)
             (call null? 1) (call return 1)
@@ -186,205 +186,205 @@
 (with-test-prefix "module refs"
   (assert-tree-il->glil
    (@ (foo) bar)
-   (program 0 0 0 () (arity 0 0 #f)
+   (program () (arity 0 0 #f)
             (module public ref (foo) bar)
             (call return 1)))
 
   (assert-tree-il->glil
    (begin (@ (foo) bar) (const #f))
-   (program 0 0 0 () (arity 0 0 #f)
+   (program () (arity 0 0 #f)
             (module public ref (foo) bar) (call drop 1)
             (const #f) (call return 1)))
 
   (assert-tree-il->glil
    (apply (primitive null?) (@ (foo) bar))
-   (program 0 0 0 () (arity 0 0 #f)
+   (program () (arity 0 0 #f)
             (module public ref (foo) bar)
             (call null? 1) (call return 1)))
 
   (assert-tree-il->glil
    (@@ (foo) bar)
-   (program 0 0 0 () (arity 0 0 #f)
+   (program () (arity 0 0 #f)
             (module private ref (foo) bar)
             (call return 1)))
 
   (assert-tree-il->glil
    (begin (@@ (foo) bar) (const #f))
-   (program 0 0 0 () (arity 0 0 #f)
+   (program () (arity 0 0 #f)
             (module private ref (foo) bar) (call drop 1)
             (const #f) (call return 1)))
 
   (assert-tree-il->glil
    (apply (primitive null?) (@@ (foo) bar))
-   (program 0 0 0 () (arity 0 0 #f)
+   (program () (arity 0 0 #f)
             (module private ref (foo) bar)
             (call null? 1) (call return 1))))
 
 (with-test-prefix "module sets"
   (assert-tree-il->glil
    (set! (@ (foo) bar) (const 2))
-   (program 0 0 0 () (arity 0 0 #f)
+   (program () (arity 0 0 #f)
             (const 2) (module public set (foo) bar)
             (void) (call return 1)))
 
   (assert-tree-il->glil
    (begin (set! (@ (foo) bar) (const 2)) (const #f))
-   (program 0 0 0 () (arity 0 0 #f)
+   (program () (arity 0 0 #f)
             (const 2) (module public set (foo) bar)
             (const #f) (call return 1)))
 
   (assert-tree-il->glil
    (apply (primitive null?) (set! (@ (foo) bar) (const 2)))
-   (program 0 0 0 () (arity 0 0 #f)
+   (program () (arity 0 0 #f)
             (const 2) (module public set (foo) bar)
             (void) (call null? 1) (call return 1)))
 
   (assert-tree-il->glil
    (set! (@@ (foo) bar) (const 2))
-   (program 0 0 0 () (arity 0 0 #f)
+   (program () (arity 0 0 #f)
             (const 2) (module private set (foo) bar)
             (void) (call return 1)))
 
   (assert-tree-il->glil
    (begin (set! (@@ (foo) bar) (const 2)) (const #f))
-   (program 0 0 0 () (arity 0 0 #f)
+   (program () (arity 0 0 #f)
             (const 2) (module private set (foo) bar)
             (const #f) (call return 1)))
 
   (assert-tree-il->glil
    (apply (primitive null?) (set! (@@ (foo) bar) (const 2)))
-   (program 0 0 0 () (arity 0 0 #f)
+   (program () (arity 0 0 #f)
             (const 2) (module private set (foo) bar)
             (void) (call null? 1) (call return 1))))
 
 (with-test-prefix "toplevel refs"
   (assert-tree-il->glil
    (toplevel bar)
-   (program 0 0 0 () (arity 0 0 #f)
+   (program () (arity 0 0 #f)
             (toplevel ref bar)
             (call return 1)))
 
   (assert-tree-il->glil
    (begin (toplevel bar) (const #f))
-   (program 0 0 0 () (arity 0 0 #f)
+   (program () (arity 0 0 #f)
             (toplevel ref bar) (call drop 1)
             (const #f) (call return 1)))
 
   (assert-tree-il->glil
    (apply (primitive null?) (toplevel bar))
-   (program 0 0 0 () (arity 0 0 #f)
+   (program () (arity 0 0 #f)
             (toplevel ref bar)
             (call null? 1) (call return 1))))
 
 (with-test-prefix "toplevel sets"
   (assert-tree-il->glil
    (set! (toplevel bar) (const 2))
-   (program 0 0 0 () (arity 0 0 #f)
+   (program () (arity 0 0 #f)
             (const 2) (toplevel set bar)
             (void) (call return 1)))
 
   (assert-tree-il->glil
    (begin (set! (toplevel bar) (const 2)) (const #f))
-   (program 0 0 0 () (arity 0 0 #f)
+   (program () (arity 0 0 #f)
             (const 2) (toplevel set bar)
             (const #f) (call return 1)))
 
   (assert-tree-il->glil
    (apply (primitive null?) (set! (toplevel bar) (const 2)))
-   (program 0 0 0 () (arity 0 0 #f)
+   (program () (arity 0 0 #f)
             (const 2) (toplevel set bar)
             (void) (call null? 1) (call return 1))))
 
 (with-test-prefix "toplevel defines"
   (assert-tree-il->glil
    (define bar (const 2))
-   (program 0 0 0 () (arity 0 0 #f)
+   (program () (arity 0 0 #f)
             (const 2) (toplevel define bar)
             (void) (call return 1)))
 
   (assert-tree-il->glil
    (begin (define bar (const 2)) (const #f))
-   (program 0 0 0 () (arity 0 0 #f)
+   (program () (arity 0 0 #f)
             (const 2) (toplevel define bar)
             (const #f) (call return 1)))
 
   (assert-tree-il->glil
    (apply (primitive null?) (define bar (const 2)))
-   (program 0 0 0 () (arity 0 0 #f)
+   (program () (arity 0 0 #f)
             (const 2) (toplevel define bar)
             (void) (call null? 1) (call return 1))))
 
 (with-test-prefix "constants"
   (assert-tree-il->glil
    (const 2)
-   (program 0 0 0 () (arity 0 0 #f)
+   (program () (arity 0 0 #f)
             (const 2) (call return 1)))
 
   (assert-tree-il->glil
    (begin (const 2) (const #f))
-   (program 0 0 0 () (arity 0 0 #f)
+   (program () (arity 0 0 #f)
             (const #f) (call return 1)))
 
   (assert-tree-il->glil
    (apply (primitive null?) (const 2))
-   (program 0 0 0 () (arity 0 0 #f)
+   (program () (arity 0 0 #f)
             (const 2) (call null? 1) (call return 1))))
 
 (with-test-prefix "lambda"
   (assert-tree-il->glil
    (lambda (x) (y) () (const 2))
-   (program 0 0 0 ()  (arity 0 0 #f)
-            (program 1 0 0 () (arity 1 0 #f)
+   (program ()  (arity 0 0 #f)
+            (program () (arity 1 0 #f)
                      (bind (x #f 0))
                      (const 2) (call return 1))
             (call return 1)))
 
   (assert-tree-il->glil
    (lambda (x x1) (y y1) () (const 2))
-   (program 0 0 0 () (arity 0 0 #f)
-            (program 2 0 0 () (arity 2 0 #f)
+   (program () (arity 0 0 #f)
+            (program () (arity 2 0 #f)
                      (bind (x #f 0) (x1 #f 1))
                      (const 2) (call return 1))
             (call return 1)))
 
   (assert-tree-il->glil
    (lambda x y () (const 2))
-   (program 0 0 0 () (arity 0 0 #f)
-            (program 1 1 0 () (arity 1 1 #f)
+   (program () (arity 0 0 #f)
+            (program () (arity 1 1 #f)
                      (bind (x #f 0))
                      (const 2) (call return 1))
             (call return 1)))
 
   (assert-tree-il->glil
    (lambda (x . x1) (y . y1) () (const 2))
-   (program 0 0 0 () (arity 0 0 #f)
-            (program 2 1 0 () (arity 2 1 #f)
+   (program () (arity 0 0 #f)
+            (program () (arity 2 1 #f)
                      (bind (x #f 0) (x1 #f 1))
                      (const 2) (call return 1))
             (call return 1)))
 
   (assert-tree-il->glil
    (lambda (x . x1) (y . y1) () (lexical x y))
-   (program 0 0 0 () (arity 0 0 #f)
-            (program 2 1 0 () (arity 2 1 #f)
+   (program () (arity 0 0 #f)
+            (program () (arity 2 1 #f)
                      (bind (x #f 0) (x1 #f 1))
                      (lexical #t #f ref 0) (call return 1))
             (call return 1)))
 
   (assert-tree-il->glil
    (lambda (x . x1) (y . y1) () (lexical x1 y1))
-   (program 0 0 0 () (arity 0 0 #f)
-            (program 2 1 0 () (arity 2 1 #f)
+   (program () (arity 0 0 #f)
+            (program () (arity 2 1 #f)
                      (bind (x #f 0) (x1 #f 1))
                      (lexical #t #f ref 1) (call return 1))
             (call return 1)))
 
   (assert-tree-il->glil
    (lambda (x) (x1) () (lambda (y) (y1) () (lexical x x1)))
-   (program 0 0 0 () (arity 0 0 #f)
-            (program 1 0 0 () (arity 1 0 #f)
+   (program () (arity 0 0 #f)
+            (program () (arity 1 0 #f)
                      (bind (x #f 0))
-                     (program 1 0 0 () (arity 1 0 #f)
+                     (program () (arity 1 0 #f)
                               (bind (y #f 0))
                               (lexical #f #f ref 0) (call return 1))
                      (lexical #t #f ref 0)
@@ -396,12 +396,12 @@
 (with-test-prefix "sequence"
   (assert-tree-il->glil
    (begin (begin (const 2) (const #f)) (const #t))
-   (program 0 0 0 () (arity 0 0 #f)
+   (program () (arity 0 0 #f)
             (const #t) (call return 1)))
 
   (assert-tree-il->glil
    (apply (primitive null?) (begin (const #f) (const 2)))
-   (program 0 0 0 () (arity 0 0 #f)
+   (program () (arity 0 0 #f)
             (const 2) (call null? 1) (call return 1))))
 
 ;; FIXME: binding info for or-hacked locals might bork the disassembler,
@@ -413,7 +413,7 @@
             (lexical x y)
             (let (a) (b) ((const 2))
                  (lexical a b))))
-   (program 0 0 1 () (arity 0 0 #f) (call reserve-locals 1)
+   (program () (arity 0 0 #f) (call reserve-locals 1)
             (const 1) (bind (x #f 0)) (lexical #t #f set 0)
             (lexical #t #f ref 0) (branch br-if-not ,l1)
             (lexical #t #f ref 0) (call return 1)
@@ -431,7 +431,7 @@
             (lexical x y)
             (let (a) (b) ((const 2))
                  (lexical x y))))
-   (program 0 0 1 () (arity 0 0 #f) (call reserve-locals 1)
+   (program () (arity 0 0 #f) (call reserve-locals 1)
             (const 1) (bind (x #f 0)) (lexical #t #f set 0)
             (lexical #t #f ref 0) (branch br-if-not ,l1)
             (lexical #t #f ref 0) (call return 1)
@@ -443,10 +443,10 @@
 (with-test-prefix "apply"
   (assert-tree-il->glil
    (apply (primitive @apply) (toplevel foo) (toplevel bar))
-   (program 0 0 0 () (arity 0 0 #f) (toplevel ref foo) (toplevel ref bar) (call goto/apply 2)))
+   (program () (arity 0 0 #f) (toplevel ref foo) (toplevel ref bar) (call goto/apply 2)))
   (assert-tree-il->glil/pmatch
    (begin (apply (primitive @apply) (toplevel foo) (toplevel bar)) (void))
-   (program 0 0 0 () (arity 0 0 #f)
+   (program () (arity 0 0 #f)
             (call new-frame 0) (toplevel ref apply) (toplevel ref foo) (toplevel ref bar) (mv-call 2 ,l1)
             (call drop 1) (branch br ,l2) (label ,l3) (mv-bind () #f) (unbind)
             (label ,l4)
@@ -454,7 +454,7 @@
    (and (eq? l1 l3) (eq? l2 l4)))
   (assert-tree-il->glil
    (apply (toplevel foo) (apply (toplevel @apply) (toplevel bar) (toplevel baz)))
-   (program 0 0 0 () (arity 0 0 #f)
+   (program () (arity 0 0 #f)
             (toplevel ref foo)
             (call new-frame 0) (toplevel ref bar) (toplevel ref baz) (call apply 2)
             (call goto/args 1))))
@@ -462,10 +462,10 @@
 (with-test-prefix "call/cc"
   (assert-tree-il->glil
    (apply (primitive @call-with-current-continuation) (toplevel foo))
-   (program 0 0 0 () (arity 0 0 #f) (toplevel ref foo) (call goto/cc 1)))
+   (program () (arity 0 0 #f) (toplevel ref foo) (call goto/cc 1)))
   (assert-tree-il->glil/pmatch
    (begin (apply (primitive @call-with-current-continuation) (toplevel foo)) (void))
-   (program 0 0 0 () (arity 0 0 #f)
+   (program () (arity 0 0 #f)
             (call new-frame 0) (toplevel ref call-with-current-continuation) (toplevel ref foo) (mv-call 1 ,l1)
             (call drop 1) (branch br ,l2) (label ,l3) (mv-bind () #f) (unbind)
             (label ,l4)
@@ -474,7 +474,7 @@
   (assert-tree-il->glil
    (apply (toplevel foo)
           (apply (toplevel @call-with-current-continuation) (toplevel bar)))
-   (program 0 0 0 () (arity 0 0 #f)
+   (program () (arity 0 0 #f)
             (toplevel ref foo)
             (toplevel ref bar) (call call/cc 1)
             (call goto/args 1))))