Changeset 11183


Ignore:
Timestamp:
Oct 20, 2008, 8:46:28 PM (11 years ago)
Author:
gz
Message:

Remove some obsolete bootstrapping code, some minor tweaks to indentation/organization, nothing semantically meaningful, just prep for more merging.

Location:
trunk/source
Files:
11 edited

Legend:

Unmodified
Added
Removed
  • trunk/source/compiler/acode-rewrite.lisp

    r7768 r11183  
    6565
    6666(defun acode-constant-p (form)
    67   (let* ((form (acode-unwrapped-form form)))
     67  (let* ((form (acode-unwrapped-form-value form)))
    6868    (or (eq form *nx-nil*)
    6969        (eq form *nx-t*)
     
    7474(defun acode-post-form-typep (form type)
    7575  (let* ((ctype (specifier-type type))
    76          (form (acode-unwrapped-form form)))
     76         (form (acode-unwrapped-form-value form)))
    7777    (cond ((eq form *nx-nil*) (ctypep nil ctype))
    7878          ((eq form *nx-t*) (ctypep t ctype))
     
    256256  (destructuring-bind (test true &optional (false *nx-nil*)) w
    257257    (if (acode-constant-p test)
    258       (if (eq *nx-nil* (acode-unwrapped-form test))
     258      (if (eq *nx-nil* (acode-unwrapped-form-value test))
    259259        false
    260260        true))))
     
    268268    (let* ((form (car forms)))
    269269      (when (and (acode-constant-p form)
    270                  (not (eq *nx-nil* (acode-unwrapped-form form))))
     270                 (not (eq *nx-nil* (acode-unwrapped-form-value form))))
    271271        (progn
    272272          (rplacd forms nil)
  • trunk/source/compiler/lambda-list.lisp

    r11135 r11183  
    2121;;; Compiler functions needed elsewhere
    2222
    23 ;;; used-by: backtrace, arglist
    24 (defun function-symbol-map (fn)
    25   (getf (%lfun-info fn) 'function-symbol-map))
    26 
    2723(defun %lfun-info-index (fn)
    2824  (and (compiled-function-p fn)
     
    3935  (getf (%lfun-info fn) 'function-lambda-expression ))
    4036
     37;;; used-by: backtrace, arglist
     38(defun function-symbol-map (fn)
     39  (getf (%lfun-info fn) 'function-symbol-map))
    4140
    4241;;; Lambda-list utilities
  • trunk/source/compiler/nx-basic.lisp

    r11154 r11183  
    4848                   #-ccl-0711 (neq (debug-optimize-quantity env) 3))   ;  allow-tail-recursion-elimination
    4949               #'(lambda (env)
     50                   (declare (ignorable env))
    5051                   #+ccl-0711 nil
    5152                   #-ccl-0711 (eq (debug-optimize-quantity env) 3))   ; inhibit-register-allocation
  • trunk/source/compiler/nx.lisp

    r11156 r11183  
    151151
    152152(defparameter *load-time-eval-token* nil)
    153 
    154 
    155 (eval-when (:compile-toplevel)
    156   (declaim (ftype (function (&rest ignore) t)  ppc-compile)))
    157 
    158153(defparameter *nx-discard-xref-info-hook* nil)
    159154
     
    163158  (setq
    164159   def
    165    (let ((*load-time-eval-token* load-time-eval-token)
    166          (env (new-lexical-environment env)))
     160   (let* ((*load-time-eval-token* load-time-eval-token)
     161          (env (new-lexical-environment env)))
    167162     (setf (lexenv.variables env) 'barrier)
    168163       (let* ((*target-backend* (or (if target (find-backend target)) *host-backend*))
  • trunk/source/compiler/nx0.lisp

    r11155 r11183  
    523523         (not (%ilogbitp $vbitspecial bits)))))
    524524
     525;; Use acode-unwrapped-form-value to reason about the value of a form at
     526;; compile time.   To actually generate code, use acode-unwrapped-form.
     527(defun acode-unwrapped-form-value (form)
     528  ;; Currently no difference
     529  (acode-unwrapped-form form))
     530
    525531; Strip off any type info or "punted" lexical references.
    526532; ??? Is it true that the "value" of the punted reference is unwrapped ? ???
     
    533539
    534540(defun acode-fixnum-form-p (x)
    535   (setq x (acode-unwrapped-form x))
     541  (setq x (acode-unwrapped-form-value x))
    536542  (if (acode-p x)
    537543    (if (eq (acode-operator x) (%nx1-operator fixnum))
     
    16361642  (with-program-error-handler
    16371643      (lambda (c)
    1638         (nx1-transformed-form (nx-transform (runtime-program-error-form c) env) env))
     1644        (let ((replacement (runtime-program-error-form c)))
     1645          (nx1-transformed-form (nx-transform replacement env) env)))
    16391646    (nx1-transformed-form (nx-transform original env) env)))
    16401647
     
    16521659        (nx1-immediate (nx-unquote constant-value))))))
    16531660
    1654 
    1655 
    16561661(defun nx1-prefer-areg (form env)
    16571662  (nx1-form form env))
     
    16761681(defun nx-constant-form-p (form)
    16771682  (setq form (nx-untyped-form form))
    1678   (if form
    1679     (or (nx-null form)
    1680         (nx-t form)
    1681         (and (acode-p form)
    1682              (or (eq (acode-operator form) (%nx1-operator immediate))
    1683                  (eq (acode-operator form) (%nx1-operator fixnum))
    1684                  (eq (acode-operator form) (%nx1-operator simple-function)))))))
     1683  (and (or (nx-null form)
     1684           (nx-t form)
     1685           (and (acode-p form)
     1686                (or (eq (acode-operator form) (%nx1-operator immediate))
     1687                    (eq (acode-operator form) (%nx1-operator fixnum))
     1688                    (eq (acode-operator form) (%nx1-operator simple-function)))))
     1689       form))
    16851690
    16861691(defun nx-natural-constant-p (form)
     
    21012106
    21022107(defun nx-transform (form &optional (environment *nx-lexical-environment*))
    2103   (let* (sym transforms lexdefs changed enabled macro-function compiler-macro)
    2104     (tagbody
     2108  (macrolet ((form-changed (form)
     2109               (declare (ignore form))
     2110               '(setq changed t)))
     2111    (prog (sym transforms lexdefs changed enabled macro-function compiler-macro)
    21052112       (go START)
    21062113     LOOP
    2107        (setq changed t)
     2114       (form-changed form)
    21082115       (when (and (consp form)
    2109                   (or (eq (%car form) 'the)
    2110                       (and sym (eq (%car form) sym))))
    2111         (go DONE))
     2116                  (or (eq (%car form) 'the)
     2117                      (and sym (eq (%car form) sym))))
     2118        (go DONE))
    21122119     START
    21132120       (when (non-nil-symbol-p form)
    2114         (multiple-value-bind (newform win) (nx-transform-symbol form environment)
    2115            (unless win (go DONE))
    2116            (setq form newform changed (or changed win))
    2117            (go LOOP)))
     2121        (multiple-value-bind (newform win) (nx-transform-symbol form environment)
     2122           (unless win (go DONE))
     2123           (setq form newform)
     2124           (go LOOP)))
    21182125       (when (atom form) (go DONE))
    21192126       (unless (symbolp (setq sym (%car form)))
    2120         (go DONE))
     2127        (go DONE))
    21212128       (when (eq sym 'the)
    2122         (destructuring-bind (typespec thing) (cdr form)
     2129        (destructuring-bind (typespec thing) (cdr form)
    21232130           (if (constantp thing)
    21242131             (progn
     
    21272134             (multiple-value-bind (newform win) (nx-transform thing environment)
    21282135               (when win
    2129                  (setq changed t)
     2136                 (form-changed newform)
    21302137                 (if (and (self-evaluating-p newform)
    21312138                          (typep newform typespec))
     
    21342141                 (go DONE))))))
    21352142       (when (nx-quoted-form-p form)
    2136         (when (self-evaluating-p (%cadr form))
    2137            (setq form (%cadr form)))
    2138         (go DONE))
     2143        (when (self-evaluating-p (%cadr form))
     2144           (setq form (%cadr form)))
     2145        (go DONE))
    21392146       (when (setq lexdefs (nx-lexical-finfo sym environment))
    2140         (if (eq 'function (%car lexdefs))
    2141            (go DONE)))
     2147        (if (eq 'function (%car lexdefs))
     2148           (go DONE)))
    21422149       (setq transforms (setq compiler-macro (compiler-macro-function sym environment))
    2143              macro-function (macro-function sym environment)
    2144              enabled (nx-allow-transforms environment))
     2150             macro-function (macro-function sym environment)
     2151             enabled (nx-allow-transforms environment))
    21452152       (unless macro-function
    2146          (let* ((win nil))
    2147            (when (and enabled (functionp (fboundp sym)))
    2148              (multiple-value-setq (form win) (nx-transform-arglist form environment))
    2149              (if win (setq changed t)))))
     2153         (let* ((win nil))
     2154           (when (and enabled (functionp (fboundp sym)))
     2155             (multiple-value-setq (form win) (nx-transform-arglist form environment))
     2156             (when win
     2157               (form-changed form)))))
    21502158       (when (and enabled
    2151                   (not (nx-declared-notinline-p sym environment)))
    2152          (multiple-value-bind (value folded) (nx-constant-fold form environment)
    2153            (when folded
    2154              (setq form value changed t)
     2159                  (not (nx-declared-notinline-p sym environment)))
     2160         (multiple-value-bind (value folded) (nx-constant-fold form environment)
     2161           (when folded
     2162             (setq form value)
     2163             (form-changed form)
    21552164             (unless (and (consp form) (eq (car form) sym)) (go START))))
    2156          (when compiler-macro
    2157            (multiple-value-bind (newform win) (compiler-macroexpand-1 form environment)
    2158              (when win
    2159                (when (and (consp newform) (eq (car newform) sym) (functionp (fboundp sym)))
    2160                  (setq sym nil))
    2161                (setq form newform)
    2162                (go LOOP))))
    2163          (multiple-value-bind (newform win) (maybe-optimize-slot-accessor-form form environment)
    2164            (when win
    2165              (setq sym nil)
    2166              (setq form newform)
    2167              (go START)))
    2168          (unless macro-function
    2169            (when (setq transforms (or (environment-structref-info sym environment)
    2170                                       (and #-bccl (boundp '%structure-refs%)
    2171                                            (gethash sym %structure-refs%))))
    2172              (setq form (defstruct-ref-transform transforms (%cdr form)) changed T)
    2173              (go START))
    2174            (when (setq transforms (assq sym *nx-synonyms*))
    2175              (setq form (cons (%cdr transforms) (setq sym (%cdr form))))
    2176              (go LOOP))))
     2165         (when compiler-macro
     2166           (multiple-value-bind (newform win) (compiler-macroexpand-1 form environment)
     2167             (when win
     2168               (when (and (consp newform) (eq (car newform) sym) (functionp (fboundp sym)))
     2169                 (setq sym nil))
     2170               (setq form newform)
     2171               (go LOOP))))
     2172         (multiple-value-bind (newform win) (maybe-optimize-slot-accessor-form form environment)
     2173           (when win
     2174             (setq sym nil)
     2175             (setq form newform)
     2176             (go START)))
     2177         (unless macro-function
     2178           (when (setq transforms (or (environment-structref-info sym environment)
     2179                                      (and (boundp '%structure-refs%)
     2180                                           (gethash sym %structure-refs%))))
     2181             (setq form (defstruct-ref-transform transforms (%cdr form)))
     2182             (form-changed form)
     2183             (go START))
     2184           (when (setq transforms (assq sym *nx-synonyms*))
     2185             (setq form (cons (%cdr transforms) (setq sym (%cdr form))))
     2186             (go LOOP))))
    21772187       (when (and macro-function
    2178                   (or lexdefs
    2179                       (not (and (gethash sym *nx1-alphatizers*) (not (nx-declared-notinline-p sym environment))))))
    2180          (nx-record-xref-info :macro-calls (function-name macro-function))
    2181          (setq form (macroexpand-1 form environment) changed t)
    2182          (go START))
    2183      DONE)
    2184     (values form changed)))
     2188                  (or lexdefs
     2189                      (not (and (gethash sym *nx1-alphatizers*) (not (nx-declared-notinline-p sym environment))))))
     2190         (nx-record-xref-info :macro-calls (function-name macro-function))
     2191         (setq form (macroexpand-1 form environment))
     2192         (form-changed form)
     2193         (go START))
     2194     DONE
     2195       (return (values form changed)))))
    21852196
    21862197; Transform all of the arguments to the function call form.
    21872198; If any of them won, return a new call form (with the same operator as the original), else return the original
    21882199; call form unchanged.
    2189 
    21902200(defun nx-transform-arglist (callform env)
    2191     (let* ((any-wins nil)
    2192            (transformed-call (cons (car callform) nil))
    2193            (ptr transformed-call)
    2194            (win nil))
    2195       (declare (type cons ptr))
    2196       (dolist (form (cdr callform) (if any-wins (values (copy-list transformed-call) t) (values callform nil)))
    2197         (multiple-value-setq (form win) (nx-transform form env))
    2198         (rplacd ptr (setq ptr (cons form nil)))
    2199         (if win (setq any-wins t)))))
     2201  (let* ((any-wins nil)
     2202         (transformed-call (cons (car callform) nil))
     2203         (ptr transformed-call)
     2204         (win nil))
     2205    (declare (type cons ptr))
     2206    (dolist (form (cdr callform) (if any-wins (values (copy-list transformed-call) t) (values callform nil)))
     2207      (multiple-value-setq (form win) (nx-transform form env))
     2208      (rplacd ptr (setq ptr (cons form nil)))
     2209      (if win (setq any-wins t)))))
    22002210
    22012211;This is needed by (at least) SETF.
  • trunk/source/compiler/nx1.lisp

    r11157 r11183  
    3131  (let* ((*nx-form-type* typespec)
    3232         (transformed (nx-transform form env)))
    33     (if (and (consp transformed)
    34              (eq (car transformed) 'the))
     33    (when (and (consp transformed)
     34               (eq (car transformed) 'the))
    3535      (setq transformed form))
    36     ;; Doing this in this bizarre way may be a little easier
    37     ;; to bootstrap.
    38     (if (nx-the-typechecks env)
    39       (make-acode
    40        (%nx1-operator typed-form)
    41        typespec
    42        (nx1-transformed-form transformed env)
    43        t)
    44       (make-acode
    45        (%nx1-operator typed-form)
    46        typespec
    47        (nx1-transformed-form transformed env)))))
     36    (make-acode
     37     (%nx1-operator typed-form)
     38     typespec
     39     (nx1-transformed-form transformed env)
     40     (nx-the-typechecks env))))
    4841
    4942(defnx1 nx1-struct-ref struct-ref (&whole whole structure offset)
  • trunk/source/lib/db-io.lisp

    r11136 r11183  
    10151015        (setf (macro-function sym) #'%external-call-expander)
    10161016        sym))))
    1017 
    1018 #-BOOTSTRAPPED
    1019 (when (eql (function-args #'read-internal) 1)
    1020   ;; loading this file into an old image, only happens during bootstrapping
    1021   (fset 'read-internal (lambda (stream eof-error-p eof-value recursive-p)
    1022                          (setq stream (input-stream-arg stream))
    1023                          (if recursive-p
    1024                            (%read-form stream (if eof-error-p 0) nil)
    1025                            (let ((%read-objects% nil) (%keep-whitespace% nil))
    1026                              (%read-form stream (if eof-error-p 0) eof-value))))))
    10271017
    10281018(defun %read-symbol-preserving-case (stream package)
  • trunk/source/lib/lists.lisp

    r8338 r11183  
    351351(defun subst-if-not (new test tree &key key)
    352352  "Substitutes new for subtrees for which test is false."
    353   "replace with above def when labels works."
    354353  (unless key (setq key #'identity))
    355354  (cond ((not (funcall test (funcall key tree))) new)
  • trunk/source/lib/nfcomp.lisp

    r11104 r11183  
    10521052             ((#.target::subtag-pool #.target::subtag-weak #.target::subtag-lock) (fasl-unknown exp))
    10531053             (#+ppc-target #.target::subtag-symbol
    1054               #+x8632-target #.target::subtag-symbol
     1054              #+x8632-target #.target::subtag-symbol
    10551055              #+x8664-target #.target::tag-symbol (fasl-scan-symbol exp))
    10561056             ((#.target::subtag-instance #.target::subtag-struct)
     
    11291129                             form))))
    11301130        ((istruct-cell-p list)
    1131          (fasl-scan-form (%car list)))       
     1131         (fasl-scan-form (%car list)))
    11321132        (t (when list
    11331133             (fasl-scan-ref list)
     
    16041604        ((istruct-cell-p list)
    16051605         (fasl-out-opcode $fasl-istruct-cell (car list))
    1606          (fasl-dump-symbol (car list)))       
     1606         (fasl-dump-symbol (car list)))
    16071607        (t (fasl-dump-cons list))))
    16081608
  • trunk/source/lib/source-files.lisp

    r11161 r11183  
    1616
    1717(in-package "CCL")
    18 
    19 #-BOOTSTRAPPED (unless (fboundp 'level-1-record-source-file)
    20                  ;; We're in a lisp image with old rsf.
    21                  (fset 'level-1-record-source-file (lambda (&rest args) args))
    22                  (when (boundp '%source-files%)
    23                    (clrhash %source-files%)))
    2418
    2519;; If we're reloading this file, don't want to be calling functions from here with
  • trunk/source/library/lispequ.lisp

    r10942 r11183  
    140140(defconstant $lfbits-numinh (byte 6 17))
    141141(defconstant $lfbits-info-bit 23)
    142 (defconstant $lfbits-symmap-bit 23) ;; bootstrapping
    143142(defconstant $lfbits-trampoline-bit 24)
    144143(defconstant $lfbits-code-coverage-bit 25)
Note: See TracChangeset for help on using the changeset viewer.