mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-21 20:20:24 +02:00
Code Activity

compile list' and vector' to their associated opcodes

Browse source 
* module/language/glil/compile-assembly.scm (glil->assembly): Check the
  length when emitting calls to variable-argument stack instructions.
  Allow two-byte lengths -- allows e.g. calls to `list' with more than
  256 arguments.

* module/language/tree-il/compile-glil.scm: Add primcall associations for
  `list' and `vector', with any number of arguments. Necessary because
  syncase's quasiquote expansions will produce calls to `list' with many
  arguments.

* module/language/tree-il/optimize.scm (*interesting-primitive-names*):
  Add `list' and `vector' to the set of primitives to resolve.
This commit is contained in:
Andy Wingo 2009-05-20 13:33:44 +02:00
parent 5af166bda2
commit c11f46afe1
3 changed files with 14 additions and 4 deletions
Download patch file Download diff file Expand all files Collapse all files

7
module/language/glil/compile-assembly.scm
View file

@ -312,7 +312,12 @@
(error "Unknown instruction:" inst))
(let ((pops (instruction-pops inst)))
(cond ((< pops 0)
(emit-code `((,inst ,nargs))))
(case (instruction-length inst)
((1) (emit-code `((,inst ,nargs))))
((2) (emit-code `((,inst ,(quotient nargs 256)
,(modulo nargs 256)))))
(else (error "Unknown length for variable-arg instruction:"
inst (instruction-length inst)))))
((= pops nargs)
(emit-code `((,inst))))
(else

9
module/language/tree-il/compile-glil.scm
View file

@ -79,7 +79,9 @@
((set-car! . 2) . set-car!)
((set-cdr! . 2) . set-cdr!)
((null? . 1) . null?)
((list? . 1) . list?)))
((list? . 1) . list?)
(list . list)
(vector . vector)))
(define (make-label) (gensym ":L"))
@ -254,8 +256,9 @@
(emit-code src (make-glil-call 'drop 1)))))
((and (primitive-ref? proc)
(hash-ref *primcall-ops*
(cons (primitive-ref-name proc) (length args))))
(or (hash-ref *primcall-ops*
(cons (primitive-ref-name proc) (length args)))
(hash-ref *primcall-ops* (primitive-ref-name proc))))
=> (lambda (op)
(for-each comp-push args)
(emit-code src (make-glil-call op (length args)))

2
module/language/tree-il/optimize.scm
View file

@ -53,6 +53,8 @@
not
pair? null? list? acons cons cons*
list vector
car cdr
set-car! set-cdr!