Ignore:
Timestamp:
Apr 9, 2008, 11:48:46 PM (13 years ago)
Author:
gz
Message:

Add CCL:TEST-CCL - runs the gcl test suite (checking it out into ccl:tests;
if necessary). This will print out a bunch of warnings early on (for now),
then sit there for a while (about 3 mins on a MacBook? Pro) and finally
report "No tests failed".

Propagate assorted small fixes from trunk:

r8996 - fix case of spurious defvar warning
r9027 - check arg count before deciding to use builtin-call
r9046 - small fix for ~@:C
r9047 - report a TYPE-ERROR when make-broadcast-stream is given a non-output-stream
r9048 - Make make-file-stream rejected wildcarded pathnames. Various tweaks to make

meta-. work when using pathnames relative to the file system's "current directory".

r9049 - make defclass check for illegal class options
r9052 - Don't constant-fold if arg count is obviously wrong.
r9059 - Try harder to do function calls as function calls when (OPTIMIZE (SAFETY 3))

is in effect.

r9060, r9061 - CTYPE-SUBTYPE: try harder in some cases.
r9068, r9069, r9103, r9104 - PPC2-REF-SYMBOL-VALUE: force boundp checks unless

*ppc2-reckless* (same policy as x86; the per-thread binding lookup is generally
more expensive than boundp trap these days.). Unless skipping boundp check, don't
ignore unused result (so we can error when safety is 3, mostly.)

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/working-0711/ccl/compiler/nx0.lisp

    r8985 r9117  
    19451945      (let* ((*nx-sfname* sym) special)
    19461946        (if (and (setq special (gethash sym *nx1-alphatizers*))
     1947                 (or (not (functionp (fboundp sym)))
     1948                     (< (safety-optimize-quantity env) 3))
    19471949                 ;(not (nx-lexical-finfo sym env))
    19481950                 (not (nx-declared-notinline-p sym *nx-lexical-environment*)))
     
    20762078   (arch::builtin-function-name-offset name))
    20772079
    2078 (defun nx1-call-form (global-name afunc arglist spread-p)
     2080(defun nx1-call-form (global-name afunc arglist spread-p  &optional (env *nx-lexical-environment*))
    20792081  (if afunc
    20802082    (make-acode (%nx1-operator lexical-function-call) afunc (nx1-arglist arglist (if spread-p 1 (backend-num-arg-regs *target-backend*))) spread-p)
    2081     (let* ((builtin (unless spread-p (nx1-builtin-function-offset global-name))))
    2082       (if builtin
     2083    (let* ((builtin (unless (or spread-p
     2084                                (eql 3 (safety-optimize-quantity env)))
     2085                      (nx1-builtin-function-offset global-name))))
     2086      (if (and builtin
     2087               (let* ((bits (lfun-bits (fboundp global-name))))
     2088                 (and bits (eql (logand $lfbits-args-mask bits)
     2089                                (dpb (length arglist)
     2090                                     $lfbits-numreq
     2091                                     0)))))
    20832092        (make-acode (%nx1-operator builtin-call)
    20842093                    (make-acode (%nx1-operator fixnum) builtin)
     
    23422351
    23432352           
    2344 ; This guy has to return multiple values.
    2345 ; The arguments have already been transformed; if they're all constant (or quoted), try
    2346 ; to evaluate the expression at compile-time.
     2353;;; This guy has to return multiple values.  The arguments have
     2354;;; already been transformed; if they're all constant (or quoted), try
     2355;;; to evaluate the expression at compile-time.
    23472356(defun nx-constant-fold (original-call &optional (environment *nx-lexical-environment*) &aux
    23482357                                       (fn (car original-call)) form mv foldable foldfn)
     
    23602369        (funcall foldfn original-call environment)
    23612370        (progn
    2362             (let ((args nil))
    2363               (dolist (arg (cdr original-call) (setq args (nreverse args)))
    2364                 (if (quoted-form-p arg)
    2365                   (setq arg (%cadr arg))
    2366                   (unless (self-evaluating-p arg) (return-from nx-constant-fold (values original-call nil))))
    2367                 (push arg args))
     2371          (let ((args nil))
     2372            (dolist (arg (cdr original-call) (setq args (nreverse args)))
     2373              (if (quoted-form-p arg)
     2374                (setq arg (%cadr arg))
     2375                (unless (self-evaluating-p arg) (return-from nx-constant-fold (values original-call nil))))
     2376              (push arg args))
     2377            (if (nx1-check-call-args (fboundp fn) args nil)
     2378              (return-from nx-constant-fold (values original-call nil))
    23682379              (setq form (multiple-value-list
    2369                           (handler-case (apply fn args)
    2370                             (error (condition)
    2371                                    (warn "Error: \"~A\" ~&signalled during compile-time evaluation of ~S ."
    2372                                          condition original-call)
    2373                                    (return-from nx-constant-fold
    2374                                      (values `(locally (declare (notinline ,fn))
    2375                                                 ,original-call)
    2376                                              t)))))))
     2380                             (handler-case (apply fn args)
     2381                               (error (condition)
     2382                                      (warn "Error: \"~A\" ~&signalled during compile-time evaluation of ~S ."
     2383                                            condition original-call)
     2384                                      (return-from nx-constant-fold
     2385                                        (values `(locally (declare (notinline ,fn))
     2386                                                  ,original-call)
     2387                                                t))))))))
    23772388          (if form
    23782389            (if (null (%cdr form))
Note: See TracChangeset for help on using the changeset viewer.