[Guile-commits] 04/19: Keywords have a tc7

[Andy Wingo]

wingo pushed a commit to branch master
in repository guile.

commit e2fafeb9012cbe5e3ec63326692a4cc3a22c318e
Author: Andy Wingo <address@hidden>
Date:   Mon Jan 19 16:57:42 2015 +0100

    Keywords have a tc7
    
    * libguile/tags.h (scm_tc7_keyword): Allocate a tc7, so that the VM can
      have cheap keyword? tests.
    
    * libguile/keywords.c:
    * libguile/keywords.h: Adapt.
    
    * libguile/goops.c (scm_class_of, scm_sys_goops_early_init): Capture
      <keyword>.
    
    * libguile/print.c (iprin1): Inline keyword printer.
    
    * libguile/evalext.c (scm_self_evaluating_p): Add keywords here.
    
    * libguile/deprecated.h:
    * libguile/deprecated.c (scm_tc16_keyword): Deprecate.
    
    * module/language/cps/compile-bytecode.scm (compile-fun): Add keyword?
      case, and bitvector? case while we're at it.
    * module/language/cps/effects-analysis.scm (define-primitive-effects):
      Add bytevector?, keyword?, and bitvector? cases.
    
    * module/language/cps/primitives.scm (*branching-primcall-arities*): Add
      keyword?.
    
    * module/language/cps/types.scm (bitvector?, keyword?, bytevector?): Add
      branch inferrers.
    
    * module/language/tree-il/primitives.scm (*interesting-primitive-names*):
      (*effect-free-primitives*):
      (*effect+exception-free-primitives*): Add bytevector?, keyword?, and
      bitvector?.
    
    * module/oop/goops.scm (<keyword>): New class.
    
    * module/system/base/types.scm (%tc7-keyword, cell->object): Add cases.
    
    * module/system/vm/assembler.scm (br-if-keyword): New definition.
    * module/system/vm/disassembler.scm (code-annotation): Add br-if-tc7
      case for keywords.
    
    * test-suite/tests/types.test ("clonable objects"): Update now that
      keywords are cloneable.
---
 libguile/evalext.c                           |    3 +-
 libguile/goops.c                             |    6 ++--
 libguile/keywords.c                          |   33 ++++++++------------------
 libguile/keywords.h                          |    6 +----
 libguile/print.c                             |    6 ++++-
 libguile/tags.h                              |    4 +-
 module/language/cps/compile-bytecode.scm     |    2 +
 module/language/cps/effects-analysis.scm     |    5 +++-
 module/language/cps/primitives.scm           |    3 +-
 module/language/cps/specialize-primcalls.scm |   10 +------
 module/language/cps/types.scm                |    5 +++-
 module/language/tree-il/compile-cps.scm      |   18 +++++++++++++-
 module/language/tree-il/primitives.scm       |    5 +++-
 module/oop/goops.scm                         |    6 ++--
 module/system/base/types.scm                 |    5 +++-
 module/system/vm/assembler.scm               |    1 +
 module/system/vm/disassembler.scm            |    3 +-
 test-suite/tests/types.test                  |    5 +--
 18 files changed, 70 insertions(+), 56 deletions(-)

