From: Christophe Rhodes <csr21@cam.ac.uk>
Date: Thu, 18 Aug 2005 10:06:32 +0000 (+0000)
Subject: 0.9.3.61:
X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=95a014cffbb243fdc59adbdd6ab7f6dbb0058ca4;p=sbcl.git

0.9.3.61:
	Restore alpha/static-fn.lisp, apparently deleted in a dewhitespace
	accident.
	... also canonize whitespace again.
---

diff --git a/src/code/time.lisp b/src/code/time.lisp
index 72abe21..180b6b6 100644
--- a/src/code/time.lisp
+++ b/src/code/time.lisp
@@ -176,14 +176,14 @@
     (cond
       ((< unix-time (- (ash 1 31)))
        (multiple-value-bind (year offset) (years-since-mar-2000 utime)
-	 (declare (ignore year))
-	 (+  +mar-1-1903+  (- unix-to-universal-time)  offset)))
+         (declare (ignore year))
+         (+  +mar-1-1903+  (- unix-to-universal-time)  offset)))
       ((>= unix-time (ash 1 31))
        (multiple-value-bind (year offset) (years-since-mar-2000 utime)
-	 (declare (ignore year))
-	 (+  +mar-1-2035+  (- unix-to-universal-time)  offset)))
+         (declare (ignore year))
+         (+  +mar-1-2035+  (- unix-to-universal-time)  offset)))
       (t unix-time))))
