Changeset 11135


Ignore:
Timestamp:
Oct 17, 2008, 1:26:11 PM (11 years ago)
Author:
gz
Message:

Mostly semantically insignificant indentation/comments/etc changes, remove more lock-accounting and class-cell bootstrapping remnants, rename -symmap-bit to -info-bit

Location:
trunk/source
Files:
18 edited

Legend:

Unmodified
Added
Removed
  • trunk/source/compiler/PPC/ppc2.lisp

    r10977 r11135  
    474474                         (setq function-debugging-info (nconc (list 'function-symbol-map *ppc2-recorded-symbols*)
    475475                                                              function-debugging-info)))
    476                        (setq bits (logior (ash 1 $lfbits-symmap-bit) bits))
     476                       (setq bits (logior (ash 1 $lfbits-info-bit) bits))
    477477                       (backend-new-immediate function-debugging-info)))
    478478                   (if (or fname lambda-form *ppc2-recorded-symbols*)
  • trunk/source/compiler/X86/x862.lisp

    r11088 r11135  
    696696                         (setq function-debugging-info (nconc (list 'function-symbol-map *x862-recorded-symbols*)
    697697                                                              function-debugging-info)))
    698                        (setq bits (logior (ash 1 $lfbits-symmap-bit) bits))
     698                       (setq bits (logior (ash 1 $lfbits-info-bit) bits))
    699699                       (setq debug-info function-debugging-info)))
    700700                   (unless (or fname lambda-form *x862-recorded-symbols*)
  • trunk/source/compiler/lambda-list.lisp

    r4020 r11135  
    2929       (let ((bits (lfun-bits fn)))
    3030         (declare (fixnum bits))
    31          (and (logbitp $lfbits-symmap-bit bits)
     31         (and (logbitp $lfbits-info-bit bits)
    3232               (%i- (uvsize (function-to-function-vector fn))
    3333                              (if (logbitp $lfbits-noname-bit bits) 2 3))))))
  • trunk/source/level-0/l0-misc.lisp

    r10864 r11135  
    1616
    1717(in-package "CCL")
    18 
    19 
    20 (defparameter *locks-held* () "per-thread list of held locks")
    21 (defparameter *locks-pending* () "per-thread list of locks we're waiting for.")
    22 (defparameter *lock-conses* ())
    23 
    24 
    2518
    2619
     
    663656       (cond ((eql p owner)
    664657              (incf (%get-natural ptr target::lockptr.count))
    665               #+lock-accounting
    666               (setq *locks-held* (%lock-cons lock *locks-held*))
    667658              (if flag (setf (lock-acquisition.status flag) t))
    668659              t)
     
    673664                  (setf (%get-ptr ptr target::lockptr.owner) p
    674665                        (%get-natural ptr target::lockptr.count) 1)
    675                   #+lock-accounting
    676                   (setq *locks-held* (%lock-cons lock *locks-held*))
    677666                  (if flag (setf (lock-acquisition.status flag) t)))
    678667                (setf (%get-ptr spin) (%null-ptr))
     
    693682     (cond ((eql (%get-object ptr target::lockptr.owner) self)
    694683            (incf (%get-natural ptr target::lockptr.count))
    695             #+lock-accounting*
    696             (setq *locks-held* (%lock-cons lock *locks-held*))
    697684            (if flag (setf (lock-acquisition.status flag) t))
    698685            t)
     
    701688              (%set-object ptr target::lockptr.owner self)
    702689              (setf (%get-natural ptr target::lockptr.count) 1)
    703               #+lock-accounting
    704               (setq *locks-held* (%lock-cons lock *locks-held*))
    705690              (if flag (setf (lock-acquisition.status flag) t))
    706691              t))))))
     
    911896         (progn
    912897           (setf (%get-natural ptr target::rwlock.spin) 0)
    913            (setq *locks-pending* (cdr *locks-pending*))
    914898           (error 'deadlock :lock lock))
    915899         (do* ((state
     
    945929         (progn
    946930           (%unlock-futex ptr)
    947            (setq *locks-pending* (cdr *locks-pending*))
    948931           (error 'deadlock :lock lock))
    949932         (do* ((state
  • trunk/source/level-1/l1-aprims.lisp

    r10672 r11135  
    4141    symbol))
    4242
    43 (defstatic *kernel-tcr-area-lock* (%make-lock (%null-ptr) "Kernal tcr-area-lock"))
    44 
    45 (defstatic *kernel-exception-lock* (%make-lock (%null-ptr) "Kernal exception-lock"))
     43(defstatic *kernel-tcr-area-lock* (%make-lock (%null-ptr) "Kernel tcr-area-lock"))
     44
     45(defstatic *kernel-exception-lock* (%make-lock (%null-ptr) "Kernel exception-lock"))
    4646 
    4747(def-ccl-pointers kernel-locks ()
     
    5656(def-standard-initial-binding *gensym-counter* 0)
    5757(def-standard-initial-binding *random-state* (initialize-random-state #xFBF1 9))
    58 #+lock-accounting
    59 (progn
    60 (def-standard-initial-binding *locks-held* ())
    61 (def-standard-initial-binding *locks-pending* ())
    62 (def-standard-initial-binding *lock-conses* (make-list 20)))
    6358(def-standard-initial-binding *whostate* "Reset")
    6459(setq *whostate* "Reset")
  • trunk/source/level-1/l1-files.lisp

    r10942 r11135  
    808808                                  (eql (schar sstr 1) #\:))
    809809                           (setq pos2 2)))
    810                       (pathname-directory-sstr sstr pos2 end host))))
     810                       (pathname-directory-sstr sstr pos2 end host))))
    811811                  (t (report-bad-arg path pathname-arg-type)))))
    812812    (if (and case (neq case :local))
     
    12351235           (*readtable* *readtable*)
    12361236           (*loading-files* (cons file-name (specialv *loading-files*)))
    1237            (*loading-file-source-file* (namestring source-file))) ;reset by fasload to logical name stored in the file?
     1237           ;;reset by fasload to logical name stored in the file
     1238           (*loading-file-source-file* (namestring source-file)))
    12381239      (declare (special *loading-files* *loading-file-source-file*))
    12391240      (when verbose
  • trunk/source/level-1/l1-init.lisp

    r10672 r11135  
    255255(defparameter *break-level* 0)
    256256(defparameter *last-break-level* 0)
    257 (defvar *record-source-file* nil)       ; set in l1-utils.
    258 (defvar *warn-if-redefine* nil)         ; set in l1-utils.
     257(defparameter *warn-if-redefine* nil)
     258(defvar *record-source-file*)           ; set in l1-utils.
    259259(defparameter *level-1-loaded* nil)     ; set t by l1-boot
    260260(defparameter *save-definitions* nil)
  • trunk/source/level-1/l1-processes.lisp

    r10876 r11135  
    391391                      (setq exited t)
    392392                      nil)
    393                     (abort-break () :report "Reset this process")
    394                     (abort () :report "Kill this process" (setq exited t)))
     393                    (abort-break () :report "Reset this thread")
     394                    (abort () :report "Kill this thread" (setq exited t)))
    395395                 (process-reset (condition)
    396396                   (process-reset-kill condition)))))
     
    727727
    728728
    729 (defmethod process-locks-held ((p process))
    730   #+lock-accounting
    731   (copy-list (symbol-value-in-process '*locks-held* p)))
    732 
    733 (defmethod process-locks-pending ((p process))
    734   #+lock-accounting
    735   (copy-list (symbol-value-in-process '*locks-pending* p)))
  • trunk/source/level-1/l1-streams.lisp

    r10942 r11135  
    1717
    1818(in-package "CCL")
     19
    1920;;;
    2021
  • trunk/source/level-1/l1-utils.lisp

    r11039 r11135  
    2828
    2929
    30 (setq *warn-if-redefine-kernel* nil)
    31 
    32 (setq *warn-if-redefine* nil)
    33 (setq *record-source-file* t)
    34 
    3530;;; Kludge for record-source-file bootstrapping
    36 
    37 ; Set T by l1-boot.lisp
    38 (setq *level-1-loaded* nil)
    3931
    4032(%fhave 'full-pathname (qlfun bootstrapping-full-pathname (name) name))
     
    4739(fset 'physical-pathname-p (lambda (file)(declare (ignore file)) nil)) ; redefined later
    4840
    49 
    50 ;(%defvar *enqueued-window-title* nil)
     41(setq *record-source-file* t)
    5142
    5243(fset 'level-1-record-source-file
  • trunk/source/level-1/level-1.lisp

    r5173 r11135  
    9494  (l1-load "l1-boot-2")
    9595  (l1-load "l1-boot-3")
     96
     97  ;; Without this, forms from the -e command line parameter would run with
     98  ;; *loading-file-source-file* set to "l1-boot-3".
     99  (setq *loading-file-source-file* nil)
    96100  )
    97101
    98102(require "PREPARE-MCL-ENVIRONMENT")
    99 (progn (%set-toplevel #'toplevel-loop) (set-user-environment t) (toplevel))
    100 
    101 
    102 
    103 
     103(progn
     104  (%set-toplevel #'toplevel-loop)
     105  (set-user-environment t)
     106  (toplevel))
  • trunk/source/lib/backquote.lisp

    r6992 r11135  
    371371                  (let ((*backquote-stack* (list* |`,| |`,.| |`,@| *backquote-stack*)))
    372372                    (read stream t nil t)))))
    373     (if *backquote-expand* (macroexpand-1 form) form))))
     373    (if *backquote-expand* (values (macroexpand-1 form)) form))))
    374374
    375375(set-macro-character
  • trunk/source/lib/defstruct-macros.lisp

    r10408 r11135  
    8181(defmacro sd-refnames (sd) `(svref ,sd 6))
    8282
    83 (defmacro struct-name (struct)
    84   (let* ((temp (gensym)))
    85     `(let* ((,temp (car (uvref ,struct 0))))
    86       (if (istruct-typep ,temp 'class-cell)
    87         (class-cell-name ,temp)
    88         ,temp))))
    89 
     83(defmacro struct-name (struct) `(class-cell-name (car (uvref ,struct 0))))
    9084(defmacro struct-def (struct) `(gethash (struct-name ,struct) %defstructs%))
    9185
  • trunk/source/lib/encapsulate.lisp

    r9887 r11135  
    646646    res))
    647647
     648(defmacro with-traces (syms &body body)
     649 `(unwind-protect
     650       (progn
     651         (let ((*trace-output* (make-broadcast-stream)))
     652           ;; if you're tracing ccl internals you'll get trace output as it encapsulates the
     653           ;; functions so hide all the trace output while eval'ing the trace form itself.
     654           (trace ,@syms))
     655         ,@body)
     656    (untrace ,@syms)))
     657
    648658;; this week def is the name of an uninterned gensym whose fn-cell is original def
    649659
     
    732742
    733743(defun compile-named-function-warn (fn name)
    734   (multiple-value-bind (result warnings)(compile-named-function fn :name name)
     744  (multiple-value-bind (result warnings) (compile-named-function fn :name name)
    735745    (when warnings
    736746      (let ((first t))
  • trunk/source/lib/format.lisp

    r10942 r11135  
    8585
    8686; does this need to exist?????
    87 #| ; put it out of its misery
     87#|| ; put it out of its misery
    8888(defmacro format-with-control-string (control-string &rest forms)
    8989  `(let ((string (if (simple-string-p ,control-string)
     
    104104                                      (1+ *format-index*))
    105105                                error))))))
    106 |#
     106||#
    107107(defmacro format-indirect-error (error)
    108108  `(throw 'format-error
  • trunk/source/lib/method-combination.lisp

    r10942 r11135  
    9191  `(gethash ,method-combination-type *method-combination-info*))
    9292
    93 ; Need to special case (find-method-combination #'find-method-combination ...)
     93;;; Need to special case (find-method-combination #'find-method-combination ...)
    9494(without-duplicate-definition-warnings ;; override version in l1-clos-boot.lisp
    9595 (defmethod find-method-combination ((generic-function standard-generic-function)
  • trunk/source/lib/read.lisp

    r11071 r11135  
    140140         (apply sd (nreverse args))))))
    141141
    142 ;from slisp reader2.lisp.
     142;;;from slisp reader2.lisp, and apparently not touched in 20 years.
    143143(defun parse-integer (string &key (start 0) end
    144144                      (radix 10) junk-allowed)
     
    149149  (flet ((parse-integer-not-integer-string (s)
    150150           (error 'parse-integer-not-integer-string :string s)))
    151     (declare (inline not-integer-string-error))
     151    (declare (inline parse-integer-not-integer-string))
    152152    (unless (typep string 'string)
    153153      (setq string (require-type string 'string)))
  • trunk/source/xdump/xfasload.lisp

    r10419 r11135  
    3838(defparameter *xload-special-binding-indices* nil)
    3939(defparameter *xload-reserved-special-binding-index-symbols*
    40   '(*interrupt-level* *locks-held* *locks-pending* *lock-conses*))
     40  '(*interrupt-level*))
    4141
    4242(defparameter *xload-next-special-binding-index* (length *xload-reserved-special-binding-index-symbols*))
Note: See TracChangeset for help on using the changeset viewer.