;;; Continuation-passing style (CPS) intermediate language (IL)
-;; Copyright (C) 2013 Free Software Foundation, Inc.
+;; Copyright (C) 2013, 2014 Free Software Foundation, Inc.
;;;; This library is free software; you can redistribute it and/or
;;;; modify it under the terms of the GNU Lesser General Public
(emit-builtin-ref asm dst (constant name)))
(($ $primcall 'bv-u8-ref (bv idx))
(emit-bv-u8-ref asm dst (slot bv) (slot idx)))
+ (($ $primcall 'bv-s8-ref (bv idx))
+ (emit-bv-s8-ref asm dst (slot bv) (slot idx)))
(($ $primcall 'bv-u16-ref (bv idx))
(emit-bv-u16-ref asm dst (slot bv) (slot idx)))
(($ $primcall 'bv-s16-ref (bv idx))
(define (compile-effect label exp k nlocals)
(match exp
(($ $values ()) #f)
- (($ $prompt escape? tag handler pop)
+ (($ $prompt escape? tag handler)
(match (lookup-cont handler)
(($ $ktrunc ($ $arity req () rest () #f) khandler-body)
(let ((receive-args (gensym "handler"))
(emit-wind asm (slot winder) (slot unwinder)))
(($ $primcall 'bv-u8-set! (bv idx val))
(emit-bv-u8-set! asm (slot bv) (slot idx) (slot val)))
+ (($ $primcall 'bv-s8-set! (bv idx val))
+ (emit-bv-s8-set! asm (slot bv) (slot idx) (slot val)))
(($ $primcall 'bv-u16-set! (bv idx val))
(emit-bv-u16-set! asm (slot bv) (slot idx) (slot val)))
(($ $primcall 'bv-s16-set! (bv idx val))
(unless (eq? kf next-label)
(emit-br asm kf)))))
(match exp
- (($ $values (sym)) (unary emit-br-if-true sym))
+ (($ $values (sym))
+ (call-with-values (lambda ()
+ (lookup-maybe-constant-value sym allocation))
+ (lambda (has-const? val)
+ (if has-const?
+ (if val
+ (unless (eq? kt next-label)
+ (emit-br asm kt))
+ (unless (eq? kf next-label)
+ (emit-br asm kf)))
+ (unary emit-br-if-true sym)))))
(($ $primcall 'null? (a)) (unary emit-br-if-null a))
(($ $primcall 'nil? (a)) (unary emit-br-if-nil a))
(($ $primcall 'pair? (a)) (unary emit-br-if-pair a))