diff --git a/src/ikarus.boot b/src/ikarus.boot
index 9c1f032..e23222f 100644
Binary files a/src/ikarus.boot and b/src/ikarus.boot differ
diff --git a/src/ikarus.compiler.ss b/src/ikarus.compiler.ss
index 0d925a6..ce45a43 100644
--- a/src/ikarus.compiler.ss
+++ b/src/ikarus.compiler.ss
@@ -42,203 +42,6 @@
 
 (include "set-operations.ss")
 
-
-(define open-coded-primitives
-;;; these primitives, when found in operator position with the correct
-;;; number of arguments, will be open-coded by the generator.  If an 
-;;; incorrect number of args is detected, or if they appear in non-operator
-;;; position, then they cannot be open-coded, and the pcb-primitives table
-;;; is consulted for a reference of the pcb slot containing the primitive.
-;;; If it's not found there, an error is signalled.
-;;;
-;;; prim-name          args
-  '([$constant-ref      1   value]
-    [$constant-set!     2   effect]
-    [$pcb-ref           1   value]
-    [$pcb-set!          2   effect]
-    ;;; type predicates
-    [fixnum?            1   pred]
-    [bignum?            1   pred]
-    [flonum?            1   pred]
-    [immediate?         1   pred]
-    [boolean?           1   pred]
-    [char?              1   pred]
-    [pair?              1   pred]
-    [symbol?            1   pred]
-    [vector?            1   pred]
-    [string?            1   pred]
-    [procedure?         1   pred]
-    [null?              1   pred]
-    [eof-object?        1   pred]
-    [bwp-object?        1   pred]
-    [$unbound-object?   1   pred]
-    [$forward-ptr?      1   pred]
-    [not                1   pred]
-    [pointer-value      1  value]
-    [eq?                2   pred]
-    ;;; fixnum primitives
-    [$fxadd1            1   value]
-    [$fxsub1            1   value]
-    [$fx+               2   value]
-    [$fx-               2   value]
-    [$fx*               2   value]
-    [$fxsll             2   value]
-    [$fxsra             2   value]
-    [$fxlogand          2   value]
-    [$fxlogor           2   value]
-    [$fxlogxor          2   value]
-    [$fxlognot          1   value]
-    [$fxquotient        2   value]
-    [$fxmodulo          2   value]
-    ;;; fixnum predicates
-    [$fxzero?           1   pred]
-    [$fx=               2   pred]
-    [$fx<               2   pred]
-    [$fx<=              2   pred]
-    [$fx>               2   pred]
-    [$fx>=              2   pred]
-    ;;; character predicates
-    [$char=             2   pred]
-    [$char<             2   pred]
-    [$char<=            2   pred]
-    [$char>             2   pred]
-    [$char>=            2   pred]
-    ;;; character conversion
-    [$fixnum->char      1   value]
-    [$char->fixnum      1   value]
-    ;;; lists/pairs
-    [cons               2   value]
-    [list*         positive value]
-    [list             any   value]
-    [car                1   value]
-    [cdr                1   value]
-    [$car               1   value]
-    [$cdr               1   value]
-    [$set-car!          2   effect]
-    [$set-cdr!          2   effect]
-    ;;; vectors
-    [$make-vector       1   value]
-    [vector           any   value]
-    [$vector-length     1   value]
-    [$vector-ref        2   value]
-    [$vector-set!       3   effect]
-    ;;; strings
-    [$make-string       1   value]
-    [$string          any   value]
-    [$string-length     1   value]
-    [$string-ref        2   value]
-    [$string-set!       3   effect]
-    ;;; bytevectors
-    [bytevector?        1   pred]
-    [$make-bytevector   1   value]
-    [$bytevector-length 1   value]
-    [$bytevector-u8-ref    2   value]
-    [$bytevector-s8-ref    2   value]
-    [$bytevector-set!   3   effect]
-    ;;; bignums
-    [$make-bignum       2   value]
-    [$bignum-positive?  1   pred]
-    [$bignum-size       1   value]
-    [$bignum-byte-ref   2   value]
-    [$bignum-byte-set!  3   effect]
-    ;;; ratnums
-    [$make-ratnum       2   value]
-    [ratnum?            1   pred]
-    [$ratnum-n          1   value]
-    [$ratnum-d          1   value]
-    ;;; symbols
-    [$make-symbol       1   value]
-    [$symbol-value      1   value]
-    [$symbol-string     1   value]
-    [$symbol-unique-string     1   value]
-    [$set-symbol-value! 2   effect]
-    [$set-symbol-function! 2   effect]
-    [$set-symbol-string! 2   effect]
-    [$set-symbol-unique-string! 2   effect]
-    [$symbol-plist      1   value]
-    [$set-symbol-plist! 2   effect]
-    [top-level-value      1   value]
-    ;;; ports
-    [port?                    1 pred]
-    [input-port?              1 pred]
-    [output-port?             1 pred]
-    [$make-port/input         7 value]
-    [$make-port/output        7 value]
-    [$make-port/both          7 value]
-    [$port-handler            1 value]
-    [$port-input-buffer       1 value]
-    [$port-input-index        1 value]
-    [$port-input-size         1 value]
-    [$port-output-buffer      1 value]
-    [$port-output-index       1 value]
-    [$port-output-size        1 value]
-    [$set-port-input-index!   2 effect]
-    [$set-port-input-size!    2 effect]
-    [$set-port-output-index!  2 effect]
-    [$set-port-output-size!   2 effect]
-    ;;; tcbuckets
-    [$make-tcbucket       4   value]
-    [$tcbucket-key        1   value]
-    [$tcbucket-val        1   value]
-    [$tcbucket-next       1   value]
-    [$set-tcbucket-val!   2  effect]
-    [$set-tcbucket-next!  2  effect]
-    [$set-tcbucket-tconc! 2  effect]
-    ;;; misc
-    [eof-object         0   value]
-    [void               0   value]
-    [$exit              1   effect]
-    [$fp-at-base        0   pred]
-    [$current-frame     0   value]
-    [$arg-list          0   value]
-    [base-rtd           0   value]
-    [$seal-frame-and-call 1  tail]
-    [$frame->continuation 1 value]
-    [$interrupted?       0   pred]
-    [$unset-interrupted! 0 effect]
-    ;;; 
-    ;;; records
-    ;;;
-    [$make-record       2   value]
-    [$record?           1    pred]
-    [$record/rtd?       2    pred]
-    [$record-rtd        1   value]
-    [$record-ref        2   value]
-    [$record-set!       3  effect]
-    [$record          any   value]
-    ;;;
-    ;;; asm
-    ;;;
-    [code?              1    pred]
-    [$code-size          1    value]
-    [$code-reloc-vector  1    value]
-    [$code-freevars      1    value]
-    [$code-ref           2    value]
-    [$code-set!          3    value]
-    [$code->closure      1    value]
-    [$closure-code       1    value]
-    ;;;
-    [$make-call-with-values-procedure 0 value]
-    [$make-values-procedure 0 value]
-   ))
-
-(define (primitive-context x)
-  (cond
-    [(assq x open-coded-primitives) => caddr]
-    [else (error 'primitive-context "unknown prim ~s" x)]))
-
-(define (open-codeable? x)
-  (cond
-    [(assq x open-coded-primitives) #t]
-    [else  #f]))
-
-(define (open-coded-primitive-args x)
-  (cond
-    [(assq x open-coded-primitives) => cadr]
-    [else (error 'open-coded-primitive-args "invalid ~s" x)]))
-
-;;; end of primitives table section
-
   
 (define-record constant (value))
 (define-record code-loc (label))
diff --git a/src/lab/ikarus.r6rs.records.procedural.ss b/src/lab/ikarus.r6rs.records.procedural.ss
index edfa575..7dc6bd9 100644
--- a/src/lab/ikarus.r6rs.records.procedural.ss
+++ b/src/lab/ikarus.r6rs.records.procedural.ss
@@ -4,14 +4,20 @@
     make-record-type-descriptor
     make-record-constructor-descriptor
     record-accessor record-mutator
-    record-constructor record-predicate)
+    record-constructor record-predicate
+    record? record-rtd record-type-name
+    record-type-parent record-type-uid record-type-generative?
+    record-type-sealed? record-type-opaque? record-type-field-names)
   (import 
-    (except (ikarus) record-constructor record-predicate
-            set-rtd-printer!)
+    (except (ikarus) record-constructor record-predicate set-rtd-printer!
+            record? record-type-name record-type-parent
+            record-type-field-names)
+    (prefix (only (ikarus) set-rtd-printer!) core:)
     (ikarus system $records))
 
   (define-record rtd 
     (name size old-fields printer symbol parent sealed? opaque? uid fields))
+
   (define rtd-alist '())
   (define (intern-rtd! uid rtd)
     (set! rtd-alist (cons (cons uid rtd) rtd-alist)))
@@ -23,20 +29,78 @@
 
   (define (record-type-descriptor? x) (rtd? x))
 
+  (define (record? x)
+    (and ($record? x) 
+         (let ([rtd ($record-rtd x)])
+           (and (rtd? rtd) 
+                (not (rtd-opaque? rtd))))))
+
+  (define (record-rtd x)
+    (define (err x)
+      (error 'record-rtd "~s is not a record" x))
+    (if ($record? x)
+        (let ([rtd ($record-rtd x)])
+          (if (rtd? rtd)
+              (if (not (rtd-opaque? rtd))
+                  rtd
+                  (err x))
+              (err x)))
+        (err x)))
+
+  (define (record-type-name x)
+    (if (rtd? x)
+        (rtd-name x)
+        (error 'record-type-name "~s is not an rtd" x)))
+
+  (define (record-type-parent x)
+    (if (rtd? x)
+        (rtd-parent x)
+        (error 'record-type-parent "~s is not an rtd" x)))
+
+  (define (record-type-uid x)
+    (if (rtd? x)
+        (rtd-uid x)
+        (error 'record-type-uid "~s is not an rtd" x)))
+
+  (define (record-type-sealed? x)
+    (if (rtd? x)
+        (rtd-sealed? x)
+        (error 'record-type-sealed? "~s is not an rtd" x)))
+
+  (define (record-type-opaque? x)
+    (if (rtd? x)
+        (rtd-opaque? x)
+        (error 'record-type-opaque? "~s is not an rtd" x)))
+
+  (define (record-type-generative? x)
+    (if (rtd? x)
+        (not (rtd-sealed? x))
+        (error 'record-type-generative? "~s is not an rtd" x)))
+
+  (define (record-type-field-names x)
+    (if (rtd? x)
+        (let ([v (rtd-fields x)])
+          (let ([n (vector-length v)])
+            (let f ([x (make-vector n)] [v v] [n n] [i 0])
+              (if (= i n) 
+                  x
+                  (begin
+                    (vector-set! x i (cdr (vector-ref v i)))
+                    (f x v n (fxadd1 i)))))))
+        (error 'record-type-field-names "~s is not an rtd" x)))
+
+
   (module (make-record-type-descriptor)
     (define who 'make-record-type-descriptor)
-    (define (make-rtd-aux name parent uid sealed? opaque? fields)
-      (make-rtd name (vector-length fields) #f #f #f parent sealed? opaque? uid fields))
-    (define (convert-fields pfv sv)
+    (define (make-rtd-aux name parent uid sealed? opaque?
+                          parent-size fields)
+      (make-rtd name (+ parent-size (vector-length fields))
+          #f #f #f parent sealed? opaque? uid fields))
+    (define (convert-fields sv)
       (unless (vector? sv) 
         (error who "invalid fields argument ~s" sv))
-      (let ([n1 (vector-length pfv)]
-            [n2 (vector-length sv)])
-        (let ([v (make-vector (+ n1 n2))])
-          (let f ([i 0])
-            (unless (= i n1) 
-              (vector-set! v i (vector-ref pfv i))
-              (f (add1 i))))
+      (let ([n2 (vector-length sv)])
+        (let ([v (make-vector n2)])
           (let f ([i 0])
             (unless (= i n2)
               (let ([x (vector-ref sv i)])
@@ -46,7 +110,7 @@
                           (let ([name (car x)])
                             (unless (and (null? (cdr x)) (symbol? name))
                               (error who "invalid fields argument ~s" sv))
-                            (vector-set! v (+ i n1) 
+                            (vector-set! v i
                               (cons (case m/u
                                       [(mutable)   #t]
                                       [(immutable) #f]
@@ -65,10 +129,11 @@
              (error who "cannot extend sealed parent ~s" parent))
            (make-rtd-aux name parent uid sealed? 
              (or opaque? (rtd-opaque? parent))
-             (convert-fields (rtd-fields parent) fields))]
+             (rtd-size parent)
+             (convert-fields fields))]
           [(eqv? parent #f) 
-           (make-rtd-aux name parent uid sealed? opaque?
-             (convert-fields '#() fields))]
+           (make-rtd-aux name parent uid sealed? opaque? 0
+             (convert-fields fields))]
           [else (error who "~s is not a valid parent" parent)])))
     (define (same-fields-as-rtd? fields rtd)
       (let* ([fv (rtd-fields rtd)]
@@ -146,8 +211,8 @@
              (error who "descriptor ~s does not apply to ~s" 
                     prcd rtd))
            (make-rcd rtd prcd protocol)]
-          [else (error who "~s is not a valid record constructor
-                       descriptor" prcd)]))))
+          [else
+           (error who "~s is not a valid record constructor descriptor" prcd)]))))
 
   (define (iota i n)
     (if (= i n)
@@ -234,7 +299,6 @@
           [prcd (rcd-prcd rcd)])
       (let ([c*
              (let ([n (rtd-size rtd)])
-               (printf "base=~s\n" n)
                (let f ([c0 ((base-constructor-maker n) rtd)]
                        [prcd prcd]
                        [n n])
@@ -243,7 +307,6 @@
                    [else
                     (let ([r (rcd-rtd prcd)])
                       (let ([m (rtd-size r)])
-                        (printf "ext ~s ~s\n" n m)
                         (f ((extended-constructor-maker n m) c0)
                            (rcd-prcd prcd)
                            m)))])))])
@@ -255,10 +318,6 @@
                (let ([proc (rcd-proc rcd)])
                  (if proc (proc c*) c*)))])))))
 
-
-
-
-
   (define (record-accessor rtd k) 
     (define who 'record-accessor)
     (unless (rtd? rtd)
@@ -332,7 +391,14 @@
                        [else (f (rtd-parent prtd) rtd)]))))]
            [else #f]))))
 
+  (core:set-rtd-printer! (type-descriptor rtd)
+    (lambda (x p) 
+      (display (format "#<record-type-descriptor ~s>" (rtd-name x)) p)))
 
+  (core:set-rtd-printer! (type-descriptor rcd)
+    (lambda (x p) 
+      (display (format "#<record-constructor-descriptor ~s>"
+                       (rtd-name (rcd-rtd x))) p)))
                   
 
 
diff --git a/src/libaltcogen.ss b/src/libaltcogen.ss
index 395b3b8..8ec648e 100644
--- a/src/libaltcogen.ss
+++ b/src/libaltcogen.ss
@@ -56,9 +56,6 @@
        (cond
          [(primop? name)
           (make-primcall name arg*)]
-         [(open-codeable? name)
-          (error 'chaitin-compiler "primitive ~s is not supported"
-                 name)]
          [else (make-funcall op arg*)])]
       [else (make-funcall op arg*)]))
   ;;;