diff --git a/libguile/evalext.c b/libguile/evalext.c
index 48a9eff..48d9a17 100644
--- a/libguile/evalext.c
+++ b/libguile/evalext.c
@@ -1,4 +1,4 @@
-/* Copyright (C) 1998,1999,2000,2001,2002,2003, 2006, 2008, 2009, 2010, 2011, 
2012, 2013 Free Software Foundation, Inc.
+/* Copyright (C) 1998,1999,2000,2001,2002,2003, 2006, 2008, 2009, 2010, 2011, 
2012, 2013, 2015 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
@@ -81,6 +81,7 @@ SCM_DEFINE (scm_self_evaluating_p, "self-evaluating?", 1, 0, 
0,
        case scm_tc7_fluid:
        case scm_tc7_dynamic_state:
         case scm_tc7_frame:
+        case scm_tc7_keyword:
         case scm_tc7_vm_cont:
        case scm_tc7_number:
        case scm_tc7_string:
diff --git a/libguile/goops.c b/libguile/goops.c
index 450ae0d..ab4d7d7 100644
--- a/libguile/goops.c
+++ b/libguile/goops.c
@@ -1,4 +1,4 @@
-/* Copyright (C) 
1998,1999,2000,2001,2002,2003,2004,2008,2009,2010,2011,2012,2013,2014
+/* Copyright (C) 
1998,1999,2000,2001,2002,2003,2004,2008,2009,2010,2011,2012,2013,2014,2015
  * Free Software Foundation, Inc.
  *
  * This library is free software; you can redistribute it and/or
@@ -264,6 +264,8 @@ SCM_DEFINE (scm_class_of, "class-of", 1, 0, 0,
          return class_dynamic_state;
         case scm_tc7_frame:
          return class_frame;
+        case scm_tc7_keyword:
+         return scm_class_keyword;
         case scm_tc7_vm_cont:
          return class_vm_cont;
        case scm_tc7_bytevector:
@@ -2659,8 +2661,6 @@ create_smob_classes (void)
   for (i = 0; i < SCM_I_MAX_SMOB_TYPE_COUNT; ++i)
     scm_smob_class[i] = SCM_BOOL_F;
 
-  scm_smob_class[SCM_TC2SMOBNUM (scm_tc16_keyword)] = scm_class_keyword;
-
   for (i = 0; i < scm_numsmob; ++i)
     if (scm_is_false (scm_smob_class[i]))
       scm_smob_class[i] = scm_make_extended_class (SCM_SMOBNAME (i),
diff --git a/libguile/keywords.c b/libguile/keywords.c
index f630259..49cccd5 100644
--- a/libguile/keywords.c
+++ b/libguile/keywords.c
@@ -1,5 +1,5 @@
 /* Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2003, 2004,
- *   2006, 2008, 2009, 2011, 2013 Free Software Foundation, Inc.
+ *   2006, 2008, 2009, 2011, 2013, 2015 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
@@ -41,18 +41,8 @@
 
 static SCM keyword_obarray;
 
-scm_t_bits scm_tc16_keyword;
-
-#define KEYWORDP(X)    (SCM_SMOB_PREDICATE (scm_tc16_keyword, (X)))
-#define KEYWORDSYM(X)  (SCM_SMOB_OBJECT (X))
-
-static int
-keyword_print (SCM exp, SCM port, scm_print_state *pstate SCM_UNUSED)
-{
-  scm_puts_unlocked ("#:", port);
-  scm_display (KEYWORDSYM (exp), port);
-  return 1;
-}
+#define SCM_KEYWORDP(x) (SCM_HAS_TYP7 (x, scm_tc7_keyword))
+#define SCM_KEYWORD_SYMBOL(x) (SCM_CELL_OBJECT_1 (x))
 
 SCM_DEFINE (scm_keyword_p, "keyword?", 1, 0, 0, 
             (SCM obj),
@@ -60,7 +50,7 @@ SCM_DEFINE (scm_keyword_p, "keyword?", 1, 0, 0,
            "@code{#f}.")
 #define FUNC_NAME s_scm_keyword_p
 {
-  return scm_from_bool (KEYWORDP (obj));
+  return scm_from_bool (SCM_KEYWORDP (obj));
 }
 #undef FUNC_NAME
 
@@ -74,11 +64,12 @@ SCM_DEFINE (scm_symbol_to_keyword, "symbol->keyword", 1, 0, 
0,
   SCM_ASSERT_TYPE (scm_is_symbol (symbol), symbol, 0, NULL, "symbol");
 
   SCM_CRITICAL_SECTION_START;
-  /* njrev: NEWSMOB and hashq_set_x can raise errors */
+  /* Note: `scm_cell' and `scm_hashq_set_x' can raise an out-of-memory
+     error.  */
   keyword = scm_hashq_ref (keyword_obarray, symbol, SCM_BOOL_F);
   if (scm_is_false (keyword))
     {
-      SCM_NEWSMOB (keyword, scm_tc16_keyword, SCM_UNPACK (symbol));
+      keyword = scm_cell (scm_tc7_keyword, SCM_UNPACK (symbol));
       scm_hashq_set_x (keyword_obarray, symbol, keyword);
     }
   SCM_CRITICAL_SECTION_END;
@@ -91,15 +82,15 @@ SCM_DEFINE (scm_keyword_to_symbol, "keyword->symbol", 1, 0, 
0,
            "Return the symbol with the same name as @var{keyword}.")
 #define FUNC_NAME s_scm_keyword_to_symbol
 {
-  scm_assert_smob_type (scm_tc16_keyword, keyword);
-  return KEYWORDSYM (keyword);
+  SCM_VALIDATE_KEYWORD (1, keyword);
+  return SCM_KEYWORD_SYMBOL (keyword);
 }
 #undef FUNC_NAME
 
 int
 scm_is_keyword (SCM val)
 {
-  return KEYWORDP (val);
+  return SCM_KEYWORDP (val);
 }
 
 SCM
