[cl-net-snmp-cvs] r90 - in vendor/cl-http: client clim/ui lw lw/server mcl/server server
ctian at common-lisp.net
ctian at common-lisp.net
Sat Oct 20 08:33:07 UTC 2007
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)))))))
More information about the Cl-net-snmp-cvs
mailing list