Changeset 11088


Ignore:
Timestamp:
Oct 14, 2008, 5:22:57 PM (11 years ago)
Author:
gz
Message:

Trivial tweaks, mostly indentation and comments, to simplify merging with working-0711 branch

Location:
trunk/source
Files:
10 edited

Legend:

Unmodified
Added
Removed
  • trunk/source/compiler/X86/x86-arch.lisp

    r8431 r11088  
    5454    heap-end                            ; end of lisp heap
    5555    statically-linked                   ; true if the lisp kernel is statically linked
    56     stack-size                          ; weak gc policy/algorithm.
     56    stack-size                          ; value of --stack-size arg
    5757    objc-2-begin-catch                  ; objc_begin_catch
    5858    bad-funcall                         ; pseudo-target for funcall
  • trunk/source/compiler/X86/x86-disassemble.lisp

    r10486 r11088  
    27232723
    27242724
    2725    
    2726    
    27272725(defun x86-print-disassembled-instruction (ds instruction seq)
    27282726  (let* ((addr (x86-di-address instruction))
     
    27992797
    28002798#+x8664-target
    2801 (defun x8664-xdisassemble (function &optional (collect-function #'x86-print-disassembled-instruction ))
     2799(defun x8664-xdisassemble (function
     2800                           &optional (collect-function #'x86-print-disassembled-instruction))
    28022801  (let* ((fv (%function-to-function-vector function))
    28032802         (function-size-in-words (uvsize fv))
     
    28142813          (j 1 (1+ j)))
    28152814         ((= k function-size-in-words)
    2816           (x8664-disassemble-xfunction xfunction :collect-function collect-function))
     2815          (x8664-disassemble-xfunction xfunction
     2816                                       :collect-function collect-function))
    28172817      (declare (fixnum j k))
    28182818      (setf (uvref xfunction j) (uvref fv k)))))
  • trunk/source/compiler/X86/x86-lapmacros.lisp

    r11062 r11088  
    3232  (cond ((= n 0) `(xorl (% nargs) (% nargs)))
    3333        (t `(movl ($ ',n) (% nargs)))))
    34        
    3534
    3635(defx86lapmacro anchored-uuo (form)
     
    141140  (let* ((bad (gensym))
    142141         (anchor (gensym)))
    143            
    144142    `(progn
    145143      ,anchor
     
    413411      (leaq (@ ,(* (1+ nstackargs) x8664::node-size) (% rsp)) (% rbp))
    414412      (popq (@ x8632::node-size (% rbp)))))))
    415    
    416  
     413
    417414(defx86lapmacro save-frame-variable-arg-count ()
    418415  (let* ((push (gensym))
  • trunk/source/compiler/X86/x862.lisp

    r11050 r11088  
    474474      (unless (afunc-lfun a)
    475475        (x862-compile a
    476                       (if lambda-form
    477                         (afunc-lambdaform a))
     476                      (if lambda-form (afunc-lambdaform a))
    478477                      *x862-record-symbols*))) ; always compile inner guys
    479478    (let* ((*x862-cur-afunc* afunc)
     
    657656                         (let* ((val (single-float-bits sfloat)))
    658657                           (x86-lap-directive frag-list :long val)))))
    659                    (target-arch-case
     658                   (target-arch-case
    660659                    (:x8632
    661660                     (x86-lap-directive frag-list :align 2)
     
    672671                     (x86-lap-directive frag-list :align 3)
    673672                     (x86-lap-directive frag-list :quad x8664::function-boundary-marker)))
    674                    
     673
    675674                   (emit-x86-lap-label frag-list end-code-tag)
    676675                   
     
    687686                        (:x8664
    688687                         (x86-lap-directive frag-list :quad 0)))))
    689                    
     688
    690689                   (if (logbitp $fbitnonnullenv (the fixnum (afunc-bits afunc)))
    691690                     (setq bits (+ bits (ash 1 $lfbits-nonnullenv-bit))))
     
    725724                         (x86-lap-directive frag-list :quad 0))
    726725                       (x86-lap-directive frag-list :quad 0)))
    727                      
    728                      (relax-frag-list frag-list)
     726
     727                     (relax-frag-list frag-list)
    729728                     (apply-relocs frag-list)
    730729                     (fill-for-alignment frag-list)
     
    743742                       ;;(show-frag-bytes frag-list)
    744743                       ))
    745                      
    746                      (x862-lap-process-regsave-info frag-list regsave-label regsave-mask regsave-addr)
    747                      (setf (afunc-lfun afunc)
    748                            #+x86-target
    749                            (if (eq *host-backend* *target-backend*)
    750                              (create-x86-function fname frag-list *x862-constant-alist* bits debug-info)
    751                              (cross-create-x86-function fname frag-list *x862-constant-alist* bits debug-info))
    752                            #-x86-target
    753                            (cross-create-x86-function fname frag-list *x862-constant-alist* bits debug-info)))
     744
     745                     (x862-lap-process-regsave-info frag-list regsave-label regsave-mask regsave-addr)
     746                     (setf (afunc-lfun afunc)
     747                           #+x86-target
     748                           (if (eq *host-backend* *target-backend*)
     749                             (create-x86-function fname frag-list *x862-constant-alist* bits debug-info)
     750                             (cross-create-x86-function fname frag-list *x862-constant-alist* bits debug-info))
     751                           #-x86-target
     752                           (cross-create-x86-function fname frag-list *x862-constant-alist* bits debug-info)))
    754753                   (x862-digest-symbols)))))
    755754          (backend-remove-labels))))
     
    768767    (when fwd-refs
    769768      (let* ((native-x86-functions #-x86-target nil
    770                                    #+x86-target (eq *target-backend*
    771                                                     *host-backend*))
     769                                   #+x86-target (eq *target-backend*
     770                                                    *host-backend*))
    772771             (v (if native-x86-functions
    773772                  (function-to-function-vector (afunc-lfun afunc))
     
    787786                (setf (%svref v i) ref-fun)))))))))
    788787
     788(defun x862-vinsn-note-label-address (note &optional start-p sym)
     789  (-
     790   (let* ((label (vinsn-note-label note))
     791          (lap-label (if label (vinsn-label-info label))))
     792     (if lap-label
     793       (x86-lap-label-address lap-label)
     794       (compiler-bug "Missing or bad ~s label~@[: ~s~]"
     795                     (if start-p 'start 'end)
     796                     sym)))
     797   (target-arch-case
     798    (:x8632 x8632::fulltag-misc)        ;xxx?
     799    (:x8664 x8664::fulltag-function))))
     800
    789801(defun x862-digest-symbols ()
    790   (if *x862-recorded-symbols*
     802  (when *x862-recorded-symbols*
    791803    (let* ((symlist *x862-recorded-symbols*)
    792804           (len (length symlist))
     
    798810      (dolist (info symlist (progn (%rplaca symlist syms)
    799811                                   (%rplacd symlist ptrs)))
    800         (flet ((label-address (note start-p sym)
    801                  (-
    802                   (let* ((label (vinsn-note-label note))
    803                          (lap-label (if label (vinsn-label-info label))))
    804                     (if lap-label
    805                       (x86-lap-label-address lap-label)
    806                       (compiler-bug "Missing or bad ~s label: ~s"
    807                                     (if start-p 'start 'end) sym)))
    808                   (target-arch-case
    809                    (:x8632 x8632::fulltag-misc) ;xxx?
    810                    (:x8664 x8664::fulltag-function)))))
    811           (destructuring-bind (var sym startlab endlab) info
    812             (let* ((ea (var-ea var))
    813                    (ea-val (ldb (byte 16 0) ea)))
    814               (setf (aref ptrs (incf i)) (if (memory-spec-p ea)
    815                                            (logior (ash ea-val 6) #o77)
    816                                            ea-val)))
    817             (setf (aref syms (incf j)) sym)
    818             (setf (aref ptrs (incf i)) (label-address startlab t sym))
    819             (setf (aref ptrs (incf i)) (label-address endlab nil sym))))))))
     812        (destructuring-bind (var sym startlab endlab) info
     813          (let* ((ea (var-ea var))
     814                 (ea-val (ldb (byte 16 0) ea)))
     815            (setf (aref ptrs (incf i)) (if (memory-spec-p ea)
     816                                         (logior (ash ea-val 6) #o77)
     817                                         ea-val)))
     818          (setf (aref syms (incf j)) sym)
     819          (setf (aref ptrs (incf i)) (x862-vinsn-note-label-address startlab t sym))
     820          (setf (aref ptrs (incf i)) (x862-vinsn-note-label-address endlab nil sym))))
     821      *x862-recorded-symbols*)))
    820822
    821823(defun x862-decls (decls)
     
    912914      (do* ((things (%sort-list-no-key maybe #'%x862-bigger-cdr-than) (cdr things))
    913915            (n 0 (1+ n))
    914             (registers (target-arch-case 
     916            (registers (target-arch-case
    915917                        (:x8632 (error "no nvrs on x8632"))
    916918                        (:x8664
     
    16921694                             (:x8664
    16931695                              (! box-fixnum target temp)))))))))
    1694              (with-imm-target () idx-reg
    1695                (if index-known-fixnum
     1696             (with-imm-target () idx-reg
     1697               (if index-known-fixnum
    16961698                 (x862-absolute-natural seg idx-reg nil (+ (arch::target-misc-data-offset arch) (ash index-known-fixnum 2)))
    16971699                 (! scale-32bit-misc-index idx-reg unscaled-idx))
     
    24992501      (when (and vreg val-reg) (<- val-reg))
    25002502      (^))))
    2501          
    2502          
     2503
    25032504
    25042505(defun x862-vset (seg vreg xfer type-keyword vector index value safe)
     
    58015802                               (tail parsed-ops))
    58025803                          (declare (dynamic-extent parsed-ops)
    5803                                    (cons parsed-ops tail))
     5804                                   (list parsed-ops tail))
    58045805                          (dolist (op op-vals
    58055806                                   (if for-pred
     
    60176018        (@ (backend-get-next-label)) ; generic self-reference label, should be label #1
    60186019        (! establish-fn)
    6019         (@ (backend-get-next-label)) ; self-call label
     6020        (@ (backend-get-next-label))    ; self-call label
    60206021        (unless next-method-p
    60216022          (setq method-var nil))
     
    80318032          (if (node-reg-p vreg)
    80328033            (! mem-ref-c-bit-fixnum vreg src-reg offval)
    8033             (with-imm-target ()           ;OK if src-reg & dest overlap
     8034            (with-imm-target ()         ;OK if src-reg & dest overlap
    80348035                (dest :u8)
    80358036              (! mem-ref-c-bit dest src-reg offval)
     
    98459846   (when vreg
    98469847     (ensuring-node-target (target vreg)
    9847                                 (! %foreign-stack-pointer target)))
     9848      (! %foreign-stack-pointer target)))
    98489849   (^))
    98499850
     
    1001810019                                         '%short-float)
    1001910020                             (list nil (list arg))))))))
    10020    
     10021
    1002110022
    1002210023(defx862 x862-%new-ptr %new-ptr (seg vreg xfer size clear-p )
     
    1007510076                         *target-ftd*)))
    1007610077    (multiple-value-bind (xlfun warnings)
    10077         (compile-named-function def nil
    10078                                 nil
    10079                                 nil
    10080                                 nil
    10081                                 nil
    10082                                 nil
    10083                                 target)
     10078        (compile-named-function def :target target)
    1008410079      (signal-or-defer-warnings warnings nil)
    1008510080      (when disassemble
  • trunk/source/compiler/nx-basic.lisp

    r10942 r11088  
    2121(in-package :ccl)
    2222
    23 #| Note: when MCL-AppGen 4.0 is built, the following form will need to be included in it:
     23#|| Note: when MCL-AppGen 4.0 is built, the following form will need to be included in it:
    2424; for compiler-special-form-p, called by cheap-eval-in-environment
    2525(defparameter *nx1-compiler-special-forms*
     
    3030    OLD-LAP-INLINE OR PROG1 PROGN PROGV QUOTE RETURN-FROM SETQ STRUCT-REF STRUCT-SET
    3131    SYMBOL-MACROLET TAGBODY THE THROW UNWIND-PROTECT WITH-STACK-DOUBLE-FLOATS WITHOUT-INTERRUPTS))
    32 |#
     32||#
    3333
    3434(eval-when (:compile-toplevel)
     
    407407  (%make-function nil lambda-expression env))
    408408
    409 #| Might be nicer to do %declaim
     409#|| Might be nicer to do %declaim
    410410(defmacro declaim (&rest decl-specs &environment env)
    411411  `(progn
     
    414414     (eval-when (:compile-toplevel)
    415415       (%declaim ',@decl-specs ,env))))
    416 |#
     416||#
    417417
    418418(defmacro declaim (&environment env &rest decl-specs)
     
    448448
    449449;;; This is called by, e.g., note-function-info & so can't be -too- funky ...
    450 ;;; don't call proclaimed-inline-p or proclaimed-notinline-p with
    451 ;;; alphatized crap
     450;;; don't call proclaimed-inline-p or proclaimed-notinline-p with alphatized crap
    452451
    453452(defun nx-declared-inline-p (sym env)
  • trunk/source/compiler/nx.lisp

    r9887 r11088  
    186186           (funcall (backend-p2-compile *target-backend*)
    187187            afunc
    188             ; will also bind *nx-lexical-environment*
     188            ;; will also bind *nx-lexical-environment*
    189189            (if keep-lambda (if (lambda-expression-p keep-lambda) keep-lambda def))
    190190            keep-symbols)))))
    191191  (values (afunc-lfun def) (afunc-warnings def)))
    192192)
    193 
    194 
    195  
    196 
    197 
    198193
    199194
  • trunk/source/compiler/nx0.lisp

    r10942 r11088  
    304304(defun nx-allow-transforms (env)
    305305  (nx-apply-env-hook policy.allow-transforms env))
    306 
    307 
    308306
    309307(defun nx-force-boundp-checks (var env)
     
    12551253                                     (ash -1 $vbitspecial)
    12561254                                     (%ilsl $vbitclosed 1)) varbits))
    1257           (error "Bug-o-rama - \"punted\" var had bogus bits.
     1255          (error "Bug-o-rama - \"punted\" var had bogus bits. ~
    12581256Or something. Right? ~s ~s" var varbits))
    12591257        (let* ((varcount     (%ilogand $vrefmask varbits))
     
    13751373       (consp (setq form (%cdr form)))       
    13761374       (eq (caar form) '&method)))
    1377          
    1378 
    1379 
    1380 
    13811375
    13821376
    13831377(defun nx1-lambda (ll body decls &aux (l ll) methvar)
    1384   (let ((old-env *nx-lexical-environment*)
    1385         (*nx-bound-vars* *nx-bound-vars*))
     1378  (let* ((old-env *nx-lexical-environment*)
     1379         (*nx-bound-vars* *nx-bound-vars*))
    13861380    (with-nx-declarations (pending)
    13871381      (let* ((*nx-parsing-lambda-decls* t))
     
    13931387              (nx-error "invalid lambda-list  - ~s" l)))
    13941388          (return-from nx1-lambda
    1395                        (list
     1389                       (make-acode
    13961390                        (%nx1-operator lambda-list)
    13971391                        (list (cons '&lap bits))
  • trunk/source/compiler/nx1.lisp

    r10904 r11088  
    10851085
    10861086(defnx1 nx1-load-time-value (load-time-value) (&environment env form &optional read-only-p)
    1087   ; Validate the "read-only-p" argument
     1087  ;; Validate the "read-only-p" argument
    10881088  (if (and read-only-p (neq read-only-p t)) (require-type read-only-p '(member t nil)))
    1089   ; Then ignore it.
     1089  ;; Then ignore it.
    10901090  (if *nx-load-time-eval-token*
    10911091    (multiple-value-bind (function warnings)
     
    13711371             ((:darwinppc32 :darwinppc64 :linuxppc64)
    13721372              (%nx1-operator poweropen-syscall))
    1373              (:darwinx8632 :linuxx632 :win32 (%nx1-operator i386-syscall))
     1373             ((:darwinx8632 :linuxx632 :win32) (%nx1-operator i386-syscall))
    13741374             ((:linuxx8664 :freebsdx8664 :darwinx8664 :solarisx8664 :win64) (%nx1-operator syscall))))))
    13751375
     
    18951895            (if arglist
    18961896              (when (and (not keys) (not rest))
    1897                 (nx-error "Extra args ~s for (LAMBDA ~s ,,,)" args lambda-list))
     1897                (nx-error "Extra args ~s for (LAMBDA ~s ...)" args lambda-list))
    18981898              (when rest
    18991899                (push rest vars*) (push *nx-nil* vals*)
  • trunk/source/compiler/optimizers.lisp

    r10616 r11088  
    24392439
    24402440(provide "OPTIMIZERS")
    2441 
  • trunk/source/lib/macros.lisp

    r10983 r11088  
    17171717(defmacro defmethod (name &rest args &environment env)
    17181718  (multiple-value-bind (function-form specializers-form qualifiers lambda-list documentation specializers)
    1719                        (parse-defmethod name args env)   
     1719      (parse-defmethod name args env)
    17201720    `(progn
    17211721       (eval-when (:compile-toplevel)
     
    20002000
    20012001(defmacro defgeneric (function-name lambda-list &rest options-and-methods &environment env)
    2002   (fboundp function-name)               ; type-check
     2002  (fboundp function-name)             ; type-check
    20032003  (multiple-value-bind (method-combination generic-function-class options methods)
    20042004      (parse-defgeneric function-name t lambda-list options-and-methods)
    20052005    (let ((gf (gensym)))
    20062006      `(progn
    2007         (eval-when (:compile-toplevel)
    2008           (record-function-info ',(maybe-setf-function-name function-name)
     2007         (eval-when (:compile-toplevel)
     2008           (record-function-info ',(maybe-setf-function-name function-name)
    20092009                                 ',(%cons-def-info 'defgeneric (encode-gf-lambda-list lambda-list))
    20102010                                 ,env))
    2011         (let ((,gf (%defgeneric
    2012                     ',function-name ',lambda-list ',method-combination ',generic-function-class
    2013                     ',(apply #'append options))))
    2014           (%set-defgeneric-methods ,gf ,@methods)
    2015           ,gf)))))
     2011         (let ((,gf (%defgeneric
     2012                     ',function-name ',lambda-list ',method-combination ',generic-function-class
     2013                     ',(apply #'append options))))
     2014           (%set-defgeneric-methods ,gf ,@methods)
     2015           ,gf)))))
    20162016
    20172017
     
    20282028              (defmethod (if global-p 'defmethod 'anonymous-method)))
    20292029          (if (eq keyword :method)
    2030             (push `(,defmethod ,function-name ,@(%cdr o)) methods)
     2030            (let ((defn `(,defmethod ,function-name ,@(%cdr o))))
     2031              (push defn methods))
    20312032            (cond ((and (not (eq keyword 'declare))
    20322033                        (memq keyword (prog1 option-keywords (push keyword option-keywords))))             
     
    21372138       (defclass ,name ,(or supers '(condition)) ,slots ,@classopts)
    21382139       ,@reporter
    2139        ;; defclass will record name as a class, we only want
    2140       #+new-record-source
    2141        (remove-definition-source 'class ',name)
    2142        (record-source-file ',name 'condition)
    21432140       ',name)))
    21442141
     
    26612658    `(do* ((,val ,place ,place))
    26622659          ((typep ,val ',typespec))
    2663       (setf ,place (%check-type ,val ',typespec ',place ,string)))))
     2660       (setf ,place (%check-type ,val ',typespec ',place ,string)))))
    26642661
    26652662
Note: See TracChangeset for help on using the changeset viewer.