src/compiler/alpha/values.lisp

   1 ;;; -*- Package: ALPHA -*-
   2 ;;;
   3 ;;; **********************************************************************
   4 ;;; This code was written as part of the CMU Common Lisp project at
   5 ;;; Carnegie Mellon University, and has been placed in the public domain.
   6 ;;;
   7
   8 ;;;
   9 ;;; **********************************************************************
  10 ;;;
  11 ;;;    This file contains the implementation of unknown-values VOPs.
  12 ;;;
  13 ;;; Written by Rob MacLachlan
  14 ;;;
  15 ;;; Converted to the Alpha by Sean Hallgren.
  16 ;;;
  17
  18 (in-package "SB!VM")
  19
  20
  21 (define-vop (reset-stack-pointer)
  22   (:args (ptr :scs (any-reg)))
  23   (:generator 1
  24     (move ptr csp-tn)))
  25
  26
  27 ;;; Push some values onto the stack, returning the start and number of values
  28 ;;; pushed as results.  It is assumed that the Vals are wired to the standard
  29 ;;; argument locations.  Nvals is the number of values to push.
  30 ;;;
  31 ;;; The generator cost is pseudo-random.  We could get it right by defining a
  32 ;;; bogus SC that reflects the costs of the memory-to-memory moves for each
  33 ;;; operand, but this seems unworthwhile.
  34 ;;;
  35 (define-vop (push-values)
  36   (:args
  37    (vals :more t))
  38   (:results
  39    (start :scs (any-reg))
  40    (count :scs (any-reg)))
  41   (:info nvals)
  42   (:temporary (:scs (descriptor-reg)) temp)
  43   (:temporary (:scs (descriptor-reg)
  44                :to (:result 0)
  45                :target start)
  46               start-temp)
  47   (:generator 20
  48     (move csp-tn start-temp)
  49     (inst lda csp-tn (* nvals word-bytes) csp-tn)
  50     (do ((val vals (tn-ref-across val))
  51          (i 0 (1+ i)))
  52         ((null val))
  53       (let ((tn (tn-ref-tn val)))
  54         (sc-case tn
  55           (descriptor-reg
  56            (storew tn start-temp i))
  57           (control-stack
  58            (load-stack-tn temp tn)
  59            (storew temp start-temp i)))))
  60     (move start-temp start)
  61     (inst li (fixnumize nvals) count)))
  62
  63
  64 ;;; Push a list of values on the stack, returning Start and Count as used in
  65 ;;; unknown values continuations.
  66 ;;;
  67 (define-vop (values-list)
  68   (:args (arg :scs (descriptor-reg) :target list))
  69   (:arg-types list)
  70   (:policy :fast-safe)
  71   (:results (start :scs (any-reg))
  72             (count :scs (any-reg)))
  73   (:temporary (:scs (descriptor-reg) :type list :from (:argument 0)) list)
  74   (:temporary (:scs (non-descriptor-reg)) temp)
  75   (:temporary (:scs (non-descriptor-reg)) ndescr)
  76   (:vop-var vop)
  77   (:save-p :compute-only)
  78   (:generator 0
  79     (move arg list)
  80     (move csp-tn start)
  81
  82     LOOP
  83     (inst cmpeq list null-tn temp)
  84     (inst bne temp done)
  85     (loadw temp list cons-car-slot list-pointer-type)
  86     (loadw list list cons-cdr-slot list-pointer-type)
  87     (inst lda csp-tn word-bytes csp-tn)
  88     (storew temp csp-tn -1)
  89     (inst and list lowtag-mask ndescr)
  90     (inst xor ndescr list-pointer-type ndescr)
  91     (inst beq ndescr loop)
  92     (error-call vop bogus-argument-to-values-list-error list)
  93
  94     DONE
  95     (inst subq csp-tn start count)))
  96
  97 ;;; Copy the more arg block to the top of the stack so we can use them
  98 ;;; as function arguments.
  99 ;;;
 100 (define-vop (%more-arg-values)
 101   (:args (context :scs (descriptor-reg any-reg) :target src)
 102          (skip :scs (any-reg zero immediate))
 103          (num :scs (any-reg) :target count))
 104   (:arg-types * positive-fixnum positive-fixnum)
 105   (:temporary (:sc any-reg :from (:argument 0)) src)
 106   (:temporary (:sc any-reg :from (:argument 2)) dst)
 107   (:temporary (:sc descriptor-reg :from (:argument 1)) temp)
 108   (:temporary (:sc non-descriptor-reg) temp1)
 109   (:results (start :scs (any-reg))
 110             (count :scs (any-reg)))
 111   (:generator 20
 112     (sc-case skip
 113       (zero
 114        (move context src))
 115       (immediate
 116        (inst lda src (* (tn-value skip) word-bytes) context))
 117       (any-reg
 118        (inst addq context skip src)))
 119     (move num count)
 120     (inst move csp-tn start)
 121     (inst beq num done)
 122     (inst move csp-tn dst)
 123     (inst addq csp-tn count csp-tn)
 124     LOOP
 125     (inst ldl temp 0 src)
 126     (inst addq src 4 src)
 127     (inst addq dst 4 dst)
 128     (inst stl temp -4 dst)
 129     (inst cmpeq dst csp-tn temp1)
 130     (inst beq temp1 loop)
 131     DONE))