conservatory
/
ikarus
4
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

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

This commit is contained in:
Abdulaziz Ghuloum 2006-12-04 09:54:28 -05:00
parent 30a3ce94ef
commit ab6c87b71f
4 changed files with 9 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

BIN
lib/ikarus.boot
View File

Binary file not shown.

6
lib/libcompile.ss
View File

@ -184,6 +184,7 @@
[$code-ref 2 value] [$code-ref 2 value]
[$code-set! 3 value] [$code-set! 3 value]
[$code->closure 1 value] [$code->closure 1 value]
[$closure-code 1 value]
;;; ;;;
[$make-call-with-values-procedure 0 value] [$make-call-with-values-procedure 0 value]
[$make-values-procedure 0 value] [$make-values-procedure 0 value]
@ -1318,6 +1319,7 @@
$set-symbol-unique-string! $set-symbol-unique-string!
$set-symbol-string! $set-symbol-string!
$seal-frame-and-call $frame->continuation $code->closure $seal-frame-and-call $frame->continuation $code->closure
$closure-code
$code-size $code-reloc-vector $code-freevars $code-size $code-reloc-vector $code-freevars
$code-ref $code-set! $code-ref $code-set!
$make-record $record? $record/rtd? $record-rtd $record-ref $record-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)] (indirect-ref arg* (fx- disp-code-relocsize vector-tag) ac)]
[($code-freevars) [($code-freevars)
(indirect-ref arg* (fx- disp-code-freevars vector-tag) ac)] (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-car! $set-cdr! $vector-set! $string-set! $exit
$set-symbol-value! $set-symbol-plist! $set-symbol-value! $set-symbol-plist!
$code-set! primitive-set! $code-set! primitive-set!

4
lib/libwriter.ss
View File

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

2
lib/makefile.ss Normal file → Executable file
View File

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