From 003e2beae8e4b490b1a828605be7844c0441665f Mon Sep 17 00:00:00 2001 From: wlott <wlott> Date: Wed, 27 Jun 1990 06:43:46 +0000 Subject: [PATCH] Fixed a bug introduced into default-unknown-values, where it would try to compute the code object from the LRA a second time when a single value was returned. --- compiler/mips/call.lisp | 53 ++++++++++++++++++++--------------------- 1 file changed, 26 insertions(+), 27 deletions(-) diff --git a/compiler/mips/call.lisp b/compiler/mips/call.lisp index 06ee8c2f8..c905e9b8f 100644 --- a/compiler/mips/call.lisp +++ b/compiler/mips/call.lisp @@ -7,7 +7,7 @@ ;;; Scott Fahlman (FAHLMAN@CMUC). ;;; ********************************************************************** ;;; -;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/mips/call.lisp,v 1.22 1990/06/25 21:13:07 wlott Exp $ +;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/mips/call.lisp,v 1.23 1990/06/27 06:43:46 wlott Exp $ ;;; ;;; This file contains the VM definition of function call for the MIPS. ;;; @@ -286,7 +286,6 @@ default-value-5 (inst nop) ;; Do the single value calse. - (inst compute-code-from-lra code-tn code-tn lra-label temp) (do ((i 1 (1+ i)) (val (tn-ref-across values) (tn-ref-across val))) ((= i (min nvals register-arg-count))) @@ -301,31 +300,31 @@ default-value-5 (when (> nvals register-arg-count) (inst addu temp nargs-tn (fixnum (- register-arg-count))) (collect ((defaults)) - (do ((i register-arg-count (1+ i)) - (val (do ((i 0 (1+ i)) - (val values (tn-ref-across val))) - ((= i register-arg-count) val)) - (tn-ref-across val))) - ((null val)) - - (let ((default-lab (gen-label)) - (tn (tn-ref-tn val))) - (defaults (cons default-lab tn)) - - (inst bltz temp default-lab) - (inst addu temp temp (fixnum -1)) - (loadw move-temp old-fp-tn i) - (store-stack-tn tn move-temp))) - - (emit-label defaulting-done) - (move csp-tn old-fp-tn) - - (assemble (*elsewhere*) - (dolist (def (defaults)) - (emit-label (car def)) - (store-stack-tn (cdr def) null-tn)) - (inst b defaulting-done) - (inst nop)))))) + (do ((i register-arg-count (1+ i)) + (val (do ((i 0 (1+ i)) + (val values (tn-ref-across val))) + ((= i register-arg-count) val)) + (tn-ref-across val))) + ((null val)) + + (let ((default-lab (gen-label)) + (tn (tn-ref-tn val))) + (defaults (cons default-lab tn)) + + (inst bltz temp default-lab) + (inst addu temp temp (fixnum -1)) + (loadw move-temp old-fp-tn i) + (store-stack-tn tn move-temp))) + + (emit-label defaulting-done) + (move csp-tn old-fp-tn) + + (assemble (*elsewhere*) + (dolist (def (defaults)) + (emit-label (car def)) + (store-stack-tn (cdr def) null-tn)) + (inst b defaulting-done) + (inst nop)))))) (undefined-value)) -- GitLab