Author: ctian Date: Sat Oct 20 04:33:06 2007 New Revision: 90

Modified: vendor/cl-http/client/connection.lisp vendor/cl-http/clim/ui/http-ui.lisp vendor/cl-http/lw/server/time-and-author.lisp vendor/cl-http/lw/start.lisp vendor/cl-http/mcl/server/www-utils.lisp vendor/cl-http/server/data-cache.lisp vendor/cl-http/server/headers.lisp vendor/cl-http/server/server.lisp vendor/cl-http/server/url.lisp Log: Fix for LispWorks 5 64-bit

Modified: vendor/cl-http/client/connection.lisp ============================================================================== --- vendor/cl-http/client/connection.lisp (original) +++ vendor/cl-http/client/connection.lisp Sat Oct 20 04:33:06 2007 @@ -447,7 +447,7 @@ (cond ((zerop (connection-free-since connection)) (let* ((time (get-universal-time)) (close (+ time (the integer (or (connection-timeout connection) *client-persistent-connection-timeout*))))) - (declare (bignum time)) + (declare (#-lispworks-64bit bignum #+lispworks-64bit fixnum time)) ;; reset instance variables (setf (connection-free-since connection) time (connection-close-time connection) close))

Modified: vendor/cl-http/clim/ui/http-ui.lisp ============================================================================== --- vendor/cl-http/clim/ui/http-ui.lisp (original) +++ vendor/cl-http/clim/ui/http-ui.lisp Sat Oct 20 04:33:06 2007 @@ -119,8 +119,8 @@ (defun http-ui () "Top level function for starting the HTTP-UI user interface" (or (clim:find-application-frame 'http-ui :create nil) - (let ((width #+Genera clim:+fill+ #-Genera 750) - (height #+Genera clim:+fill+ #-Genera 650)) + (let ((width #+Genera clim:+fill+ #-(or lispworks Genera 750) #+lispworks 1600) + (height #+Genera clim:+fill+ #-(or lispworks Genera 650) #+lispworks 1000)) (clim:run-frame-top-level (clim:make-application-frame 'http-ui :width width :height height)))))

@@ -296,8 +296,8 @@ :default proxy-caching-p))) (if proxy-enabled-p (when (not proxy-is-enabled-p) - (http:enable-proxy-service)) - (http:disable-proxy-service)) + (funcall (symbol-function (find-symbol "ENABLE-PROXY-SERVICE" :package :http)))) + (funcall (symbol-function (find-symbol "DISABLE-PROXY-SERVICE" :package :http)))) (setf http::*debug-proxy* debug-proxy http::*proxy-caching-p* proxy-caching-p))))

Modified: vendor/cl-http/lw/server/time-and-author.lisp ============================================================================== --- vendor/cl-http/lw/server/time-and-author.lisp (original) +++ vendor/cl-http/lw/server/time-and-author.lisp Sat Oct 20 04:33:06 2007 @@ -30,7 +30,7 @@ #+unix (defconstant *time-til-70* 2208988800)

-#+unix +#+(and unix (not lispworks-64bit)) (defun set-file-dates (file &key creation modification access) (declare (ignore creation)) ; makes no sense on UNIX (let* ((pathname (truename file)) @@ -49,6 +49,12 @@ (unless (zerop (c-utime filename buffer)) (report-unix-error 'set-file-dates (lw:errno-value) pathname)))))

+#+(and unix lispworks-64bit) +(defun set-file-dates (file &key creation modification access) + (declare (ignore creation)) ; makes no sense on UNIX + ;; binghe: do nothing until c exception is fixed + t) + #+unix (defun report-unix-error (function errno pathname) (error "Failed to ~A file ~A: ~A(~A)."

Modified: vendor/cl-http/lw/start.lisp ============================================================================== --- vendor/cl-http/lw/start.lisp (original) +++ vendor/cl-http/lw/start.lisp Sat Oct 20 04:33:06 2007 @@ -11,6 +11,9 @@

(in-package "CL-USER")

+#+lispworks-64bit +(require "clim") + ;;; lispm major.minor LispWorks major.minor (setq *cl-http-server-version* '(70 190 1 9 2))

