* added code? to the compiler.

src/ikarus.code-objects.ss

@@ -1,12 +1,13 @@
 
 (library (ikarus code-objects)
   (export
-    make-code code? code-reloc-vector code-freevars
+    make-code code-reloc-vector code-freevars
-    code-size code-ref code-set! set-code-reloc-vector!)
+    code-size code-ref code-set! set-code-reloc-vector!
+    code->thunk)
   (import
     (ikarus system $fx)
     (ikarus system $codes)
-    (except (ikarus) make-code code? code-reloc-vector code-freevars
+    (except (ikarus) make-code code-reloc-vector code-freevars
             code-size code-ref code-set! set-code-reloc-vector!))
 
   (define make-code
@@ -17,9 +18,6 @@
         (error 'make-code "~s is not a valid number of free vars" freevars))
       (foreign-call "ikrt_make_code" code-size freevars '#())))
 
-  (define code?
-    (lambda (x) ($code? x)))
-
   (define code-reloc-vector
     (lambda (x)
       (unless ($code? x) (error 'code-reloc-vector "~s is not a code" x))
@@ -64,5 +62,14 @@
       (unless (vector? v)
         (error 'set-code-reloc-vector! "~s is not a vector" v))
       (foreign-call "ikrt_set_code_reloc_vector" x v)))
+
+  (define code->thunk
+    (lambda (x)
+      (unless ($code? x)
+        (error 'code->thunk "~s is not a a code object" x))
+      (unless ($fxzero? ($code-freevars x))
+        (error 'code->thunk "~s has free variables" x))
+      ($code->closure x)))
+
   )
 

src/ikarus.compiler.ss

@@ -190,6 +190,7 @@
     ;;; asm
     ;;;
     [$code?              1    pred]
+    [code?              1    pred]
     [$code-size          1    value]
     [$code-reloc-vector  1    value]
     [$code-freevars      1    value]
@@ -2017,7 +2018,7 @@
     (case op
       [(fixnum? flonum? bignum? immediate? boolean? char? vector? string? procedure?
         null? pair? not cons eq? vector symbol? error eof-object eof-object? 
-        void base-rtd $unbound-object? $code? $forward-ptr? bwp-object?
+        void base-rtd $unbound-object? $code? code? $forward-ptr? bwp-object?
         pointer-value top-level-value car cdr list* list $record
         port? input-port? output-port?
         $make-port/input $make-port/output $make-port/both
@@ -3327,7 +3328,7 @@
      [(not)        (Pred (car rand*) Lf Lt ac)]
      [(eof-object?) (type-pred #f eof rand* Lt Lf ac)]
      [(bwp-object?) (type-pred #f bwp-object rand* Lt Lf ac)]
-     [($code?) 
+     [($code? code?) 
       (indirect-type-pred vector-mask vector-tag #f code-tag 
          rand* Lt Lf ac)]
      [($fxzero?)   (type-pred #f 0 rand* Lt Lf ac)]
@@ -4092,7 +4093,8 @@
      [(fixnum? bignum? flonum? immediate? $fxzero? boolean? char? pair? 
        vector? string? symbol?
        procedure? null? not eof-object? $fx= $fx< $fx<= $fx> $fx>= eq?
-       $char= $char< $char<= $char> $char>= $unbound-object? $code? 
+       $char= $char< $char<= $char> $char>= $unbound-object? $code?
+       code?
        $record? $record/rtd? bwp-object? port? input-port? output-port?) 
       (do-pred->value-prim op arg* ac)]
      [($code->closure)

src/ikarus.fasl.ss

@@ -35,6 +35,7 @@
   (import
     (ikarus system $codes)
     (ikarus system $records)
+    (ikarus code-objects)
     (except (ikarus) fasl-write))
 
   (define write-fixnum 

src/ikarus.intel-assembler.ss

@@ -1,47 +1,10 @@
 
-;;; 
-;;; assuming the existence of a code manager, this file defines an assember
-;;; that takes lists of assembly code and produces a list of code objects
-;;;
-
-   ;;;      add     
-   ;;;      and
-   ;;;      cmp
-   ;;;      call
-   ;;;      cltd
-   ;;;      idiv
-   ;;;      imull
-   ;;;      ja
-   ;;;      jae
-   ;;;      jb
-   ;;;      jbe
-   ;;;      je
-   ;;;      jg
-   ;;;      jge
-   ;;;      jl
-   ;;;      jle
-   ;;;      jne
-   ;;;      jmp
-   ;;;      movb
-   ;;;      movl
-   ;;;      negl
-   ;;;      notl
-   ;;;      orl
-   ;;;      popl
-   ;;;      pushl
-   ;;;      ret
-   ;;;      sall
-   ;;;      sarl
-   ;;;      shrl
-   ;;;      sete
-   ;;;      setg
-
 
 (library (ikarus intel-assembler)
   (export assemble-sources)
   (import 
     (ikarus)
-    (ikarus system $codes)
+    (ikarus code-objects)
     (ikarus system $pairs))
 
 (define fold
@@ -894,7 +857,7 @@
                              (error 'whack-reloc 
                                "cannot create a thunk pointing at ~s"
                                idx))
-                           (let ([thunk ($code->closure code)])
+                           (let ([thunk (code->thunk code)])
                              (set-cdr! (cdr p) (list thunk))
                              thunk))]
                         [else (caddr p)])))]

src/ikarus.predicates.ss

@@ -4,14 +4,14 @@
   (export fixnum? flonum? bignum? number? complex? real? rational?
           integer? exact? eof-object? bwp-object? immediate?
           boolean? char? vector? string? procedure? null? pair?
-          symbol? not weak-pair? eq? eqv? equal?) 
+          symbol? code? not weak-pair? eq? eqv? equal?) 
 
   (import 
 
     (except (ikarus) fixnum? flonum? bignum? number? complex? real?
             rational? integer? exact? eof-object? bwp-object?
             immediate? boolean? char? vector? string? procedure?
-            null? pair? weak-pair? symbol? not eq? eqv? equal?
+            null? pair? weak-pair? symbol? code? not eq? eqv? equal?
             port? input-port? output-port?)
     (ikarus system $fx)
     (ikarus system $pairs)
@@ -20,7 +20,7 @@
     (ikarus system $vectors)
     (rename (only (ikarus) fixnum? flonum? bignum? eof-object?
                   bwp-object? immediate? boolean? char? vector? string?
-                  procedure? null? pair? symbol? eq?
+                  procedure? null? pair? symbol? code? eq?
                   port? input-port? output-port?)
             (fixnum? sys:fixnum?)
             (flonum? sys:flonum?)
@@ -36,6 +36,7 @@
             (null? sys:null?)
             (pair? sys:pair?)
             (symbol? sys:symbol?)
+            (code? sys:code?)
             (eq? sys:eq?)
             (port? sys:port?)
             (input-port? sys:input-port?)
@@ -99,7 +100,7 @@
   (define null? (lambda (x) (sys:null? x)))
   (define pair? (lambda (x) (sys:pair? x)))
   (define symbol? (lambda (x) (sys:symbol? x)))
-
+  (define code? (lambda (x) (sys:code? x)))
 
 
   (define weak-pair?

src/makefile.ss

@@ -52,8 +52,8 @@
       "ikarus.writer.ss"
       "ikarus.reader.ss"
       "ikarus.code-objects.ss"
-      "ikarus.trace.ss"
       "ikarus.intel-assembler.ss"
+      "ikarus.trace.ss"
       "ikarus.fasl.ss"
       "ikarus.compiler.ss"
       "ikarus.library-manager.ss"
@@ -394,13 +394,6 @@
       [generate-temporaries              i]
       [free-identifier=?                 i]
       [code?                             i]
-      [make-code                         i]
-      [code-reloc-vector                 i]
-      [set-code-reloc-vector!            i]
-      [code-size                         i]
-      [code-freevars                     i]
-      [code-ref                          i]
-      [code-set!                         i]
       [immediate?                        i]
       [pointer-value                     i]