@@ -195,13 +186,9 @@ scm_c_bind_keyword_arguments (const char *subr, SCM rest,
     }
 }
 
-/* njrev: critical sections reviewed so far up to here */
 void
 scm_init_keywords ()
 {
-  scm_tc16_keyword = scm_make_smob_type ("keyword", 0);
-  scm_set_smob_print (scm_tc16_keyword, keyword_print);
-
   keyword_obarray = scm_c_make_hash_table (0);
 #include "libguile/keywords.x"
 }
diff --git a/libguile/keywords.h b/libguile/keywords.h
index 3cdb0ec..32311dd 100644
--- a/libguile/keywords.h
+++ b/libguile/keywords.h
@@ -3,7 +3,7 @@
 #ifndef SCM_KEYWORDS_H
 #define SCM_KEYWORDS_H
 
-/* Copyright (C) 1995,1996,1999,2000,2001, 2006, 2008 Free Software 
Foundation, Inc.
+/* Copyright (C) 1995,1996,1999,2000,2001, 2006, 2008, 2015 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
@@ -27,10 +27,6 @@
 
 
 
-SCM_API scm_t_bits scm_tc16_keyword;
-
-
-
 SCM_API SCM scm_keyword_p (SCM obj);
 SCM_API SCM scm_symbol_to_keyword (SCM symbol);
 SCM_API SCM scm_keyword_to_symbol (SCM keyword);
diff --git a/libguile/print.c b/libguile/print.c
index 684b3d4..0a2067f 100644
--- a/libguile/print.c
+++ b/libguile/print.c
@@ -1,5 +1,5 @@
 /* Copyright (C) 1995-1999, 2000, 2001, 2002, 2003, 2004, 2006, 2008,
- *   2009, 2010, 2011, 2012, 2013, 2014 Free Software Foundation, Inc.
+ *   2009, 2010, 2011, 2012, 2013, 2014, 2015 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
@@ -776,6 +776,10 @@ iprin1 (SCM exp, SCM port, scm_print_state *pstate)
        case scm_tc7_frame:
          scm_i_frame_print (exp, port, pstate);
          break;
+        case scm_tc7_keyword:
+          scm_puts_unlocked ("#:", port);
+          scm_iprin1 (scm_keyword_to_symbol (exp), port, pstate);
+          break;
        case scm_tc7_vm_cont:
          scm_i_vm_cont_print (exp, port, pstate);
          break;
diff --git a/libguile/tags.h b/libguile/tags.h
index 53d40d8..a5082f8 100644
--- a/libguile/tags.h
+++ b/libguile/tags.h
@@ -3,7 +3,7 @@
 #ifndef SCM_TAGS_H
 #define SCM_TAGS_H
 
-/* Copyright (C) 
1995,1996,1997,1998,1999,2000,2001,2002,2003,2004,2008,2009,2010,2011,2012,2013,2014
+/* Copyright (C) 
1995,1996,1997,1998,1999,2000,2001,2002,2003,2004,2008,2009,2010,2011,2012,2013,2014,2015
  * Free Software Foundation, Inc.
  *
  * This library is free software; you can redistribute it and/or
@@ -416,7 +416,7 @@ typedef union SCM { struct { scm_t_bits n; } n; } SCM;
 #define scm_tc7_dynamic_state  45
 
 #define scm_tc7_frame          47
-#define scm_tc7_unused_53      53
+#define scm_tc7_keyword                53
 #define scm_tc7_unused_55      55
 #define scm_tc7_vm_cont                71
 
diff --git a/module/language/cps/compile-bytecode.scm 
b/module/language/cps/compile-bytecode.scm
index e6dfaad..9537e9c 100644
--- a/module/language/cps/compile-bytecode.scm
+++ b/module/language/cps/compile-bytecode.scm
@@ -434,6 +434,8 @@
         (($ $primcall 'vector? (a)) (unary emit-br-if-vector a))
         (($ $primcall 'string? (a)) (unary emit-br-if-string a))
         (($ $primcall 'bytevector? (a)) (unary emit-br-if-bytevector a))
+        (($ $primcall 'bitvector? (a)) (unary emit-br-if-bitvector a))
+        (($ $primcall 'keyword? (a)) (unary emit-br-if-keyword a))
         ;; Add more TC7 tests here.  Keep in sync with
         ;; *branching-primcall-arities* in (language cps primitives) and
         ;; the set of macro-instructions in assembly.scm.
diff --git a/module/language/cps/effects-analysis.scm 
b/module/language/cps/effects-analysis.scm
index 246b22e..8951b40 100644
--- a/module/language/cps/effects-analysis.scm
+++ b/module/language/cps/effects-analysis.scm
@@ -1,6 +1,6 @@
 ;;; Effects analysis on CPS
 
-;; Copyright (C) 2011, 2012, 2013, 2014 Free Software Foundation, Inc.
+;; Copyright (C) 2011, 2012, 2013, 2014, 2015 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
@@ -273,6 +273,9 @@ is or might be a read or a write to the same location as A."
   ((string? arg))
   ((number? arg))
   ((char? arg))
+  ((bytevector? arg))
+  ((keyword? arg))
+  ((bitvector? arg))
   ((procedure? arg))
   ((thunk? arg)))
 
diff --git a/module/language/cps/primitives.scm 
b/module/language/cps/primitives.scm
index a095fce..5f7f474 100644
--- a/module/language/cps/primitives.scm
+++ b/module/language/cps/primitives.scm
@@ -1,6 +1,6 @@
 ;;; Continuation-passing style (CPS) intermediate language (IL)
 
-;; Copyright (C) 2013, 2014 Free Software Foundation, Inc.
+;; Copyright (C) 2013, 2014, 2015 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
@@ -75,6 +75,7 @@
     (string? . (1 . 1))
     (vector? . (1 . 1))
     (symbol? . (1 . 1))
+    (keyword? . (1 . 1))
     (variable? . (1 . 1))
     (bitvector? . (1 . 1))
     (bytevector? . (1 . 1))
diff --git a/module/language/cps/specialize-primcalls.scm 
b/module/language/cps/specialize-primcalls.scm
index e03eb62..0502fe6 100644
--- a/module/language/cps/specialize-primcalls.scm
+++ b/module/language/cps/specialize-primcalls.scm
@@ -95,14 +95,8 @@
           (('struct-ref s (? immediate-u8? n))
            (adapt-val ($primcall 'struct-ref/immediate (s n))))
           (('struct-set! s (? immediate-u8? n) x)
-           ;; Unhappily, and undocumentedly, struct-set! returns the value
-           ;; that was set.  There is code that relies on this.  Hackety
-           ;; hack...
-           (let-fresh (k*) ()
-             (build-cps-term
-               ($letk ((k* ($kargs () ()
-                             ($continue k src ($primcall 'values (x))))))
-                 ($continue k* src ($primcall 'struct-set!/immediate (s n 
x)))))))
+           (build-cps-term
+             ($continue k src ($primcall 'struct-set!/immediate (s n x)))))
           (_ 
            (build-cps-term ($continue k src ($primcall name args))))))
 
diff --git a/module/language/cps/types.scm b/module/language/cps/types.scm
index ca90f50..934fa11 100644
--- a/module/language/cps/types.scm
+++ b/module/language/cps/types.scm
@@ -1,5 +1,5 @@
 ;;; Type analysis on CPS
-;;; Copyright (C) 2014 Free Software Foundation, Inc.
+;;; Copyright (C) 2014, 2015 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 as
@@ -480,6 +480,9 @@ minimum, and maximum."
 (define-simple-predicate-inferrer vector? &vector)
 (define-simple-predicate-inferrer struct? &struct)
 (define-simple-predicate-inferrer string? &string)
+(define-simple-predicate-inferrer bytevector? &bytevector)
+(define-simple-predicate-inferrer bitvector? &bitvector)
+(define-simple-predicate-inferrer keyword? &keyword)
 (define-simple-predicate-inferrer number? &number)
 (define-simple-predicate-inferrer char? &char)
 (define-simple-predicate-inferrer procedure? &procedure)
diff --git a/module/language/tree-il/compile-cps.scm 
b/module/language/tree-il/compile-cps.scm
index 3822316..a5afa7a 100644
--- a/module/language/tree-il/compile-cps.scm
+++ b/module/language/tree-il/compile-cps.scm
@@ -1,6 +1,6 @@
 ;;; Continuation-passing style (CPS) intermediate language (IL)
 
-;; Copyright (C) 2013, 2014 Free Software Foundation, Inc.
+;; Copyright (C) 2013, 2014, 2015 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
@@ -682,6 +682,22 @@ integer."
                           (make-lexical-ref src 'v v)
                           (reverse args) (reverse (iota len))))))
 
+       (($ <primcall> src 'struct-set! (struct index value))
+        ;; Unhappily, and undocumentedly, struct-set! returns the value
+        ;; that was set.  There is code that relies on this.  Hackety
+        ;; hack...
+        (let ((v (gensym "v ")))
+          (make-let src
+                    (list 'v)
+                    (list v)
+                    (list value)
+                    (make-seq src
+                              (make-primcall src 'struct-set!
+                                             (list struct
+                                                   index
+                                                   (make-lexical-ref src 'v 
v)))
+                              (make-lexical-ref src 'v v)))))
+
        (($ <prompt> src escape-only? tag body
            ($ <lambda> hsrc hmeta
               ($ <lambda-case> _ hreq #f hrest #f () hsyms hbody #f)))
diff --git a/module/language/tree-il/primitives.scm 
b/module/language/tree-il/primitives.scm
index e4e6104..7bed783 100644
--- a/module/language/tree-il/primitives.scm
+++ b/module/language/tree-il/primitives.scm
@@ -1,6 +1,6 @@
 ;;; open-coding primitive procedures
 
-;; Copyright (C) 2009, 2010, 2011, 2012, 2013, 2014 Free Software Foundation, 
Inc.
+;; Copyright (C) 2009, 2010, 2011, 2012, 2013, 2014, 2015 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
@@ -51,6 +51,7 @@
     sqrt abs
     not
     pair? null? list? symbol? vector? string? struct? number? char? nil?
+    bytevector? keyword? bitvector?
 
     procedure? thunk?
 
@@ -170,6 +171,7 @@
     not
     pair? null? nil? list?
     symbol? variable? vector? struct? string? number? char?
+    bytevector? keyword? bitvector?
     complex? real? rational? inf? nan? integer? exact? inexact? even? odd?
     char<? char<=? char>=? char>?
     integer->char char->integer number->string string->number
@@ -191,6 +193,7 @@
     not
     pair? null? nil? list?
     symbol? variable? vector? struct? string? number? char?
+    bytevector? keyword? bitvector?
     procedure? thunk?
     acons cons cons* list vector))
 
diff --git a/module/oop/goops.scm b/module/oop/goops.scm
index 0376d9e..6afd049 100644
--- a/module/oop/goops.scm
+++ b/module/oop/goops.scm
@@ -1,6 +1,6 @@
 ;;; installed-scm-file
 
-;;;; Copyright (C) 1998,1999,2000,2001,2002, 2003, 2006, 2009, 2010, 2011, 
2013, 2014 Free Software Foundation, Inc.
+;;;; Copyright (C) 1998,1999,2000,2001,2002, 2003, 2006, 2009, 2010, 2011, 
2013, 2014, 2015 Free Software Foundation, Inc.
 ;;;; Copyright (C) 1993-1998 Erick Gallesio - I3S-CNRS/ESSI <address@hidden>
 ;;;;
 ;;;; This library is free software; you can redistribute it and/or
@@ -58,6 +58,7 @@
             <boolean> <char> <list> <pair> <null> <string> <symbol>
             <vector> <bytevector> <uvec> <foreign> <hashtable>
             <fluid> <dynamic-state> <frame> <vm> <vm-continuation>
+            <keyword>
 
             ;; Numbers.
             <number> <complex> <real> <integer> <fraction>
@@ -71,7 +72,7 @@
             ;; smob-type-name->class procedure.
             <arbiter> <promise> <thread> <mutex> <condition-variable>
             <regexp> <hook> <bitvector> <random-state> <async>
-            <directory> <keyword> <array> <character-set>
+            <directory> <array> <character-set>
             <dynamic-object> <guardian> <macro>
 
             ;; Modules.
@@ -1740,7 +1741,6 @@
 (define <random-state> (find-subclass <top> '<random-state>))
 (define <async> (find-subclass <top> '<async>))
 (define <directory> (find-subclass <top> '<directory>))
-(define <keyword> (find-subclass <top> '<keyword>))
 (define <array> (find-subclass <top> '<array>))
 (define <character-set> (find-subclass <top> '<character-set>))
 (define <dynamic-object> (find-subclass <top> '<dynamic-object>))
diff --git a/module/system/base/types.scm b/module/system/base/types.scm
index 6c1d40d..c051b31 100644
--- a/module/system/base/types.scm
+++ b/module/system/base/types.scm
@@ -1,5 +1,5 @@
 ;;; 'SCM' type tag decoding.
-;;; Copyright (C) 2014 Free Software Foundation, Inc.
+;;; Copyright (C) 2014, 2015 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 as published by
@@ -251,6 +251,7 @@ the matching bits, possibly with bitwise operations to 
extract it from BITS."
 (define %tc7-stringbuf 39)
 (define %tc7-dynamic-state 45)
 (define %tc7-frame 47)
+(define %tc7-keyword 53)
 (define %tc7-program 69)
 (define %tc7-vm-continuation 71)
 (define %tc7-bytevector 77)
@@ -472,6 +473,8 @@ using BACKEND."
            (inferior-object 'hash-table address))
           (((_ & #x7f = %tc7-pointer) address)
            (make-pointer address))
+          (((_ & #x7f = %tc7-keyword) symbol)
+           (symbol->keyword (cell->object symbol backend)))
           (((_ & #x7f = %tc7-vm-continuation))
            (inferior-object 'vm-continuation address))
           (((_ & #x7f = %tc7-weak-set))
diff --git a/module/system/vm/assembler.scm b/module/system/vm/assembler.scm
index 8b9a70e..19f8120 100644
--- a/module/system/vm/assembler.scm
+++ b/module/system/vm/assembler.scm
@@ -1002,6 +1002,7 @@ returned instead."
 ;(define-tc7-macro-assembler br-if-fluid 37)
 ;(define-tc7-macro-assembler br-if-dynamic-state 45)
 ;(define-tc7-macro-assembler br-if-frame 47)
+(define-tc7-macro-assembler br-if-keyword 53)
 ;(define-tc7-macro-assembler br-if-vm 55)
 ;(define-tc7-macro-assembler br-if-vm-cont 71)
 ;(define-tc7-macro-assembler br-if-rtl-program 69)
diff --git a/module/system/vm/disassembler.scm 
b/module/system/vm/disassembler.scm
index adacf1b..08aa057 100644
--- a/module/system/vm/disassembler.scm
+++ b/module/system/vm/disassembler.scm
@@ -1,6 +1,6 @@
 ;;; Guile bytecode disassembler
 
-;;; Copyright (C) 2001, 2009, 2010, 2012, 2013, 2014 Free Software Foundation, 
Inc.
+;;; Copyright (C) 2001, 2009, 2010, 2012, 2013, 2014, 2015 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
@@ -215,6 +215,7 @@ address of that offset."
                         ((7) "variable?")
                         ((13) "vector?")
                         ((15) "string?")
+                        ((53) "keyword?")
                         ((77) "bytevector?")
                         ((95) "bitvector?")
                         (else (number->string tc7)))))
diff --git a/test-suite/tests/types.test b/test-suite/tests/types.test
index ea71d3c..c68262b 100644
--- a/test-suite/tests/types.test
+++ b/test-suite/tests/types.test
@@ -1,6 +1,6 @@
 ;;;; types.test --- Type tag decoding.      -*- mode: scheme; coding: utf-8; 
-*-
 ;;;;
-;;;;   Copyright (C) 2014 Free Software Foundation, Inc.
+;;;;   Copyright (C) 2014, 2015 Free Software Foundation, Inc.
 ;;;;
 ;;;; This file is part of GNU Guile.
 ;;;;
@@ -48,7 +48,7 @@
    42 (expt 2 28) 3.14
    "narrow string" "wide στρινγ"
    'symbol 'λ
-   ;; NB: keywords are SMOBs.
+   #:keyword #:λ
    '(2 . 3) (iota 123) '(1 (two ("three")))
    #(1 2 3) #(foo bar baz)
    #vu8(255 254 253)
@@ -98,7 +98,6 @@
 (with-test-prefix "opaque objects"
   (test-inferior-objects
    ((make-guardian) smob (? integer?))
-   (#:keyword smob (? integer?))
    ((%make-void-port "w") port (? integer?))
    ((open-input-string "hello") port (? integer?))
    ((lambda () #t) program _)