Modified: vendor/cl-http/mcl/server/www-utils.lisp ============================================================================== --- vendor/cl-http/mcl/server/www-utils.lisp (original) +++ vendor/cl-http/mcl/server/www-utils.lisp Sat Oct 20 04:33:06 2007 @@ -158,7 +158,7 @@ (define next-3am-universal-time (&optional (offset 0) (reference-time (get-universal-time))) "Returns the universal time for the next 3am in the local timezone relative to REFERENCE-TIME. OFFSET is a positive or negative number of seconds relative to 3am." - (declare (fixnum offset) (bignum reference-time)) + (declare (fixnum offset) (#-lispworks-64bit bignum #+lispworks-64bit fixnum reference-time)) (multiple-value-bind (seconds minutes hours date month year day-of-the-week) (decode-universal-time reference-time) (declare (fixnum seconds minutes hours) @@ -169,7 +169,8 @@ #.(* 60. 60. 24.) ;plus 24 hours 0) offset ;offset - (the bignum (encode-universal-time 0 0 3. date month year (time-zone)))))) + (the #-lispworks-64bit bignum + #+lispworks-64bit fixnum (encode-universal-time 0 0 3. date month year (time-zone))))))

;;;-------------------------------------------------------------------- ;;;

Modified: vendor/cl-http/server/data-cache.lisp ============================================================================== --- vendor/cl-http/server/data-cache.lisp (original) +++ vendor/cl-http/server/data-cache.lisp Sat Oct 20 04:33:06 2007 @@ -1062,7 +1062,8 @@ (next-revalidation (recache-data-universe-as-necessary data-universe cache-time)) (finish-time (get-universal-time)) (wait-seconds (- next-revalidation finish-time))) - (declare (bignum start-time finish-time next-revalidation)) + (declare (#-lispworks-64bit bignum #+lispworks-64bit fixnum + start-time finish-time next-revalidation)) #+ignore(notify-log-window "Waiting ~\time-interval\ seconds before Revalidating ~A" wait-seconds (data-universe-name data-universe)) (setq elapsed-time (- finish-time start-time))

Modified: vendor/cl-http/server/headers.lisp ============================================================================== --- vendor/cl-http/server/headers.lisp (original) +++ vendor/cl-http/server/headers.lisp Sat Oct 20 04:33:06 2007 @@ -4044,7 +4044,8 @@ (integer cache-time) (cons (apply #'min cache-time))))) (declare (fixnum margin) - (bignum last-modification cache-time cache-universal-time)) + (#-lispworks-64bit bignum #+lispworks-64bit fixnum + last-modification cache-time cache-universal-time)) (< (- last-modification margin) (+ cache-universal-time margin)))))

(declaim (inline if-modified-since-p))

Modified: vendor/cl-http/server/server.lisp ============================================================================== --- vendor/cl-http/server/server.lisp (original) +++ vendor/cl-http/server/server.lisp Sat Oct 20 04:33:06 2007 @@ -4260,7 +4260,12 @@ (unless (and directory-string (eql cached-last-modification current-modification) (or (not (numberp use-cache)) - (< (- (the bignum (server-request-time *server*)) (the bignum cache-time)) + ;; LispWorks 5 Point (bignum -> fixnum) + (< (- (the #-lispworks-64bit bignum + #+lispworks-64bit fixnum + (server-request-time *server*)) + (the #-lispworks-64bit bignum + #+lispworks-64bit fixnum cache-time)) use-cache))) #+ignore(fast-format *standard-output* "~&[~I] Caching Directory: ~A" (http::write-standard-time (get-universal-time) stream) ,url)

Modified: vendor/cl-http/server/url.lisp ============================================================================== --- vendor/cl-http/server/url.lisp (original) +++ vendor/cl-http/server/url.lisp Sat Oct 20 04:33:06 2007 @@ -4013,7 +4013,8 @@ (with-slots (expiration-function) expiration-mixin (setf expiration-function #'(lambda (url) (declare (ignore url)) - (the bignum (+ *one-year-interval* (get-universal-time))))))) + (the #-lispworks-64bit bignum + #+lispworks-64bit fixnum (+ *one-year-interval* (get-universal-time)))))))

(defmethod set-expiration-function ((expiration-mixin expiration-mixin) (type (eql :time)) &rest arguments) (with-slots (expiration-function) expiration-mixin @@ -4029,7 +4030,8 @@ (check-type argument integer) (setf expiration-function #'(lambda (url) (declare (ignore url)) - (the bignum (+ (get-universal-time) argument))))))) + (the #-lispworks-64bit bignum + #+lispworks-64bit fixnum (+ (get-universal-time) argument)))))))

(defmethod set-expiration-function ((expiration-mixin expiration-mixin) (type (eql :function)) &rest arguments ) (with-slots (expiration-function) expiration-mixin @@ -4068,7 +4070,8 @@ (check-type argument integer) (setf max-age-function #'(lambda (url) (declare (ignore url)) - (- (the bignum (get-universal-time)) + (- (the #-lispworks-64bit bignum + #+lispworks-64bit fixnum (get-universal-time)) (the integer argument)))))))

(defmethod set-max-age-function ((expiration-mixin expiration-mixin) (type (eql :interval)) &rest arguments) @@ -4081,7 +4084,8 @@ (declare (ignore arguments)) (with-slots (max-age-function) expiration-mixin (setf max-age-function #'(lambda (url) - (- (the bignum (get-universal-time)) + (- (the #-lispworks-64bit bignum + #+lispworks-64bit fixnum (get-universal-time)) (the integer (expiration-universal-time url)))))))