Skip to content

Commit

Permalink
actually use a VOP
Browse files Browse the repository at this point in the history
the cross-compiler is built knowing that some functions (usually as a
result of code transformations) should never be compiled as calls, but
should instead be /translated/ using one of our Virtual OPerations.
DATA-VECTOR-REF, which the AREF in our scratch.lisp file translates to
because of the type declarations, is one such function, so we need to
define it: and also define it in such a way that it will be used no
matter what the current compiler policy.
  • Loading branch information
csrhodes committed Aug 7, 2018
1 parent 506323c commit 76186a4
Show file tree
Hide file tree
Showing 2 changed files with 5 additions and 1 deletion.
5 changes: 4 additions & 1 deletion src/compiler/rv32/array.lisp
Expand Up @@ -13,8 +13,11 @@


(macrolet (macrolet
((def-full-data-vector-frobs (type element-type &rest scs) ((def-full-data-vector-frobs (type element-type &rest scs)
(let ((setname (symbolicate "DATA-VECTOR-SET/" type))) (let ((refname (symbolicate "DATA-VECTOR-REF/" type))
(setname (symbolicate "DATA-VECTOR-SET/" type)))
`(progn `(progn
(define-full-reffer ,refname ,type
vector-data-offset other-pointer-lowtag ,scs ,element-type data-vector-ref)
(define-full-setter ,setname ,type (define-full-setter ,setname ,type
vector-data-offset other-pointer-lowtag ,scs ,element-type data-vector-set)))) vector-data-offset other-pointer-lowtag ,scs ,element-type data-vector-set))))
(def-partial-data-vector-frobs (type element-type size signed &rest scs) (def-partial-data-vector-frobs (type element-type size signed &rest scs)
Expand Down
1 change: 1 addition & 0 deletions src/compiler/rv32/macros.lisp
Expand Up @@ -15,6 +15,7 @@
`(progn `(progn
(define-vop (,name) (define-vop (,name)
,@(when translate `((:translate ,translate))) ,@(when translate `((:translate ,translate)))
(:policy :fast-safe)
(:args (object :scs (descriptor-reg)) (index :scs (any-reg))) (:args (object :scs (descriptor-reg)) (index :scs (any-reg)))
(:arg-types ,type tagged-num) (:arg-types ,type tagged-num)
(:results (value :scs ,scs)) (:results (value :scs ,scs))
Expand Down

0 comments on commit 76186a4

Please sign in to comment.