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

values and call-with-values now have proper names when printed. 

e.g. #<procedure values> and #<procedure call-with-values>
This commit is contained in:
Abdulaziz Ghuloum 2007-12-05 01:33:47 -05:00
parent dbf3620a0c
commit 171604d7fc
3 changed files with 6 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
scheme/ikarus.compiler.ss
View File

@ -2284,6 +2284,7 @@
(let ([L_values_one_value (gensym)] (let ([L_values_one_value (gensym)]
[L_values_many_values (gensym)]) [L_values_many_values (gensym)])
(list 0 ; no freevars (list 0 ; no freevars
'(name values)
(label SL_values) (label SL_values)
(cmpl (int (argc-convention 1)) eax) (cmpl (int (argc-convention 1)) eax)
(je (label L_values_one_value)) (je (label L_values_one_value))
@ -2315,6 +2316,7 @@
[L_cwv_call (gensym)]) [L_cwv_call (gensym)])
(list (list
0 ; no free vars 0 ; no free vars
'(name call-with-values)
(label SL_call_with_values) (label SL_call_with_values)
(cmpl (int (argc-convention 2)) eax) (cmpl (int (argc-convention 2)) eax)
(jne (label (sl-invalid-args-label))) (jne (label (sl-invalid-args-label)))

6
scheme/ikarus.intel-assembler.ss
View File

@ -1067,9 +1067,9 @@
(cdr ls))) (cdr ls)))
(define (code-name ls) (define (code-name ls)
(let ([a (cadr ls)]) (let ([a (cadr ls)])
(and (pair? a) (if (and (pair? a) (eq? (car a) 'name))
(eq? (car a) 'name)) (cadr a)
(cadr a))) #f)))
(let ([closure-size* (map car ls*)] (let ([closure-size* (map car ls*)]
[code-name* (map code-name ls*)] [code-name* (map code-name ls*)]
[ls* (map code-list ls*)]) [ls* (map code-list ls*)])

2
scheme/last-revision
View File

@ -1 +1 @@
1180 1182