-  
+
 (defun decode-universal-time (universal-time &optional time-zone)
   #!+sb-doc
   "Converts a universal-time to decoded time format returning the following
@@ -266,10 +266,10 @@
            (type (integer 1 31) date)
            (type (integer 1 12) month)
            (type (or (integer 0 99) (integer 1899)) year)
-	   ;; that type used to say (integer 1900), but that's
-	   ;; incorrect when a time-zone is specified: we should be
-	   ;; able to encode to produce 0 when a non-zero timezone is
-	   ;; specified - bem, 2005-08-09
+           ;; that type used to say (integer 1900), but that's
+           ;; incorrect when a time-zone is specified: we should be
+           ;; able to encode to produce 0 when a non-zero timezone is
+           ;; specified - bem, 2005-08-09
            (type (or null rational) time-zone))
   (let* ((year (if (< year 100)
                    (pick-obvious-year year)
@@ -281,7 +281,7 @@
                       (leap-years-before year))
                   (* (- year 1900) 365)))
          (hours (+ hour (* days 24)))
-	 (encoded-time 0))
+         (encoded-time 0))
     (if time-zone
         (setf encoded-time (+ second (* (+ minute (* (+ hours time-zone) 60)) 60)))
         (let* ((secwest-guess
diff --git a/src/compiler/alpha/static-fn.lisp b/src/compiler/alpha/static-fn.lisp
index e69de29..635ddf1 100644
--- a/src/compiler/alpha/static-fn.lisp
+++ b/src/compiler/alpha/static-fn.lisp
@@ -0,0 +1,131 @@
+;;;; VOPs and macro magic for calling static functions
+
+;;;; This software is part of the SBCL system. See the README file for
+;;;; more information.
+;;;;
+;;;; This software is derived from the CMU CL system, which was
+;;;; written at Carnegie Mellon University and released into the
+;;;; public domain. The software is in the public domain and is
+;;;; provided with absolutely no warranty. See the COPYING and CREDITS
+;;;; files for more information.
+
+(in-package "SB!VM")
+
+(define-vop (static-fun-template)
+  (:save-p t)
+  (:policy :safe)
+  (:variant-vars symbol)
+  (:vop-var vop)
+  (:temporary (:scs (non-descriptor-reg)) temp)
+  (:temporary (:scs (descriptor-reg)) move-temp)
+  (:temporary (:sc descriptor-reg :offset lra-offset) lra)
+  (:temporary (:sc interior-reg :offset lip-offset) entry-point)
+  (:temporary (:sc any-reg :offset nargs-offset) nargs)
+  (:temporary (:sc any-reg :offset ocfp-offset) ocfp)
+  (:temporary (:sc control-stack :offset nfp-save-offset) nfp-save))
+
+(eval-when  (:compile-toplevel :load-toplevel :execute)
+
+(defun static-fun-template-name (num-args num-results)
+  (intern (format nil "~:@(~R-arg-~R-result-static-fun~)"
+                  num-args num-results)))
+
+(defun moves (src dst)
+  (collect ((moves))
+    (do ((dst dst (cdr dst))
+         (src src (cdr src)))
+        ((or (null dst) (null src)))
+      (moves `(move ,(car src) ,(car dst))))
+    (moves)))
+
+(defun static-fun-template-vop (num-args num-results)
+  (unless (and (<= num-args register-arg-count)
+               (<= num-results register-arg-count))
+    (error "either too many args (~W) or too many results (~W); max = ~W"
+           num-args num-results register-arg-count))
+  (let ((num-temps (max num-args num-results)))
+    (collect ((temp-names) (temps) (arg-names) (args) (result-names) (results))
+      (dotimes (i num-results)
+        (let ((result-name (intern (format nil "RESULT-~D" i))))
+          (result-names result-name)
+          (results `(,result-name :scs (any-reg descriptor-reg)))))
+      (dotimes (i num-temps)
+        (let ((temp-name (intern (format nil "TEMP-~D" i))))
+          (temp-names temp-name)
+          (temps `(:temporary (:sc descriptor-reg
+                               :offset ,(nth i *register-arg-offsets*)
+                               ,@(when (< i num-args)
+                                   `(:from (:argument ,i)))
+                               ,@(when (< i num-results)
+                                   `(:to (:result ,i)
+                                     :target ,(nth i (result-names)))))
+                              ,temp-name))))
+      (dotimes (i num-args)
+        (let ((arg-name (intern (format nil "ARG-~D" i))))
+          (arg-names arg-name)
+          (args `(,arg-name
+                  :scs (any-reg descriptor-reg null zero)
+                  :target ,(nth i (temp-names))))))
+      `(define-vop (,(static-fun-template-name num-args num-results)
+                    static-fun-template)
+         (:args ,@(args))
+         ,@(temps)
+         (:results ,@(results))
+         (:generator ,(+ 50 num-args num-results)
+           (let ((lra-label (gen-label))
+                 (cur-nfp (current-nfp-tn vop)))
+             ,@(moves (arg-names) (temp-names))
+             (inst li (fixnumize ,num-args) nargs)
+             (inst ldl entry-point (static-fun-offset symbol) null-tn)
+             (when cur-nfp
+               (store-stack-tn nfp-save cur-nfp))
+             (inst move cfp-tn ocfp)
+             (inst compute-lra-from-code lra code-tn lra-label temp)
+             (note-this-location vop :call-site)
+             (inst move csp-tn cfp-tn)
+             (inst jsr zero-tn entry-point)
+             (emit-return-pc lra-label)
+             ,(collect ((bindings) (links))
+                (do ((temp (temp-names) (cdr temp))
+                     (name 'values (gensym))
+                     (prev nil name)
+                     (i 0 (1+ i)))
+                    ((= i num-results))
+                  (bindings `(,name
+                              (make-tn-ref ,(car temp) nil)))
+                  (when prev
+                    (links `(setf (tn-ref-across ,prev) ,name))))
+                `(let ,(bindings)
+                   ,@(links)
+                   (default-unknown-values vop
+                       ,(if (zerop num-results) nil 'values)
+                       ,num-results move-temp temp lra-label)))
+             (when cur-nfp
+               (maybe-load-stack-nfp-tn cur-nfp nfp-save temp))
+             ,@(moves (temp-names) (result-names))))))))
+
+) ; EVAL-WHEN
+
+(expand
+ (collect ((templates (list 'progn)))
+   (dotimes (i register-arg-count)
+     (templates (static-fun-template-vop i 1)))
+   (templates)))
+
+(defmacro define-static-fun (name args &key (results '(x)) translate
+                                       policy cost arg-types result-types)
+  `(define-vop (,name
+                ,(static-fun-template-name (length args)
+                                           (length results)))
+     (:variant ',name)
+     (:note ,(format nil "static-fun ~@(~S~)" name))
+     ,@(when translate
+         `((:translate ,translate)))
+     ,@(when policy
+         `((:policy ,policy)))
+     ,@(when cost
+         `((:generator-cost ,cost)))
+     ,@(when arg-types
+         `((:arg-types ,@arg-types)))
+     ,@(when result-types
+         `((:result-types ,@result-types)))))
diff --git a/src/compiler/ppc/parms.lisp b/src/compiler/ppc/parms.lisp
index c4ea36c..d665d13 100644
--- a/src/compiler/ppc/parms.lisp
+++ b/src/compiler/ppc/parms.lisp
@@ -93,7 +93,7 @@
 #!+linux
 (progn
   (def!constant dynamic-0-space-start #x40000000)
-  (def!constant dynamic-0-space-end   #x47fff000)  
+  (def!constant dynamic-0-space-end   #x47fff000)
   (def!constant dynamic-1-space-start #x48000000)
   (def!constant dynamic-1-space-end   #x4ffff000))
 
diff --git a/src/pcl/ctor.lisp b/src/pcl/ctor.lisp
index 7a981aa..b37beaf 100644
--- a/src/pcl/ctor.lisp
+++ b/src/pcl/ctor.lisp
@@ -356,7 +356,7 @@
 (defun optimizing-generator (ctor ii-methods si-methods)
   (multiple-value-bind (locations names body before-method-p)
       (fake-initialization-emf ctor ii-methods si-methods)
-    (values 
+    (values
      `(lambda ,(make-ctor-parameter-list ctor)
        (declare #.*optimize-speed*)
        ,(wrap-in-allocate-forms ctor body before-method-p))
@@ -596,7 +596,7 @@
                                  ,(case type
                                     (constant `',(eval value))
                                     ((param var) `,value)
-                                    (initfn `(funcall ,value)))) 
+                                    (initfn `(funcall ,value))))
                   into class-init-forms
                   finally (return (values names locations class-init-forms)))
           (multiple-value-bind (vars bindings)
@@ -604,8 +604,8 @@
                     collect var into vars
                     collect `(,var (funcall ,initfn)) into bindings
                     finally (return (values vars bindings)))
-            (values locations names 
-                    bindings vars 
+            (values locations names
+                    bindings vars
                     (nreverse defaulting-initargs)
                     `(,@(delete nil instance-init-forms)
                       ,@class-init-forms))))))))
diff --git a/tests/clos.impure.lisp b/tests/clos.impure.lisp
index f4bacff..cbc2802 100644
--- a/tests/clos.impure.lisp
+++ b/tests/clos.impure.lisp
@@ -1170,7 +1170,7 @@
 (assert (null (r-c/c-m-1-gf)))
 
 (handler-bind ((warning #'error))
-  (eval '(defclass class-for-ctor/class-slot () 
+  (eval '(defclass class-for-ctor/class-slot ()
           ((class-slot :initarg :class-slot :allocation :class))))
   (eval '(let ((c1 (make-instance 'class-for-ctor/class-slot))
                (c2 (make-instance 'class-for-ctor/class-slot :class-slot 1)))
diff --git a/version.lisp-expr b/version.lisp-expr
index 91d0194..90d4a22 100644
--- a/version.lisp-expr
+++ b/version.lisp-expr
@@ -17,4 +17,4 @@
 ;;; checkins which aren't released. (And occasionally for internal
 ;;; versions, especially for internal versions off the main CVS
 ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
-"0.9.3.60"
+"0.9.3.61"