diff --git a/compiler/fndb.lisp b/compiler/fndb.lisp index 4bd0b3fbab49c7b5394075920fb2b5640753eaac..91a3e1727c0886e19c772fadb7d2b173df5d3180 100644 --- a/compiler/fndb.lisp +++ b/compiler/fndb.lisp @@ -7,7 +7,7 @@ ;;; Scott Fahlman or slisp-group@cs.cmu.edu. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/fndb.lisp,v 1.60 1993/08/25 01:11:21 ram Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/fndb.lisp,v 1.61 1993/09/13 19:30:31 wlott Exp $") ;;; ;;; ********************************************************************** ;;; @@ -1105,6 +1105,7 @@ (defknown %listify-rest-args (t t) list (flushable)) (defknown %more-arg-context (t t) (values t fixnum) (flushable)) (defknown %more-arg (t t) t) +(defknown %more-arg-values (t t) * (flushable)) (defknown %verify-argument-count (index index) (values)) (defknown %argument-count-error (t) nil) (defknown %unknown-values () *) diff --git a/compiler/hppa/values.lisp b/compiler/hppa/values.lisp index 76ff19a0804f1109737a462af46e457f8ee3d6c5..96d76fc0350224ed06ac50cccedd80e43990a445 100644 --- a/compiler/hppa/values.lisp +++ b/compiler/hppa/values.lisp @@ -7,7 +7,7 @@ ;;; Scott Fahlman or slisp-group@cs.cmu.edu. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/hppa/values.lisp,v 1.1 1992/07/13 03:48:39 wlott Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/hppa/values.lisp,v 1.2 1993/09/13 19:30:57 wlott Exp $") ;;; ;;; ********************************************************************** ;;; @@ -87,3 +87,28 @@ DONE (inst sub csp-tn start count))) + +;;; Copy the more arg block to the top of the stack so we can use them +;;; as function arguments. +;;; +(define-vop (%more-arg-values) + (:args (context :scs (descriptor-reg any-reg) :target src) + (num :scs (descriptor-reg any-reg) :target count)) + (:temporary (:sc any-reg :from (:argument 0)) src) + (:temporary (:sc any-reg :from (:argument 1)) dst end) + (:temporary (:sc descriptor-reg :from (:argument 1)) temp) + (:results (start :scs (any-reg)) + (count :scs (any-reg))) + (:generator 20 + (move context src) + (move num count) + (inst comb := num zero-tn done) + (inst move csp-tn start) + (inst move csp-tn dst) + (inst add csp-tn count csp-tn) + (inst addi (- word-bytes) csp-tn end) + LOOP + (inst ldwm 4 src temp) + (inst comb :< dst end loop) + (inst stwm temp 4 dst) + DONE)) diff --git a/compiler/ir2tran.lisp b/compiler/ir2tran.lisp index b391713a723a23cdf0c43c2b5143b72a3fa16445..31b5034f7970a6b0691bf3f0188e176df828042a 100644 --- a/compiler/ir2tran.lisp +++ b/compiler/ir2tran.lisp @@ -7,7 +7,7 @@ ;;; Scott Fahlman or slisp-group@cs.cmu.edu. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/ir2tran.lisp,v 1.54 1993/08/19 23:14:36 wlott Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/ir2tran.lisp,v 1.55 1993/09/13 19:31:27 wlott Exp $") ;;; ;;; ********************************************************************** ;;; @@ -1386,6 +1386,22 @@ ((continuation-tn node block list) nil) ((reference-tn-list locs t))))))))) + +(defoptimizer (%more-arg-values ir2-convert) ((context count) node block) + (let* ((cont (node-cont node)) + (2cont (continuation-info cont))) + (when 2cont + (ecase (ir2-continuation-kind 2cont) + (:fixed (ir2-convert-full-call node block)) + (:unknown + (let ((locs (ir2-continuation-locs 2cont))) + (vop* %more-arg-values node block + ((continuation-tn node block context) + (continuation-tn node block count) + nil) + ((reference-tn-list locs t))))))))) + + ;;;; Special binding: