From b5d48b7208b40508e9ac5348ccddbd527c493365 Mon Sep 17 00:00:00 2001 From: ram <ram> Date: Fri, 20 Aug 1993 23:55:30 +0000 Subject: [PATCH] Added some system constants. Fixed deleted local arg stuff to correctly compute the number of args. Added push-n-under to disassembler. --- compiler/byte-comp.lisp | 31 +++++++++++++++++-------------- 1 file changed, 17 insertions(+), 14 deletions(-) diff --git a/compiler/byte-comp.lisp b/compiler/byte-comp.lisp index a505ede75..016835b51 100644 --- a/compiler/byte-comp.lisp +++ b/compiler/byte-comp.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/byte-comp.lisp,v 1.18 1993/08/20 20:04:10 ram Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/byte-comp.lisp,v 1.19 1993/08/20 23:55:30 ram Exp $") ;;; ;;; ********************************************************************** ;;; @@ -201,6 +201,8 @@ (def-system-constant 23 '(%fdefinition-marker% . nconc)) (def-system-constant 24 '(%fdefinition-marker% . list)) (def-system-constant 25 '(%fdefinition-marker% . list*)) +(def-system-constant 26 '(%fdefinition-marker% . %coerce-to-function)) +(def-system-constant 27 '(%fdefinition-marker% . values-list)) (defparameter *xop-names* '(breakpoint; 0 @@ -1429,10 +1431,6 @@ ;; None of the arugments supply :unknown values, so ;; we know exactly how many there are. num-fixed) - ((null (car args)) - ;; A local call arg has been deleted, but we have to pass - ;; a place-holder anyway. (MVs impossible here.) - (examine (cdr args) (1+ num-fixed))) (t (let* ((vals (byte-continuation-info-results @@ -1453,14 +1451,19 @@ :unknown) (t (examine (cdr args) (+ num-fixed vals))))))))) - (let ((num-args (examine (basic-combination-args call) 0))) - (case (basic-combination-kind call) - (:local - (generate-byte-code-for-local-call segment call cont num-args)) - (:full - (generate-byte-code-for-full-call segment call cont num-args)) - (t - (generate-byte-code-for-known-call segment call cont num-args)))))) + (let* ((args (basic-combination-args call)) + (kind (basic-combination-kind call)) + (num-args (if (and (eq kind :local) + (combination-p call)) + (length args) + (examine args 0)))) + (case kind + (:local + (generate-byte-code-for-local-call segment call cont num-args)) + (:full + (generate-byte-code-for-full-call segment call cont num-args)) + (t + (generate-byte-code-for-known-call segment call cont num-args)))))) (defun generate-byte-code-for-basic-combination (segment call cont) (cond ((and (mv-combination-p call) @@ -2252,7 +2255,7 @@ (case xop ((catch go unwind-protect) (extract-24-bits)) - (type-check + ((type-check push-n-under) (get-constant (extract-extended-op))))))) ((#b11100000 #b11100000) -- GitLab