Changeset 11155


Ignore:
Timestamp:
Oct 18, 2008, 5:51:07 PM (11 years ago)
Author:
gz
Message:

never tail-call print-call-history, bigger initial *nx1-operators* table, indentation tweaks

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/source/compiler/nx0.lisp

    r11088 r11155  
    5555(defvar *nx1-fcells* nil)
    5656
    57 (defvar *nx1-operators* (make-hash-table :size 160 :test #'eq))
     57(defvar *nx1-operators* (make-hash-table :size 300 :test #'eq))
    5858
    5959                                         
     
    8484  '(error cerror break warn type-error file-error
    8585    signal-program-error signal-simple-program-error
     86    print-call-history
    8687    #-bccl %get-frame-pointer
    8788    #-bccl break-loop)
     
    208209    (let ((body (parse-macro-1 block-name arglist body env)))
    209210      `(eval-when (:compile-toplevel :load-toplevel :execute)
    210         (eval-when (:load-toplevel :execute)
    211           (record-source-file ',name 'compiler-macro))
    212         (setf (compiler-macro-function ',name)
    213          (nfunction (compiler-macro-function ,name)  ,body))
    214         ',name))))
     211         (eval-when (:load-toplevel :execute)
     212           (record-source-file ',name 'compiler-macro))
     213         (setf (compiler-macro-function ',name)
     214               (nfunction (compiler-macro-function ,name)  ,body))
     215         ',name))))
    215216
    216217;;; This is silly (as may be the whole idea of actually -using-
     
    703704      (unless (nx-allow-register-allocation env)
    704705        (nx-inhibit-register-allocation))
    705             (setq *nx-new-p2decls*
     706      (setq *nx-new-p2decls*
    706707            (if (eql (safety-optimize-quantity env) 3)
    707708              (logior $decl_full_safety
    708709                      (if (nx-tailcalls env) $decl_tailcalls 0))
    709               (%ilogior 
    710                (if (nx-tailcalls env) $decl_tailcalls 0)
    711                (if (nx-open-code-in-line env) $decl_opencodeinline 0)
    712                (if (nx-inhibit-safety-checking env) $decl_unsafe 0)
    713                (if (nx-trust-declarations env) $decl_trustdecls 0)))))))
     710              (%ilogior
     711                (if (nx-tailcalls env) $decl_tailcalls 0)
     712                (if (nx-open-code-in-line env) $decl_opencodeinline 0)
     713                (if (nx-inhibit-safety-checking env) $decl_unsafe 0)
     714                (if (nx-trust-declarations env) $decl_trustdecls 0)))))))
    714715
    715716#|     
     
    939940    (nx1-punt-var v (pop initforms))))
    940941
    941 
     942;;; at the beginning of a binding construct, note which lexical
     943;;; variables are bound to other variables and the number of setqs
     944;;; done so far on the initform.  After executing the body, if neither
     945;;; variable has been closed over, the new variable hasn't been
     946;;; setq'ed, and the old guy wasn't setq'ed in the body, the binding
     947;;; can be punted.
    942948(defun nx1-note-var-binding (var initform)
    943949  (let* ((init (nx-untyped-form initform))
     
    14351441         body
    14361442         *nx-new-p2decls*)))))
    1437  
     1443
    14381444(defun nx-parse-simple-lambda-list (pending ll &aux
    14391445                                              req
     
    16221628
    16231629(defun nx1-form (form &optional (*nx-lexical-environment* *nx-lexical-environment*))
    1624   (let* ((*nx-form-type* t))
    1625     (when (and (consp form)(eq (car form) 'the))
    1626       (setq *nx-form-type* (nx-target-type (cadr form))))
    1627     (prog1
    1628       (nx1-typed-form form *nx-lexical-environment*))))
     1630  (let* ((*nx-form-type* (if (and (consp form) (eq (car form) 'the))
     1631                           (nx-target-type (cadr form))
     1632                           t)))
     1633    (nx1-typed-form form *nx-lexical-environment*)))
    16291634
    16301635(defun nx1-typed-form (original env)
     
    16341639    (nx1-transformed-form (nx-transform original env) env)))
    16351640
    1636 (defun nx1-transformed-form (form &optional (env *nx-lexical-environment*))
     1641(defun nx1-transformed-form (form env)
    16371642  (if (consp form)
    16381643    (nx1-combination form env)
     
    16741679    (or (nx-null form)
    16751680        (nx-t form)
    1676         (and (consp form)
     1681        (and (acode-p form)
    16771682             (or (eq (acode-operator form) (%nx1-operator immediate))
    16781683                 (eq (acode-operator form) (%nx1-operator fixnum))
     
    18711876      (setq whined t))
    18721877    (when (and args-p (setq somedef (or lexenv-def defenv-def global-def)))
    1873       (multiple-value-bind (deftype  reason)
     1878      (multiple-value-bind (deftype reason)
    18741879          (nx1-check-call-args somedef args spread-p)
    18751880        (when deftype
     
    21182123           (if (constantp thing)
    21192124             (progn
    2120                (setq form thing form thing)
     2125               (setq form thing)
    21212126               (go LOOP))
    21222127             (multiple-value-bind (newform win) (nx-transform thing environment)
     
    21462151                  (not (nx-declared-notinline-p sym environment)))
    21472152         (multiple-value-bind (value folded) (nx-constant-fold form environment)
    2148            (when folded (setq form value changed t)  (unless (and (consp form) (eq (car form) sym)) (go START))))
     2153           (when folded
     2154             (setq form value changed t)
     2155             (unless (and (consp form) (eq (car form) sym)) (go START))))
    21492156         (when compiler-macro
    21502157           (multiple-value-bind (newform win) (compiler-macroexpand-1 form environment)
     
    21882195      (declare (type cons ptr))
    21892196      (dolist (form (cdr callform) (if any-wins (values (copy-list transformed-call) t) (values callform nil)))
    2190         (rplacd ptr (setq ptr (cons (multiple-value-setq (form win) (nx-transform form env)) nil)))
     2197        (multiple-value-setq (form win) (nx-transform form env))
     2198        (rplacd ptr (setq ptr (cons form nil)))
    21912199        (if win (setq any-wins t)))))
    21922200
Note: See TracChangeset for help on using the changeset viewer.