added $closure-code system primitive that returns the code of a closure

lib/libcompile.ss

@@ -184,6 +184,7 @@
     [$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]
@@ -1318,6 +1319,7 @@
         $set-symbol-unique-string!
         $set-symbol-string!
         $seal-frame-and-call  $frame->continuation $code->closure
+        $closure-code
         $code-size $code-reloc-vector $code-freevars 
         $code-ref $code-set!
         $make-record $record? $record/rtd? $record-rtd $record-ref $record-set!
@@ -3006,6 +3008,10 @@
        (indirect-ref arg* (fx- disp-code-relocsize vector-tag) ac)]
      [($code-freevars) 
        (indirect-ref arg* (fx- disp-code-freevars vector-tag) ac)]
+     [($closure-code)
+      (indirect-ref arg* (fx- disp-closure-code closure-tag)
+        (list* (addl (int (fx- vector-tag disp-code-data)) eax)
+               ac))]
      [($set-car! $set-cdr! $vector-set! $string-set! $exit
        $set-symbol-value! $set-symbol-plist! 
        $code-set!  primitive-set! 

lib/libwriter.ss

@@ -308,8 +308,8 @@
            (if (procedure? printer)
                (begin (printer x p) i)
                (write-shareable x p m h i write-record)))]
-        ;[(code? x)
-        ; (write-char* "#<code>" p)]
+        [(code? x)
+         (write-char* "#<code>" p)]
         [(hash-table? x)
          (write-char* "#<hash-table>" p)
          i]

lib/makefile.ss

@@ -1,4 +1,4 @@
-
+#!/Users/aghuloum/.opt/bin/ikarus --script
 
 ;;; 9.1: * starting with libnumerics
 ;;; 9.0: * graph marks for both reader and writer