From 7eef46a01ccbdf6c8febd8601613a9743d4f5a63 Mon Sep 17 00:00:00 2001 From: ram <ram> Date: Tue, 27 Nov 1990 15:39:30 +0000 Subject: [PATCH] Fixed FUNCTION-ARGLIST to call INTERPRETED-FUNCTION-ARGLIST rather than INTERPRETED-FUNCTION-NAME. Added definition of PRINT-RANDOM-THING-INTERNAL that prints the hex address of objects. Changed set-function-name to just stick the name in there, w/o any interning. --- pcl/cmu-low.lisp | 18 +++++++++--------- 1 file changed, 9 insertions(+), 9 deletions(-) diff --git a/pcl/cmu-low.lisp b/pcl/cmu-low.lisp index 46c7fd2b3..959a5adf6 100644 --- a/pcl/cmu-low.lisp +++ b/pcl/cmu-low.lisp @@ -29,6 +29,12 @@ (in-package 'pcl) + +;;; Print the object addr in default printers. +;;; +(defun printing-random-thing-internal (thing stream) + (format stream "{~X}" (sys:%primitive c:make-fixnum thing))) + ;; ;;;;;; Cache No's ;; @@ -40,14 +46,13 @@ (the fixnum mask))) - (defun function-arglist (fcn) "Returns the argument list of a compiled function, if possible." (cond ((symbolp fcn) (when (fboundp fcn) (function-arglist (symbol-function fcn)))) ((eval:interpreted-function-p fcn) - (eval:interpreted-function-name fcn)) + (eval:interpreted-function-arglist fcn)) ((functionp fcn) (let ((lambda-expr (function-lambda-expression fcn))) (if lambda-expr @@ -71,11 +76,6 @@ fcn) (t (let ((header (kernel:%closure-function fcn))) - (system:%primitive c::set-function-name header - (if (symbolp new-name) - new-name - (let ((*package* *the-pcl-package*) - (*print-case* :upcase) - (*print-gensym* 't)) - (prin1-to-string new-name))))) + (system:%primitive c::set-function-name header new-name)) fcn))) + -- GitLab