:reexport ("ARRAY" "BOOLEAN" "DOUBLE-FLOAT" "LONG-FLOAT" "FUNCTION"
"INTEGER" "SINGLE-FLOAT" "UNION" "SYSTEM-AREA-POINTER"
"VALUES" "*")
- :export ("ADDR" "ALIEN" "ALIEN-FUNCALL" "ALIEN-SAP"
- "ALIEN-SIZE" "ALIEN-BOOLEAN" "CAST" "DEF-ALIEN-ROUTINE"
- "DEF-ALIEN-TYPE" "DEF-ALIEN-VARIABLE" "DEF-BUILTIN-ALIEN-TYPE"
- "DEREF" "ENUM" "EXTERN-ALIEN"
+ :export ("ADDR" "ALIEN" "ALIEN-FUNCALL" "ALIEN-SAP" "ALIEN-SIZE"
+ "CAST"
+ "DEF-ALIEN-ROUTINE" "DEF-ALIEN-TYPE"
+ "DEF-ALIEN-VARIABLE" "DEF-BUILTIN-ALIEN-TYPE"
+ "DEREF"
+ "ENUM" "EXTERN-ALIEN"
+ "FREE-ALIEN"
+ "LOAD-FOREIGN" "LOAD-1-FOREIGN"
+ "MAKE-ALIEN"
+ "NULL-ALIEN"
"SAP-ALIEN" "SIGNED" "SLOT" "STRUCT"
- "UNSIGNED" "WITH-ALIEN" "FREE-ALIEN" "NULL-ALIEN"
- "MAKE-ALIEN"
- "LOAD-FOREIGN" "LOAD-1-FOREIGN"))
+ "UNSIGNED"
+ "WITH-ALIEN"))
#s(sb-cold:package-data
:name "SB!ALIEN-INTERNALS"
"*BACKEND-T-PRIMITIVE-TYPE*"
"*CODE-SEGMENT*"
- "*CONVERTING-FOR-INTERPRETER*"
"*COUNT-VOP-USAGES*" "*ELSEWHERE*"
"*SETF-ASSUMED-FBOUNDP*"
"*SUPPRESS-VALUES-DECLARATION*"
"CHECK-SIGNED-BYTE-32" "CHECK-SYMBOL" "CHECK-UNSIGNED-BYTE-32"
"CLOSURE-INIT" "CLOSURE-REF"
"CODE-CONSTANT-REF" "CODE-CONSTANT-SET"
- "COMPILE-FOR-EVAL" "COMPILER-ERROR"
+ "COMPILER-ERROR"
"COMPONENT" "COMPONENT-HEADER-LENGTH"
"COMPONENT-INFO" "COMPONENT-LIVE-TN" "COMPUTE-FUNCTION"
"COMPUTE-OLD-NFP" "COPY-MORE-ARG"
"HALT" "IF-EQ" "INSTANCE-REF" "INSTANCE-SET"
"IR2-COMPONENT-CONSTANTS" "IR2-CONVERT"
"IR2-ENVIRONMENT-NUMBER-STACK-P" "KNOWN-CALL-LOCAL"
- "KNOWN-RETURN" "LAMBDA-EVAL-INFO-ARGS-PASSED"
- "LAMBDA-EVAL-INFO-ENTRIES" "LAMBDA-EVAL-INFO-FRAME-SIZE"
- "LAMBDA-EVAL-INFO-FUNCTION" "LOCATION=" "LTN-ANNOTATE"
+ "KNOWN-RETURN" "LOCATION=" "LTN-ANNOTATE"
"MAKE-ALIAS-TN" "MAKE-CATCH-BLOCK"
"MAKE-CLOSURE" "MAKE-CONSTANT-TN" "MAKE-FIXNUM"
"MAKE-LOAD-TIME-CONSTANT-TN" "MAKE-N-TNS" "MAKE-NORMAL-TN"
debugger interface mixed with various low-level implementation stuff
like *STACK-TOP-HINT*"
:use ("CL" "SB!EXT" "SB!INT" "SB!SYS")
- :export ("*AUTO-EVAL-IN-FRAME*" "*DEBUG-BEGINNER-HELP-P*"
+ :export ("*DEBUG-BEGINNER-HELP-P*"
"*DEBUG-CONDITION*"
"*DEBUG-PRINT-LENGTH*" "*DEBUG-PRINT-LEVEL*"
"*DEBUG-READTABLE*" "*DEBUG-HELP-STRING*"
"DEBUG-SOURCE-CREATED" "DEBUG-SOURCE-COMPILED"
"DEBUG-SOURCE-START-POSITIONS" "DEBUG-SOURCE"
"DEBUG-SOURCE-P")
- :export ("*DEBUGGING-INTERPRETER*" "ACTIVATE-BREAKPOINT"
+ :export ("ACTIVATE-BREAKPOINT"
"AMBIGUOUS-DEBUG-VARS" "AMBIGUOUS-VARIABLE-NAME" "BREAKPOINT"
"BREAKPOINT-ACTIVE-P" "BREAKPOINT-HOOK-FUNCTION" "BREAKPOINT-INFO"
"BREAKPOINT-KIND" "BREAKPOINT-P" "BREAKPOINT-WHAT" "CODE-LOCATION"
"DEBUG-VAR-VALIDITY" "DEBUG-VAR-VALUE"
"DELETE-BREAKPOINT" "DO-BLOCKS"
"DO-DEBUG-BLOCK-LOCATIONS" "DO-DEBUG-FUNCTION-BLOCKS"
- "DO-DEBUG-FUNCTION-VARIABLES" "EVAL-IN-FRAME"
+ "DO-DEBUG-FUNCTION-VARIABLES"
"FORM-NUMBER-TRANSLATIONS" "FRAME" "FRAME-CATCHES"
"FRAME-CODE-LOCATION" "FRAME-DEBUG-FUNCTION" "FRAME-DOWN"
"FRAME-FUNCTION-MISMATCH" "FRAME-NUMBER" "FRAME-P" "FRAME-UP"
;; are assertions" default
"TRULY-THE"
- ;; This is something which must exist inside any Common Lisp
- ;; implementation, and which someone writing a customized toplevel
- ;; might well want. It seems perverse to hide it from
- ;; them..
+ ;; This is something which must exist inside any Common
+ ;; Lisp implementation, and which someone writing a
+ ;; customized toplevel might well want. It seems perverse
+ ;; to hide it from them..
"INTERACTIVE-EVAL"
;; weak pointers and finalization
"%WITH-ARRAY-DATA" "%WITH-ARRAY-DATA-MACRO"
"*ALREADY-MAYBE-GCING*"
"*CURRENT-LEVEL*" "*EMPTY-TYPE*"
- "*EVAL-STACK-TOP*" "*GC-INHIBIT*"
+ "*EVAL-STACK*" "*EVAL-STACK-TOP*" "*GC-INHIBIT*"
"*NEED-TO-COLLECT-GARBAGE*"
"*PRETTY-PRINTER*" "*UNIVERSAL-TYPE*"
"*UNIVERSAL-FUNCTION-TYPE*"
"%RANDOM-DOUBLE-FLOAT" "%RANDOM-LONG-FLOAT"
"%RANDOM-SINGLE-FLOAT"
"RANDOM-PCL-CLASS" "BASIC-STRUCTURE-CLASS-PRINT-FUNCTION"
- "%FUNCALLABLE-INSTANCE-INFO" "*EVAL-STACK*" "RANDOM-CHUNK"
+ "%FUNCALLABLE-INSTANCE-INFO" "RANDOM-CHUNK"
"MAKE-FUNCALLABLE-STRUCTURE-CLASS" "LAYOUT-CLOS-HASH-MAX"
"CLASS-CELL-NAME" "BUILT-IN-CLASS-DIRECT-SUPERCLASSES"
"INITIALIZE-BYTE-COMPILED-FUNCTION"
;;; at BASIC-CODE-LOCATION:
;;; :VALID The value is known to be available.
;;; :INVALID The value is known to be unavailable.
-;;; :UNKNOWN The value's availability is unknown."
+;;; :UNKNOWN The value's availability is unknown.
;;;
;;; If the variable is always alive, then it is valid. If the
;;; code-location is unknown, then the variable's validity is
(cons res (nthcdr (1+ n) form))))))))
(frob form path context))))
\f
-;;;; PREPROCESS-FOR-EVAL and EVAL-IN-FRAME
+;;;; PREPROCESS-FOR-EVAL
;;; Return a function of one argument that evaluates form in the
;;; lexical context of the BASIC-CODE-LOCATION LOC, or signal a
(debug-signal 'frame-function-mismatch
:code-location loc :form form :frame frame))
(funcall res frame))))))
-
-;;; Evaluate FORM in the lexical context of FRAME's current code
-;;; location, returning the results of the evaluation.
-(defun eval-in-frame (frame form)
- (declare (type frame frame))
- (funcall (preprocess-for-eval form (frame-code-location frame)) frame))
\f
;;;; breakpoints
(t
(funcall cmd-fun)))))))))))))))
-;;; FIXME: As far as I know, the CMU CL X86 codebase has never
-;;; supported access to the environment of the debugged function. It
-;;; would be really, really nice to make that work! (Until then,
-;;; non-NIL *AUTO-EVAL-IN-FRAME* seems to be useless, and as of
-;;; sbcl-0.6.10 it even seemed to be actively harmful, since the
-;;; debugger gets confused when trying to unwind the frames which
-;;; arise in SIGINT interrupts. So it's set to NIL.)
-(defvar *auto-eval-in-frame* nil
- #!+sb-doc
- "When set, evaluations in the debugger's command loop occur relative
- to the current frame's environment without the need of debugger
- forms that explicitly control this kind of evaluation. In an ideal
- world, the default would be T, but since unfortunately the X86
- debugger support isn't good enough to make this useful, the
- default is NIL instead.")
-
;;; FIXME: We could probably use INTERACTIVE-EVAL for much of this logic.
(defun debug-eval-print (expr)
(/noshow "entering DEBUG-EVAL-PRINT" expr)
(/noshow (fboundp 'compile))
- (/noshow (and (fboundp 'compile) *auto-eval-in-frame*))
(setq +++ ++ ++ + + - - expr)
- (let* ((values (multiple-value-list
- (if (and (fboundp 'compile) *auto-eval-in-frame*)
- (sb!di:eval-in-frame *current-frame* -)
- (eval -))))
+ (let* ((values (multiple-value-list (eval -)))
(*standard-output* *debug-io*))
(/noshow "done with EVAL in DEBUG-EVAL-PRINT")
(fresh-line)
sb!vm:*initial-dynamic-space-free-pointer*
*current-catch-block*
*current-unwind-protect-block*
- *eval-stack-top*
sb!vm::*alien-stack*
;; FIXME: The pseudo-atomic variable stuff should be
;; conditional on :SB-PSEUDO-ATOMIC-SYMBOLS, which
(in-package "SB!BYTECODE")
-;;; This needs to be initialized in the cold load, since the top-level
-;;; catcher will always restore the initial value.
+;;; Note: This is defined here, but it's visible in SB-KERNEL, since
+;;; various magical things need to happen to it, e.g. initialization
+;;; early in cold load, and save/restore in nonlocal exit logic.
(defvar *eval-stack-top* 0)
;;; general case of EVAL (except in that it can't handle toplevel
(defmacro-mundanely defconstant (name value &optional documentation)
#!+sb-doc
- "For defining global constants. DEFCONSTANT says that the value is
- constant and may be compiled into code. If the variable already has
- a value, and this is not EQL to the init, the code is not portable
- (undefined behavior). The third argument is an optional documentation
- string for the variable."
+ "Define a global constant, saying that the value is constant and may be
+ compiled into code. If the variable already has a value, and this is not
+ EQL to the new value, the code is not portable (undefined behavior). The
+ third argument is an optional documentation string for the variable."
`(eval-when (:compile-toplevel :load-toplevel :execute)
(sb!c::%defconstant ',name ,value ',documentation)))
(values nil
nil
(list value)
- (if sb!c:*converting-for-interpreter*
- `(%set-local-alien ',info ,alien ,value)
- `(if (%local-alien-forced-to-memory-p ',info)
- (%set-local-alien ',info ,alien ,value)
- (setf ,alien
- (deport ,value ',(local-alien-info-type info)))))
+ `(if (%local-alien-forced-to-memory-p ',info)
+ (%set-local-alien ',info ,alien ,value)
+ (setf ,alien
+ (deport ,value ',(local-alien-info-type info))))
whole)))
(defun %local-alien-forced-to-memory-p (info)
(defvar *compiler-note-count*)
(defvar *compiler-trace-output*)
(defvar *constraint-number*)
-(defvar *converting-for-interpreter*)
(defvar *count-vop-usages*)
(defvar *current-path*)
(defvar *current-component*)
(dolist (exit (entry-exits entry))
(let ((target-env (node-environment entry)))
(if (eq (node-environment exit) target-env)
- (unless *converting-for-interpreter*
- (maybe-delete-exit exit))
+ (maybe-delete-exit exit)
(note-non-local-exit target-env exit))))))
(values))
(tail (component-tail (block-component block)))
(succ (first (block-succ block))))
(unless (or (and (eq call (block-last block)) (eq succ tail))
- (block-delete-p block)
- *converting-for-interpreter*)
+ (block-delete-p block))
(when (or (and (eq (continuation-asserted-type cont) *empty-type*)
(not (or ir1-p (eq (continuation-kind cont) :deleted))))
(eq (node-derived-type call) *empty-type*))
(declaim (list *current-path*))
(defvar *current-path* nil)
-;;; *CONVERTING-FOR-INTERPRETER* is true when we are creating IR1 to
-;;; be interpreted rather than compiled. This inhibits source
-;;; tranformations and stuff.
-(defvar *converting-for-interpreter* nil)
-;;; FIXME: Rename to *IR1-FOR-INTERPRETER-NOT-COMPILER-P*.
-
(defvar *derive-function-types* nil
"Should the compiler assume that function types will never change,
so that it can use type information inferred from current definitions
(translator (info :function :ir1-convert fun))
(cmacro (info :function :compiler-macro-function fun)))
(cond (translator (funcall translator start cont form))
- ((and cmacro (not *converting-for-interpreter*)
- (not (eq (info :function :inlinep fun) :notinline)))
+ ((and cmacro
+ (not (eq (info :function :inlinep fun)
+ :notinline)))
(let ((res (careful-expand-macro cmacro form)))
(if (eq res form)
(ir1-convert-global-functoid-no-cmacro start cont form fun)
;;; Convert a call to a global function. If not :NOTINLINE, then we do
;;; source transforms and try out any inline expansion. If there is no
-;;; expansion, but is :INLINE, then give an efficiency note (unless a known
-;;; function which will quite possibly be open-coded.) Next, we go to
-;;; ok-combination conversion.
+;;; expansion, but is :INLINE, then give an efficiency note (unless a
+;;; known function which will quite possibly be open-coded.) Next, we
+;;; go to ok-combination conversion.
(defun ir1-convert-srctran (start cont var form)
(declare (type continuation start cont) (type global-var var))
(let ((inlinep (when (defined-function-p var)
(defined-function-inlinep var))))
- (cond
- ((eq inlinep :notinline)
- (ir1-convert-combination start cont form var))
- (*converting-for-interpreter*
- (ir1-convert-combination-checking-type start cont form var))
- (t
- (let ((transform (info :function :source-transform (leaf-name var))))
- (cond
- (transform
- (multiple-value-bind (result pass) (funcall transform form)
- (if pass
- (ir1-convert-maybe-predicate start cont form var)
- (ir1-convert start cont result))))
- (t
- (ir1-convert-maybe-predicate start cont form var))))))))
-
-;;; If the function has the Predicate attribute, and the CONT's DEST isn't
-;;; an IF, then we convert (IF <form> T NIL), ensuring that a predicate always
-;;; appears in a conditional context.
+ (if (eq inlinep :notinline)
+ (ir1-convert-combination start cont form var)
+ (let ((transform (info :function :source-transform (leaf-name var))))
+ (if transform
+ (multiple-value-bind (result pass) (funcall transform form)
+ (if pass
+ (ir1-convert-maybe-predicate start cont form var)
+ (ir1-convert start cont result)))
+ (ir1-convert-maybe-predicate start cont form var))))))
+
+;;; If the function has the PREDICATE attribute, and the CONT's DEST
+;;; isn't an IF, then we convert (IF <form> T NIL), ensuring that a
+;;; predicate always appears in a conditional context.
;;;
;;; If the function isn't a predicate, then we call
;;; IR1-CONVERT-COMBINATION-CHECKING-TYPE.
res))
-;;; Convert a Lambda into a Lambda or Optional-Dispatch leaf.
+;;; Convert a LAMBDA form into a LAMBDA leaf or an OPTIONAL-DISPATCH leaf.
(defun ir1-convert-lambda (form &optional name)
(unless (consp form)
(compiler-error "A ~S was found when expecting a lambda expression:~% ~S"
(defoptimizer (%special-unbind ir2-convert) ((var) node block)
(vop unbind node block))
-;;; ### Not clear that this really belongs in this file, or should
-;;; really be done this way, but this is the least violation of
+;;; ### It's not clear that this really belongs in this file, or
+;;; should really be done this way, but this is the least violation of
;;; abstraction in the current setup. We don't want to wire
;;; shallow-binding assumptions into IR1tran.
(def-ir1-translator progv ((vars vals &body body) start cont)
(ir1-convert
start cont
- (if (or *converting-for-interpreter* (byte-compiling))
+ (if (byte-compiling)
`(%progv ,vars ,vals #'(lambda () ,@body))
(once-only ((n-save-bs '(%primitive current-binding-pointer)))
`(unwind-protect
(if (and (policy call
(and (>= speed space) (>= speed compilation-speed)))
(not (eq (functional-kind (node-home-lambda call)) :external))
- (not *converting-for-interpreter*)
(inline-expansion-ok call))
(with-ir1-environment call
(let* ((*lexenv* (functional-lexenv fun))
(if (symbolp x)
(symbol-name x)
(prin1-to-string x)))))))
- (unless *converting-for-interpreter*
- (dolist (undef undefs)
- (let ((name (undefined-warning-name undef))
- (kind (undefined-warning-kind undef))
- (warnings (undefined-warning-warnings undef))
- (undefined-warning-count (undefined-warning-count undef)))
- (dolist (*compiler-error-context* warnings)
- (compiler-style-warning "undefined ~(~A~): ~S" kind name))
-
- (let ((warn-count (length warnings)))
- (when (and warnings (> undefined-warning-count warn-count))
- (let ((more (- undefined-warning-count warn-count)))
- (compiler-style-warning
- "~D more use~:P of undefined ~(~A~) ~S"
- more kind name)))))))
+ (dolist (undef undefs)
+ (let ((name (undefined-warning-name undef))
+ (kind (undefined-warning-kind undef))
+ (warnings (undefined-warning-warnings undef))
+ (undefined-warning-count (undefined-warning-count undef)))
+ (dolist (*compiler-error-context* warnings)
+ (compiler-style-warning "undefined ~(~A~): ~S" kind name))
+ (let ((warn-count (length warnings)))
+ (when (and warnings (> undefined-warning-count warn-count))
+ (let ((more (- undefined-warning-count warn-count)))
+ (compiler-style-warning
+ "~D more use~:P of undefined ~(~A~) ~S"
+ more kind name))))))
(dolist (kind '(:variable :function :type))
(let ((summary (mapcar #'undefined-warning-name
~% ~{~<~% ~1:;~S~>~^ ~}"
(cdr summary) kind summary)))))))
- (unless (or *converting-for-interpreter*
- (and (not abort-p)
- (zerop *aborted-compilation-unit-count*)
- (zerop *compiler-error-count*)
- (zerop *compiler-warning-count*)
- (zerop *compiler-style-warning-count*)
- (zerop *compiler-note-count*)))
+ (unless (and (not abort-p)
+ (zerop *aborted-compilation-unit-count*)
+ (zerop *compiler-error-count*)
+ (zerop *compiler-warning-count*)
+ (zerop *compiler-style-warning-count*)
+ (zerop *compiler-note-count*))
(format *error-output* "~&")
(pprint-logical-block (*error-output* nil :per-line-prefix "; ")
(compiler-mumble "compilation unit ~:[finished~;aborted~]~
;;;;
;;;; (See EMIT-MAKE-LOAD-FORM.)
-;;; Returns T if we are currently producing a fasl file and hence
+;;; Return T if we are currently producing a fasl file and hence
;;; constants need to be dumped carefully.
(defun producing-fasl-file ()
- (unless *converting-for-interpreter*
- (fasl-output-p *compile-object*)))
+ (fasl-output-p *compile-object*))
;;; Compile FORM and arrange for it to be called at load-time. Return
;;; the dumper handle and our best guess at the type of the object.
(*package* (sane-package))
(*policy* *policy*)
(*lexenv* (make-null-lexenv))
- (*converting-for-interpreter* nil)
(*source-info* info)
(sb!xc:*compile-file-pathname* nil)
(sb!xc:*compile-file-truename* nil)
(error "can't compile a lexical closure"))
(compile nil lambda)))
-;;; FIXME: Couldn't we just use COMPILE for this?
(defun compiled-function-or-lose (thing &optional (name thing))
(cond ((or (symbolp thing)
(and (listp thing)
((functionp thing)
thing)
((and (listp thing)
- (eq (car thing) 'sb!impl::lambda))
+ (eq (car thing) 'lambda))
(compile nil thing))
(t
(error "can't make a compiled function from ~S" name))))
(form `#',(get-lambda-to-compile definition))
(*source-info* (make-lisp-source-info form))
(*top-level-lambdas* ())
- (*converting-for-interpreter* nil)
(*block-compile* nil)
(*compiler-error-bailout*
#'(lambda ()
;;; for internal versions, especially for internal versions off the
;;; main CVS branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
-"0.pre7.19"
+"0.pre7.20"
projects / sbcl.git / commitdiff